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

[Frode Vatvedt Fjeld]

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

Modified Files:
	assembly-syntax.lisp 
Log Message:
Make assembly-macroexpand not barf on non-proper lists.

Date: Wed Apr 21 11:05:40 2004
Author: ffjeld

Index: movitz/assembly-syntax.lisp
diff -u movitz/assembly-syntax.lisp:1.2 movitz/assembly-syntax.lisp:1.3
--- movitz/assembly-syntax.lisp:1.2	Mon Jan 19 06:23:41 2004
+++ movitz/assembly-syntax.lisp	Wed Apr 21 11:05:39 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.2 2004/01/19 11:23:41 ffjeld Exp $
+;;;; $Id: assembly-syntax.lisp,v 1.3 2004/04/21 15:05:39 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -25,29 +25,21 @@
   (setf (gethash symbol (assembly-macro-environment-expanders amenv))
     expander))
 
-;;;(defun assembly-macroexpand (prg amenv)
-;;;  (cond
-;;;   ((and (consp prg) (symbolp (car prg)))
-;;;    (let ((expander (assembly-macro-expander (car prg) amenv)))
-;;;      (if expander
-;;;	  (assembly-macroexpand (funcall expander prg) amenv)
-;;;	#0=(cons (assembly-macroexpand (car prg) amenv)
-;;;		 (assembly-macroexpand (cdr prg) amenv)))))
-;;;   ((consp prg) #0#)
-;;;   (t prg)))
-
 (defun assembly-macroexpand (prg amenv)
-  (loop for p in 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)))
-
-;;;(defmacro with-assembly-syntax (&body body)
-;;;  `(let ((*readtable* (copy-readtable nil)))
-;;;     (set-dispatch-macro-character
+  (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))