;;;; Let+ macro building
;;;; Compyright 2008 Peter Goodman, all rights reserved.

(defun fix-func-refs (lst name)
    "Recursively fix function calls and references to the symbol assigned to a 
     lambda within lst."
    (if (not (null lst))
        (let ((a (car lst)))
          (setf a (if (listp a) 
	                  ;; a reference to the function
                      (if (equal a `#',name)
                          name ; remove sharp-quote
                          ;; a function call, add funcall and update function
                          ;; function arguments
                          (if (eql (car a) name)
                              (append `(funcall ,name ,name)
                                       (fix-func-refs (cdr a) name))
                                 
                              (fix-func-refs a name)))
                      a))
          (cons a (fix-func-refs (cdr lst) name)))))

(defmacro make-lambda-freindly-let (name let-type)
  "Allow for lambdas defined within a let block to be used as if they were 
   existing functions."
  `(defmacro ,name  (let-defs &rest let-body)
     ;; parse the let and fix lambda args and the let body function calls
     (let ((new-let-defs nil) 
           (name nil)
           (value nil))
          
       (dolist (elm let-defs)
         (setf name  (first elm)
               value (second elm))
                  
         ;; does the value look like a quoted function?
         (if (eq (first value) 'function)
	         ;; update the let-body, arg list, and function body, respectively
             (progn (setf let-body       (fix-func-refs let-body name)
                          (cadadr value) (cons name (cadadr value))
                          (cddadr value) (fix-func-refs (cddadr value) name))))
                  
             ;; add this var definition into our new let block
             (push (list name value) new-let-defs))
       (append (list ',let-type new-let-defs) let-body))))

;; make our two lambda-friendly lets
(make-lambda-freindly-let let+ let)
(make-lambda-freindly-let let*+ let*)

;; demoing it with factorial, fibonacci, and identity function definitions
(let+ ((var 'val)
       (factorial #'(lambda (x &optional (acc 1)) (if (eql x 1) acc (factorial (- x 1) (* x acc)))))
       (another-var 'val)
       (fibonacci #'(lambda (x) (cond ((eql x 0) 1) ((eql x 1) 1) ((+ (fibonacci (- x 1)) (fibonacci (- x 2)))))))
       (e #'(lambda (x) x)))
  (print (factorial (e 5)))
  (print (fibonacci 5))
  (print (e #'e)))