Implemented aif, awhen and acond.

README.md

@@ -14,5 +14,5 @@ Anaphoric conditionnal forms for `racket`:
 (acond
   [(member 'a lst) (displayln it)]
   [(member 'b lst) (displayln it)]
-  [else (displayln "not found")] ;; Can't use "it" in the else clause.
+  [else (displayln "not found")]) ;; Can't use "it" in the else clause.
 ```

acond.rkt

@@ -0,0 +1,18 @@
+#lang racket
+
+(provide acond it)
+(require anaphoric/it
+         racket/stxparam)
+
+(define-syntax (acond stx)
+  (syntax-case stx (else)
+    [(_ [else . else-body])
+     #'(begin . else-body)]
+    [(_)
+     #'(void)]
+    [(_ [condition . body] . rest)
+     #'(let ([tmp condition])
+         (if tmp
+             (syntax-parameterize ([it (make-rename-transformer #'tmp)])
+               . body)
+             (acond . rest)))]))

aif.rkt

@@ -0,0 +1,12 @@
+#lang racket
+
+(provide aif it)
+(require anaphoric/it
+         racket/stxparam)
+
+(define-syntax-rule (aif condition true-branch false-branch)
+  (let ([tmp condition])
+    (if tmp
+        (syntax-parameterize ([it (make-rename-transformer #'tmp)])
+          true-branch)
+        false-branch)))

awhen.rkt

@@ -0,0 +1,11 @@
+#lang racket
+
+(provide awhen it)
+(require anaphoric/it
+         racket/stxparam)
+
+(define-syntax-rule (awhen condition . body)
+  (let ([tmp condition])
+    (when tmp
+      (syntax-parameterize ([it (make-rename-transformer #'tmp)])
+        . body))))

it.rkt

@@ -0,0 +1,11 @@
+#lang racket
+
+(provide it)
+(require racket/stxparam)
+
+(define-syntax-parameter it
+  (λ (stx)
+    (raise-syntax-error
+     'it
+     "Use of the \"it\" identifier is only allowd within anaphoric macros."
+     stx)))

main.rkt

@@ -1,8 +1,5 @@
 #lang racket/base
 
-(module+ test
-  (require rackunit))
-
 ;; Notice
 ;; To install (from within the package directory):
 ;;   $ raco pkg install
@@ -12,24 +9,12 @@
 ;;   $ raco pkg remove <<name>>
 ;; To view documentation:
 ;;   $ raco docs <<name>>
-;;
-;; For your convenience, we have included a LICENSE.txt file, which links to
-;; the GNU Lesser General Public License.
-;; If you would prefer to use a different license, replace LICENSE.txt with the
-;; desired license.
-;;
-;; Some users like to add a `private/` directory, place auxiliary files there,
-;; and require them in `main.rkt`.
-;;
-;; See the current version of the racket style guide here:
-;; http://docs.racket-lang.org/style/index.html
 
-;; Code here
-
-(module+ test
-  ;; Tests to be run with raco test
-  )
-
-(module+ main
-  ;; Main entry point, executed when run with the `racket` executable or DrRacket.
-  )
+(provide (all-from-out anaphoric/it
+                       anaphoric/aif
+                       anaphoric/awhen
+                       anaphoric/acond))
+(require anaphoric/it
+         anaphoric/aif
+         anaphoric/awhen
+         anaphoric/acond)

scribblings/anaphoric.scrbl

@@ -7,4 +7,42 @@
 
 @defmodule[anaphoric]
 
-Package Description Here
+This package provides anaphoric versions of @racket[if], 
+@racket[when] and @racket[cond]. These bind the syntax
+parameter @racket[if] to the value produced by the
+condition expression. 
+
+@racketblock[(aif (member 'a lst)
+               (displayln it)
+               (displayln "not found"))]
+
+@racketblock[(awhen (member 'a lst)
+               (displayln it))]
+
+@racketblock[(acond
+               [(member 'a lst) (displayln it)]
+               [(member 'b lst) (displayln it)]
+               [else (displayln "not found")])]
+
+In the @racket[else] clause of @racket[acond] and in the
+else branch of @racket[aif], the @racket[it] syntax
+parameter keeps its value. This meeans it keeps the value
+bound by the surrounding conditionnal, if any. Otherwise it acts just
+like when it is used at the top-level, and raises a syntax error.
+
+@racketblock[(aif 'first
+               (aif (eq? 'second 'no)
+                 'not-executed
+                 (displayln it))
+               'not-executed)]
+
+In the example above, @racket[(displayln it)] prints 
+@racket['first]. In the example below, 
+@racket[(displayln it)] will raises a syntax error, as it
+appears in a sequence of else branches:
+
+@racketblock[(aif (eq? 'first 'no)
+               'not-executed
+               (aif (eq? 'second 'no)
+                 'not-executed
+                 (displayln it)))]

test/acond-test.rkt

@@ -0,0 +1,79 @@
+#lang racket
+
+(require anaphoric/acond
+         rackunit)
+
+(define lst '(x y z a b c))
+(define seen 0)
+
+;; With else branch
+(check-equal? (acond
+                [(member 'a lst) (set! seen (add1 seen))
+                                 (check-equal? it '(a b c))
+                                 'seen-01]
+                [(member 'b lst) (fail "acond selected wrong branch")]
+                [else (fail "acond selected wrong branch")])
+              'seen-01)
+(check-equal? seen 1) ;; multiple body statements
+
+(check-equal? (acond
+                [(member 'absent lst) (fail "acond selected wrong branch")]
+                [(member 'b lst) (begin (check-equal? it '(b c))
+                                        'seen-02)]
+                [else (fail "acond selected wrong branch")])
+              'seen-02)
+
+(check-equal? (acond
+                [(member 'absent lst) (fail "acond selected wrong branch")]
+                [(member 'absent2 lst) (fail "acond selected wrong branch")]
+                [else 'seen-03])
+              'seen-03)
+
+;; Just else branch
+(check-equal? (acond
+                [else 'seen-04])
+              'seen-04)
+
+;; Multiple body statements
+
+(check-equal? (acond
+                [(member 'absent lst) (fail "acond selected wrong branch")]
+                [(member 'absent2 lst) (fail "acond selected wrong branch")]
+                [else (set! seen (add1 seen))
+                      'seen-05])
+              'seen-05)
+(check-equal? seen 2)
+
+;; Without else branch
+(check-equal? (acond
+                [(member 'a lst) (set! seen (add1 seen))
+                                 (check-equal? it '(a b c))
+                                 'seen-06]
+                [(member 'b lst) (fail "acond selected wrong branch")])
+              'seen-06)
+(check-equal? seen 3)
+
+(check-equal? (acond
+                [(member 'absent lst) (fail "acond selected wrong branch")]
+                [(member 'b lst) (begin (check-equal? it '(b c))
+                                        'seen-07)])
+              'seen-07)
+
+(check-equal? (acond
+                [(member 'absent lst) (fail "acond selected wrong branch")]
+                [(member 'absent2 lst) (fail "acond selected wrong branch")])
+              (void))
+
+;; No branch
+(check-equal? (acond)
+              (void))
+
+;; Single branch
+(check-equal? (acond
+                [(member 'a lst) (begin (check-equal? it '(a b c))
+                                        'seen-09)])
+              'seen-09)
+
+(check-equal? (acond
+                [(member 'absent lst) (fail "acond selected wrong branch")])
+              (void))

test/aif-test.rkt

@@ -0,0 +1,17 @@
+#lang racket
+
+(require anaphoric/aif
+         rackunit)
+
+(define lst '(x y z a b c))
+
+(check-equal? (aif (member 'a lst)
+                (begin (check-equal? it '(a b c))
+                       'seen)
+                (fail "aif selected wrong branch"))
+              'seen)
+
+(check-equal? (aif (member 'absent lst)
+                (fail "aif selected wrong branch")
+                'seen)
+              'seen)

test/awhen-test.rkt

@@ -0,0 +1,24 @@
+#lang racket
+
+(require anaphoric/awhen
+         rackunit)
+
+(define lst '(x y z a b c))
+(define seen 0)
+
+(check-equal? (awhen (member 'absent lst)
+                (fail "awhen should not have executed body")
+                'seen)
+              (void))
+
+(check-equal? (awhen (member 'a lst)
+                'seen)
+              'seen)
+
+
+(check-equal? (awhen (member 'a lst)
+                (set! seen (add1 seen))
+                (check-equal? it '(a b c))
+                'seen)
+              'seen)
+(check-equal? seen 1) ;; Multiple body statements