[movitz-cvs] CVS update: movitz/losp/muerte/packages.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	packages.lisp 
Log Message:
Improved do-all-symbols expansion so that (block nil ...) is installed correctly.

Date: Tue Mar  1 00:36:15 2005
Author: ffjeld

Index: movitz/losp/muerte/packages.lisp
diff -u movitz/losp/muerte/packages.lisp:1.6 movitz/losp/muerte/packages.lisp:1.7
--- movitz/losp/muerte/packages.lisp:1.6	Sat Nov 13 15:50:13 2004
+++ movitz/losp/muerte/packages.lisp	Tue Mar  1 00:36:08 2005
@@ -1,6 +1,6 @@
 ;;;;------------------------------------------------------------------
 ;;;; 
-;;;;    Copyright (C) 2001, 2002-2004
+;;;;    Copyright (C) 2001, 2002-2005
 ;;;;    Department of Computer Science, University of Tromso, Norway.
 ;;;; 
 ;;;;    For distribution policy, see the accompanying file COPYING.
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Thu Aug 30 15:19:43 2001
 ;;;;                
-;;;; $Id: packages.lisp,v 1.6 2004/11/13 14:50:13 ffjeld Exp $
+;;;; $Id: packages.lisp,v 1.7 2005/02/28 23:36:08 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -105,10 +105,11 @@
 	(dummy (gensym))
 	(package-var (gensym))
 	(package-hash-var (gensym))
-	(state-var (gensym "do-all-symbols-state-"))
 	(next-symbol (gensym))
 	(more-symbols-var (gensym))
-	(symbol-var (gensym)))
+	(symbol-var (gensym))
+	(loop-tag (gensym))
+	(end-tag (gensym)))
     `(with-hash-table-iterator (,next-package (get-global-property :packages))
        (do () (nil)
 	 (multiple-value-bind (,more-packages-var ,dummy ,package-var)
@@ -116,18 +117,22 @@
 	   (declare (ignore ,dummy))
 	   (unless ,more-packages-var
 	     (return ,result-form))
-	   (do ((,state-var '(:externals :internals) (cdr ,state-var))
-		(,package-hash-var (package-object-external-symbols ,package-var)
-				   (package-object-internal-symbols ,package-var)))
-	       ((null ,state-var))
-	     (with-hash-table-iterator (,next-symbol ,package-hash-var)
-	       (do () (nil)
-		 (multiple-value-bind (,more-symbols-var ,dummy ,symbol-var)
-		     (,next-symbol)
-		   (declare (ignore ,dummy))
-		   (unless ,more-symbols-var (return nil))
-		   (let ((,var ,symbol-var))
-		     , at declarations-and-body))))))))))
+	   (let ((,package-hash-var (package-object-external-symbols ,package-var)))
+	     (tagbody ,loop-tag
+	       (with-hash-table-iterator (,next-symbol ,package-hash-var)
+		 (tagbody ,loop-tag
+		   (multiple-value-bind (,more-symbols-var ,dummy ,symbol-var)
+		       (,next-symbol)
+		     (declare (ignore ,dummy))
+		     (unless ,more-symbols-var (go ,end-tag))
+		     (let ((,var ,symbol-var))
+		       , at declarations-and-body))
+		   (go ,loop-tag)
+		   ,end-tag))
+	       (let ((internals (package-object-internal-symbols ,package-var)))
+		 (unless (eq ,package-hash-var internals)
+		   (setf ,package-hash-var internals)
+		   (go ,loop-tag))))))))))
 
 (defmacro do-external-symbols ((var &optional (package *package*) result-form) &body declarations-and-body)
   (let ((next-var (gensym))
@@ -185,3 +190,5 @@
 	(do-all-symbols (symbol)
 	  (apropos-symbol symbol string)))))
   (values))
+
+