Commit 6fb9452b authored by James M. Lawrence's avatar James M. Lawrence Committed by Nikodemus Siivola

fix bug in CURRY compiler-macro

  Multiple evaluation of the function argument, oops.
parent 268b6da4
(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
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment