Исправление staseg, (текущая версия) :
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (x args) (princ x s))))
(let ((cache (make-hash-table)))
(defmacro make-fun ((&rest args) &rest body)
(let ((name (intern (mkstr (list args body)))))
(or (gethash name cache)
(setf (gethash name cache)
(eval `(compile nil (lambda ,args ,@body))))))))Смысл в том, что лямбда компилируется прямо во время раскрытия макроса. Минус — сломаются замыкания между body и окружением вызова make-fun.
(eq (make-fun (x) 1) (make-fun (x) 1)); eval; => T
(defun xx ()
(eq (make-fun (x) 1) (make-fun (x) 1))); Compile
(xx); => T
(defun xx (x)
(funcall (make-fun (a) (+ a x)) 1)); Suxx.UPD. Анон меня опередил :)
Исправление staseg, :
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (x args) (princ x s))))
(let ((cache (make-hash-table)))
(defmacro make-fun ((&rest args) &rest body)
(let ((name (intern (mkstr (list args body)))))
(or (gethash name cache)
(setf (gethash name cache)
(eval `(compile nil (lambda ,args ,@body))))))))Смысл в том, что лямбда компилируется прямо во время раскрытия макроса. Минус — сломаются замыкания между body и окружением вызова make-fun.
(eq (make-fun (x) 1) (make-fun (x) 1)); eval; => T
(defun xx ()
(eq (make-fun (x) 1) (make-fun (x) 1))); Compile
(xx); => T
(defun xx (x)
(funcall (make-fun (a) (+ a x)) 1)); Suxx.
UPD. Анон меня опередил :)Исходная версия staseg, :
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (x args) (princ x s))))
(let ((cache (make-hash-table)))
(defmacro make-fun ((&rest args) &rest body)
(let ((name (intern (mkstr (list args body)))))
(or (gethash name cache)
(setf (gethash name cache)
(eval `(compile nil (lambda ,args ,@body))))))))Смысл в том, что лямбда компилируется прямо во время раскрытия макроса. Минус — сломаются замыкания между body и окружением вызова make-fun.
(eq (make-fun (x) 1) (make-fun (x) 1)); eval; => T
(defun xx ()
(eq (make-fun (x) 1) (make-fun (x) 1))); Compile
(xx); => T
(defun xx (x)
(funcall (make-fun (a) (+ a x)) 1)); Suxx.