3 ms·
No problem! Here you go! (defmacro defun-curried (name param-list &body body) (dolist (p param-list) (when (member p '(&optional &key &rest)) (er
by ScottBurson 10y ago
No problem! Here you go!
(defmacro defun-curried (name param-list &body body)
(dolist (p param-list)
(when (member p '(&optional &key &rest))
(error "DEFUN-CURRIED does not yet handle &OPTIONAL, &KEY, or &REST")))
(let ((new-params (mapcar (lambda (p) (list p nil (gensym)))
param-list))
(prelude nil))
(when (stringp (car body))
(setq prelude (list (pop body))))
(do () ((not (and (listp (car body)) (eq (caar body) 'declare))))
(push (pop body) prelude))
`(defun ,name ,(cons '&optional new-params)
,@(reverse prelude)
(cond ,@(reverse
(maplist (lambda (nps)
(let ((ra (gensym)))
`((not ,(third (car nps)))
(lambda (&rest ,ra)
(apply #',name ,@(mapcar #'first (reverse (cdr nps)))
,ra)))))
(reverse new-params)))
(t . ,body)))))
Handling &OPTIONAL, &KEY, and &REST in the original parameter list is left as an exercise for the reader :-)
Examples:
> (defun-curried foo (x y z) (+ x y z))
FOO
> (funcall (foo 1 2) 3)
6
> (funcall (funcall (foo 1) 2) 3)
6
Okay, I will admit, the 'funcall' thing is annoying.
In case anyone is wondering how this works, here's the expansion of FOO:
> (macroexpand-1 '(defun-curried foo (x y z) (+ x y z)))
(DEFUN FOO (&OPTIONAL (X () #:G839) (Y () #:G840) (Z () #:G841))
(COND ((NOT #:G839) (LAMBDA (&REST #:G844) (APPLY #'FOO #:G844)))
((NOT #:G840) (LAMBDA (&REST #:G843) (APPLY #'FOO X #:G843)))
((NOT #:G841) (LAMBDA (&REST #:G842) (APPLY #'FOO X Y #:G842)))
(T (+ X Y Z))))