[anaphora-cvs] CVS src

[jsquires]

Update of /project/anaphora/cvsroot/src
In directory cl-net:/tmp/cvs-serv13798

Modified Files:
	anaphora.lisp packages.lisp tests.lisp 
Log Message:
Applied patches from Olof-Joachim Frahm <Olof.Frahm at web.de> to provide
ALET, SLET, and remove extraneous argument from SIF's definition.


--- /project/anaphora/cvsroot/src/anaphora.lisp	2008/05/27 00:03:02	1.5
+++ /project/anaphora/cvsroot/src/anaphora.lisp	2010/06/15 03:18:13	1.6
@@ -21,6 +21,15 @@
 ;;;   `(symbol-macrolet ((it ,test))
 ;;;        (,op it , at body)))
 
+(defmacro alet (form &body body)
+  "Binds the FORM to IT (via LET) in the scope of the BODY."
+  `(anaphoric ignore-first ,form (progn , at body)))
+
+(defmacro slet (form &body body)
+  "Binds the FORM to IT (via SYMBOL-MACROLET) in the scope of the BODY. IT can
+be set with SETF."
+  `(symbolic ignore-first ,form (progn , at body)))
+
 (defmacro aand (first &rest rest)
   "Like AND, except binds the first argument to IT (via LET) for the
 scope of the rest of the arguments."
@@ -36,10 +45,9 @@
 the scope of the then and else expressions."  
   `(anaphoric if ,test ,then ,else))
 
-(defmacro sif (test then &optional else &environment env)
+(defmacro sif (test then &optional else)
   "Like IF, except binds the test form to IT (via SYMBOL-MACROLET) for
 the scope of the then and else expressions. IT can be set with SETF"
-  (declare (ignore env))
   `(symbolic if ,test ,then ,else))
 
 (defmacro asif (test then &optional else)
--- /project/anaphora/cvsroot/src/packages.lisp	2006/06/30 09:40:51	1.3
+++ /project/anaphora/cvsroot/src/packages.lisp	2010/06/15 03:18:13	1.4
@@ -7,6 +7,8 @@
   (:use :cl)
   (:export
    #:it
+   #:alet
+   #:slet
    #:aif
    #:aand
    #:sor
@@ -39,6 +41,7 @@
   (:use :cl :anaphora)
   (:export
    #:it
+   #:alet
    #:aif
    #:aand
    #:awhen
@@ -58,6 +61,7 @@
   (:use :cl :anaphora)
   (:export
    #:it
+   #:slet
    #:sor
    #:sif
    #:asif
--- /project/anaphora/cvsroot/src/tests.lisp	2006/06/30 09:40:51	1.3
+++ /project/anaphora/cvsroot/src/tests.lisp	2010/06/15 03:18:13	1.4
@@ -8,6 +8,23 @@
 
 (in-package :anaphora-test)
 
+(deftest alet.1
+    (alet (1+ 1)
+      (1+ it))
+  3)
+
+(deftest alet.2
+    (alet (1+ 1)
+      it
+      (1+ it))
+  3)
+
+(deftest slet.1
+    (let ((x (list 1 2 3)))
+      (slet (car x)
+	(incf it) (values it x)))
+  2 (2 2 3))
+
 (deftest aand.1
     (aand (+ 1 1)
 	  (+ 1 it))