[anaphora-cvs] CVS src
nsiivola
nsiivola at common-lisp.net
Fri Jun 30 09:40:52 UTC 2006
Update of /project/anaphora/cvsroot/src
In directory clnet:/tmp/cvs-serv29665
Modified Files:
anaphora.asd anaphora.lisp packages.lisp tests.lisp
Log Message:
More documentation, more test. Bump version in preparation for a release.
--- /project/anaphora/cvsroot/src/anaphora.asd 2004/03/18 10:52:19 1.1.1.1
+++ /project/anaphora/cvsroot/src/anaphora.asd 2006/06/30 09:40:51 1.2
@@ -4,7 +4,7 @@
;;;; Nikodemus Siivola <nikodemus at random-state.net>
(defsystem :anaphora
- :version "0.9.2"
+ :version "0.9.3"
:components
((:file "packages")
(:file "early" :depends-on ("packages"))
--- /project/anaphora/cvsroot/src/anaphora.lisp 2006/02/18 12:46:07 1.3
+++ /project/anaphora/cvsroot/src/anaphora.lisp 2006/06/30 09:40:51 1.4
@@ -5,14 +5,17 @@
(in-package :anaphora)
-(defmacro anaphoric (op test &body body)
+(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 are subject to is in symbolic.lisp.
+;;; 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
+;;; are subject to, is in symbolic.lisp.
;;;
;;; (defmacro symbolic (op test &body body &environment env)
;;; `(symbol-macrolet ((it ,test))
@@ -54,53 +57,85 @@
`(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
+ "Like WHEN, except binds the result of the test to IT (via LET) for the scope
of the body."
`(anaphoric when ,test , at body))
(defmacro swhen (test &body body)
+ "Like WHEN, except binds the test form to IT (via SYMBOL-MACROLET) for the
+scope of the body. IT can be set with SETF."
`(symbolic when ,test , at body))
(defmacro sunless (test &body body)
+ "Like UNLESS, except binds the test form to IT (via SYMBOL-MACROLET) for the
+scope of the body. IT can be set with SETF."
`(symbolic unless ,test , at body))
-(defmacro acase (form &body cases)
- `(anaphoric case ,form , at cases))
-
-(defmacro scase (form &body cases)
- `(symbolic case ,form , at cases))
-
-(defmacro aecase (form &body cases)
- `(anaphoric ecase ,form , at cases))
-
-(defmacro secase (form &body cases)
- `(symbolic ecase ,form , at cases))
+(defmacro acase (keyform &body cases)
+ "Like CASE, except binds the result of the keyform to IT (via LET) for the
+scope of the cases."
+ `(anaphoric case ,keyform , at cases))
+
+(defmacro scase (keyform &body cases)
+ "Like CASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
+scope of the body. IT can be set with SETF."
+ `(symbolic case ,keyform , at cases))
+
+(defmacro aecase (keyform &body cases)
+ "Like ECASE, except binds the result of the keyform to IT (via LET) for the
+scope of the cases."
+ `(anaphoric ecase ,keyform , at cases))
+
+(defmacro secase (keyform &body cases)
+ "Like ECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
+scope of the cases. IT can be set with SETF."
+ `(symbolic ecase ,keyform , at cases))
-(defmacro accase (form &body cases)
- `(anaphoric ccase ,form , at cases))
-
-(defmacro sccase (form &body cases)
- `(symbolic ccase ,form , at cases))
-
-(defmacro atypecase (form &body cases)
- `(anaphoric typecase ,form , at cases))
-
-(defmacro stypecase (form &body cases)
- `(symbolic typecase ,form , at cases))
-
-(defmacro aetypecase (form &body cases)
- `(anaphoric etypecase ,form , at cases))
-
-(defmacro setypecase (form &body cases)
- `(symbolic etypecase ,form , at cases))
-
-(defmacro actypecase (form &body cases)
- `(anaphoric ctypecase ,form , at cases))
-
-(defmacro sctypecase (form &body cases)
- `(symbolic ctypecase ,form , at cases))
+(defmacro accase (keyform &body cases)
+ "Like CCASE, except binds the result of the keyform to IT (via LET) for the
+scope of the cases. Unlike CCASE, the keyform/place doesn't receive new values
+possibly stored with STORE-VALUE restart; the new value is received by IT."
+ `(anaphoric ccase ,keyform , at cases))
+
+(defmacro sccase (keyform &body cases)
+ "Like CCASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
+scope of the cases. IT can be set with SETF."
+ `(symbolic ccase ,keyform , at cases))
+
+(defmacro atypecase (keyform &body cases)
+ "Like TYPECASE, except binds the result of the keyform to IT (via LET) for
+the scope of the cases."
+ `(anaphoric typecase ,keyform , at cases))
+
+(defmacro stypecase (keyform &body cases)
+ "Like TYPECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for the
+scope of the cases. IT can be set with SETF."
+ `(symbolic typecase ,keyform , at cases))
+
+(defmacro aetypecase (keyform &body cases)
+ "Like ETYPECASE, except binds the result of the keyform to IT (via LET) for
+the scope of the cases."
+ `(anaphoric etypecase ,keyform , at cases))
+
+(defmacro setypecase (keyform &body cases)
+ "Like ETYPECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for
+the scope of the cases. IT can be set with SETF."
+ `(symbolic etypecase ,keyform , at cases))
+
+(defmacro actypecase (keyform &body cases)
+ "Like CTYPECASE, except binds the result of the keyform to IT (via LET) for
+the scope of the cases. Unlike CTYPECASE, new values possible stored by the
+STORE-VALUE restart are not received by the keyform/place, but by IT."
+ `(anaphoric ctypecase ,keyform , at cases))
+
+(defmacro sctypecase (keyform &body cases)
+ "Like CTYPECASE, except binds the keyform to IT (via SYMBOL-MACROLET) for
+the scope of the cases. IT can be set with SETF."
+ `(symbolic ctypecase ,keyform , at cases))
(defmacro acond (&body clauses)
+ "Like COND, except result of each test-form is bound to IT (via LET) for the
+scope of the corresponding clause."
(labels ((rec (clauses)
(if clauses
(destructuring-bind ((test &body body) . rest) clauses
@@ -111,6 +146,8 @@
(rec clauses)))
(defmacro scond (&body clauses)
+ "Like COND, except each test-form is bound to IT (via SYMBOL-MACROLET) for the
+scope of the corresponsing clause. IT can be seet with SETF."
(labels ((rec (clauses)
(if clauses
(destructuring-bind ((test &body body) . rest) clauses
--- /project/anaphora/cvsroot/src/packages.lisp 2006/02/18 12:46:07 1.2
+++ /project/anaphora/cvsroot/src/packages.lisp 2006/06/30 09:40:51 1.3
@@ -29,7 +29,11 @@
#:stypecase
#:setypecase
#:sctypecase
- #:scond))
+ #:scond)
+ (:documentation
+ "ANAPHORA provides a full complement of anaphoric macros. Subsets of the
+functionality provided by this package are exported from ANAPHORA-BASIC and
+ANAPHORA-SYMBOL."))
(defpackage :anaphora-basic
(:use :cl :anaphora)
@@ -38,13 +42,17 @@
#:aif
#:aand
#:awhen
+ #:aprog1
#:acase
#:aecase
#:accase
#:atypecase
#:aetypecase
#:actypecase
- #:acond))
+ #:acond)
+ (:documentation
+ "ANAPHORA-BASIC provides all normal anaphoric constructs, which bind
+primary values to IT."))
(defpackage :anaphora-symbol
(:use :cl :anaphora)
@@ -61,4 +69,16 @@
#:stypecase
#:setypecase
#:sctypecase
- #:scond))
+ #:scond)
+ (:documentation
+ "ANAPHORA-SYMBOL provides ``symbolic anaphoric macros'', which bind forms
+to IT via SYMBOL-MACROLET.
+
+Examples:
+
+ (sor (gethash key table) (setf it default))
+
+ (asif (gethash key table)
+ (foo it) ; IT is a value bound by LET here
+ (setf it default)) ; IT is the GETHASH form bound by SYMBOL-MACROLET here
+"))
--- /project/anaphora/cvsroot/src/tests.lisp 2006/02/18 12:46:07 1.2
+++ /project/anaphora/cvsroot/src/tests.lisp 2006/06/30 09:40:51 1.3
@@ -1,6 +1,6 @@
;;;; Anaphora: The Anaphoric Macro Package from Hell
;;;;
-;;;; This been placed in Public Domain by the author,
+;;;; This been placed in Public Domain by the author,
;;;; Nikodemus Siivola <nikodemus at random-state.net>
(defpackage :anaphora-test
@@ -13,6 +13,28 @@
(+ 1 it))
3)
+(deftest aand.2
+ (aand 1 t (values it 2))
+ 1 2)
+
+(deftest aand.3
+ (let ((x 1))
+ (aand (incf x) t t (values t it)))
+ t 2)
+
+(deftest aand.4
+ (aand 1 (values t it))
+ t 1)
+
+#+(or)
+;;; bug or a feature? forms like this expand to
+;;;
+;;; (let ((it (values ...))) (and it ...))
+;;;
+(deftest aand.5
+ (aand (values nil t) it)
+ nil t)
+
(deftest sor.1
(let ((x (list nil)))
(sor (car x)
@@ -57,9 +79,9 @@
:yes!)
(deftest sif.3
- (sif (list 1 2 3)
- (sif (car it)
- (setf it 'a)
+ (sif (list 1 2 3)
+ (sif (car it)
+ (setf it 'a)
:foo))
a)
@@ -69,8 +91,8 @@
((a :initform (list :sif))))
(with-slots (a)
(make-instance 'sif.4)
- (sif a
- (sif (car it)
+ (sif a
+ (sif (car it)
it))))
:sif)
@@ -245,7 +267,7 @@
x)
(:bar))
-(deftest aetypecase.1
+(deftest aetypecase.1
(aetypecase 1.0
(fixnum (* 2 it))
(float (+ 2.0 it))
@@ -331,7 +353,7 @@
(scond ((car x) (setf it :nono))
((car y) (setf it :yes)))
(values x y))
- (nil)
+ (nil)
(:yes))
(deftest scond.2
@@ -350,6 +372,6 @@
(deftest aprog.1
(aprog1 :yes
- (unless (eql it :yes) (error "Broken."))
+ (unless (eql it :yes) (error "Broken."))
:no)
:yes)
More information about the anaphora-cvs
mailing list