[plt-scheme] Dot-notation for structure field access

Matthew Flatt mflatt at cs.utah.edu
Mon Mar 19 02:56:01 EDT 2007


At Sun, 11 Mar 2007 12:49:17 +0100, "jos koot" wrote:
> Inspired by the dot notation of Jens Axel Søgaard I tried to eliminate the 
> need for define-accessor. See enclosure. However, I can't get rid of the error 
> reported at the end of my trial, reading:
> "compile: bad syntax; reference to top-level identifier is not allowed, 
> because no #%top syntax transformer is bound in: acc85"

The problem starts here:

 (define-syntax (define-struct-type stx)
  (syntax-case stx ()
   ....
   ((define-struct-type (descr constr pred super) (field ...) inspector)
    (let-values (((acc mut) (apply values (generate-temporaries #'(acc mut)))))
     (register-transformer-builder #'constr #'(field ...) acc mut)
   #`(define-values (descr constr pred #,acc #,mut)
       ....)))))

The call to `register-transformer-builder' is a side effect that
happens while the macro is expanded. After a `define-struct-type' form
is expanded --- say, when compiling a module --- the side-effect won't
happen anymore. In particular, the side effect won't happen if you
(next week, on a different machine) load the compiled form of module
whose source contains the `define-struct-type' declaration.

Well, the error you see is only indirectly related to the problem,
which is partly why it's difficult to track down. The problem is that
the registration uses `acc' and `mut' identifiers before any such
bindings exist, and that leads to the bad reference.

The solution to both problems is the same, and it's simple to write
down:

 (define-syntax (define-struct-type stx)
  (syntax-case stx ()
   ....
   ((define-struct-type (descr constr pred super) (field ...) inspector)
    (let-values (((acc mut) (apply values (generate-temporaries #'(acc mut)))))
     #`(begin
         (begin-for-syntax
          (register-transformer-builder #'constr #'(field ...) #'#,acc #'#,mut))
         (define-values (descr constr pred #,acc #,mut)
           ....))))))

All I've done is move the `register-transformer-builder' call into the
result of the macro, so that it's a side-effect wrapped by
`begin-for-syntax'. Since it's part of the result expansion, the side
effect happens each time the expanded (or compiled) expression is
loaded.

Moreover, `acc' and `mut are now in the same binding context as the
`define-values' form, so they get bound in the way that you want.


The general rule is: Don't put any side-effects in a macro expansion.
If you must have side effects at compile time, they should be in
`begin-for-syntax'.


See also 
  http://www.cs.utah.edu/plt/publications/macromod.pdf
which may make more sense now that you've hit the problem that it
describes. :)


Unfortunately, there's a small catch, which I think is almost certainly
related to your later question about `syntax-recertify'. If you try

 (module m mzscheme
   (require dot)
   (define-struct-type d c p (x y z) (make-inspector))
   (provide d c p))

 (module n mzscheme
   (require dot m)
   (define-struct-var s (c 1 2 add1))
   (printf "~s\n" s.x))

then you get

 compile: access from an uncertified context to unexported variable
 from module: m at: acc1 in: acc1.1

Even though there's no `local-expand' in the macro implementation,
there is a kind of manual expansion that happens when looking up a
binding via `register-lookup'. That manual lookup must be accompanied
by manual management of certificates (though not through using
`syntax-recertify').

So, explicitly certify the referencing identifiers before you record
them:

 (define-syntax (define-struct-type stx)
  (syntax-case stx ()
   ....
   ((define-struct-type (descr constr pred super) (field ...) inspector)
    (let-values (((acc mut) (apply values (generate-temporaries #'(acc mut)))))
     #`(begin
         (begin-for-syntax
          (let ([cert (syntax-local-certifier)])
            (register-transformer-builder #'constr #'(field ...) 
                                          (cert #'#,acc)
                                          (cert #'#,mut))))
         (define-values (descr constr pred #,acc #,mut)
           ....))))))

Revised code and example enclosed.

Matthew
-------------- next part --------------
; Language: Textual (MzScheme, includes R5RS), DrScheme version 369.8-svn9mar2007 [3m].

(module dot mzscheme ; for dotted notation of struct-fields for both references and assignments.
  
 (define-for-syntax (compare-id? a b)
  (or
   (module-identifier=? a b)
   (free-identifier=?   a b)
   (bound-identifier=?  a b)))
 
 (define-for-syntax register ())
 
 (define-for-syntax (register-add! constr proc) (set! register (cons (cons constr proc) register)))
 
 (define-for-syntax (register-lookup constr)
  (let register-lookup ((register register))
   (cond
    ((null? register) (raise-syntax-error 'module-dot "unknown struct-constructor" constr constr))
    ((compare-id? (caar register) constr) (cdar register))
    (else (register-lookup (cdr register))))))
 
 (define-for-syntax (make-id var field)
  (datum->syntax-object var (string->symbol (string-append (symbol->string (syntax-e var)) "." (symbol->string (syntax-e field))))))
 
 (define-for-syntax (register-transformer-builder constr fields acc mut)
  (register-add! constr
   (lambda (var)
    (let ((n 0))
     (map
      (lambda (field)
       (let ((dotted-var (make-id var field)))
        (begin0
       #`(define-syntax #,dotted-var
          (make-set!-transformer
           (lambda (stx) 
            (syntax-case stx (set!)
             ((set! id v) #'((make-struct-field-mutator #,mut #,n) #,var v))
             ((id x (... ...)) #'(((make-struct-field-accessor #,acc #,n) #,var) x (... ...)))
             (id #'((make-struct-field-accessor #,acc #,n) #,var))))))
         (set! n (add1 n)))))
      (syntax->list fields))))))
 
 (define-syntax (define-struct-type stx)
  (syntax-case stx ()
   ((define-struct-type  descr constr pred        (field ...)          )
  #'(define-struct-type (descr constr pred #f   ) (field ...) #f       ))
   ((define-struct-type  descr constr pred        (field ...) inspector)
  #'(define-struct-type (descr constr pred #f   ) (field ...) inspector))
   ((define-struct-type (descr constr pred      ) (field ...)          )
  #'(define-struct-type (descr constr pred #f   ) (field ...) #f       ))
   ((define-struct-type (descr constr pred super) (field ...)          )
  #'(define-struct-type (descr constr pred super) (field ...) #f       ))
   ((define-struct-type (descr constr pred      ) (field ...) inspector)
  #'(define-struct-type (descr constr pred #f   ) (field ...) inspector))
   ((define-struct-type (descr constr pred super) (field ...) inspector)
    (let-values (((acc mut) (apply values (generate-temporaries #'(acc mut)))))
     #`(begin
         (begin-for-syntax
          (let ([cert (syntax-local-certifier)])
            (register-transformer-builder #'constr #'(field ...) 
                                          (cert #'#,acc)
                                          (cert #'#,mut))))
         (define-values (descr constr pred #,acc #,mut)
           (let-values
               (((descr constr pred #,acc #,mut)
                 (make-struct-type 'descr super #,(length (syntax->list #'(field ...))) 0 #f () inspector #f () #f)))
             (values descr constr pred #,acc #,mut))))))))
 
 (define-syntax (define-struct-var stx)
  (syntax-case stx ()
   ((define-struct-var var (constr expr ...))
  #`(begin
     (define var (constr expr ...))
  #,@((register-lookup #'constr) #'var)))))
 
 (define-syntax let-struct-type
  (syntax-rules ()
   ((let-struct-type (binding ...) . rest)
    (let () (define-struct-type . binding) ... . rest))))
 
 (define-syntax let-struct-var
  (syntax-rules ()
   ((let-struct-var (binding ...) . rest)
    (let () (define-struct-var . binding) ... . rest))))
 
 (provide define-struct-type define-struct-var let-struct-type let-struct-var))


(module m mzscheme
  (require dot)
  (define-struct-type d c p (x y z) (make-inspector))
  (provide d c p))

(module n mzscheme
  (require dot m)
  (define-struct-var s (c 1 2 add1))
  (printf "~s\n" s.x))

(require n)


More information about the plt-scheme mailing list