named-let

nlet.el

(defmacro nlet (name varlist &rest body)
  "Named-LET for elisp. Create function dynamic bind as NAME.
DO NOT use primitive name of elisp function as NAME.

Example:
\(nlet next ((a 0)
          (res '()))
  (if (< a 3)
      (next (1+ a) (cons (* a 2) res))
    (nreverse res)))
"
  (declare (indent 2))
  (let ((origp (make-symbol "origp"))
        (orig (make-symbol "orig"))
        (loop-args (make-symbol "loop-args"))
        (lambda-args (make-symbol "lambda-args"))
        (result (make-symbol "result"))
        (instance (indirect-function name t)))
    (when (eq (car-safe instance) 'macro)
      ;;TODO FIXME:
      ;; macro will be expanded when evaluate the BODY
      (error "Unable bind `%s' because this is a macro" name))
    `(let* ((,origp (fboundp ',name))
            (,orig (and ,origp (symbol-function ',name))))
       (fset ',name (lambda (&rest ,lambda-args)
                      (unless (= (length ',varlist) (length ,lambda-args))
                        (signal 'wrong-number-of-arguments
                                (list
                                 (list 'lambda (mapcar 'car ',varlist))
                                 (length ,lambda-args))))
                      (let ((vs ',varlist)
                            (la ,lambda-args))
                        (while (and vs la)
                          (set (caar vs) (car la))
                          (setq vs (cdr vs)
                                la (cdr la))))
                      (throw 'next t)))
       (unwind-protect
           (catch 'done
             (let ,varlist
               (while t
                 (catch 'next
                   (setq ,result (progn ,@body))
                   (throw 'done ,result)))))
         (if ,origp
             (fset ',name ,orig)
           (fmakunbound ',name))))))