Syntax Parse Examples
Source code: https://github.com/bennn/syntax-parse-example
1 How to browse the examples
Scroll through this document, read the macros’ source code and look at the example uses of each macro.
The source code for each macro is in a top-level folder at https://github.com/bennn/syntax-parse-example. For example, the source for a macro named big-mac would be in the folder https://github.com/bennn/syntax-parse-example/big-mac.
2 How to use the examples in another project
Copy/paste the example code into a new file in your project, require that new file normally.
Install the syntax-parse-example package, then require the macro’s defining module. For example, the defining module for the first-class-or macro is "syntax-parse-example/first-class-or/first-class-or".
Clone the source code, then require the module path of the file that defines the macro.
3 Tutorials
Where to learn about syntax-parse?
How to Design Languages track of Racket School 2019, especially the Tuesday classes. This is a compact introduction to fundamental use of macros with lots of examples posed as exercises.
Official documentation, Syntax: Meta-Programming Helpers. docs.racket-lang.org/syntax/index.html The basic examples in Section 1.1 and more complex ideas in Section 1.2 (for example 1.2.2 "Optional Keyword Arguments") are a great way to get started.
Mythical Macros. soegaard.github.io/mythical-macros
Macros and Languages in Racket. rmculpepper.github.io/malr/index.html An unfinished manuscript from 2016 with a great "Basic Macrology" section. Recommended as a first introduction to macros. Demonstrates how to write "minimal macros" which defer evaluation of expressions but then call run-time functions to do most of their work.
The Fear of Macros tutorial is a great resource for basic macro engineering (though, not syntax-parse in particular).
4 A syntax-parse Crash Course
The syntax-parse form is a tool for unpacking data from a syntax object. It is similar to Racket’s match. Since the input to a macro is always a syntax object, syntax-parse is helpful for writing macros.
A syntax object is a Racket representation of source code. For example, #'(+ 1 2) is a syntax object that represents the sequence of characters (+ 1 2), along with the information that the + identifier is bound to a function in the racket/base library.
A macro is a compile-time function on syntax objects. In other words, a macro: (1) is a function, (2) expects a syntax object as input, (3) returns a new syntax object, and (4) runs at compile-time [Expansion].
The name K is historic.
> (require (for-syntax racket/base))
> (define-syntax (K args-stx) (define args (syntax-e args-stx)) ; syntax->list works too (if (= (length args) 3) (cadr args) (raise-argument-error 'K "syntax object containing a list with 3 elements" args-stx))) > (K 1 2) 1
> (K 1) K: contract violation
expected: syntax object containing a list with 3 elements
given: #<syntax:eval:4:0 (K 1)>
> (K 1 2 3) K: contract violation
expected: syntax object containing a list with 3 elements
given: #<syntax:eval:5:0 (K 1 2 3)>
Here is the same macro, defined using syntax-parse instead of the low-level syntax-e and cadr functions:
> (require (for-syntax racket/base syntax/parse))
> (define-syntax (K args-stx) (syntax-parse args-stx [(_ ?arg0 ?arg1) #'?arg0])) > (K 1 2) 1
> (K 1) eval:4:0: K: expected more terms starting with any term
at: ()
within: (K 1)
in: (K 1)
> (K 1 2 3) eval:5:0: K: unexpected term
at: 3
in: (K 1 2 3)
I don’t expect that all this makes sense so far. Try running and modifying these examples. Try reading the documentation for define-syntax and syntax-e and syntax-parse and syntax (aka #').
the parentheses say this pattern matches a (special kind of) list,
the underscore (_) means the first element of the list can be anything,
the name ?arg0 means the second element of the list can be anything and gets bound to the pattern variable ?arg0,
the name ?arg1 binds the third element to another pattern variable,
and if the list has more or fewer elements the pattern does not match.
A pattern variable is a special kind of variable; it can only be referenced inside
a new syntax object.
The name ?arg0 starts with a ? as a style choice —
5 The Examples
5.1 displaylns
Contributed by Lazerbeak12345 (#2) during the 2021 Syntax Parse Bee.
syntax
(displayln* expr ...)
To change the output port use parameterize.
> (displayln* 1 2 3 4 5 '(this is a list of datums 1 2 3 "hi")) 1 2 3 4 5 (this is a list of datums 1 2 3 hi)
> (parameterize ([current-output-port a-port]) (displayln* 1 2 '(a b))) 1 2 (a b)
With define-syntax-parse-rule, this macro is a one-liner:
#lang racket |
(provide displayln*) |
(require syntax/parse/define) |
(define-syntax-parse-rule (displayln* items:expr ...) |
(displayln (string-join (map ~a (list items ...)) " "))) |
You can easily to hide all the debug expressions by changing the macro body to (void).
You might extend the macro to compute source locations from its arguments.
5.2 defines
Contributed by Fictitious-Rotor (#7) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/defines/defines) | |
package: syntax-parse-example |
syntax
(defines [id-spec expr] ...)
id-spec = id | (id ...)
Definitions are automatically dispatched either to define or define-values as appropriate.
> (defines [x 4] [y 18] [(quot rem) (quotient/remainder x y)]) > quot 0
> rem 4
The macro uses the ~? fallthrough syntax to choose between define and define-values.
#lang racket |
(provide defines) |
(require syntax/parse/define) |
(define-syntax-parser defines |
[(_ (~or [id:id expr:expr] |
[(idv:id ...+) expr:expr]) ...+) |
#'(begin |
(~? (define id expr) |
(define-values (idv ...) expr)) ...)]) |
5.3 let-star
(require syntax-parse-example/let-star/let-star) | |
package: syntax-parse-example |
syntax
(let-star ((id expr) ...) expr)
(let* ([a 1] [b (+ a 1)]) b)
behaves the same as a nested let:
(let ([a 1]) (let ([b (+ a 1)]) b))
The let-star macro implements let* in terms of let.
#lang racket/base |
(provide let-star) |
(require (for-syntax racket/base syntax/parse)) |
(define-syntax (let-star stx) |
(syntax-parse stx |
[(_ ([x:id v:expr]) body* ...+) |
#'(let ([x v]) |
body* ...)] |
[(_ ([x:id v:expr] . bind*) body* ...+) |
#'(let ([x v]) |
(let-star bind* body* ...))] |
[(_ bad-binding body* ...+) |
(raise-syntax-error 'let-star |
"not a sequence of identifier--expression pairs" stx #'bad-binding)] |
[(_ (bind*)) |
(raise-syntax-error 'let-star |
"missing body" stx)])) |
> (let-star 1) eval:1:0: let-star: expected more terms
at: ()
within: (let-star 1)
in: (let-star 1)
> (let-star ([a 1])) eval:2:0: let-star: missing body
in: (let-star ((a 1)))
> (let-star ([a 1] [b (+ a 1)] [c (+ b 1)]) c) 3
5.4 first-class-or
(require syntax-parse-example/first-class-or/first-class-or) | |
package: syntax-parse-example |
syntax
(first-class-or expr ...)
See also Combining Tests: and and or
Identifier macros can be evaluated as identifiers.
expand like Racket’s or when called like a function, and
expand to a function definition when used like an identifier.
> (first-class-or #false #true) #t
> (apply first-class-or '(#false #true 0)) #t
> (first-class-or (+ 2 3) (let loop () (loop))) 5
> (map first-class-or '(9 #false 3) '(8 #false #false)) '(9 #f 3)
Implementation:
#lang racket/base |
(provide first-class-or) |
(require (for-syntax racket/base syntax/parse)) |
(define-syntax (first-class-or stx) |
(syntax-parse stx |
[(_) |
#'#false] |
[(_ ?a . ?b) |
#'(let ([a-val ?a]) |
(if a-val a-val (first-class-or . ?b)))] |
[_:id |
#'(lambda arg* |
(let loop ([arg* arg*]) |
(cond |
[(null? arg*) |
#false] |
[(car arg*) |
(car arg*)] |
[else |
(loop (cdr arg*))])))])) |
The first two syntax/parse clauses define what happens when or is called like a function.
The pattern _:id matches any identifier.
The dot notation in (_ ?a . ?b) could be (_ ?a ?b ...) instead. See Pairs, Lists, and Racket Syntax for intuition about what the dot means, and Syntax Patterns for what it means in a syntax pattern.
5.5 optional-assert
(require syntax-parse-example/optional-assert/optional-assert) | |
package: syntax-parse-example |
syntax
(optional-assert expr ...)
a test that evaluates an expression and halts the program if the result is #f,
or nothing
#lang racket/base |
(provide optional-assert exn:fail:optional-assert?) |
(require (for-syntax racket/base syntax/parse)) |
(define-for-syntax no-asserts? (getenv "DISABLE_OPTIONAL_ASSERT")) |
(struct exn:fail:optional-assert exn:fail ()) |
(define (make-exn:fail:optional-assert datum) |
(exn:fail:optional-assert (format "assertion failure: ~a" datum) |
(current-continuation-marks))) |
(define-syntax (optional-assert stx) |
(syntax-parse stx |
[(_ e:expr) |
(if no-asserts? |
#'(void) |
#'(unless e |
(raise (make-exn:fail:optional-assert 'e))))])) |
procedure
x : any/c
5.6 make-variable
Adapted from the racket-ebuild project.
(require syntax-parse-example/make-variable/make-variable) | |
package: syntax-parse-example |
syntax
(make-variable v)
When given a string or symbol, the input is the name and value of the new variable.
When given an identifier, the identifier name is the variable name and the identifier value is the variable’s value.
> (make-variable "this_variable_will_probably_change") "this_variable_will_probably_change=\"this_variable_will_probably_change\""
> (define Z "Zzz...") > (make-variable Z) "Z=\"Zzz...\""
The macro uses syntax-parse to decide how to process its input. It then outputs code that calls the as-variable helper function.
#lang racket/base |
(provide make-variable as-variable) |
(require (for-syntax racket/base syntax/parse)) |
(define (as-variable lhs rhs) |
(format "~a=\"~a\"" lhs rhs)) |
(define-syntax (make-variable stx) |
(syntax-parse stx |
[(_ name:id) |
#'(as-variable (symbol->string 'name) name)] |
[(_ str:string) |
#'(as-variable str str)] |
[(_ ((~literal quote) sym)) |
#'(as-variable (symbol->string 'sym) 'sym)])) |
procedure
(as-variable lhs rhs) → string?
lhs : any/c rhs : any/c
5.7 define/curry
(require syntax-parse-example/define-curry/define-curry) | |
package: syntax-parse-example |
syntax
(define/curry (fn-id arg-id ...+) body ...+)
> (define/curry (insert-between mid left right) (string-join (list left mid right) "")) > (define dash-between (insert-between "-")) > (dash-between "left" "right") "left-right"
The macro uses syntax/loc to give newly-defined functions names that point to their definition rather than to the macro body.
#lang racket |
(provide define/curry) |
(require (for-syntax syntax/parse)) |
(begin-for-syntax |
(define-syntax-class name-params |
#:description "name and parameters clause" |
(pattern (name:id params:id ...+) |
#:fail-when (check-duplicate-identifier |
(syntax->list #'(params ...))) |
"duplicate parameter name"))) |
(define-syntax (define/curry stx) |
(syntax-parse stx |
[(_ np:name-params body ...+) |
#`(define np.name |
(curry |
#,(syntax/loc stx |
(λ (np.params ...) body ...))))])) |
5.8 Cross Macro Communication
(require syntax-parse-example/cross-macro-communication/cross-macro-communication) | |
package: syntax-parse-example |
syntax
(define-for-macros id expr)
syntax
(get-macroed id)
> (define-for-macros cake 42) > (get-macroed cake) 42
> cake eval:3:0: cake: illegal use of syntax
in: cake
value at phase 1: 42
This communication works even if the identifiers are defined and used in different files or modules:
> (module the-definition racket (require syntax-parse-example/cross-macro-communication/cross-macro-communication) (define-for-macros shake 54) (provide shake))
> (require 'the-definition syntax-parse-example/cross-macro-communication/cross-macro-communication) > (get-macroed shake) 54
Implementation:
#lang racket/base |
(provide define-for-macros get-macroed) |
(require (for-syntax racket/base syntax/parse)) |
(define-syntax (define-for-macros stx) |
(syntax-parse stx |
[(_ name:id expr) |
#'(define-syntax name expr)])) |
(define-syntax (get-macroed stx) |
(syntax-parse stx |
[(_ name:id) |
#`(#%datum . #,(syntax-local-value #'name))])) |
define-for-macros simply binds a new value at compile time using define-syntax. In this example define-for-macros is mostly synonymous with define-syntax, but it demonstrates that the name could be changed (to say add a question mark at the end), and the given expression can be changed. The get-macroed form simply takes the compile time value and puts it in the run time module. If name is used outside of a macro then a syntax error is raised.
The point of #%datum is to make it seem like a value was part of the source code. See Expansion Steps for details.
5.9 Basic while loop equipped with break
Contributed by countvajhula (#20) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/while-break/while-break) | |
package: syntax-parse-example |
syntax
(while test body ...+)
A simple while loop familiar from many programming languages, this macro works by using a named let to provide the looping, and an escape continuation to provide the ability to break out of the loop.
In typical implementations, break is a statement that allows you to leave the while loop at any time, but it is also a special kind of statement in that you can only use it within the body of the while loop. To ensure this behavior, the macro defines break as a syntax parameter, which in a nutshell is a way to define syntax with default behavior outside the macro body (in our case, simply reporting a syntax error) and special behavior within the macro body. This parameter is then used as a label for the continuation so that it may be used to exit the loop.
syntax
(break value ...)
#lang racket/base |
(provide while break) |
(require syntax/parse/define racket/stxparam (for-syntax racket/base)) |
(define-syntax-parameter break |
(lambda (stx) |
(raise-syntax-error (syntax-e stx) "can only be used inside `while`"))) |
(define-syntax-parse-rule (while condition body ...) |
(call/ec |
(λ (return) |
(syntax-parameterize ([break (make-rename-transformer #'return)]) |
(let loop () |
(when condition |
(begin body ... |
(loop)))))))) |
In Racket, most expressions evaluate to a specific value (or many values), reflecting the functional style of programming which discourages side effects such as mutating the value of a variable. A while loop inherently encourages side effects since it typically has no return value (and of course, must mutate a variable if the loop is to terminate!). Yet, in the present implementation, the while expression can evaluate to a specific value when one is explicitly returned via break. Could the implementation be modified to return a value even in the case of a normal exit? For instance, we could have it return the value of the final expression executed in the course of looping. As an exercise, see if you can make the while loop a little more "functional" by allowing it to always return a value.
5.10 define-extend
Contributed by camoy (#13) during the 2021 Syntax Parse Bee.
Suppose we’re writing interpreters interp0 and interp1 for languages L0 and L1 respectively. L0 has numbers and binary addition, and L1 extends L0 with binary multiplication. Goal: Write interp1 without copying all the cases from interp0.
Basic Solution
One solution is to write the interpreters in open-recursive style. Instead of recurring directly, recursive calls occur indirectly through an extra parameter. An interpreter can be invoked by closing the recursion using a fixed-point combinator.
(define fix (λ (f) ((λ (x) (f (λ (g) ((x x) g)))) (λ (x) (f (λ (g) ((x x) g))))))) (define ((interp0 recur) e) (match e [`(+ ,x ,y) (+ (recur x) (recur y))] [(? number?) e])) ((fix interp0) '(+ (+ 1 2) (+ 5 6))) (define ((interp1 recur) e) (match e [`(* ,x ,y) (* (recur x) (recur y))] [_ ((interp0 recur) e)])) ((fix interp1) '(+ (+ 1 2) (* 5 6)))
We can do better.
(require syntax-parse-example/define-extend/define-extend) | |
package: syntax-parse-example |
syntax
(define-extend (name . formals) maybe-extend body ...+)
maybe-extend =
| (#:extend parent-id)
> (define-extend (interp0 e) (match e [`(+ ,x ,y) (+ (interp0 x) (interp0 y))] [(? number?) e])) > (interp0 '(+ (+ 1 2) (+ 5 6))) 14
> (define-extend (interp1 e) #:extend interp0 (match e [`(* ,x ,y) (* (interp1 x) (interp1 y))] [_ (interp0 e)])) > (interp1 '(+ (+ 1 2) (* 5 6))) 33
This macro supports some static checking. If the procedure we’re extending wasn’t defined using define-extend, then we get a compile-time error.
> (define-extend (interp1 e) #:extend map 'not-implemented) eval:5:0: define-extend: expected an extensible procedure
at: map
in: (define-extend (interp1 e) #:extend map (quote
not-implemented))
parsing context:
while parsing extend-option
term: (#:extend map (quote not-implemented))
location: eval:5:0
Implementation:
#lang racket/base |
(provide define-extend) |
(require (for-syntax racket/base |
syntax/parse |
syntax/parse/lib/function-header)) |
(begin-for-syntax |
(struct extensible (closed-id open-id) |
#:property prop:rename-transformer 0) |
(define-splicing-syntax-class extend-option |
#:attributes (parent-id open-id) |
(pattern (~seq #:extend parent-id:id) |
#:do [(define-values (parent-ext _) |
(syntax-local-value/immediate #'parent-id |
(λ () (values #f #f))))] |
#:fail-when (and (not (extensible? parent-ext)) #'parent-id) |
"expected an extensible procedure" |
#:attr open-id (extensible-open-id parent-ext)) |
(pattern (~seq) |
#:attr parent-id #f |
#:attr open-id #f))) |
(define-syntax (define-extend stx) |
(syntax-parse stx |
[(_ (?name:id . ?fmls:formals) ?ext:extend-option ?body:expr ...+) |
#:with (?closed ?open) (generate-temporaries #'(?name ?name)) |
#:with ?proc |
(syntax/loc stx |
(~? (λ ?fmls |
(let ([?ext.parent-id (?ext.open-id ?name)]) |
?body ...)) |
(λ ?fmls ?body ...))) |
#'(begin |
(define ?closed |
(letrec ([?name ?proc]) |
?name)) |
(define (?open ?name) ?proc) |
(define-syntax ?name |
(extensible #'?closed #'?open)))])) |
For a valid input, define-extend generates two variants of the procedure: a closed version and an open version. It then creates a transformer binding that records the name of both these variants in an extensible struct. This struct has prop:rename-transformer so that calling the procedure defaults to the closed variant.
When defining an extension of procedure f, we make sure to shadow the binding of f within the body of the extension so as to close it off appropriately. We use the extensible struct (found by syntax-local-value/immediate) to get the identifier of the open version of f.
5.11 def
(require syntax-parse-example/def/def) | |
package: syntax-parse-example |
requires a docstring
requires test cases;
optionally accepts contract annotations on its arguments; and
optionally accepts pre- and post- conditions.
syntax
(def (id argspec ...) doc-string testcases optional-pre-post ... body ...+)
argspec = arg-id | (arg-id : contract?) testcases = #:tests [test ...] test = (boolean-expr ==> result-expr) optional-pre-post = #:pre [(pre-comparison-fn failure-doc) ...] | #:post [(post-comparison-fn failure-doc) ...]
arg-id : symbol?
pre-comparison-fn : (-> any/c ... boolean?)
post-comparison-fn : (-> any/c boolean?)
failure-doc : string?
doc-string : string?
The expansion of def must occur inside a module (rather than a REPL) because it adds (module+ test) for the #:test code. Ordinarily def will be used inside a file, so it will automatically be inside a module.
> (module snoc racket/base (require syntax-parse-example/def/def) (def (snoc (x* : list?) x) "Append the value `x` to the end of the given list" #:test [ ((snoc '(1 2) 3) ==> '(1 2 3)) ((snoc '(a b) '(c)) ==> '(a b (c)))] (append x* (list x))) (provide snoc)) > (require 'snoc) > (snoc 1 '(2 3)) snoc: contract violation
expected: list?
given: 1
> (snoc '(1 2) 3) '(1 2 3)
> (module gcd racket/base (require syntax-parse-example/def/def) (def (gcd (x : integer?) (y : integer?)) "greatest common divisor" #:pre [ (>= "First argument must be greater-or-equal than second")] #:test [ ((gcd 10 3) ==> 1) ((gcd 12 3) ==> 3)] (cond [(zero? y) x] [else (gcd y (- x (* y (quotient x y))))])) (provide gcd)) > (require 'gcd) > (gcd 42 777) gcd: First argument must be greater-or-equal than second
> (gcd 777 42) 21
If the docstring or test cases are missing, def throws a syntax error.
> (def (f x) x) eval:9:0: def: expected string or expected one of these
literals: #:test, #:pre, or #:post
at: x
in: (def (f x) x)
> (def (f x) "identity" x) eval:10:0: def: expected string or expected one of these
literals: #:test, #:pre, or #:post
at: x
in: (def (f x) "identity" x)
> (def (f x) #:test [((f 1) ==> 1)] x) eval:11:0: def: expected string or expected one of these
literals: #:test, #:pre, or #:post
at: x
in: (def (f x) #:test (((f 1) ==> 1)) x)
The begin-for-syntax defines two syntax classes (see Syntax Classes). The first syntax class, arg-spec, captures arguments with an optional contract annotation. The second, doc-spec, captures docstrings.
The large ~or pattern captures the required-and-optional stuff that def accepts: the docstring, the #:test test cases, the #:pre pre-conditions, and the #:post post-conditions.
The four #:with clauses build syntax objects that run unit tests and/or checks.
The syntax object made from the #:test clause creates a post-submodule (module+ test ....) and uses parameterize to capture everything that the tests print to current-output-port.
The examples in the docs for the ~optional pattern help explain (1) why #'#f can be a useful #:default and (2) when it is necessary to specify the ellipses depth in a #:default, as in (check-pre* 1).
#lang racket/base |
(provide def) |
(require rackunit (for-syntax racket/base syntax/parse)) |
(begin-for-syntax |
(define-syntax-class arg-spec |
#:attributes (name type) |
#:datum-literals (:) |
(pattern |
(name:id : type:expr)) |
(pattern |
name:id |
#:with type #'#f)) |
(define-syntax-class doc-spec |
(pattern |
e:str)) |
) |
(define-syntax (def stx) |
(syntax-parse stx #:datum-literals (==>) |
[(_ (name:id arg*:arg-spec ...) |
(~or ;; using (~or (~once a) ...) to simulate an unordered (~seq a ...) |
(~once (~describe #:role "docstring" "docstring" doc:doc-spec)) |
(~once (~seq #:test ((in* ==> out* |
(~optional (~seq #:stdout expected-output*:str) |
#:defaults ([expected-output* #'#f]))) |
...))) |
(~once (~optional (~seq #:pre ([check-pre* pre-doc*:doc-spec] ...)) |
#:defaults ([(check-pre* 1) '()] [(pre-doc* 1) '()]))) |
(~once (~optional (~seq #:post ([check-post* post-doc*:doc-spec] ...)) |
#:defaults ([(check-post* 1) '()] [(post-doc* 1) '()])))) ... |
body) |
#:with check-types |
#'(for ([arg-name (in-list (list arg*.name ...))] |
[arg-type (in-list (list arg*.type ...))] |
[i (in-naturals)] |
#:when arg-type) |
(unless (arg-type arg-name) |
(raise-argument-error 'name (symbol->string (object-name arg-type)) i arg-name))) |
#:with check-pre |
#'(for ([pre-check (in-list (list check-pre* ...))] |
[pre-doc (in-list (list pre-doc* ...))]) |
(unless (pre-check arg*.name ...) |
(raise-user-error 'name pre-doc))) |
#:with check-post |
#'(lambda (result) |
(for ([post-check (in-list (list check-post* ...))] |
[post-doc (in-list (list post-doc* ...))]) |
(unless (post-check result) |
(error 'name post-doc)))) |
#:with test-cases |
#'(module+ test |
(let* ([p (open-output-string)] |
[result-val (parameterize ([current-output-port p]) in*)] |
[result-str (begin0 (get-output-string p) |
(close-output-port p))]) |
(check-equal? result-val out*) |
(when expected-output* |
(check-equal? result-str expected-output*))) |
...) |
#'(begin |
test-cases |
(define (name arg*.name ...) |
check-types |
check-pre |
(let ([result body]) |
(begin0 result |
(check-post result)))))])) |
This macro gives poor error messages when the docstring or test cases are missing.
The doc-spec syntax class could be extended to accept Scribble, or another kind of docstring syntax.
A #:test case may optionally use the #:stdout keyword. If given, the test will fail unless running the test prints the same string to current-output-port.
5.12 conditional-require
(require syntax-parse-example/conditional-require/conditional-require) | |
package: syntax-parse-example |
syntax
(conditional-require expr id id)
#lang racket/base |
(provide conditional-require) |
(require (for-syntax racket/base syntax/parse)) |
(begin-for-syntax |
(define-syntax-class mod-name |
(pattern _:id) |
(pattern _:str))) |
(define-syntax (conditional-require stx) |
(syntax-parse stx |
[(_ test:boolean r1:mod-name r2:mod-name) |
(if (syntax-e #'test) |
#'(require r1) |
#'(require r2))])) |
The syntax class mod-name matches syntactic strings or identifiers. This doesn’t guarantee that the second and third argument to conditional-require are valid module paths, but it rules out nonsense like (conditional-require #true (+ 2 2) 91).
The test could be more interesting. It could branch on the value of current-command-line-arguments, or do a case based on system-type.
5.13 multi-check-true
(require syntax-parse-example/multi-check-true/multi-check-true) | |
package: syntax-parse-example |
syntax
(multi-check-true expr ...)
(multi-check-true #true #false (even? 0))
expands to code that behaves the same as:
(check-true #true) (check-true #false) (check-true (even? 0))
The main difference between the macro and the example is that the macro uses with-check-info* to improve test failure messages. If part of a multi-check-true fails, the error message points to the bad expression (rather than the multi-check-true macro).
#lang racket/base |
(provide multi-check-true) |
(require rackunit (for-syntax racket/base syntax/srcloc syntax/parse)) |
(define-syntax (multi-check-true stx) |
(syntax-parse stx |
[(_ e* ...) |
#`(begin |
#,@(for/list ([e (in-list (syntax-e #'(e* ...)))]) |
(define loc (build-source-location-list e)) |
#`(with-check-info* (list (make-check-location '#,loc)) |
(λ () (check-true #,e)))))])) |
5.14 define-datum-literal-set
(require syntax-parse-example/define-datum-literal-set/define-datum-literal-set) | |
package: syntax-parse-example |
syntax
(define-datum-literal-set id (id ...))
Given a sequence of symbols, the define-datum-literal-set macro builds a syntax class that matches these symbols.
(define-datum-literal-set C-keyword (auto break case char const continue default do double else)) (define-syntax (is-C-keyword? stx) (syntax-parse stx [(_ x:C-keyword) #'#true] [(_ x) #'#false])) (is-C-keyword? else) (is-C-keyword? synchronized)
The macro works by defining a literal set and then a syntax class.
#lang racket/base |
(provide define-datum-literal-set) |
(require (for-syntax racket/base racket/syntax syntax/parse)) |
(define-syntax (define-datum-literal-set stx) |
(syntax-parse stx |
[(_ cls-name:id (lit*:id ...)) |
#:with set-name (format-id stx "~a-set" (syntax-e #'cls-name)) |
#'(begin-for-syntax |
(define-literal-set set-name |
#:datum-literals (lit* ...) |
()) |
(define-syntax-class cls-name |
#:literal-sets ([set-name]) |
(pattern (~or lit* ...)))) ])) |
5.15 rec/c
(require syntax-parse-example/rec-contract/rec-contract) | |
package: syntax-parse-example |
syntax
(rec/c id expr)
#lang racket/base |
(provide rec/c) |
(require racket/contract (for-syntax racket/base syntax/parse)) |
(define-syntax-rule (rec/c t ctc) |
(letrec ([rec-ctc |
(let-syntax ([t (syntax-parser (_:id #'(recursive-contract rec-ctc)))]) |
ctc)]) |
rec-ctc)) |
> (define/contract (deep n) (-> integer? (rec/c t (or/c integer? (list/c t)))) (if (zero? n) n (list (deep (- n 1))))) > (deep 4) '((((0))))
5.16 log-once
Contributed by Fictitious-Rotor (#3) during the 2021 Syntax Parse Bee.
procedure
(log-once [ #:skip-count skip #:log-count log-count #:when cond #:message msg #:newline newline?] expr ...) → void? skip : natural? = 0 log-count : natural? = 1 cond : any/c = (void) msg : string? = "" newline? : boolean? = #f expr : any/c
> (for ([char (in-string "abcdefghijklmnopqrstuvwxyz")]) (log-once #:skip-count 18 #:log-count 3 char))
char = #\s.
char = #\t.
char = #\u.
> (for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")]) (log-once #:skip-count 2 #:when (char-upper-case? char) char)) char = #\Q.
The macro replaces patterns of code that would look something like this:
; You have to define the variables somewhere where they won't ; fall out of scope so that the mutations matter ; You also have to be wary of leaving any of this code lying ; around once you're finished with debugging (define is-logged #f) (define skip-count 0) (for ([char (in-string "abcdefGhijkLmnopQrstuVwxyz")]) (when (and (not is-logged) (char-upper-case? char) (begin (set! skip-count (add1 skip-count)) (> skip-count 2))) (printf "char = ~s\n" char) (set! is-logged #t)))
The set of macros have gone through many revisions (link). This iteration makes use of ~?, ~@, syntax-local-lift-expression, and the excellent ....
#lang racket/base |
(require racket/function |
syntax/parse/define |
(for-syntax racket/base |
syntax/parse |
racket/format |
syntax/parse)) |
(provide log-once) |
(define log-var (curry printf "~a = ~s. ")) |
(define-syntax-parser log-def |
[(_ expr:expr) |
#`(log-var #,(~s (syntax->datum #'expr)) expr)]) |
(begin-for-syntax |
(define (make-incrementor id) |
(with-syntax ([id id]) |
#'(λ () |
(set! id (add1 id)) |
id)))) |
(define-syntax-parser log-defs |
[(_ (~optional (~seq #:newline use-newline-stx:boolean)) |
exprs*:expr ...+) |
#:attr use-newline (syntax-e #'(~? use-newline-stx #f)) |
#:attr intermediate-newline-clause (if (attribute use-newline) #'(newline) #f) |
#:attr ultimate-newline-clause (if (attribute use-newline) #f #'(newline)) |
#'(begin |
(~@ (log-def exprs*) |
(~? intermediate-newline-clause)) ... |
(~? ultimate-newline-clause))]) |
(define-syntax-parser log-once |
[(_ (~alt (~optional (~seq #:skip-count target-skip-count:nat) #:name "#:skip-count keyword" |
#:defaults ([target-skip-count #'0])) |
(~optional (~seq #:log-count target-log-count:nat) #:name "#:log-count keyword" |
#:defaults ([target-log-count #'1])) |
(~optional (~seq #:when condition:expr) #:name "#:when keyword") |
(~optional (~seq #:message message:str) #:name "#:message keyword") |
(~optional (~seq #:newline newln:boolean) #:name "#:newln keyword")) ... |
exprs* ...+) |
#:with logged (syntax-local-lift-expression #'#f) |
#:with run-count (syntax-local-lift-expression #'0) |
#:with ++run-count (make-incrementor #'run-count) |
#:with log-count (syntax-local-lift-expression #'0) |
#:with ++log-count (make-incrementor #'log-count) |
#:with should-run?! (syntax-local-lift-expression |
#'(λ () |
(and (> (++run-count) target-skip-count) |
(<= (++log-count) target-log-count)))) |
#:with stop-logging?! (syntax-local-lift-expression |
#'(λ () |
(when (<= target-log-count log-count) |
(set! logged #t)))) |
#'(and (not logged) |
(when (and (~? condition) |
(should-run?!)) |
(~? (display message)) |
(log-defs (~? (~@ #:newline newln)) exprs* ...) |
(stop-logging?!)))]) |
5.17 marc-matcher
Contributed by hzafar (#4) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/marc-matcher/marc-matcher) | |
package: syntax-parse-example |
This is a very domain-specific macro, developed for a particular bibliographic metadata use-case.
syntax
(marc-matcher ([re #:as name] ...) body ...)
$aCarroll, Lewis,$d1832-1898,$eauthor.
In each field, individual subfields are separated using a separator character (in this case $); the character immediately following the separator is called the subtag; and the substring up to the next separator or end-of-string is the subfield data. So in the example above, there are three subfields, $a, $d, and $e, whose data are, respectively, Carroll, Lewis, 1832-1898, and author.
Parsing subfields out of this is often done using regular expressions, but it gets really difficult when trying to deal with subfield repetitions. I’ll use field 264 to illustrate. This field mainly contains the following pieces of publication information: the $a subfield contains place of publication; the $b subfield contains the entity responsible for publication; and the $c subfield contains the date of publication. There are several possible repetition patterns for these subfields which require different semantic interpretations. To give a few examples:
- a+bc: multiple places of publication with the same publisher
$aLondon ;$aNew York :$bRoutledge,$c2017. [source]
- ab+c: multiple publishers with the same place of publication
$aNew York, NY :$bBarnes & Noble :$bSterling Publishing Co., Inc.,$c2012. [source]
- (ab)+c: multiple publications, each with different places and publishers
$aBoston :$bLee and Shepard, publishers ;$aNew York :$bLee, Shepard, and Dillingham,$c1872. [source]
Writing a regex to intelligently parse this information out of the string is a pain, but regexes are an already popular and well understood tool in the metadata community. Thus, marc-matcher lets users specify regular expressions that match subgroups within the field they want to parse, and define variables they can use in their code containing the results of those matches, which allows more complex kinds of processing to be done with simpler code.
> (define parse-264 (marc-matcher ([#px"ab" #:as place-entity-groups] [#px"c" #:as date]) (for/list ([group place-entity-groups]) (cons (marc-subfield-data date) (map marc-subfield-data group))))) > (parse-264 "$aBoston :$bLee and Shepard, publishers ;$aNew York :$bLee, Shepard, and Dillingham,$c1872.")
'(("1872." "Boston :" "Lee and Shepard, publishers ;")
("1872." "New York :" "Lee, Shepard, and Dillingham,"))
The first clause of the marc-matcher expression is a list of variable definitions, similar to a parameter list for a lambda. For example, the clause [#px"ab" :as place-entity-groups] defines a variable called place-entity-groups, which will be a list of all the groups (which are themselves lists of structs) consisting of a single subfield $a followed by a single subfield $b. The second clause is the computation the user wishes to do with the values extracted from the field, and can refer to the variables defined in the first clause.
Here is another example, using table of contents data [source].
> (define matcher (marc-matcher ([#px"tr?" #:as title-info-groups]) (for ([group title-info-groups]) (define title (first (map marc-subfield-data (filter (λ (sf) (equal? "t" (marc-subfield-subtag sf))) group)))) (define authors (map marc-subfield-data (filter (λ (sf) (equal? "r" (marc-subfield-subtag sf))) group))) (printf "Title: ~a~a~n~n" (string-trim title #px"( /\\s*)|( --\\s*)|\\.") (if (empty? authors) "" (string-append "\nAuthor: " (string-trim (first authors) #px"( /\\s*)|( --\\s*)|\\.")))))))
> (matcher (string-join '("$tCaveat Lector; or how I ransacked Wikipedias across the Multiverse soley " "to amuse and edify readers -- $tMystery of the missing mothers / $rKristin King -- " "$tSecrets of Flatland / $rAnne Toole -- $tSanyo TM-300 Home-Use Time Machine / " "$rJeremy Sim -- $tElizabeth Burgoyne Corbett / $rL. Timmel Duchamp -- " "$tBiographies.") ""))
Title: Caveat Lector; or how I ransacked Wikipedias across the Multiverse soley to amuse and edify readers
Title: Mystery of the missing mothers
Author: Kristin King
Title: Secrets of Flatland
Author: Anne Toole
Title: Sanyo TM-300 Home-Use Time Machine
Author: Jeremy Sim
Title: Elizabeth Burgoyne Corbett
Author: L. Timmel Duchamp
Title: Biographies
The macro definition parses the clauses for parameters and regexps, and then generates calls to run-time helper functions.
#lang racket |
(provide marc-matcher (struct-out marc-subfield)) |
(require syntax/parse/define |
syntax-parse-example/marc-matcher/marc-matcher-helpers |
(for-syntax syntax-parse-example/marc-matcher/marc-matcher-syntax-classes)) |
(define-syntax (marc-matcher stx) |
(syntax-parse stx |
[(_ (var:marc-var-defn ...) body:expr ...) |
(define params #'(var.name ...)) |
(define regexps #'(var.re ...)) |
#`(λ (input [sep "$"]) |
(define args (get-subfield-data '#,regexps input sep)) |
(apply (λ #,params (begin body ...)) (map simplify-groups args)))])) |
struct
(struct marc-subfield (subtag data) #:extra-constructor-name make-marc-subfield #:transparent) subtag : any/c data : any/c
5.18 struct-list
(require syntax-parse-example/struct-list/struct-list) | |
package: syntax-parse-example |
syntax
(struct-list expr ...)
> (struct-list foo ([a : String] [b : String]) #:type-name Foo) > (define f (foo "hello" "world")) > (foo? f) - : Boolean
#t
> (string-append (foo-a f) " " (foo-b f)) - : String
"hello world"
> (ann f Foo) - : Foo
'(foo "hello" "world")
extracts the names and type names from the syntax,
creates an identifier for the predicate and a sequence of identifiers for the accessors (see the #:with clauses),
and defines a constructor and predicate and accessor(s).
#lang typed/racket/base |
(provide struct-list) |
(require (for-syntax racket/base racket/syntax syntax/parse)) |
(define-syntax (struct-list stx) |
(syntax-parse stx #:datum-literals (:) |
[(_ name:id ([f*:id : t*] ...) #:type-name Name:id) |
#:fail-when (free-identifier=? #'name #'Name) |
"struct name and #:type-name must be different" |
#:with name? |
(format-id stx "~a?" (syntax-e #'name)) |
#:with ((name-f* i*) ...) |
(for/list ([f (in-list (syntax-e #'(f* ...)))] |
[i (in-naturals 1)]) |
(list (format-id stx "~a-~a" (syntax-e #'name) (syntax-e f)) i)) |
(syntax/loc stx |
(begin |
(define-type Name (Pairof 'name (Listof Any))) |
(define (name (f* : t*) ...) : Name |
(list 'name f* ...)) |
(define (name? (v : Any)) : Boolean |
(and (list? v) (not (null? v)) (eq? 'name (car v)))) |
(define (name-f* (p : Name)) : t* |
(cast (list-ref p 'i*) t*)) |
...))])) |
5.19 syntax-class-contract
(require syntax-parse-example/syntax-class-contract/syntax-class-contract) | |
package: syntax-parse-example |
procedure
(syntax-class-contract cls) → flat-contract?
cls : reified-syntax-class?
> (define-syntax add-hello (contract (-> (syntax-class-contract (reify-syntax-class str)) syntax?) (lambda (stx) (let ([orig-str (syntax-e (cadr (syntax-e stx)))]) (with-syntax ([new-str (string-append "hello" " " orig-str)]) #'new-str))) 'this-macro 'the-macro-user)) > (add-hello "world") "hello world"
> (add-hello 'not-string) add-hello: contract violation
expected: (syntax-parse-arg/c
#(struct:reified-syntax-class -string ...))
given: #<syntax:eval:3:0 (add-hello (quote not-string))>
in: the 1st argument of
(->
(syntax-parse-arg/c
#(struct:reified-syntax-class
-string
...))
syntax?)
contract from: this-macro
blaming: the-macro-user
(assuming the contract is correct)
Implementation:
#lang racket/base |
(provide syntax-class-contract) |
(require racket/contract |
syntax/parse |
syntax/parse/experimental/reflect) |
(define (syntax-class-contract cls) |
(flat-named-contract `(syntax-parse-arg/c ,cls) |
(syntax-parser |
[(_ (~reflect arg (cls))) #true] |
[_ #false]))) |
Special thanks to Michael Ballantyne for developing this macro tool.
Challenge: try making a kind of contract-out that can attach contracts to macros.
5.20 except-in-quiet
(require syntax-parse-example/except-in-quiet/except-in-quiet) | |
package: syntax-parse-example |
Thanks to Leif Andersen for the original macro.
Racket’s except-in form subtracts a sequence of identifiers from a source. If the source does not provide one of the named identifiers, then except-in raises a syntax error.
> (require (except-in racket/list second)) > (first '(1 2 3)) 1
> (second '(1 2 3)) second: undefined;
cannot reference an identifier before its definition
in module: top-level
> (require (except-in racket/list snd)) eval:4:0: except-in: identifier `snd' not included in nested
require spec
at: racket/list
in: (except-in racket/list snd)
syntax
(except-in-quiet expr ...)
> (require (except-in-quiet racket/list second)) > (first '(1 2 3)) 1
> (second '(1 2 3)) second: undefined;
cannot reference an identifier before its definition
in module: top-level
> (require (except-in-quiet racket/list snd))
The macro (or rather, require transformer) should work in four steps:
resolve the required expression to a module,
find all exports from that module,
subtract names from the export list, and
proceed with a call to expand-import.
Steps 2 through 4 are implemented fairly well below. Step 1, however, is done in a very simple way. It works for basic paths like racket/base but nothing more complicated.
#lang racket/base |
(provide except-in-quiet) |
(require |
(for-syntax |
racket/base |
racket/require-transform |
racket/set |
syntax/parse)) |
(define-for-syntax (export-list->phase0-ids phase-dict) |
(define phase0-id-info* |
(cdr |
(or (assoc 0 phase-dict) |
(cons #f '())))) |
(map car phase0-id-info*)) |
(define-syntax except-in-quiet |
(make-require-transformer |
(syntax-parser |
[(_ modname:id exception-names:id ...) |
(define-values [provided-vals provided-macros] |
(module->exports (syntax-e #'modname))) |
(define exceptions |
(map syntax-e (attribute exception-names))) |
(define excluded |
(set-intersect |
exceptions |
(set-union |
(export-list->phase0-ids provided-vals) |
(export-list->phase0-ids provided-macros)))) |
(expand-import #`(except-in modname #,@excluded))]))) |
5.21 dot-underscore
Contributed by soegaard (#15) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/dot-underscore/dot-underscore) | |
package: syntax-parse-example |
See the source file dot-underscore.rkt for explanation.
There are examples in test-dot-underscore.rkt.
5.22 Try/Catch/Finally Macros
try/catch/finally is a common and familiar syntax for handling exceptions, used in many languages such as Java, C++ and Clojure. Errors thrown within the try block may be "caught" by the catch clauses. In any case, whether by normal return or exception, the finally clause is executed.
5.22.1 try — a try/catch/finally for sarna
Adapted from the try-make-sarna-happy package.
syntax
(try body-expr ...+ maybe-catch maybe-catch/match maybe-finally)
maybe-catch =
| (catch [pred-expr exn-id handler-expr ...+] ...) | (catch/match [match-expr handler-expr ...+] ...) maybe-finally =
| (finally finally-expr ...+)
The catch clauses use with-handlers, but in a different format: when pred-expr returns true for a thrown exception, exn-id is bound to the exception for the body handler-expr.
The catch/match clauses are match forms tested against the exception.
When both catch-style and catch/match-style clauses are present, all of the catch-style clauses are tried before any of the catch/match clauses.
> (try (/ 10 0) (catch [exn:fail? e (exn-message e)])) "/: division by zero"
> (let ([resource (open-input-string "")]) (try (write-bytes #"Hi" resource) (catch [exn? e (displayln (exn-message e))]) (finally (close-input-port resource))) (port-closed? resource))
write-bytes: contract violation
expected: output-port?
given: #<input-port:string>
#t
> (struct posn [x y])
> (try (raise (posn 1 2)) (catch [exn? e (exn-message e)]) (catch/match [(posn 1 y) y])) 2
syntax
(catch [pred-expr exn-id handler-expr ...+])
If no pred-exprs succeed, testing proceeds to any catch/match clauses.
syntax
(catch/match [match-expr handler-expr ...+])
If no match-exprs succeed, the exception is re-raised.
syntax
(finally finally-expr ...+)
Implementation:
#lang racket/base |
(provide try catch catch/match finally) |
(require (for-syntax racket/base) |
racket/match |
syntax/parse/define) |
(begin-for-syntax |
(define ((only-in-try name) stx) |
(raise-syntax-error name "not allowed except in try" stx))) |
(define-syntax catch (only-in-try 'catch)) |
(define-syntax catch/match (only-in-try 'catch/match)) |
(define-syntax finally (only-in-try 'finally)) |
(begin-for-syntax |
(define-syntax-class try-body |
#:literals (catch catch/match finally) |
(pattern {~and :expr {~not {~or (catch . _) (catch/match . _) (finally . _)}}})) |
(define-syntax-class catch-clause |
#:attributes ((handlers 1)) |
#:literals (catch) |
(pattern (catch [pred:expr name:id body:expr ...+] ...) |
#:with (handlers ...) #'([pred (λ (name) body ...)] ...))) |
;; this one's for you, notjack |
(define-syntax-class catch-match-clause |
#:attributes (handler) |
#:literals (catch/match) |
(pattern (catch/match [clause:expr body:expr ...+] ...) |
#:with (match-clauses ...) #'([clause body ...] ...) |
#:with handler #'[(λ (_) #t) ;; catch 'em all |
(match-lambda |
match-clauses ... |
;; rethrow as last resort |
[e (raise e)])])) |
(define-syntax-class finally-clause |
#:attributes (handler) |
#:literals (finally) |
(pattern (finally body:expr ...+) |
#:with handler #'(λ () body ...)))) |
;; Calls value-thunk, then post-thunk, with post-thunk guaranteed to be run |
;; even if execution exits value-thunk through an exception or continuation |
;; |
;; value-thunk is prevented from re-entry and continutation shenanigans by a |
;; continuation-barrier |
;; |
;; thanks to Alex Knauth & SamPh on Discord |
(define (call-with-try-finally value-thunk post-thunk) |
(call-with-continuation-barrier |
(λ () (dynamic-wind void value-thunk post-thunk)))) |
(define-syntax-parser try |
[(_ body:try-body ...+ |
{~optional c:catch-clause} |
{~optional m:catch-match-clause} |
{~optional f:finally-clause}) |
#'(call-with-try-finally |
(λ () |
(with-handlers ((~? (~@ c.handlers ...)) |
(~? m.handler)) |
body ...)) |
(~? f.handler void))]) |
5.22.2 try — another try/catch/finally inspired by Gerbil Scheme
Contributed by AlexKnauth (#10) during the 2021 Syntax Parse Bee.
Adapted from the try-catch-finally package.
syntax
(try expr ...+ maybe-catch maybe-finally)
maybe-catch =
| (catch pred => (lambda (x) expr ...+)) | (catch (pred id) expr ...+) | (catch id expr ...+) | (catch _ expr ...+) maybe-finally =
| (finally expr ...+)
> (try (raise-syntax-error #f "a syntax error") (catch (exn:fail:syntax? e) (displayln "got a syntax error"))) got a syntax error
> (let/cc up (try (displayln "at before") (up (void)) (displayln "at after") (finally (displayln "out"))))
at before
out
Compare the implementation below to the procedural syntax-case baseline from Gerbil scheme: the try macro and helper functions.
#lang racket/base |
(provide try catch finally => _) |
(require syntax/parse/define (for-syntax racket/base)) |
(begin-for-syntax |
(define (not-allowed-as-an-expression stx) |
(raise-syntax-error #f "not allowed as an expression" stx)) |
(define-syntax-class finally-clause #:literals [finally] |
[pattern (finally e:expr ...+) #:with post-thunk #'(λ () e ...)]) |
(define-syntax-class catch-clause #:literals [catch => _] |
[pattern (catch pred:expr => handler:expr)] |
[pattern (catch (pred:expr x:id) b:expr ...+) |
#:with handler #'(λ (x) b ...)] |
[pattern (catch (x:id) b:expr ...+) |
#:with pred #'void |
#:with handler #'(λ (x) b ...)] |
[pattern (catch _ b:expr ...+) |
#:with pred #'void |
#:with handler #'(λ (x) b ...)]) |
(define-syntax-class body #:literals [finally catch] |
[pattern {~and :expr {~not {~or (finally . _) (catch . _)}}}])) |
(define-syntax catch not-allowed-as-an-expression) |
(define-syntax finally not-allowed-as-an-expression) |
(define-syntax-parser try |
[(_ b:body ...+ f:finally-clause) |
#'(call-with-try-finally (λ () b ...) f.post-thunk)] |
[(_ b:body ...+ c:catch-clause ...) |
#'(with-handlers ([c.pred c.handler] ...) b ...)] |
[(_ b:body ...+ c:catch-clause ... f:finally-clause) |
#'(call-with-try-finally |
(λ () (with-handlers ([c.pred c.handler] ...) b ...)) |
f.post-thunk)]) |
;; call-with-try-finally : [-> X] [-> Any] -> X |
;; Calls value-thunk, then post-thunk, with post-thunk guaranteed to be run |
;; even if execution exits value-thunk through an exception or continuation |
(define (call-with-try-finally value-thunk post-thunk) |
(call-with-continuation-barrier |
(λ () (dynamic-wind void value-thunk post-thunk)))) |
Overall, this Racket version uses half as much macro code and 70% fewer lines of helper code (down from 11 lines to 3). The notes below provide a detailed comparison.
- Changes in supporting runtime function definitions:
The try macro does not need a supporting with-catch function because it can use a combination of the syntax/parse technique Variants with Uniform Meanings and the existing Racket with-handlers form.
Gerbil’s supporting function with-unwind-protect uses mutable state to make a one-time-use closure dynamically check that it really is only called once. In the Racket version, call-with-try-finally uses a continuation barrier (as suggested by SamPh on Discord), to accomplish the same without mutable state.
- Changes in the compile-time syntax transformation definitions:
The catch and finally literals use a compile-time helper function not-allowed-as-an-expression to generate precise error messages. Gerbil’s simply uses empty defrules and gives a generic Bad syntax error message.
The try macro uses syntax-parse’s ...+ to express one-or-more repetition. Gerbil’s version uses manual null? checks and stx-null? checks; see the generate-thunk helper function and the finally case.
The try macro uses a syntax class to recognize body expressions that are not catch or finally clauses via the ~not pattern. Gerbil’s version uses a named let loop with 2 extra nested syntax-case expressions to identify body expressions.
The try macro uses a syntax class to handling catch clauses as Variants with Uniform Meanings allowing repetition with ellipses. Gerbil’s version uses the helper function generate-catch (which hasits own with-syntax, named let loop, match, and syntax-case expressions) in combination with another named let loop and another nested syntax-case expression (beyond the ones mentioned above) in the main body of the macro to separate the catch clauses from the finally clause.
The try macro uses a syntax class to handle the finally clause. Syntax classes allow try macro to express this simply by putting the finally-clause pattern at the end of the main syntax pattern, after the previous patterns and their ellipses. Gerbil’s version uses a helper function generate-fini and 2 different finally cases in different syntax-case expressions in the main body of the macro. One of these is to separate body expressions from finally in the case when there are no catches in between, and the other is to separate catch clauses from finally. Their first finally case requires a manual stx-null? check to make sure nothing comes after finally, while their second finally case encodes that into a syntax-case pattern for a 1-element list.
5.22.3 try, try-with, try-with*
Adapted from the try-catch-match package.
syntax
(try body ...+ catch-clause ... maybe-finally-clause)
catch-clause = (catch pat body ...+) maybe-finally-clause =
| (finally body ...+)
The expressiveness of match syntax makes it sufficiently flexible for any case, and grants familiarity to those that are used to it.
> (try (cons 1) (catch (or (? exn? (app exn-message msg)) (app ~a msg)) (car (string-split msg ";"))) (finally (displayln "finally"))) finally
"cons: arity mismatch"
syntax
(try-with ([id val-expr] ...) expr ...+)
Like let, bind ids to vals in body. vals are evaluated with current-custodian set to a new custodian created with make-custodian. When the expression returns, the custodian is shutdown with custodian-shutdown-all in a finally clause.
> (try-with ([port (open-output-string)]) (displayln "Hello!" port))
syntax
(try-with* ([id val-expr] ...) expr ...+)
Implementation:
#lang racket/base |
(provide try catch finally |
try-with try-with*) |
(require racket/match (for-syntax syntax/parse racket/base)) |
(begin-for-syntax |
(define ((invalid-expr name) stx) |
(raise-syntax-error name "invalid in expression context" stx))) |
(define-syntax catch (invalid-expr 'catch)) |
(define-syntax finally (invalid-expr 'finally)) |
(begin-for-syntax |
(define-syntax-class catch-clause |
#:description "catch clause" |
#:literals [catch] |
(pattern (catch binding:expr body:expr ...+))) |
(define-syntax-class finally-clause |
#:description "finally clause" |
#:literals [finally] |
(pattern (finally body:expr ...+))) |
(define-syntax-class body-expr |
#:literals [catch finally] |
(pattern (~and :expr |
(~not (~or (finally . _) |
(catch . _))))))) |
(define-syntax (try stx) |
(syntax-parse stx |
[(_ body:body-expr ...+) |
#'(let () body ...)] |
[(_ body:body-expr ...+ |
catch:catch-clause ... |
finally:finally-clause) |
#'(call-with-continuation-barrier |
(lambda () |
(dynamic-wind |
void |
(lambda () |
(try body ... catch ...)) |
(lambda () |
finally.body ...))))] |
[(_ body:body-expr ...+ |
catch:catch-clause ...) |
#'(with-handlers |
([void |
(lambda (e) |
(match e |
[catch.binding catch.body ...] ... |
[_ (raise e)]))]) |
body ...)])) |
(define-syntax (try-with stx) |
(syntax-parse stx |
[(_ ([name:id val:expr] ...) |
body:body-expr ...+) |
#'(let ([cust (make-custodian)]) |
(try |
(define-values (name ...) |
(parameterize ([current-custodian cust]) |
(values val ...))) |
body ... |
(finally (custodian-shutdown-all cust))))])) |
(define-syntax (try-with* stx) |
(syntax-parse stx |
[(_ ([name:id val:expr] ...) |
body:body-expr ...+) |
#'(let ([cust (make-custodian)]) |
(try |
(define-values (name ...) |
(parameterize ([current-custodian cust]) |
(define name val) ... |
(values name ...))) |
body ... |
(finally (custodian-shutdown-all cust))))])) |
5.23 Generate Contracts for Keyword Functions
Adapted from the struct-plus-plus module, which contains many other interesting macros (#18).
(require syntax-parse-example/kw-ctc/kw-ctc) | |
package: syntax-parse-example |
syntax
(kw-ctc (dom-spec ...) cod-spec)
dom-spec = [id] | [id ctc-expr] | [(id default)] | [(id default) ctc-expr] cod-spec = ctc-expr
> (struct pumpkin [name weight color])
> (define/contract (make-pumpkin #:name name #:weight weight #:color [color "Dark Orange"]) (kw-ctc ([name] [weight natural?] [(color _) string?]) pumpkin?) (pumpkin name weight color)) > (make-pumpkin #:name 'roger #:weight 140) #<pumpkin>
> (make-pumpkin #:name #false #:weight 117 #:color "Indigo") #<pumpkin>
> (make-pumpkin #:weight 999) application: required keyword argument not supplied
procedure: make-pumpkin
required keyword: #:name
arguments...:
#:weight 999
Implementation:
#lang racket/base |
(provide kw-ctc) |
(require racket/contract (for-syntax racket/base racket/list syntax/parse syntax/parse/experimental/template)) |
(begin-for-syntax |
(define (id->keyword stx) |
(string->keyword (symbol->string (syntax-e stx)))) |
(define-syntax-class field |
(pattern [id:id (~optional cont:expr)] |
#:with required? #'#t |
#:with field-contract (template (?? cont any/c)) |
#:with kw #`#,(id->keyword #'id)) |
(pattern [(id:id _:expr) (~optional cont:expr)] |
#:with required? #'#f |
#:with field-contract (template (?? cont any/c)) |
#:with kw #`#,(id->keyword #'id))) |
(define field->required? |
(syntax-parser [f:field (syntax-e #'f.required?)])) |
(define field->kw |
(syntax-parser [f:field (syntax/loc this-syntax f.kw)])) |
(define field->ctc |
(syntax-parser [f:field (syntax/loc this-syntax f.field-contract)])) |
(define (field*->contract-spec field*) |
(apply append (map (lambda (f) (list (field->kw f) (field->ctc f))) field*))) |
) |
(define-syntax (kw-ctc stx) |
(syntax-parse stx |
[(_ (?dom*:field ...) cod) |
(define-values [mandatory* optional*] |
(partition field->required? (syntax-e #'(?dom* ...)))) |
(with-syntax ([mandatory-ctc-spec #`#,(field*->contract-spec mandatory*)] |
[optional-ctc-spec #`#,(field*->contract-spec optional*)]) |
(syntax/loc stx |
(->* mandatory-ctc-spec optional-ctc-spec cod)))])) |
5.24 pyret-for
Contributed by sorawee (#11) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/pyret-for/pyret-for) | |
package: syntax-parse-example |
syntax
(pyret-for fn-expr ([pattern arg] ...) expr ...+)
> (define things '(("pen") ("pineapple") ("apple") ("pen"))) > (define quantities '(1 2 3 5))
> (andmap (λ (thing quantity) (or (string-contains? (first thing) "apple") (odd? quantity))) things quantities) #t
The problem is that:
It is difficult for readers to relate formal arguments of the function value to the actual arguments of the call.
There is a lot of rightward drift.
> (define things '(("pen") ("pineapple") ("apple") ("pen"))) > (define quantities '(1 2 3 5))
> (pyret-for andmap ([thing things] [quantity quantities]) (or (string-contains? (first thing) "apple") (odd? quantity))) #t
The pyret-for syntax, based on Pyret’s for, can be used to invoke this kind of higher-order function.
pyret-for additionally improves upon Pyret’s for by allowing arbitrary match pattern.
> (define things '(("pen") ("pineapple") ("apple") ("pen"))) > (define quantities '(1 2 3 5))
> (pyret-for andmap ([(list thing) things] [quantity quantities]) (or (string-contains? thing "apple") (odd? quantity))) #t
Implementation:
#lang racket/base |
(provide pyret-for) |
(require racket/match syntax/parse/define (for-syntax racket/base)) |
(define-syntax-parse-rule |
(pyret-for f:expr ([pat:expr arg:expr] ...) body:expr ...+) |
#:with (x ...) (generate-temporaries (attribute arg)) |
(f (λ (x ...) |
(match-define pat x) ... |
body ...) |
arg ...)) |
5.25 Hierarchical parsing of command-line arguments
Adapted from a PR to resyntax
(require syntax-parse-example/hierarchical-cmdline/hierarchical-cmdline) | |
package: syntax-parse-example |
syntax
(shift-command-line-arguments body ...)
syntax
(parameterize-help-if-empty-ccla body ...)
The purpose of the first macro is to make it easy to parse command line arguments in a hierarchical way using the built-in command-line form. The second macro is an additional helper that displays the help message automatically when no command-line argument is specified at this level, which avoids the case where the user tries one argument is then has no information about what to do next.
> (define prog "my-prog")
> (define (parse-relative) (parameterize-help-if-empty-ccla (command-line #:program (string-append prog " --relative") #:once-each [("--left") => (shift-command-line-arguments (displayln "You're going left!") (parse-main)) '("Go to the left")] [("--right") => (shift-command-line-arguments (displayln "You're going right!") (parse-main)) '("Go to the right")])))
> (define (parse-absolute) (parameterize-help-if-empty-ccla (command-line #:program (string-append prog " --absolute") #:once-each [("--north") => (shift-command-line-arguments (displayln "You're going north!") (parse-main)) '("Go to the north")] [("--south") => (shift-command-line-arguments (displayln "You're going south!") (parse-main)) '("Go to the south")])))
> (define (parse-move) (parameterize-help-if-empty-ccla (command-line #:program (string-append prog " --move") #:once-each [("--relative") => (shift-command-line-arguments (parse-relative)) '("Specify a relative direction")] [("--absolute") => (shift-command-line-arguments (parse-absolute)) '("Specify an absolute direction")])))
> (define (parse-main) (command-line #:program prog #:once-each [("--move") => (shift-command-line-arguments (parse-move)) '("Specify directions")] [("--jump") => (shift-command-line-arguments (displayln "You're jumping!") (parse-main)) '("jump")])) ; $ racket syntax-bee.rkt --move --relative --left --jump --jump --move --absolute --south --jump
> (parameterize ([current-command-line-arguments (vector "--move" "--relative" "--left" "--jump" "--jump" "--move" "--absolute" "--south" "--jump")]) (parse-main))
You're going left!
You're jumping!
You're jumping!
You're going south!
You're jumping!
Implementation:
#lang racket/base |
(provide shift-command-line-arguments parameterize-help-if-empty-ccla) |
(require syntax/parse/define racket/vector) |
;; Remove the first argument of the command line arguments |
(define-syntax-parse-rule (shift-command-line-arguments body ...) |
(λ args |
(parameterize ([current-command-line-arguments (vector-copy (current-command-line-arguments) 1)]) |
body ...))) |
;; If the command line arguments are empty, re-parameterize it to |
;; default to #("--help") |
(define-syntax-parse-rule (parameterize-help-if-empty-ccla body ...) |
(let ([ccla (current-command-line-arguments)]) |
(parameterize ([current-command-line-arguments |
(if (vector-empty? ccla) |
#("--help") |
ccla)]) |
body ...))) |
5.26 flaggable-app
Contributed by sorawee (#14) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/flaggable-app/flaggable-app) | |
package: syntax-parse-example |
syntax
(#%app fn expr ...+)
> (define (trim s #:left? [left? #f] #:right? [right? #f]) (string-trim s #:left? left? #:right? right?))
The function may be invoked with any number of flags, but if a flag keyword appears then it needs an argument as well:
> (trim " 1 2 3 " #:left? #t) "1 2 3 "
> (trim " 1 2 3 " #:left?) eval:3:0: application: missing argument expression after
keyword
at: #:left?
in: (#%app trim " 1 2 3 " #:left?)
Flaggable #%app allows users to instead write:
> (trim " 1 2 3 " #:left?) "1 2 3 "
> (trim " 1 2 3 " #:left? #:right?) "1 2 3"
That is, a keyword that doesn’t come with an argument will default the value to #t. Arguments are still supported.
This does come at a cost: all keyword arguments must be specified after positional arguments to avoid ambiguity. Without this restriction, it is hard to tell whether:
(f #:a 1)
is meant to be itself or:
(f 1 #:a #t)
Note: inspired by reddit.com/r/Racket/comments/oytknk/keyword_arguments_without_values/h7w67dd.
#lang racket/base |
(provide #%app) |
(require syntax/parse/define |
(only-in racket [#%app racket:#%app]) |
(for-syntax racket/base)) |
(begin-for-syntax |
(define-splicing-syntax-class arg/keyword |
#:attributes (k v) |
;; first case: something like #:a 1 |
(pattern {~seq k:keyword v:expr}) |
;; second case: something like #:a. |
(pattern {~seq k:keyword} |
#:with v #'#t))) |
(define-syntax-parse-rule |
(#%app f arg/no-keyword:expr ... arg/keyword:arg/keyword ...) |
(racket:#%app f arg/no-keyword ... {~@ arg/keyword.k arg/keyword.v} ...)) |
5.27 JavaScript-Inspired Dictionary Syntax
Contributed by sorawee (#17) during the 2021 Syntax Parse Bee.
JavaScript (JS) has really elegant syntax to manipulate dictionaries.
JS Dictionary Creation
Given x = 42 the following syntax makes a dictionary with four entries:
{a: 1 + 2, b: 3, ['a' + 'b']: 4, x}
’a’ maps to 3;
’b’ maps to 3;
’ab’ maps to 4; and
’x’ maps to 42
JS Dictionary Merging
Other dictionaries can be merged as a part of dictionary creation.
Given:
let a = {a: 1, c: 2};
let b = {b: 2, c: 3};
Then the following dictionary has four entries:
{b: 42, ...a, ...b, a: 4, d: 5}
’a’ maps to 4;
’b’ maps to 2;
’c’ maps to 3; and
’d’ maps to 5
Note that the merging syntax can be used to set a value functionally without mutating the dictionary.
JS Dictionary Extraction
Given:
let x = {a: 1, b: 2, c: 3, d: 4};
Then the following syntax:
`let {a, b: bp} = x;`
binds a to 1 and bp to 2.
JS Dictionary Extraction of the rest
As a part of extraction, there can be at most one ..., which will function as the extraction of the rest
For example:
let {a, b: bp, ...y} = x;
binds a to 1, bp to 2, y to {c: 3, d: 4}.
(require syntax-parse-example/js-dict/js-dict) | |
package: syntax-parse-example |
The js-dict and js-extract macros bring these operations to Racket, using immutable hash tables as the data structure. Additionally, the js-extract macro improves upon JS by supporting arbitrary match pattern.
syntax
(js-dict construct-spec ...)
ccnstruct-spec = [key expr] | #:merge expr | id key = #:expr expr | id
syntax
(js-extract (extract-spec ... maybe-rest) obj-expr)
extract-spec = [key pattern-expr] | id maybe-rest =
| #:rest expr key = #:expr expr | id
> (js-extract ([#:expr (string->symbol "a") f] c d [x (list (list x))] #:rest rst) obj) > f 40
> c 3
> d 4
> x 10
> rst '#hash((b . 2) (y . 30))
Implementation:
#lang racket/base |
(provide js-dict js-extract) |
(require syntax/parse/define |
racket/match |
racket/hash |
racket/splicing |
(for-syntax racket/base |
racket/list)) |
(begin-for-syntax |
(define-splicing-syntax-class key |
(pattern {~seq #:expr key:expr} |
#:with static #'()) |
(pattern {~seq key*:id} |
#:with key #''key* |
#:with static #'(key*))) |
(define-splicing-syntax-class construct-spec |
(pattern {~seq [key:key val:expr]} |
#:with code #'`[#:set ,key.key ,val] |
#:with (static ...) #'key.static) |
(pattern {~seq #:merge e:expr} |
#:with code #'`[#:merge ,e] |
#:with (static ...) #'()) |
(pattern {~seq x:id} |
#:with code #'`[#:set x ,x] |
#:with (static ...) #'(x))) |
(define-syntax-class extract-spec |
(pattern [key*:key pat:expr] |
#:with key #'key*.key |
#:with (static ...) #'key*.static) |
(pattern x:id |
#:with key #''x |
#:with pat #'x |
#:with (static ...) #'(x)))) |
(define (make-dict . xs) |
(for/fold ([h (hash)]) ([x (in-list xs)]) |
(match x |
[`[#:set ,key ,val] (hash-set h key val)] |
[`[#:merge ,d] (hash-union h d #:combine (λ (a b) b))]))) |
(define-syntax-parse-rule (js-dict spec:construct-spec ...) |
#:fail-when |
(check-duplicate-identifier (append* (attribute spec.static))) |
"duplicate static key" |
(make-dict spec.code ...)) |
(define-syntax-parser extract |
[(_ () pat-rst rst-obj) #'(match-define pat-rst rst-obj)] |
[(_ (spec:extract-spec specs ...) pat-rst rst-obj) |
#'(splicing-let ([KEY spec.key] |
[OBJ rst-obj]) |
(match-define spec.pat (hash-ref OBJ KEY)) |
(extract (specs ...) pat-rst (hash-remove OBJ KEY)))]) |
(define-syntax-parse-rule (js-extract (spec:extract-spec ... |
{~optional {~seq #:rest e:expr}}) |
obj:expr) |
#:fail-when |
(check-duplicate-identifier (append* (attribute spec.static))) |
"duplicate static key" |
(extract (spec ...) (~? e _) obj)) |
5.28 Functions with Dynamically-Scoped Parameters
Contributed by shhyou (#24) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/define-freevar/define-freevar) | |
package: syntax-parse-example |
syntax
(define/freevar (function-id arg-id ...) #:freevars (freevar1-id freevar2-id ...) body1-expr body2-expr ...)
One motivating example is the following helper function for Redex models:
> (require racket/pretty redex/reduction-semantics)
> (define/freevar (apply-reduction-relation*--> term) #:freevars (-->R) (pretty-print term) (for/fold ([term-list (list (list #f term))]) ([step (in-naturals)] #:break (null? term-list)) (define new-terms (apply-reduction-relation/tag-with-names -->R (list-ref (car term-list) 1))) (pretty-print new-terms) new-terms))
This second example dynamically looks for a value who to format an error message:
> (define/freevar (raise-who-error message source-stx) #:freevars (who) (raise-syntax-error who message source-stx))
> (let ([who 'knock-knock]) (raise-who-error "who's there" #'door)) eval:4:0: knock-knock: who's there
in: door
Conceptually, the define/freevar form expands into a new definition having the original code and a new macro that generates references for the free variables:
(define (raise-who-error/impl who message source-stx) (raise-syntax-error who message source-stx)) (define-syntax (raise-who-error stx) (syntax-parse stx [(proc-src:id args ...) #:with who/use-site (syntax-property (format-id stx "~a" 'who #:source #'proc-src) 'original-for-check-syntax #t) (syntax/loc stx (raise-who-error/impl who/use-site args ...))]))
The new macro raise-who-error creates a reference, who/use-site, to be captured non-hygienically using the context from the use site. The expansion then proceeds with the use-site reference and calls the original code.
Additionally, the use-site references have the source location of the proc-src identifier and the syntax property 'original-for-check-syntax so that Check Syntax and DrRacket can draw the binding arrows.
Caveat: mutation on the free variables will not reflect on the original binding. This restriction can be overcome using make-set!-transformer.
syntax
(with-freevar function-id ([freevar-id new-freevar-id] ...) body-expr1 body-expr2 ...)
syntax
(define/with-freevar new-function-id old-function-id [freevar-id new-freevar-id] ...)
While the idea is straightforward, a direct translation generates a large amount of code duplication. In the output of define/freevar, the only varying parts are the names of the free variables and the identifier of the actual implementation. The implementation of define/freevar thus follows the common pattern of using a struct to share the transformer code.
The define/freevar form expands to a new definition storing the original code and a macro for binding the free identifiers.
The implementation introduces a procedure-like struct, open-term, that holds the list of free variables and the identifier of the actual code.
When the macro expander applies an instance of open-term, it extracts names of the free variables and redirects the reference to the actual code.
The idea behind custom pattern expanders and syntax class aliases (see prop:syntax-class) are related: using structs to store varying information while attaching struct type properties to assign behavior.
#lang racket/base |
(provide define/freevar |
with-freevar |
define/with-freevar) |
(require (for-syntax racket/base |
racket/list |
racket/syntax |
syntax/parse)) |
(define-syntax (define/freevar stx) |
(syntax-parse stx |
[(_ (name:id arg:id ...) |
#:freevars (fv:id ...+) |
(~optional (~and #:immediate immediate-flag)) |
body:expr ...+) |
#:attr dup-id (or (check-duplicate-identifier (syntax-e #'(fv ... arg ...))) |
(cdr (check-duplicates |
(map cons (syntax->datum #'(fv ...)) (syntax-e #'(fv ...))) |
#:key car |
#:default '(#f . #f)))) |
#:do [(when (attribute dup-id) |
(raise-syntax-error 'define/freevar |
"duplicated argument or free variable name" |
stx |
(attribute dup-id)))] |
#:with name-with-fvs (format-id #'fresh-stx "~a/fvs" #'name) |
#:with immediate? (if (attribute immediate-flag) #t #f) |
#`(begin |
(define name-with-fvs |
#,(cond |
[(attribute immediate-flag) |
#`(λ (fv ...) |
(let ([name #,(syntax/loc stx |
(λ (arg ...) body ...))]) |
name))] |
[else |
#`(let ([name #,(syntax/loc stx |
(λ (fv ... arg ...) body ...))]) |
name)])) |
(define-syntax name |
(open-term #'name-with-fvs |
'(fv ...) |
'(arg ...) |
'immediate?)))])) |
(define-syntax (with-freevar stx) |
(syntax-parse stx |
[(_ term-with-fv:id ([fv:id new-fv:id] ...) body:expr ...+) |
(syntax-property |
(syntax/loc stx |
(let-syntax ([term-with-fv |
(open-term-set-freevars 'with-freevar |
#'term-with-fv |
(hash (~@ 'fv 'new-fv) ...))]) |
body ...)) |
'disappeared-use (list (syntax-local-introduce #'term-with-fv)))])) |
(define-syntax (define/with-freevar stx) |
(syntax-parse stx |
[(_ new-name:id original-term-with-fv:id [fv:id new-fv:id] ...) |
(syntax-property |
(syntax/loc stx |
(define-syntax new-name |
(open-term-set-freevars 'with-freevar |
#'original-term-with-fv |
(hash (~@ 'fv 'new-fv) ...)))) |
'disappeared-use (list (syntax-local-introduce #'original-term-with-fv)))])) |
(begin-for-syntax |
(struct open-term (proc-stx freevars-name args-name immediate?) |
#:property prop:procedure (λ (self stx) (link-freevars self stx))) |
(define (freevars-in-context fvs #:context ctxt #:source src) |
(for/list ([fv (in-list fvs)]) |
(syntax-property |
(format-id ctxt "~a" fv #:source src) |
'original-for-check-syntax #t))) |
(define (link-freevars self stx) |
(define/syntax-parse target (open-term-proc-stx self)) |
(syntax-parse stx |
[proc-src:id |
#:with (fv ...) (freevars-in-context (open-term-freevars-name self) |
#:context stx |
#:source #'proc-src) |
#:with (arg ...) (generate-temporaries (open-term-args-name self)) |
(cond |
[(open-term-immediate? self) |
(fix-app stx |
(syntax/loc stx |
(target fv ...)))] |
[else |
(quasisyntax/loc stx |
(λ (arg ...) |
#,(fix-app stx |
(syntax/loc stx |
(target fv ... arg ...)))))])] |
[(proc-src:id . args) |
#:with (fv ...) (freevars-in-context (open-term-freevars-name self) |
#:context stx |
#:source #'proc-src) |
(cond |
[(open-term-immediate? self) |
(fix-app stx |
(quasisyntax/loc stx |
(#,(fix-app stx |
(syntax/loc stx |
(target fv ...))) |
. args)))] |
[else |
(fix-app stx |
(syntax/loc stx |
(target fv ... . args)))])])) |
(define (fix-app ctxt app-stx) |
(define app-datum (syntax-e app-stx)) |
(datum->syntax ctxt app-datum app-stx app-stx)) |
(define (open-term-set-freevars who open-term-id map) |
(define (fail) |
(raise-syntax-error who |
"the binding is not defined by define/freevar" |
open-term-id)) |
(define self |
(syntax-local-value open-term-id fail)) |
(unless (open-term? self) |
(fail)) |
(define original-fvs (open-term-freevars-name self)) |
(define new-fvs |
(for/list ([fv (in-list original-fvs)]) |
(hash-ref map fv (λ () fv)))) |
(open-term (open-term-proc-stx self) |
new-fvs |
(open-term-args-name self) |
(open-term-immediate? self)))) |
5.29 Function Parameter Syntax Class
Contributed by shhyou (#23) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/fnarg/fnarg) | |
package: syntax-parse-example |
Syntax classes offer a powerful mechanism for abstracting over classes of conceptually related patterns. Moreover, syntax classes can be parameterized, with expr/c being one prominent example.
In this example, we define a syntax class that roughly captures the grammar of formal parameters in function headers. It parses the name of the formal parameter, the default expressions of optional arguments and the keywords of keyworded arguments.
syntax
Refer to the source file fnarg-test.rkt for an example use.
#lang racket/base |
(provide fnarg) |
(require racket/syntax syntax/parse) |
;; Use _splicing_ to parse a sequence of elements for keyword args. |
(define-splicing-syntax-class (fnarg [allow-optional? #t] |
#:keyword? [allow-keyword? #t]) |
#:attributes (name fresh-var keyword default) |
#:commit |
(pattern name:id |
#:attr keyword #f |
#:attr default #f |
#:with fresh-var (generate-temporary #'name)) |
(pattern [name:id default:expr] |
#:fail-unless allow-optional? "optional argument is not allowed" |
#:attr keyword #f |
#:with fresh-var (generate-temporary #'name)) |
;; The ~seq pattern describes a _sequence_ of elements |
(pattern (~seq keyword:keyword name:id) |
#:fail-unless allow-keyword? "keyword argument is not allowed" |
#:attr default #f |
#:with fresh-var (generate-temporary #'name)) |
(pattern (~seq keyword:keyword [name:id default:expr]) |
#:fail-unless allow-optional? "optional argument is not allowed" |
#:fail-unless allow-keyword? "keyword argument is not allowed" |
#:with fresh-var (generate-temporary #'name))) |
5.30 Generate Temporaries On The Fly: fresh-variable Syntax Class
Contributed by shhyou (#22) during the 2021 Syntax Parse Bee.
(require syntax-parse-example/fresh-variable/fresh-variable) | |
package: syntax-parse-example |
Some macros need to generate a sequence of fresh identifiers corresponding to a list of input forms. The standard solution is to invoke generate-temporaries with a syntax list and bind the result to a new pattern variable. However, the new pattern variable is disconnected from the input forms and such an approach quickly becomes unmanageable when the input forms come nested in more than one ellipses.
The fresh-variable syntax class solves both these issues. First, it tightly couples generated identifiers to the input forms. The new identifiers even have DrRacket binding arrows. Second, it leverages the syntax-parse pattern matcher to handle deeply-nested repetitions.
syntax
In the example below, we create a macro define/immutable-parameter for defining functions whose parameters cannot be mutated by the function body. The macro parses arguments using the fresh-variable syntax class to generate temporary identifiers on the fly.
> (define-syntax (define/immutable-parameter stx) (syntax-parse stx [(_ (name:id (~or* (~and :id arg:fresh-variable) [(~and :id arg:fresh-variable) default-value:expr]) ...) body:expr ...+) #'(define (name (~? [arg.fresh-var default-value] arg.fresh-var) ...) (define-syntax arg (make-variable-like-transformer #'arg.fresh-var #f)) ... body ...)]))
> (define/immutable-parameter (fib n [verbose? #f]) ; (set! n 12345) ;=> syntax error (when verbose? (printf "(fib ~a)\n" n)) (cond [(<= n 1) n] [else (+ (fib (- n 1) verbose?) (fib (- n 2) verbose?))])) > (fib 5) 5
The implementation accepts any expression and generates a temporary identifier.
#lang racket/base |
(provide fresh-variable) |
(require racket/syntax syntax/parse) |
(define-syntax-class (fresh-variable [context #f]) |
#:attributes (fresh-var) |
(pattern name |
#:with temp-var (generate-temporary #'name) |
#:with fresh-var (if context |
(format-id context "~a" #'temp-var) |
#'temp-var))) |
Q. Why use name instead of asking for an identifier with name:id?
A. Some macros may let-bind subforms to first evaluate them for later use. Therefore the subforms can be any expressions. I couldn’t find a way to pass syntax classes around or compose them, so the :id specification is left out of the syntax class.
5.31 define/with-datum+
syntax
(define/with-datum+ pattern datum-expr)
The following example defines three pattern variables: x gets bound to a string, y (at ellipsis depth 1) gets bound to a list of strings, and z (at ellipsis depth 2) gets bound to a list of lists of strings.
> (define/with-datum+ (x ((y z ...) ...)) '("X" (("Y1" "Z11" "Z12") ("Y2" "Z21")))) > (datum x) "X"
> (with-datum ([w "W"]) (datum ((y w) ...))) '(("Y1" "W") ("Y2" "W"))
> (datum ((^ z ... $) ...)) '((^ "Z11" "Z12" $) (^ "Z21" $))
The implementation is similar to that of define/with-syntax (link) but uses syntax-parse pattern directives to express the procedural code from the original. These pattern directives allow escaping into arbitrary expansion-time computation while retaining appropriate semantical meanings such as binding a pattern variable (#:with) or performing an imperative action (#:do).
#lang racket/base |
(provide define/with-datum+) |
(require syntax/parse/define |
syntax/datum |
(for-syntax racket/base |
racket/syntax |
racket/private/sc)) |
(begin-for-syntax |
(define-syntax-class (fresh-temporary fresh-stx) |
#:attributes (fresh-var) |
(pattern name |
#:with fresh-var (format-id fresh-stx "~a" (generate-temporary #'name)))) |
(define (count-ellipses-depth var...^n) |
(for/fold ([var...^n var...^n] |
[depth 0]) |
([current-depth (in-naturals 1)] |
#:break (not (pair? var...^n))) |
(values (car var...^n) current-depth)))) |
#| |
Source: |
https://github.com/racket/racket/blob/8e83dc25f7f5767d9e975f20982fdbb82f62415a/racket/collects/racket/syntax.rkt#L22-#L59 |
racket/collects/racket/syntax.rktracket/collects/racket/syntax.rkt |
Commit SHA: 8e83dc25f7f5767 |
Line: 22-59 |
|# |
(define-syntax-parse-rule (define/with-datum+ pattern rhs) |
#:attr matched-vars (get-match-vars #'define/with-datum+ |
this-syntax |
#'pattern |
'()) |
#:with (((~var pvar (fresh-temporary #'here)) . depth) ...) |
(for/list ([x (attribute matched-vars)]) |
(define-values (var depth) |
(count-ellipses-depth x)) |
(cons var depth)) |
(begin |
(define-values (pvar.fresh-var ...) |
(with-datum ([pattern rhs]) |
(values (pvar-value pvar) ...))) |
(define-syntax pvar |
(make-s-exp-mapping 'depth (quote-syntax pvar.fresh-var))) |
...)) |
;; auxiliary macro |
(define-syntax-parse-rule (pvar-value pvar:id) |
#:attr mapping (syntax-local-value #'pvar) |
#:do [(unless (s-exp-pattern-variable? (attribute mapping)) |
(raise-syntax-error #f "not a datum variable" #'pvar))] |
#:with value-var (s-exp-mapping-valvar (attribute mapping)) |
value-var) |
6 How to contribute a new example
Clone this repository (link).
- Run raco syntax-parse-example --new EUGENE in the top-level folder of the cloned repository. This generates three new files:
EUGENE/EUGENE.rkt (source code)
EUGENE/EUGENE-test.rkt (tests)
EUGENE/EUGENE-doc.scrbl (Scribble documentation)
Fill the holes in the newly-generated files with an implementation, some unit tests, and documentation.
Run raco setup syntax-parse-example to generate the documentation.
7 Example-Formatting Tools
uses the reader from scribble/base; and
provides a few utility functions, documented below.
procedure
filename : path-string?