From jsquires at common-lisp.net Tue Jun 15 03:18:13 2010 From: jsquires at common-lisp.net (jsquires) Date: Mon, 14 Jun 2010 23:18:13 -0400 Subject: [anaphora-cvs] CVS src Message-ID: 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 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)) From jsquires at common-lisp.net Tue Jun 15 21:25:26 2010 From: jsquires at common-lisp.net (jsquires) Date: Tue, 15 Jun 2010 17:25:26 -0400 Subject: [anaphora-cvs] CVS src Message-ID: 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 . --- /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) +