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

[Frode Vatvedt Fjeld]

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

Modified Files:
	arithmetic-macros.lisp 
Log Message:
Re-wrote the + compiler-macro. It actually failed before on some forms.

Date: Tue Sep 21 15:09:40 2004
Author: ffjeld

Index: movitz/losp/muerte/arithmetic-macros.lisp
diff -u movitz/losp/muerte/arithmetic-macros.lisp:1.6 movitz/losp/muerte/arithmetic-macros.lisp:1.7
--- movitz/losp/muerte/arithmetic-macros.lisp:1.6	Wed Aug  4 14:59:18 2004
+++ movitz/losp/muerte/arithmetic-macros.lisp	Tue Sep 21 15:09:40 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sat Jul 17 13:42:46 2004
 ;;;;                
-;;;; $Id: arithmetic-macros.lisp,v 1.6 2004/08/04 12:59:18 ffjeld Exp $
+;;;; $Id: arithmetic-macros.lisp,v 1.7 2004/09/21 13:09:40 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -47,23 +47,21 @@
     (2 `(let ((x ,(first operands))
 	      (y ,(second operands)))
 	  (++%2op x y)))
-    (t (let ((operands
-	      (loop for operand in operands
-		  if (movitz:movitz-constantp operand env)
-		  sum (movitz:movitz-eval operand env)
-		  into constant-term
-		  else collect operand
-		  into non-constant-operands
-		  finally (return (if (zerop constant-term)
-				      non-constant-operands
-				    (cons constant-term non-constant-operands))))))
+    (t (multiple-value-bind (constant-term non-constants)
+	   (loop for operand in operands
+	       if (movitz:movitz-constantp operand env)
+	       sum (movitz:movitz-eval operand env) into constant-term
+	       else collect operand into non-constant-operands
+	       finally (return (values constant-term non-constant-operands)))
 	 (cond
-	  ((null operands)
-	   0)
-	  ((not (cdr operands))
-	   (check-type (car operands) integer)
-	   (car operands))
-	  (t `(+ (+ ,(first operands) ,(second operands)) ,@(cddr operands))))))))
+	  ((null non-constants)
+	   constant-term)
+	  ((and (= 0 constant-term)
+		(not (cdr non-constants)))
+	   (car non-constants))
+	  ((= 0 constant-term)
+	   `(+ (+ ,(first non-constants) ,(second non-constants)) ,@(cddr non-constants)))
+	  (t `(+ (+ ,constant-term ,(first non-constants)) ,@(cdr non-constants))))))))
 
 (define-compiler-macro 1+ (number)
   `(+ 1 ,number))