From jsquires at common-lisp.net  Fri Feb 17 20:53:59 2006
From: jsquires at common-lisp.net (jsquires)
Date: Fri, 17 Feb 2006 14:53:59 -0600 (CST)
Subject: [anaphora-cvs] CVS src
Message-ID: <20060217205359.A56602A01A@common-lisp.net>

Update of /project/anaphora/cvsroot/src
In directory common-lisp:/tmp/cvs-serv7206

Modified Files:
	anaphora.lisp 
Log Message:
Fixed acond/scond bug where cond forms weren't being executed.


--- /project/anaphora/cvsroot/src/anaphora.lisp	2004/03/18 10:52:19	1.1.1.1
+++ /project/anaphora/cvsroot/src/anaphora.lisp	2006/02/17 20:53:59	1.2
@@ -98,9 +98,9 @@
 (defmacro acond (&body clauses)
   (labels ((rec (clauses)
 	     (if clauses
-		 (destructuring-bind ((test &optional result) . rest)  clauses
-		   (if result
-		       `(anaphoric if ,test ,result ,(rec rest))
+		 (destructuring-bind ((test &body body) . rest)  clauses
+		   (if body
+		       `(anaphoric if ,test (progn , at body) ,(rec rest))
 		       `(anaphoric if ,test it ,(rec rest))))
 		 nil)))
     (rec clauses)))
@@ -108,9 +108,9 @@
 (defmacro scond (&body clauses)
   (labels ((rec (clauses)
 	     (if clauses
-		 (destructuring-bind ((test &optional result) . rest) clauses
-		   (if result
-		       `(symbolic if ,test ,result ,(rec rest))
+		 (destructuring-bind ((test &body body) . rest) clauses
+		   (if body
+		       `(symbolic if ,test (progn , at body) ,(rec rest))
 		       `(symbolic if ,test it ,(rec rest))))
 		 nil)))
     (rec clauses)))



From jsquires at common-lisp.net  Sat Feb 18 12:46:07 2006
From: jsquires at common-lisp.net (jsquires)
Date: Sat, 18 Feb 2006 06:46:07 -0600 (CST)
Subject: [anaphora-cvs] CVS src
Message-ID: <20060218124607.591C62A01A@common-lisp.net>

Update of /project/anaphora/cvsroot/src
In directory common-lisp:/tmp/cvs-serv24465

Modified Files:
	anaphora.lisp packages.lisp tests.lisp 
Log Message:
Added Gary King's aprog1.
Updated tests.


--- /project/anaphora/cvsroot/src/anaphora.lisp	2006/02/17 20:53:59	1.2
+++ /project/anaphora/cvsroot/src/anaphora.lisp	2006/02/18 12:46:07	1.3
@@ -48,6 +48,11 @@
 	   ,then
 	   (symbolic ignore-first ,test ,else))))
 
+(defmacro aprog1 (first &body rest)
+  "Binds IT to the first form so that it can be used in the rest of the
+forms. The whole thing returns IT."
+  `(anaphoric prog1 ,first , at rest))
+
 (defmacro awhen (test &body body)
   "Like WHEN, except bind the result of the test to IT (via LET) for the scope
 of the body."
--- /project/anaphora/cvsroot/src/packages.lisp	2004/03/18 10:52:19	1.1.1.1
+++ /project/anaphora/cvsroot/src/packages.lisp	2006/02/18 12:46:07	1.2
@@ -11,6 +11,7 @@
    #:aand
    #:sor
    #:awhen
+   #:aprog1
    #:acase
    #:aecase
    #:accase
--- /project/anaphora/cvsroot/src/tests.lisp	2004/03/18 10:52:19	1.1.1.1
+++ /project/anaphora/cvsroot/src/tests.lisp	2006/02/18 12:46:07	1.2
@@ -318,6 +318,13 @@
 	   (t :yes))
   :yes)
 
+;; Test COND with multiple forms in the implicit progn.
+(deftest acond.4
+    (let ((foo))
+      (acond ((+ 2 2) (setf foo 38) (incf foo it) foo)
+	     (t nil)))
+  42)
+
 (deftest scond.1
     (let ((x (list nil))
 	  (y (list t)))
@@ -341,4 +348,8 @@
 		(setf it tmp)))))
   "/tmp/")
 
-
+(deftest aprog.1
+    (aprog1 :yes
+      (unless (eql it :yes) (error "Broken."))
+      :no)
+  :yes)