Failing test:
========== diff --git a/tests.lisp b/tests.lisp index a4a8e55..8aa6730 100644 --- a/tests.lisp +++ b/tests.lisp @@ -508,6 +508,16 @@ (funcall fun 2))) 4)
+(deftest curry.4 + (let ((curried (let ((x 1)) + (curry (progn + (incf x) + (lambda (y z) (* x y z))) + 3)))) + (list (funcall curried 7) + (funcall curried 7))) + (42 42)) + (deftest rcurry.1 (let ((r (rcurry '/ 2))) (funcall r 8)) ==========
Simplest fix:
========== diff --git a/functions.lisp b/functions.lisp index 15032be..a2eb1d5 100644 --- a/functions.lisp +++ b/functions.lisp @@ -121,10 +121,12 @@ it is called with to FUNCTION."
(define-compiler-macro curry (function &rest arguments) (let ((curries (make-gensym-list (length arguments) "CURRY"))) - `(let ,(mapcar #'list curries arguments) - (declare (optimize (speed 3) (safety 1) (debug 1))) - (lambda (&rest more) - (apply ,function ,@curries more))))) + (with-gensyms (fn) + `(let ((,fn (ensure-function ,function)) + ,@(mapcar #'list curries arguments)) + (declare (optimize (speed 3) (safety 1) (debug 1))) + (lambda (&rest more) + (apply ,fn ,@curries more))))))
(defun rcurry (function &rest arguments) "Returns a function that applies the arguments it is called ==========
Alternate fix:
Since CURRY has some optimizations, we could follow suit by avoiding an unnecessary binding. I think a function designator which looks like (function ...) or (quote ...) needs no binding, and that those are the only binding-free possibilities. I have not proved this, however.
========== diff --git a/functions.lisp b/functions.lisp index 15032be..5096456 100644 --- a/functions.lisp +++ b/functions.lisp @@ -119,13 +119,21 @@ it is called with to FUNCTION." ;; Using M-V-C we don't need to append the arguments. (multiple-value-call fn (values-list arguments) (values-list more)))))
-(define-compiler-macro curry (function &rest arguments) +(defmacro curry-helper (function &rest arguments) (let ((curries (make-gensym-list (length arguments) "CURRY"))) `(let ,(mapcar #'list curries arguments) (declare (optimize (speed 3) (safety 1) (debug 1))) (lambda (&rest more) (apply ,function ,@curries more)))))
+(define-compiler-macro curry (function &rest arguments) + (if (and (consp function) + (member (first function) '(function quote))) + `(curry-helper ,function ,@arguments) + (with-gensyms (fn) + `(let ((,fn (ensure-function ,function))) + (curry-helper ,fn ,@arguments))))) + (defun rcurry (function &rest arguments) "Returns a function that applies the arguments it is called with and ARGUMENTS to FUNCTION." ==========