Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22773

Modified Files: more-macros.lisp Log Message: Added member compiler-macro.

Date: Sat Nov 20 18:36:07 2004 Author: ffjeld

Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.20 movitz/losp/muerte/more-macros.lisp:1.21 --- movitz/losp/muerte/more-macros.lisp:1.20 Wed Sep 22 19:48:00 2004 +++ movitz/losp/muerte/more-macros.lisp Sat Nov 20 18:36:07 2004 @@ -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.20 2004/09/22 17:48:00 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.21 2004/11/20 17:36:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

@@ -134,6 +134,32 @@ ((null ,cons-var) ,result-form) (let ((,var (pop ,cons-var))) ,@declarations-and-body)))) + +(define-compiler-macro member (&whole form item list &key (key ''identity) (test ''eql) + &environment env) + (let* ((test (or (and (movitz:movitz-constantp test env) + (translate-program (movitz:movitz-eval test env) :muerte.cl :cl)) + (and (consp test) (eq 'function (car test)) + (cadr test)))) + (key (or (and (movitz:movitz-constantp key env) + (translate-program (movitz:movitz-eval key env) :muerte.cl :cl)) + (and (consp key) (eq 'function (car key)) + (cadr key))))) + (cond + ((and test (symbolp test) (eq key 'identity)) + `(do ((item ,item) + (p ,list (cdr p))) + ((endp p) nil) + (when (,test (car p) item) + (return p)))) + ((and test (symbolp test) + key (symbolp key)) + `(do ((item ,item) + (p ,list (cdr p))) + ((endp p) nil) + (when (,test (car p) (,key item)) + (return p)))) + (t form))))

(defmacro letf* (bindings &body body &environment env) "Does what one might expect, saving the old values and setting the generalized