diff --git a/README.md b/README.md index 07ad848..47a4cff 100644 --- a/README.md +++ b/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. ``` \ No newline at end of file diff --git a/acond.rkt b/acond.rkt new file mode 100644 index 0000000..de9f6c1 --- /dev/null +++ b/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)))])) \ No newline at end of file diff --git a/aif.rkt b/aif.rkt new file mode 100644 index 0000000..7383463 --- /dev/null +++ b/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))) \ No newline at end of file diff --git a/awhen.rkt b/awhen.rkt new file mode 100644 index 0000000..eb48f8c --- /dev/null +++ b/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)))) \ No newline at end of file diff --git a/it.rkt b/it.rkt new file mode 100644 index 0000000..3e0207f --- /dev/null +++ b/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))) \ No newline at end of file diff --git a/main.rkt b/main.rkt index 216dcac..0338d86 100644 --- a/main.rkt +++ b/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 <> ;; To view documentation: ;; $ raco docs <> -;; -;; 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) \ No newline at end of file diff --git a/scribblings/anaphoric.scrbl b/scribblings/anaphoric.scrbl index f4eee76..c9a2adb 100644 --- a/scribblings/anaphoric.scrbl +++ b/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)))] \ No newline at end of file diff --git a/test/acond-test.rkt b/test/acond-test.rkt new file mode 100644 index 0000000..f6e7c91 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/test/aif-test.rkt b/test/aif-test.rkt new file mode 100644 index 0000000..fd5b7d2 --- /dev/null +++ b/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) diff --git a/test/awhen-test.rkt b/test/awhen-test.rkt new file mode 100644 index 0000000..f2193a5 --- /dev/null +++ b/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 \ No newline at end of file