[movitz-cvs] CVS update: movitz/assembly-syntax.lisp

[Frode Vatvedt Fjeld]

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

Modified Files:
	assembly-syntax.lisp 
Log Message:
Slightly cleaned up assembly-macroexpand, and added a work-around for
an apparent bug in CMUCL's loop.

Date: Mon Sep  6 12:07:03 2004
Author: ffjeld

Index: movitz/assembly-syntax.lisp
diff -u movitz/assembly-syntax.lisp:1.3 movitz/assembly-syntax.lisp:1.4
--- movitz/assembly-syntax.lisp:1.3	Wed Apr 21 17:05:39 2004
+++ movitz/assembly-syntax.lisp	Mon Sep  6 12:07:03 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Thu Nov  9 17:34:37 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: assembly-syntax.lisp,v 1.3 2004/04/21 15:05:39 ffjeld Exp $
+;;;; $Id: assembly-syntax.lisp,v 1.4 2004/09/06 10:07:03 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -26,20 +26,18 @@
     expander))
 
 (defun assembly-macroexpand (prg amenv)
-  (let* ((fix-tail nil)
-	 (new-prg
-	  (loop for (p . tail) on prg
-	      as expander = (and (consp p)
-				 (symbolp (car p))
-				 (assembly-macro-expander (car p) amenv))
-	      if expander
-	      append (funcall expander p)
-	      else if (consp p)
-	      append (list (assembly-macroexpand p amenv))
-	      else append (list p)
-	      unless (listp tail)
-	      do (setf fix-tail tail))))
-    (when fix-tail
-      (setf (cdr (last new-prg)) fix-tail))
-    new-prg))
+  #+cmu (declare (optimize (safety 0)))	; Circumvent CMUCL bug in loop for-as-on-list.
+  (loop for (p . tail) on prg
+      as expander = (and (consp p)
+			 (symbolp (car p))
+			 (assembly-macro-expander (car p) amenv))
+      if expander
+      append (funcall expander p) into result
+      else if (consp p)
+      append (list (assembly-macroexpand p amenv)) into result
+      else append (list p) into result
+      when (not (listp tail))
+      do (setf (cdr (last result)) tail)
+	 (return result)
+      finally (return result)))