curry

gistfile1.lisp

(defun expand-params (params body &optional wrapper)
  (if (= 1 (length params))
      (if wrapper
          `(,wrapper (lambda (,(car params)) ,@body))
          `(lambda (,(car params)) ,@body))
      (if wrapper
          `(,wrapper (lambda (,(car params)) ,(expand-params (cdr params) body wrapper)))
          `(lambda (,(car params)) ,(expand-params (cdr params) body wrapper)))))

(defmacro defcurry (name (&rest params) &body body)
  `(defvar ,name ,(expand-params params body)))

(defun memoize (f)
  (let ((cache (make-hash-table :test 'equal)))
    (lambda (arg)
      (let ((v (gethash arg cache nil)))
        (if v
            v
            (let ((v (funcall f arg)))
              (setf (gethash arg cache) v)))))))

(defmacro defmemo (name (&rest params) &body body)
  `(defvar ,name ,(expand-params params body 'memoize)))

;; CL-USER> (defcurry test-fun (a b c) (+ a b c))
;; TEST-FUN
;; CL-USER> test-fun
;; #<FUNCTION (LAMBDA (A)) {100420BD4B}>
;; CL-USER> (funcall test-fun 1)
;; #<CLOSURE (LAMBDA (B)) {10042CCC0B}>
;; CL-USER> (funcall (funcall test-fun 1) 2)
;; #<CLOSURE (LAMBDA (C)) {10043EA01B}>
;; CL-USER> (funcall (funcall (funcall test-fun 1) 2) 3)
;; 6

;; CL-USER> (defmemo mem4 (a b)
;;            (write-line "memoized fun")
;;            (+ a b))
;; MEM4
;; CL-USER> (funcall mem4 1)
;; #<CLOSURE (LAMBDA (ARG) :IN MEMOIZE) {10041BE32B}>
;; CL-USER> (funcall (funcall mem4 1) 2)
;; memoized fun
;; 3
;; CL-USER> (funcall (funcall mem4 1) 2)
;; 3
;; CL-USER> (funcall (funcall mem4 1) 3)
;; memoized fun
;; 4
;; CL-USER> (funcall (funcall mem4 1) 3)
;; 4