[alexandria-devel] A fix for `curry'

[James M. Lawrence]

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 , at 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 , at 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 , at curries more)))))

+(define-compiler-macro curry (function &rest arguments)
+  (if (and (consp function)
+           (member (first function) '(function quote)))
+      `(curry-helper ,function , at arguments)
+      (with-gensyms (fn)
+        `(let ((,fn (ensure-function ,function)))
+           (curry-helper ,fn , at arguments)))))
+
 (defun rcurry (function &rest arguments)
   "Returns a function that applies the arguments it is called
 with and ARGUMENTS to FUNCTION."
==========