[racket] Passing information between syntax classes

On Feb 12, 2015, at 9:53 AM, Konrad Hinsen <konrad.hinsen at fastmail.net> wrote:

> I am trying to clean up some lengthy syntax-class definitions, but I
> am running into a problem. Here's a much-simplified example:
> 
> ----------------------------------------------------------------------
> #lang racket
> 
> (require (for-syntax syntax/parse))
> 
> (define-syntax (foos-of-bars stx)
> 
>  (define-syntax-class foo
>    #:attributes (value)
>    (pattern ((~datum foo) foo-symbol:id ... ((~datum bar) bar-symbol:id) ...)
>             #:with value
>             #'(let ([foo-symbols (set (quote foo-symbol) ...)])
>                 (list 'foo
>                       (list 'bar
>                             (if (set-member? foo-symbols (quote bar-symbol))
>                                 (list (quote bar-symbol))
>                                 (quote bar-symbol))) ...))))
> 
>  (syntax-parse stx
>    [(_ foo:foo ...)
>     #'(list foo.value ...) ]))
> 
> (foos-of-bars (foo x y (bar a) (bar x)))
> ----------------------------------------------------------------------
> 
> I have several patterns like 'foo', and they all share the same 'bar'
> subpattern. Therefore I would like to make 'bar' a syntax class of its
> own:
> 
> ----------------------------------------------------------------------
> (define-syntax (foos-of-bars stx)
> 
>  (define-syntax-class foo
>    #:attributes (value)
>    (pattern ((~datum foo) symbol:id ... bar:bar ...)
>             #:with value
>             #'(let ([foo-symbols (set (quote symbol)  ...)])
>                 (list 'foo bar.value ...))))
> 
>  (define-syntax-class bar
>    #:attributes (value)
>    (pattern ((~datum bar) symbol:id)
>             #:with value
>             #'(list 'bar ???)))
> 
>  (syntax-parse stx
>    [(_ foo:foo ...)
>     #'(list foo.value ...) ]))
> ----------------------------------------------------------------------
> 
> The problem is what to put in place of the ???. With the split into
> two syntax-classes, the expansion of 'bar' no longer has access to
> 'foo-symbols'.
> 
> I would need something like syntax-classes that take parameters, but I
> didn't find anything like that. Is there some other way to modularize
> my definition?

Syntax classes can take arguments. Here’s one example, which adds a parameter to bar (which is a syntax object representing a variable bound to the set holding the symbols to check) and passes #’foo-symbols as the argument.

(define-syntax (foos-of-bars2 stx)

 (define-syntax-class (bar symbols-var)
   #:attributes (value)
   (pattern ((~datum bar) symbol:id)
            #:with value
            #`(list 'bar (if (set-member? #,symbols-var (quote symbol))
                             (list (quote symbol))
                             (quote symbol)))))

 (define-syntax-class foo
   #:attributes (value)
   (pattern ((~datum foo) symbol:id ... (~var b (bar #'foo-symbols)) ...)
            #:with value
            #'(let ([foo-symbols (set (quote symbol)  ...)])
                (list 'foo b.value ...))))

 (syntax-parse stx
   [(_ foo:foo ...)
    #'(list foo.value ...) ]))

(foos-of-bars2 (foo x y (bar a) (bar x)))


Of course, you can also just to the parameterization at "run time": have the attribute be a function that accepts the set as an argument. The expansion contains obvious beta redexes, which I’m sure the Racket compiler will take care of for you. Here’s the code:

(define-syntax (foos-of-bars3 stx)

 (define-syntax-class foo
   #:attributes (value)
   (pattern ((~datum foo) symbol:id ... b:bar ...)
            #:with value
            #'(let ([foo-symbols (set (quote symbol)  ...)])
                (list 'foo (b.fun foo-symbols) ...))))

 (define-syntax-class bar
   #:attributes (fun)
   (pattern ((~datum bar) symbol:id)
            #:with fun
            #'(lambda (symbols-set)
                (list 'bar
                      (if (set-member? symbols-set (quote symbol))
                          (list (quote symbol))
                          (quote symbol))))))

 (syntax-parse stx
   [(_ foo:foo ...)
    #'(list foo.value ...) ]))

(foos-of-bars3 (foo x y (bar a) (bar x)))

Ryan