[anaphora-cvs] CVS src

[jsquires]

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

Modified Files:
	anaphora.lisp symbolic.lisp tests.lisp 
Log Message:
Corrected interactions between AIF and SIF, per patch from Olof-Joachim Frahm <Olof.Frahm at web.de>.


--- /project/anaphora/cvsroot/src/anaphora.lisp	2010/06/15 03:18:13	1.6
+++ /project/anaphora/cvsroot/src/anaphora.lisp	2010/06/15 21:25:26	1.7
@@ -5,13 +5,6 @@
 
 (in-package :anaphora)
 
-(defmacro anaphoric (op test &body body)  
-  ;; Note: multiple values discarded. Handling them would be nice, but also
-  ;; requires consing up a values-list, which seems a bit harsh for something
-  ;; that is supposed to be "simple syntactic sugar".
-  `(let ((it ,test))
-     (,op it , at body)))
-
 ;;; This was the original implementation of SYMBOLIC -- and still good
 ;;; for getting the basic idea. Brian Masterbrooks solution to
 ;;; infinite recusion during macroexpansion, that nested forms of this
--- /project/anaphora/cvsroot/src/symbolic.lisp	2004/03/18 10:52:19	1.1.1.1
+++ /project/anaphora/cvsroot/src/symbolic.lisp	2010/06/15 21:25:26	1.2
@@ -44,4 +44,12 @@
         `(symbol-macrolet
              ((,this-s (internal-symbol-macrolet ((it ,current-s)) ,test))
               (it ,this-s))
-           (,operation it , at other-args))))))
+           (,operation it , at other-args)))))
+
+  (defmacro anaphoric (op test &body body)  
+    (with-unique-names (this-s)
+      (setf (get s-indicator current-s-indicator) this-s)
+      `(let* ((it ,test)
+              (,this-s it))
+         (declare (ignorable ,this-s))
+         (,op it , at body)))))
--- /project/anaphora/cvsroot/src/tests.lisp	2010/06/15 03:18:13	1.4
+++ /project/anaphora/cvsroot/src/tests.lisp	2010/06/15 21:25:26	1.5
@@ -392,3 +392,23 @@
         (unless (eql it :yes) (error "Broken."))
       :no)
   :yes)
+
+(deftest aif.sif.1
+    (sif 1 (aif it it))
+  1)
+
+(deftest aif.sif.2
+    (aif 1 (sif it it))
+  1)
+
+(deftest aif.sif.3
+    (aif (list 1 2 3)
+        (sif (car it)
+             (setf it 'a)
+             :foo))
+  a)
+
+(deftest alet.slet.1
+    (slet 42 (alet 43 (slet it it)))
+  43)
+