1 ;;; net-trans.el --- basic transaction framework for internet protocols.
3 ;; Copyright (C) 2000 Daiki Ueno
5 ;; Author: Daiki Ueno <ueno@unixuser.org>
8 ;; This file is part of FLIM (Faithful Library about Internet Message).
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
33 (eval-when-compile (require 'cl))
36 (luna-define-class transaction ())
38 (luna-define-internal-accessors 'transaction))
40 (luna-define-generic transaction-error-name (trans)
41 "Return error symbol of the TRANSACTION.")
43 (luna-define-method transaction-error-name ((trans transaction))
44 (intern (format "%s-error" (luna-class-name trans))))
46 (defvar transaction-combinator-alist
47 '((&& transaction-compose-&&)
48 (|| transaction-compose-||)))
50 (defun transaction-compose-&& (left right)
51 "Multiplicative operator of current transaction LEFT and RIGHT."
52 `(lambda (transaction)
53 (let ((next (funcall #',left transaction)))
54 (funcall #',right next))))
56 (defun transaction-compose-|| (left right)
57 "Additive operator of current transaction LEFT and RIGHT."
58 `(lambda (transaction)
61 (catch (transaction-error-name transaction)
62 (setq next (funcall #',left transaction))
65 (funcall #',right transaction)
68 (defun transaction-compose-fold-left (function accu sequence)
71 (transaction-compose-fold-left
72 function (funcall function accu (car sequence))
75 (defun transaction-compose-commands (commands)
78 (assq (pop commands) transaction-combinator-alist))
80 (if (listp (car commands))
81 (transaction-compose-commands (pop commands))
84 (error "Unknown operator")
86 (transaction-compose-fold-left
89 #',(nth 1 combinator) accu
91 (transaction-compose-commands c)
94 (if (byte-code-function-p accu)
96 (byte-compile accu)))))
100 ;;; net-trans.el ends here