(provide 'closure)
+;; closure is one of following forms.
+;; FUNCTION
+;; (WRAPPER FUNCTION FV1 . FVS)
+;; (PARTIAL-ARGS CLOSURE)
+
(defmacro closure-make (fun &rest fvs)
- "Make closure from function FUN and free variable list FVS.
+ "Make a closure from a function FUN and free variables FVS.
CAUTION: Do not assign to free variables."
- (let* ((funv (make-symbol "funv"))
- (args (make-symbol "args")))
- `(list
- ,fun
- (lambda (,funv ,args ,@fvs)
- (apply ,funv ,args))
- ,@fvs)))
+ (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."
- (if (functionp clo)
- (apply clo args)
- (apply (cadr clo) (car clo) args (cddr clo))))
+ (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.
(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