From 79ed4635a008fe194d81434dcb8ce5183cad91b4 Mon Sep 17 00:00:00 2001 From: ueno Date: Mon, 6 Nov 2000 08:07:04 +0000 Subject: [PATCH] * Makefile (PACKAGE): Modify for Deisui. (RELEASE): Likewise. * Delete closure.el and tram.el. --- Makefile | 4 +- closure.el | 66 -------------------------------- tram.el | 122 ------------------------------------------------------------ 3 files changed, 2 insertions(+), 190 deletions(-) delete mode 100644 closure.el delete mode 100644 tram.el diff --git a/Makefile b/Makefile index 2bd0536..98c32ba 100644 --- a/Makefile +++ b/Makefile @@ -2,9 +2,9 @@ # Makefile for FLIM. # -PACKAGE = flim-chao +PACKAGE = deisui API = 1.14 -RELEASE = 1 +RELEASE = 0 TAR = tar RM = /bin/rm -f diff --git a/closure.el b/closure.el deleted file mode 100644 index 8220628..0000000 --- a/closure.el +++ /dev/null @@ -1,66 +0,0 @@ -(provide 'closure) - -;; closure is one of following forms. -;; FUNCTION -;; (WRAPPER FUNCTION FV1 . FVS) -;; (PARTIAL-ARGS CLOSURE) - -(defmacro closure-make (fun &rest fvs) - "Make a closure from a function FUN and free variables FVS. -CAUTION: Do not assign to free variables." - (if (null fvs) - fun - (let* ((funv (make-symbol "funv")) - (args (make-symbol "args"))) - `(list - (lambda (,funv ,args ,@fvs) - (apply ,funv ,args)) - ,fun - ,@fvs)))) - -(defmacro closure-partial-call (clo &rest args) - "Call partially." - `(list (list ,@args) ,clo)) - -(defun closure-call (clo &rest args) - "Call closure." - (while - (and - (not (functionp clo)) - (if (cddr clo) - (progn - (setq args (cons (cadr clo) (cons args (cddr clo))) - clo (car clo)) - nil) - t)) - (setq args (append (car clo) args) - clo (cadr clo))) - (apply clo args)) - -(defun closure-compose (c1 c2) - "Compose C1 and C2. - -If either C1 or C2 is nil, another one is returned. -If C1 and C2 is non-nil, C1 must be closure with one argument." - (cond - ((null c1) c2) - ((null c2) c1) - (t - (closure-make - (lambda (&rest args) - (closure-call c1 (apply 'closure-call c2 args))) - c1 c2)))) - -'( - -(setq c1 (let ((a 1)) (closure-make (lambda (b) (+ a b)) a))) -(closure-call c1 2) ; => 3 - -(let ((a 1)) (setq plus1 (closure-make (lambda (b) (+ a b)) a))) -(let ((a 2)) (setq plus2 (closure-make (lambda (b) (+ a b)) a))) -(setq plus3 (closure-compose plus1 plus2)) -(closure-call plus3 4) ; => 7 - -(closure-call (closure-partial-call (closure-partial-call '+ 1 2 3) 4 5 6) 7 8 9) ;=> 45 - -) \ No newline at end of file diff --git a/tram.el b/tram.el deleted file mode 100644 index 18c930b..0000000 --- a/tram.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; tram.el --- basic session framework for internet protocols - -;; Copyright (C) 2000 Daiki Ueno - -;; Author: Daiki Ueno -;; Created: 2000/08/14 - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - - -;;; Commentary: -;; - -;;; Code: - -(require 'luna) -(require 'closure) - -(eval-when-compile (require 'cl)) - -(eval-and-compile - (luna-define-class tram-stream ()) - - (luna-define-internal-accessors 'tram-stream)) - -(luna-define-generic tram-stream-error-name (stream) - "Return error symbol of the STREAM.") - -(luna-define-generic tram-stream-error (stream error) - "Throw an ERROR of the STREAM.") - -(luna-define-method tram-stream-error-name ((stream tram-stream)) - (intern (format "%s-error" (luna-class-name stream)))) - -(luna-define-method tram-stream-error ((stream tram-stream) error) - (throw (tram-stream-error-name stream) error)) - -(put '&& 'tram-compose-function #'tram-compose-&&) -(put '|| 'tram-compose-function #'tram-compose-||) - -(defun tram-compose-&& (left right) - "Multiplicative combinator which composes LEFT and RIGHT operations." - `(lambda (stream) - (let ((next - ,(if (functionp left) - `(closure-call #',left stream) - `(closure-call ',left stream)))) - ,(if (functionp right) - `(closure-call #',right next) - `(closure-call ',right next))))) - -(defun tram-compose-|| (left right) - "Additive combinator which composes LEFT and RIGHT operations." - `(lambda (stream) - (let (next error) - (setq error - (catch (tram-stream-error-name stream) - (setq next - ,(if (functionp left) - `(closure-call #',left stream) - `(closure-call ',left stream))) - nil)) - (if error - ,(if (functionp right) - `(closure-call #',right next) - `(closure-call ',right next)) - next)))) - -(defun tram-fold-left (function accu sequence) - "Apply FUNCTION to ACCU while folding SEQUENCE from left to right." - (if (null sequence) - accu - (tram-fold-left - function (funcall function accu (car sequence)) - (cdr sequence)))) - -;;;###autoload -(defmacro tram-define-transaction (name tram-transaction &optional doc) - "Set NAME the compiled code of TRAM-TRANSACTION." - `(let ((transaction - ,(tram-compose-transaction (eval tram-transaction)))) - (defconst ,name transaction ,doc))) - -;;;###autoload -(defun tram-compose-transaction (tram-transaction) - "Compose transaction-function from TRAM-TRANSACTION." - (if (not (symbolp (car tram-transaction))) - tram-transaction - (let ((combinator - (get (pop tram-transaction) 'tram-compose-function))) - (or combinator - (error "Unknown operator")) - (tram-fold-left - `(lambda (accu c) - (funcall - #',combinator accu - (if (listp c) - (tram-compose-transaction c) - c))) - (if (listp (car tram-transaction)) - (tram-compose-transaction (pop tram-transaction)) - (pop tram-transaction)) - tram-transaction)))) - -(provide 'tram) - -;;; tram.el ends here -- 1.7.10.4