Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25313
Modified Files: loop.lisp Log Message: Added to loop expansions some ignorable declarations for hash-table iteration.
Date: Wed Feb 11 09:52:51 2004 Author: ffjeld
Index: movitz/losp/muerte/loop.lisp diff -u movitz/losp/muerte/loop.lisp:1.4 movitz/losp/muerte/loop.lisp:1.5 --- movitz/losp/muerte/loop.lisp:1.4 Tue Feb 10 18:40:17 2004 +++ movitz/losp/muerte/loop.lisp Wed Feb 11 09:52:51 2004 @@ -47,11 +47,22 @@
;;;; LOOP Iteration Macro
+ +;;; Movitz notes: +;;; +;;; - Because much of this file is wrapped in eval-when (:compile-toplevel), +;;; (i.e. the host-side macroexpanders), it's probably best to +;;; recompile/reload this complete file rather than on a per-toplevel +;;; form basis. + +#+movitz +(in-package muerte) + ;;;#+allegro ;;;(in-package :excl) ;;;#-allegro ;;;(in-package :ansi-loop) -(in-package muerte) +
(provide :muerte/loop :load-priority 0)
@@ -1881,12 +1892,19 @@ dummy-predicate-var (loop-when-it-variable)) (let ((key-var nil) (val-var nil) + (ignore-vars nil) (bindings `((,variable nil ,data-type) (,ht-var ,(cadar prep-phrases)) ,@(and other-p other-var `((,other-var nil)))))) - (if (eq which 'hash-key) - (setq key-var variable val-var (and other-p other-var)) - (setq key-var (and other-p other-var) val-var variable)) + (ecase which + (hash-key + (setq key-var variable val-var (and other-p other-var)) + (when val-var + (pushnew val-var ignore-vars))) + (hash-value ; default? + (setq key-var (and other-p other-var) val-var variable) + (when key-var + (pushnew key-var ignore-vars)))) (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*) (when (consp key-var) (setq post-steps `(,key-var ,(setq key-var (loop-gentemp 'loop-hash-key-temp-)) @@ -1896,6 +1914,11 @@ (setq post-steps `(,val-var ,(setq val-var (loop-gentemp 'loop-hash-val-temp-)) ,@post-steps)) (push `(,val-var nil) bindings)) + (pushnew dummy-predicate-var ignore-vars) + (when ignore-vars + (pushnew `(ignorable ,@ignore-vars) + *loop-declarations* + :test 'equalp)) `(,bindings ;bindings () ;prologue () ;pre-test