Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv3408
Modified Files: more-macros.lisp Log Message: Have macros in the run-time.
--- /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2008/03/08 14:03:35 1.39 +++ /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2008/03/15 20:58:06 1.40 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.39 2008/03/08 14:03:35 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.40 2008/03/15 20:58:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -171,6 +171,8 @@ ((or (pop-match '&rest sub-lambda-list) (pop-match '&body sub-lambda-list)) (gen-restvar var sub-lambda-list)) + ((pop-match '&key sub-lambda-list) + (gen-keyvars var sub-lambda-list)) ((pop-match '&aux sub-lambda-list) (dolist (b sub-lambda-list) (push b bindings))) @@ -294,47 +296,6 @@ (return p)))) (t form))))
-(defmacro letf* (bindings &body body &environment env) - "Does what one might expect, saving the old values and setting the generalized - variables to the new values in sequence. Unwind-protects and get-setf-method - are used to preserve the semantics one might expect in analogy to let*, - and the once-only evaluation of subforms." - (labels ((do-bindings - (bindings) - (cond ((null bindings) body) - (t (multiple-value-bind (dummies vals newval setter getter) - (get-setf-expansion (caar bindings) env) - (let ((save (gensym))) - `((let* (,@(mapcar #'list dummies vals) - (,(car newval) ,(cadar bindings)) - (,save ,getter)) - (unwind-protect - (progn ,setter - ,@(do-bindings (cdr bindings))) - (setq ,(car newval) ,save) - ,setter))))))))) - (car (do-bindings bindings)))) - -(defmacro with-letf (clauses &body body) - "Each clause is (<place> &optional <value-form> <prev-var>). -Execute <body> with alternative values for each <place>. -Note that this scheme does not work well with respect to multiple threads. -XXX This should actually be using get-setf-expansion etc. to deal with -proper evaluation of the places' subforms." - (let ((place-value-save (loop for (place . value-save) in clauses - if value-save - collect (list place `(progn ,(first value-save)) - (or (second value-save) (gensym))) - else collect (list place nil (gensym))))) - `(let (,@(loop for (place nil save-var) in place-value-save - collect `(,save-var ,place))) - (unwind-protect - (progn (setf ,@(loop for (place value) in place-value-save - append `(,place ,value))) - ,@body) - (setf ,@(loop for (place nil save) in place-value-save - append `(,place ,save))))))) - (defmacro with-alternative-fdefinitions (clauses &body body) "Each clause is (<name> <definition>). Execute <body> with alternative fdefinitions for each <name>. Note that this scheme does not work well with