On this page:
7.1 Macros Generate Macros
7.2 Macros that Conspire
7.3 More Conspiracy
7.4 A Third Evolution:   State Propagation
7.8.0.8

7 Macro Conspiracies

Goals

macros that employ auxiliary macros to enforce grammatical rules and accumulate information

macros that communicate via scope

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

Consider a trace that prints out all its function-application sub-expressions and their values as it computes their values. For example,
> (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

To get started implementing this macro, let’s settle on the precise set of expressions, e, that trace supports:
  e = (id e ...)
  | id
  | number
Here’s a first cut macro:
    (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)
   
It employs the key trick of this section, namely pushing itself down into the expression based on the grammar of what trace supports. That is, in the first case, when we find an application expression, trace expands by putting itself into the result of the expansion.

Here is how this one works:
> (trace (/ (expt (+ 1 2) 3)
            (+ 4 5)))

3

27

9

3

3

So we are part of the way there: we have the results printing out, but we don’t have the indentation or the expressions being printed out. Let’s tackle adding the expressions first. It is a fairly straightforward addition; namely we can put the expression directly into a new argument to print-and-return:
    (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)
   

Handling the indentation is a bit more complex. Clearly, to add indentation, we need to track the depth of the expressions as trace descends down into the expressions. Tracking a the depth of the expression is an implementation detail, however, that we don’t wish to expose. To avoid unnecessary exposure, we use the “accumulator design pattern” of functional programming, meaning we make a helper macro that tracks the depth and passes it as an additional argument to print-and-return.
  (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)
   

This macro can also be written using a syntax class that recognizes the es and insert calls to itself, resulting in a very simple definition of trace itself:
    (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)
   
The key extension here is defining a syntax class that accepts the depth as a parameter.

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.

We will use it to define two new constructs: define-enum that introduces an enumeration and enum-case a conditional form for testing which element of the enumeration we have. Here’s an example use of them:
> (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.

The key goal here is that using a name that isn’t in the enumeration should be an error, e.g.
> (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"))

Figure 13: Assignment Callbacks

"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)))

Figure 14: Assignment Callbacks, A Variant