Dynamic functions

dynamic-functions.lisp

(defun make-dfun-varname (fname)
  (intern (format nil "*DFUN-~A*" fname)))

(defmacro dflet (fbindings &body body)
  `(let
       ,(loop for fbinding in fbindings
           collect
             (destructuring-bind (fname args &body body) fbinding
               (let ((dfun-varname (make-dfun-varname fname)))
                 `(,dfun-varname (cons (lambda ,args
                                         ,@body)
                                       ,dfun-varname)))))
     ,@body))

(defmacro defdfun (name args &body body)
  (let ((dfun-varname (make-dfun-varname name)))
    `(progn
       (defvar ,dfun-varname
         (list (lambda ,args
                 ,@body)))
       (setf (symbol-function ',name)
             (lambda ,args
               (apply (first ,dfun-varname) (list ,@args)))))))

;; Example

#+example(progn
           (defdfun dfoo ()
             (print "foo1"))

           (dfoo)

           (defun test-dfoo ()
             (dfoo))

           (progn
             (dfoo)
             (dflet ((dfoo ()
                           (print "foo2")))
               (test-dfoo))
             (dfoo)))