[plt-scheme] Nested syntax-rules problem
; I am having a problem with nested syntax-rules interacting
; with hygienic identifiers in a non-predictable way.
; I want this
;(define-sum tree
; (empty)
; (leaf c)
; (node l r))
; to expand to this:
;
;(define (empty)
; (lambda (empty leaf node)
; ((empty))))
;
;(define (leaf c)
; (lambda (empty leaf node)
; (leaf)))
;
;(define (node l r)
; (lambda (empty leaf node)
; (node l r)))
;
;(define-syntax tree
; (syntax-rules (-> empty leaf node)
; [(_ -> tr [(empty) exp1]
; [(leaf contents) exp2]
; [(node l r) exp3])
; (tr (lambda () exp1)
; (lambda (c) exp2)
; (lambda (l r) exp3))]))
; The following set of macros work for this example.
; The one to watch is define-cases:
(define-syntax define-sum
(syntax-rules ()
[(_ sum-name (name field ...) ...)
(begin
(define-constructors ((name field ...) ...))
(define-cases sum-name ((name field ...) ...)))]))
(define-syntax define-constructors
(syntax-rules ()
[(define-constructors ((name field ...) ...))
(define-constructors ((name field ...) ...) (name ...))]
[(define-constructors ((name field ...) ...) names)
(begin
(define-constructor (name field ...) names)
...)]))
(define-syntax define-constructor
(syntax-rules ()
[(_ (name field ...) names)
(define (name field ...)
(lambda names
(name field ...)))]))
(define-syntax define-cases
(syntax-rules ()
[(define-cases sum-name ((name field ...) ...))
(define-cases sum-name () ((name field ...) ...))]
[(define-cases sum-name ((opt temp) ...) (opt+ . opts+))
(define-cases sum-name ((opt temp) ... (opt+ temp+)) opts+)]
[(define-cases sum-name (((name field ...) temp) ...) ())
(define-syntax sum-name
(syntax-rules (-> name ...)
[(_ obj -> [(name field ...) . temp]
...)
(obj (lambda (field ...) . temp)
...)]))
]))
; Testing it:
(define-sum tree
(empty)
(leaf c)
(node l r))
(define nd (node 444 555))
(tree nd -> [(empty) 'empty]
[(leaf c) (list 'leaf c)]
[(node l r) (list 'node l r)]) ; => (node 444 555)
; We can check that the expansion is correct:
(pretty-display (syntax-object->datum (expand-to-top-form
'(tree nd -> [(empty) 'empty]
[(leaf c) (list 'leaf c)]
[(node l r) (list 'node l r)])
)))
;=> (nd
; (lambda () 'empty)
; (lambda (c) (list 'leaf c))
; (lambda (l r) (list 'node l r)))
; as expected.
; However, the following does not work for no reason that I can determine:
(define-sum tree*
(foo bar)
(empty)
(goo)
(leaf c)
(node l r))
(define nd (node 444 555))
(pretty-display (syntax-object->datum (expand-to-top-form '
(tree* nd -> [(foo bar) (list 'foo bar)]
[(empty) 'empty]
[(goo) 'goo]
[(leaf c) (list 'leaf c)]
[(node l r) (list 'node l r)]) ; => (node 444 555)
)))
; => reference to undefined identifier: g1350
; There seems to be no rhyme or reason to the cases that do not work.
; For example, if we omit the field "bar", it works again.
; For some reason MzScheme seems to get confused with the names of
; the temporary identifiers generated in define-cases. I am not
; sure if this is a bug or if I'm missing some insight.
; Regards.
; A.v.T.