*** empty log message ***
[elisp/flim.git] / closure.el
1 (provide 'closure)
2
3 ;; closure is one of following forms.
4 ;;  FUNCTION
5 ;;  (WRAPPER FUNCTION FV1 . FVS)
6 ;;  (PARTIAL-ARGS CLOSURE)
7
8 (defmacro closure-make (fun &rest fvs)
9   "Make a closure from a function FUN and free variables FVS.
10 CAUTION: Do not assign to free variables."
11   (if (null fvs)
12       fun
13     (let* ((funv (make-symbol "funv"))
14            (args (make-symbol "args")))
15       `(list
16         (lambda (,funv ,args ,@fvs)
17           (apply ,funv ,args))
18         ,fun
19         ,@fvs))))
20
21 (defmacro closure-partial-call (clo &rest args)
22   "Call partially."
23   `(list (list ,@args) ,clo))
24
25 (defun closure-call (clo &rest args)
26   "Call closure."
27   (while
28       (and
29        (not (functionp clo))
30        (if (cddr clo)
31            (progn
32              (setq args (cons (cadr clo) (cons args (cddr clo)))
33                    clo (car clo))
34              nil)
35          t))
36     (setq args (append (car clo) args)
37           clo (cadr clo)))
38   (apply clo args))
39
40 (defun closure-compose (c1 c2)
41   "Compose C1 and C2.
42
43 If either C1 or C2 is nil, another one is returned.
44 If C1 and C2 is non-nil, C1 must be closure with one argument."
45   (cond
46    ((null c1) c2)
47    ((null c2) c1)
48    (t
49     (closure-make
50      (lambda (&rest args)
51        (closure-call c1 (apply 'closure-call c2 args)))
52      c1 c2))))
53
54 '(
55
56 (setq c1 (let ((a 1)) (closure-make (lambda (b) (+ a b)) a)))
57 (closure-call c1 2) ; => 3
58
59 (let ((a 1)) (setq plus1 (closure-make (lambda (b) (+ a b)) a)))
60 (let ((a 2)) (setq plus2 (closure-make (lambda (b) (+ a b)) a)))
61 (setq plus3 (closure-compose plus1 plus2))
62 (closure-call plus3 4) ; => 7
63
64 (closure-call (closure-partial-call (closure-partial-call '+ 1 2 3) 4 5 6) 7 8 9) ;=> 45
65
66 )