From 521931a96ef34dd842806897641b12134b9aea5c Mon Sep 17 00:00:00 2001 From: ueno Date: Mon, 14 Aug 2000 21:59:10 +0000 Subject: [PATCH] Add prefix. --- net-trans.el | 61 +++++++++++++++++++++++++++++----------------------------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/net-trans.el b/net-trans.el index 57b3203..8e8fefc 100644 --- a/net-trans.el +++ b/net-trans.el @@ -1,4 +1,4 @@ -;;; net-trans.el --- basic transaction framework for internet protocols. +;;; net-trans.el --- basic transaction framework for internet protocols ;; Copyright (C) 2000 Daiki Ueno @@ -33,73 +33,74 @@ (eval-when-compile (require 'cl)) (eval-and-compile - (luna-define-class transaction ()) + (luna-define-class net-transaction ()) - (luna-define-internal-accessors 'transaction)) + (luna-define-internal-accessors 'net-transaction)) -(luna-define-generic transaction-error-name (trans) +(luna-define-generic net-transaction-error-name (trans) "Return error symbol of the TRANSACTION.") -(luna-define-generic transaction-error (trans error) +(luna-define-generic net-transaction-error (trans error) "Throw an ERROR of the TRANSACTION.") -(luna-define-method transaction-error-name ((trans transaction)) +(luna-define-method net-transaction-error-name ((trans net-transaction)) (intern (format "%s-error" (luna-class-name trans)))) -(luna-define-method transaction-error ((trans transaction) error) - (throw (transaction-error-name trans) error)) +(luna-define-method net-transaction-error ((trans net-transaction) error) + (throw (net-transaction-error-name trans) error)) -(defvar transaction-combinator-alist - '((&& transaction-compose-&&) - (|| transaction-compose-||))) +(defvar net-transaction-combinator-alist + '((&& net-transaction-compose-&&) + (|| net-transaction-compose-||))) -(defun transaction-compose-&& (left right) +(defun net-transaction-compose-&& (left right) "Multiplicative operator of current transaction LEFT and RIGHT." - `(lambda (transaction) - (let ((next (funcall #',left transaction))) + `(lambda (trans) + (let ((next (funcall #',left trans))) (funcall #',right next)))) -(defun transaction-compose-|| (left right) +(defun net-transaction-compose-|| (left right) "Additive operator of current transaction LEFT and RIGHT." - `(lambda (transaction) + `(lambda (trans) (let (next error) (setq error - (catch (transaction-error-name transaction) - (setq next (funcall #',left transaction)) + (catch (net-transaction-error-name trans) + (setq next (funcall #',left trans)) nil)) (if error - (funcall #',right transaction) + (funcall #',right trans) next)))) -(defun transaction-compose-fold-left (function accu sequence) +(defun net-transaction-compose-fold-left (function accu sequence) + "Apply FUNCTION to ACCU while folding SEQUENCE left to right." (if (null sequence) accu - (transaction-compose-fold-left + (net-transaction-compose-fold-left function (funcall function accu (car sequence)) (cdr sequence)))) -(defun transaction-compose-commands (commands) - "Compose COMMANDS." +(defun net-transaction-compose-commands (commands) + "Compose transaction-function from COMMANDS." (let ((combinator - (assq (pop commands) transaction-combinator-alist)) + (assq (pop commands) net-transaction-combinator-alist)) (accu (if (listp (car commands)) - (transaction-compose-commands (pop commands)) + (net-transaction-compose-commands (pop commands)) (pop commands)))) (if (null combinator) (error "Unknown operator") (setq accu - (transaction-compose-fold-left + (net-transaction-compose-fold-left `(lambda (accu c) (funcall #',(nth 1 combinator) accu (if (listp c) - (transaction-compose-commands c) + (net-transaction-compose-commands c) c))) accu commands)) - (if (byte-code-function-p accu) - accu - (byte-compile accu))))) + (if (and (listp accu) (eq (car accu) 'lambda)) + (byte-compile accu) + accu)))) (provide 'net-trans) -- 1.7.10.4