fix bug in CURRY compiler-macro

  Multiple evaluation of the function argument, oops.

diff --git a/functions.lisp b/functions.lisp
index 15032be..f703a99 100644 (file)
--- a/functions.lisp
+++ b/functions.lisp
@@ -1,6 +1,8 @@
 (in-package :alexandria)
 
-(declaim (inline ensure-function))     ; to propagate return type.
+;;; To propagate return type and allow the compiler to eliminate the IF when
+;;; it is known if the argument is function or not.
+(declaim (inline ensure-function))
 
 (declaim (ftype (function (t) (values function &optional))
                 ensure-function))
@@ -120,11 +122,13 @@ it is called with to FUNCTION."
       (multiple-value-call fn (values-list arguments) (values-list more)))))
 
 (define-compiler-macro curry (function &rest arguments)
-  (let ((curries (make-gensym-list (length arguments) "CURRY")))
-    `(let ,(mapcar #'list curries arguments)
+  (let ((curries (make-gensym-list (length arguments) "CURRY"))
+        (fun (gensym "FUN")))
+    `(let ((,fun (ensure-function ,function))
+           ,@(mapcar #'list curries arguments))
        (declare (optimize (speed 3) (safety 1) (debug 1)))
        (lambda (&rest more)
-         (apply ,function ,@curries more)))))
+         (apply ,fun ,@curries more)))))
 
 (defun rcurry (function &rest arguments)
   "Returns a function that applies the arguments it is called

diff --git a/tests.lisp b/tests.lisp
index a4a8e55..20caf8a 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -508,11 +508,33 @@
         (funcall fun 2)))
   4)
 
+(deftest curry.4
+    (let* ((x 1)
+           (curried (curry (progn
+                             (incf x)
+                             (lambda (y z) (* x y z)))
+                           3)))
+      (list (funcall curried 7)
+            (funcall curried 7)
+            x))
+  (42 42 2))
+
 (deftest rcurry.1
     (let ((r (rcurry '/ 2)))
       (funcall r 8))
   4)
 
+(deftest rcurry.2
+    (let* ((x 1)
+           (curried (rcurry (progn
+                              (incf x)
+                              (lambda (y z) (* x y z)))
+                            3)))
+      (list (funcall curried 7)
+            (funcall curried 7)
+            x))
+  (42 42 2))
+
 (deftest named-lambda.1
     (let ((fac (named-lambda fac (x)
                  (if (> x 1)