[plt-scheme] Nested syntax-rules problem

From: Andre van Tonder (andre at het.brown.edu)
Date: Wed Jun 18 07:55:05 EDT 2003

; 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.



Posted on the users mailing list.