Skip to content
Snippets Groups Projects
Commit 16fabb10 authored by Attila Lendvai's avatar Attila Lendvai
Browse files

Make (R)CURRY inline-able, and don't locally alter the debug level.

parent 85f82ed8
No related branches found
No related tags found
No related merge requests found
...@@ -111,10 +111,12 @@ the last." ...@@ -111,10 +111,12 @@ the last."
(declare (dynamic-extent arguments)) (declare (dynamic-extent arguments))
,(compose-1 funs)))))) ,(compose-1 funs))))))
(declaim (inline curry rcurry))
(defun curry (function &rest arguments) (defun curry (function &rest arguments)
"Returns a function that applies ARGUMENTS and the arguments "Returns a function that applies ARGUMENTS and the arguments
it is called with to FUNCTION." it is called with to FUNCTION."
(declare (optimize (speed 3) (safety 1) (debug 1))) (declare (optimize (speed 3) (safety 1)))
(let ((fn (ensure-function function))) (let ((fn (ensure-function function)))
(lambda (&rest more) (lambda (&rest more)
(declare (dynamic-extent more)) (declare (dynamic-extent more))
...@@ -126,19 +128,22 @@ it is called with to FUNCTION." ...@@ -126,19 +128,22 @@ it is called with to FUNCTION."
(fun (gensym "FUN"))) (fun (gensym "FUN")))
`(let ((,fun (ensure-function ,function)) `(let ((,fun (ensure-function ,function))
,@(mapcar #'list curries arguments)) ,@(mapcar #'list curries arguments))
(declare (optimize (speed 3) (safety 1) (debug 1))) (declare (optimize (speed 3) (safety 1)))
(lambda (&rest more) (lambda (&rest more)
(declare (dynamic-extent more))
(apply ,fun ,@curries more))))) (apply ,fun ,@curries more)))))
(defun rcurry (function &rest arguments) (defun rcurry (function &rest arguments)
"Returns a function that applies the arguments it is called "Returns a function that applies the arguments it is called
with and ARGUMENTS to FUNCTION." with and ARGUMENTS to FUNCTION."
(declare (optimize (speed 3) (safety 1) (debug 1))) (declare (optimize (speed 3) (safety 1)))
(let ((fn (ensure-function function))) (let ((fn (ensure-function function)))
(lambda (&rest more) (lambda (&rest more)
(declare (dynamic-extent more)) (declare (dynamic-extent more))
(multiple-value-call fn (values-list more) (values-list arguments))))) (multiple-value-call fn (values-list more) (values-list arguments)))))
(declaim (notinline curry rcurry))
(defmacro named-lambda (name lambda-list &body body) (defmacro named-lambda (name lambda-list &body body)
"Expands into a lambda-expression within whose BODY NAME denotes the "Expands into a lambda-expression within whose BODY NAME denotes the
corresponding function." corresponding function."
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment