currying.lisp

(require 'sb-introspect)

(defun curry-helper (paramlist args function-name)
  (if (= (length paramlist) (length args))
      (apply function-name args)
      (lambda (&rest more-args)
        (let ((args (append args more-args)))
          (assert (>= (length paramlist) (length args)))
          (curry-helper paramlist args function-name)))))

(defmacro defcurry (curried-function-name function-name)
  (let ((paramlist (progn
                     #+sbcl(sb-introspect:function-lambda-list function-name)
                     #-sbcl (error "SBCL is required"))))
    (unless (notany #'(lambda (param) (position #\& (string param))) paramlist)
      (error "Can not have &optional, &key, &rest, etc in the curried function"))
    `(defun ,curried-function-name (&rest args)
       (unless (>= (length '(,@paramlist)) (length args))
         (error "Argument list too long"))
       (curry-helper '(,@paramlist) args (function ,function-name)))))


;; CL-USER> (defun foo (a b c) (+ a b c))
;; FOO
;; CL-USER> (defcurry bar foo)
;; BAR
;; CL-USER> (type-of #'bar)
;; FUNCTION
;; CL-USER> (bar 1)
;; #<CLOSURE (LAMBDA (&REST MORE-ARGS) :IN CURRY-HELPER) {1005E16FFB}>
;; CL-USER> (bar 1 2)
;; #<CLOSURE (LAMBDA (&REST MORE-ARGS) :IN CURRY-HELPER) {1005E30C8B}>
;; CL-USER> (bar 1 2 3)
;; 6
;; CL-USER> (funcall (bar 1 2) 10)
;; 13
;; CL-USER>