7 Macro Conspiracies
Goals |
— |
— |
On occasion, two macros have to cooperate or, as a dear colleague used to say, conspire to achieve a common purpose. Conspiracy is particularly needed as we move from language extensions to complete languages.
This chapter introduces two important conspiracy techniques. The first demonstrates how to systematically transform an expression, using a macro that recursively pushes itself down into subexpressions. The second demonstrates how two macros can piggy-back on the way variable bindings already work to communicate information at compile time.
7.1 Macros Generate Macros
(define-syntax-rule (define-out-of-context name ...) (begin (define-syntax (name s) (raise-syntax-error 'name "used out of context")) ...)) (define-out-of-context stop multiples)
7.2 Macros that Conspire
> (trace (/ (expt (+ 1 2) 3) (+ 4 5)))
(+ 1 2) = 3
(expt (+ 1 2) 3) = 27
(+ 4 5) = 9
(/ (expt (+ 1 2) 3) (+ 4 5)) = 3
3
e | = | (id e ...) | ||
| | id | |||
| | number |
(define-syntax (trace stx) |
(syntax-parse stx |
[(_ (f:id e:expr ...)) |
#`(print-and-return |
(f (trace e) ...))] |
[(_ x:number) #'x] |
[(_ x:id) #'x])) |
(define (print-and-return val) |
(printf "~s\n" val) |
val) |
(define-syntax (trace stx) |
(syntax-parse stx |
[(_ (f:id e:expr ...)) |
#`(print-and-return |
'(f e ...) |
(f (trace e) ...))] |
[(_ x:number) #'x] |
[(_ x:id) #'x])) |
(define (print-and-return expr val) |
(printf "~s = ~s\n" expr val) |
val) |
(define-simple-macro |
(trace e) |
(trace/d e 0)) |
(define-syntax (trace/d stx) |
(syntax-parse stx |
[(_ (f:id e:expr ...) n:nat) |
(define n+1 (+ 2 (syntax-e #'n))) |
#`(print-and-return |
n |
'(f e ...) |
(f (trace/d e #,n+1) ...))] |
[(_ x:id _) #'x] |
[(_ n:number _) #'n])) |
(define (print-and-return n expr val) |
(printf "~a~s = ~s\n" |
(make-string n #\space) |
expr |
val) |
val) |
(begin-for-syntax |
(define-syntax-class (trace-expr d) |
#:attributes ([res 0]) |
(pattern x:id |
#:with res #'x) |
(pattern n:nat |
#:with res #'n) |
(pattern (f:id e ...) |
#:declare e (trace-expr (+ 2 d)) |
#:with res |
#`(print-and-return |
#,d |
'(f e ...) |
(f e.res ...))))) |
(define-simple-macro |
(trace e) |
#:declare e (trace-expr 0) |
e.res) |
(define (print-and-return n expr val) |
(printf "~a~s = ~s\n" |
(make-string n #\space) |
expr |
val) |
val) |
7.3 More Conspiracy
The fourth chapter shows how to take advantage of syntax-parameterize, rename transformers, define-syntax, and friends to control names in various scopes. This section introduces another technique along those lines that lets us communicate arbitrary values from a binding occurrence of an identifier to uses of it.
> (define-enum animals elephant anteater snake)
> (define (food x) (enum-case animals x [anteater 'ants] [snake 'rats] [elephant 'grass])) > (food 'snake) 'rats
> (food 'elephant) 'grass
The define-enum form introduces a name, in this case animals, that defines what the enumeration consists of, in this case elephant, anteater, and snake. The food function uses enum-case to analyze its argument; the use of animals inside enum-case tells us which enumeration to use; the x should evaluate to a symbol whose name matches one of the names in the enumeration and clauses that follow tell us what to do based on which element of the enumeration x is.
> (define (food x) (enum-case animals x [anteater 'pup] [wolf 'cub] [elephant 'calf])) eval:6:0: enum-case: unknown case
at: wolf
in: (enum-case animals x (anteater (quote pup)) (wolf
(quote cub)) (elephant (quote calf)))
Before we dive into the implementation, let me tell you about a use of define-syntax that we have not seen before. In addition to binding transformers, it is also possible to bind arbitrary values. Here is an example:
> (define-syntax five 5)
Racket’s perfectly happy with that. But if we try to use five, we get into trouble:
> (+ five 3) eval:4:0: five: illegal use of syntax
in: five
value at phase 1: 5
Decoding this error message, racket is saying “I tried to treat your definition of five as a macro transformer, but it isn’t bound to a procedure so I got stuck.”.
So: why did Racket allow us to bind it to something else in the first place?! Well, because we can also look up those variables ourselves, as long as we do it at compile time. And, indeed, there is a special function we have to call to look them up; we can’t just refer to them. Here is an example:
> (define-syntax (double-it stx) (syntax-parse stx [(_ id) (define doubled (* (syntax-local-value #'id) 2)) #`(printf "I doubled ~s at compile time and got ~a\n" 'id #,doubled)])) > (double-it five) I doubled five at compile time and got 10
> (define-syntax six 6) > (double-it six) I doubled six at compile time and got 12
The reason Racket provides this functionality is to allow us macro writers to save some information we get in one macro and then use that information in another macro, as long as the user’s interface to the macro requires the user of the macro to refer to the identifier so the macro can pick up the information.
This is exactly the technique we’ll use to implement define-enum and enum-cases, using the identifier in the define-enum to communicate across to enum-cases. The information we need to communicate is the precise set of cases. So, we can just save that, as a list, and then look it up using syntax-local-value.
(define-syntax (define-enum stx) |
(syntax-parse stx |
[(_ enum-name:id enum-options:id ...) |
#'(define-syntax enum-name (list 'enum-options ...))])) |
(define-syntax (enum-case stx) |
(syntax-parse stx |
[(enum-case the-enum:id the-enum-expr:expr |
[which-case:id clause:expr] ...) |
(for ([used-case (in-list (syntax->list #'(which-case ...)))]) |
(unless (member (syntax->datum used-case) |
(syntax-local-value #'the-enum)) |
(raise-syntax-error #f |
"unknown case" |
stx |
used-case))) |
#'(case the-enum-expr |
[(which-case) clause] ...)])) |
There are two shortcomings of this version having to do with error messages. First, when a program refers to a variable bound by define-enum without using enum-cases, the error message is not helpful. Second, when using an identifier that’s not bound by define-enum inside an enum-cases, we also get a bad error message.
To fix these, we can use a trick. We create a struct at compile time to hold both the list of valid elements of the enumeration and to actually be a procedure using prop:procedure. Then, the procedure will be the transformer that the expander will use, and it will always raise a (sensible) error message, fixing the first problem. To fix the second problem, we can inspect the value returned by syntax-local-value and make sure it is an instance of the struct. Note that we pass (λ () #f) as the second argument to syntax-local-value now, meaning that if the variable isn’t bound at all, we’ll get #f back (so we can raise our own error).
(define-syntax (define-enum stx) |
(syntax-parse stx |
[(_ enum-name:id enum-options:id ...) |
#'(define-syntax enum-name |
(enum-info |
(list 'enum-options ...) |
(λ (stx) |
(raise-syntax-error |
#f |
"must be used in the first position of an enum-case" |
stx))))])) |
(define-syntax (enum-case stx) |
(syntax-parse stx |
[(_ the-enum the-enum-expr:expr |
[which-case:id clause:expr] ...) |
(define the-enum-info |
(syntax-local-value #'the-enum (λ () #f))) |
(unless (enum-info? the-enum-info) |
(raise-syntax-error |
#f |
"expected a variable bound by define-enum" |
stx #'the-enum)) |
(for ([used-case (in-list (syntax->list #'(which-case ...)))]) |
(unless (member (syntax->datum used-case) |
(enum-info-cases the-enum-info)) |
(raise-syntax-error #f |
"unknown case" |
stx |
used-case))) |
#'(case the-enum-expr |
[(which-case) clause] ...)])) |
We can also use define-simple-macro to write these two macros, using a few more tricks from syntax/parse (follow links to the docs to read more about the new constructs).
(begin-for-syntax |
(struct enum-info (cases) |
#:property prop:procedure |
(λ (me stx) |
(raise-syntax-error |
#f |
"must be used in the first position of an enum-case" |
stx))) |
(define-syntax-class (specific-ids ids) |
(pattern x:id |
#:fail-unless (set-member? ids (syntax-e #'x)) |
"unknown case"))) |
(define-simple-macro |
(define-enum enum-name:id enum-options:id ...) |
(define-syntax enum-name |
(enum-info (seteq 'enum-options ...)))) |
(define-simple-macro |
(enum-case the-enum the-enum-expr:expr |
[which-case clause:expr] ...) |
#:declare the-enum (static enum-info? "a variable bound by define-enum") |
#:declare which-case (specific-ids (enum-info-cases (attribute the-enum.value))) |
(case the-enum-expr |
[(which-case) clause] ...)) |
7.4 A Third Evolution: State Propagation
"define-state-ext.rkt"
#lang racket (provide define-state stop) (define-syntax (define-state stx) (syntax-parse stx [(NAME (~var state id) (~var state0 expr) (~var setter)) #`(begin (define state-field state0) (define propagate! setter) (define ((set-and-call n) f . r) (set! state-field f) (define pos '(NAME state _)) (define define-state (contract (ctc n) propagate! pos 'neg)) (apply define-state f r)) (define-syntax state (set #'state-field #'set-and-call)))])) (define (ctc n) (define nam (string->symbol (format "procedure-of-arity-~a" n))) (flat-named-contract nam (λ (f) (procedure-arity-includes? f n)))) (define-for-syntax (set state-field set-and-call) (make-set!-transformer (lambda (stx) (syntax-parse stx #:literals (stop values) [(~var x id) #`#,state-field] [(set! x (stop e)) #`(set! #,state-field e)] [(set! x e) #`(call-with-values (λ () e) (check #,set-and-call))])))) (define ((check f) . args) (match args ['() (error 'set! "too few values")] [`(,new-x) ((f 1) new-x)] [`(,new-x . ,r) (apply (f (+ (length r) 1)) new-x r)])) (define-syntax (stop stx) (raise-syntax-error #f "out of context"))
"define-state-ext-variant.rkt"
(define-syntax (define-state stx) (syntax-parse stx [(_ (~var state id) (~var state0 expr) ((~var x id) ...+) (~var body expr) ...+) #:with n (arity-of #'(x ...)) #:with (y0 y1 ...) #'(x ...) #`(begin (define state-field state0) (define (getter) state-field) (define (setter stop?) (if stop? (λ (y0) (set! state-field y0)) (λ (y0 y1 ...) (set! state-field y0) body ...))) (define-syntax state (set #'n #'#,stx #'getter #'setter)))])) (define-for-syntax (set n stx0 getter setter) (make-set!-transformer (lambda (stx) (syntax-parse stx #:literals (stop multiples) [(~var x id) #`(#,getter)] [(set! x (stop e)) #`((#,setter #true) e)] [(set! x (multiples e0 e1 ...)) (create-set! stx0 (syntax-e n) setter #'e0 #'(e1 ...))] [(set! x e) (create-set! stx0 (syntax-e n) setter #'e #'())])))) (define-for-syntax (create-set! stx n setter e0 e1+) (define exp-n n) (define act** (syntax-e e1+)) (define act-n (arity-of #`#,(cons e0 act**))) (unless (= exp-n act-n) (define msg (format "expected ~a multiples, given ~a" exp-n act-n)) (raise-syntax-error 'define-state msg stx e0 act**)) #`((#,setter #false) #,e0 #,@e1+)) (define-for-syntax (arity-of stx) (length (syntax-e stx)))