[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv2540

Modified Files:
	packages.lisp 
Log Message:
do-symbols &co have implicit tagbodys, not implicit progns.


--- /project/movitz/cvsroot/movitz/losp/muerte/packages.lisp	2008/04/21 19:41:52	1.15
+++ /project/movitz/cvsroot/movitz/losp/muerte/packages.lisp	2008/04/23 18:47:46	1.16
@@ -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.15 2008/04/21 19:41:52 ffjeld Exp $
+;;;; $Id: packages.lisp,v 1.16 2008/04/23 18:47:46 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -173,31 +173,33 @@
 	     (return ,result-form))
 	   (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))))))))))
+		(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))
+		       (prog ((,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)
+    ((var &optional (package '*package*) result-form) &body declarations-and-body)
   (let ((next-var (gensym))
 	(more-var (gensym))
 	(key-var (gensym)))
     `(with-hash-table-iterator (,next-var (package-object-external-symbols (assert-package ,package)))
        (do () (nil)
 	 (multiple-value-bind (,more-var ,key-var ,var) (,next-var)
-	   (unless ,more-var (return ,result-form))
-	   (let () , at declarations-and-body))))))
+	   (unless ,more-var
+	     (return ,result-form))
+	   (prog ()
+	      , at declarations-and-body))))))
 
 (defmacro do-symbols ((var &optional (package '*package*) result-form) &body declarations-and-body)
   (let ((state-var (gensym))
@@ -215,35 +217,40 @@
 			      (1 (package-object-internal-symbols ,package-object-var))
 			      (t (let ((x (pop ,use-list-var)))
 				   (and x (package-object-external-symbols x)))))))
-	 ((not ,hash-table-var) ,result-form)
+	  ((not ,hash-table-var) ,result-form)
        (declare (index ,state-var))
        (with-hash-table-iterator (,next-var ,hash-table-var)
 	 (do () (nil)
 	   (multiple-value-bind (,more-var ,key-var ,var) (,next-var)
 	     (declare (ignore ,key-var))
 	     (if ,more-var
-		 (let () , at declarations-and-body)
-	       (return))))))))
+		 (prog ()
+		    , at declarations-and-body)
+		 (return))))))))
 
 (defun apropos (string &optional package)
   (flet ((apropos-symbol (symbol string)
 	   (when (search string (symbol-name symbol) :test #'char-equal)
 	     (cond
-	      ((keywordp symbol)
-	       (format t "~&~W == keyword~%" symbol))
-	      ((fboundp symbol)
-	       (format t "~&~W == function ~:A~%"
-		       symbol (funobj-lambda-list (symbol-function symbol))))
-	      ((boundp symbol)
-	       (format t "~&~W == variable ~S~%"
-		       symbol (symbol-value symbol)))
-	      (t (format t "~&~W~%" symbol))))))
+	       ((keywordp symbol)
+		(format t "~&~W == keyword~%" symbol))
+	       ((fboundp symbol)
+		(format t "~&~W == function ~:A~%"
+			symbol (funobj-lambda-list (symbol-function symbol))))
+	       ((boundp symbol)
+		(format t "~&~W == variable ~S~%"
+			symbol (symbol-value symbol)))
+	       (t (format t "~&~W~%" symbol))))))
     (let ((string (string string)))
       (if package
 	  (do-symbols (symbol package)
 	    (apropos-symbol symbol string))
-	(do-all-symbols (symbol)
-	  (apropos-symbol symbol string)))))
+	  (do-all-symbols (symbol)
+	    (apropos-symbol symbol string)))))
   (values))
 
-
+(defmacro with-package-iterator ((name package-list-form &rest symbol-types) &body body)
+  `(macrolet ((,name ()
+		'(warn "with-package-iterator not implemented."
+		  (values nil nil nil nil))))
+     , at body))
\ No newline at end of file