From 5d9f784170bb7cf0a360e7e545d38049a354e160 Mon Sep 17 00:00:00 2001 From: jsancho Date: Wed, 11 Nov 2009 11:27:42 +0000 Subject: [PATCH] --- gacela_misc.lisp | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/gacela_misc.lisp b/gacela_misc.lisp index 9a01787..7010b09 100755 --- a/gacela_misc.lisp +++ b/gacela_misc.lisp @@ -14,8 +14,6 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with this program. If not, see . -(in-package :gacela) - (defconstant INFINITY MOST-POSITIVE-LONG-FLOAT) (defun append-if (new test tree &key (key #'first) (test-if #'equal)) @@ -83,6 +81,22 @@ (setf (symbol-function 'si::universal-error-handler) ,error-handler) result-eval)))) +(defmacro persistent-let (name vars &rest forms) + (labels ((get-vars (vars) + (cond ((null vars) nil) + (t (cons (if (consp (car vars)) (caar vars) (car vars)) + (get-vars (cdr vars))))))) + + `(let ,(cond ((functionp name) + (let ((old-vars (funcall name))) + (cond ((equal (get-vars vars) (get-vars old-vars)) old-vars) + (t vars)))) + (t vars)) + (defun ,name () + ,(let ((lvars (get-vars vars))) + `(mapcar (lambda (x y) (list x y)) ',lvars ,(cons 'list lvars)))) + ,@forms))) + ;Geometry (defun dotp (dot) (match-pattern dot '(0 0))) -- 2.39.2