(in-package :com.sandersn.util)
; all this stolen from On Lisp chapter 15 and 17.
; and then NEVER tested. fool!
#|(defun rbuild (e)
  (cond
    ((or (atom e) (eq (car e) 'lambda)) e)
    ((eq (car e) 'compose) (build-compose (cdr e)))
    (t (build-call (car e) (cdr e)))))
(defun build-call (op fns)
  (let ((g (gensym)))
    `(lambda (,g)
       (,op ,@(mapcar #'(lambda (f)
                          `(,(rbuild f) ,g))
                      fns)))))
(defun build-compose (fns)
  (let ((g (gensym)))
    `(lambda (,g)
       ,(labels ((rec (fns)
                      (if fns
                          `(,(rbuild (car fns))
                             ,(rec (cdr fns)))
                          g)))
         (rec fns)))))
(defmacro fn (e) `#',(rbuild e)) ; WARNING: this may not work
|#
(defmacro defdelim (left right parms &body body)
  `(ddfn ,left ,right #'(lambda ,parms ,@body)))
(let ((rpar (get-macro-character #\) )))
  (defun ddfn (left right fn)
    (set-macro-character right rpar)
    (set-dispatch-macro-character #\# left
      #'(lambda (stream char1 char2)
          (declare (ignore char1 char2))
          (apply fn (read-delimited-list right stream t))))))
(defdelim #\[ #\] (&rest body)
  `#'(lambda (_) ,body))
(defdelim #\{ #\} (&rest args)
  `(compose ,@args))
(defun compose (&rest fns)
  (let ((fns (reverse fns)))
    #'(lambda (&rest args)
        (with (init (apply (first fns) args)
               fns (rest fns))
          (reduce #'(lambda (result fn) (funcall fn result)) fns :initial-value init)))))
(defun flip (f)
  #'(lambda (&rest args)
      (apply f (reverse args))))
(defun cure (f &rest args)
  #'(lambda (&rest moreargs) (apply f (append args moreargs))))
(defmacro cur (fn &rest args) ; I'm not sure this is any more
  (let ((g-args (gensym)))     ; efficient than cure except that it appends
    `(function (lambda (&rest ,g-args) (apply ,fn ,@args ,g-args)))))
                               ; at compile-time instead of run-time.
(defun uncurry (f)
  #'(lambda (l) (apply f l)))