[racket] macro help redux

OK. I've also attached a zipped folder that has the two files.

Here's aug-struct.rkt:

#lang racket
(require (for-syntax racket/struct-info))

(provide define-aug-struct)

;; stolen from define-struct
(define-for-syntax (build-name id . parts)
  (datum->syntax
   id
   (string->symbol
    (apply string-append
           (map (lambda (p)
                  (cond
                    [(syntax? p) (symbol->string (syntax-e p))]
                    [(symbol? p) (symbol->string p)]
                    [(string? p) p]))
                parts)))
   id))

;; this unifies the super's info with the sub's info, allowing
;; you to override defaults and contract info
(define-for-syntax (unify super-info sub-info)
  (append (map (λ (sup)
                 (let ([sub (assoc (car sup) sub-info)])
                   (or sub sup)))
               super-info)
          (filter (λ (sub) (not (assoc (car sub) super-info))) sub-info)))


;; the general idea is that, assuming sup is either another aug-struct
;; or #f,
;;
;; (define-aug-struct (sub sup)
;;   ([field1 contract1]
;;    [field2 contract2 default2]
;;    ...))
;;
;; should be expanded to
;;
;; (define-syntax sub-info
;;   '([field1 contract1] [field2 contract2 default2] ...))
;;   so I can grab this info later to unify it with any sub-structs
;; (define-struct (sub sup)
;;   (field2))        assumes field1 was defined in sup
;; (define (create-sub #:field1 field1
;;                     #:field2 [field2 default2])
;;    (make-sub field1 field2))
;; (provide/contract
;;     [create-sub (-> #:field1 contract1
;;                     #:field2 contract2
;;                     sub?)])
(define-syntax (define-aug-struct stx)
  (syntax-case stx ()
    [(_ (id super-id) field-info-syntax)
     ; TODO: error-checking
     (let*
         ([id+maybe-super (if (syntax->datum #'super-id)
                              #'(id super-id)
                              #'id)]
          [super-info (if (syntax->datum #'super-id)
                          (syntax-local-value (build-name #'super-id
#'super-id "-info"))
                          '())]
          [id-name (syntax->datum #'id)]
          [field-info (syntax->datum #'field-info-syntax)]
          [unified-info (unify super-info field-info)]
          [subfield-names (map car (filter (λ (info)
                                             (not (assoc (car info)
super-info)))
                                           field-info))]
          [all-field-names (map car unified-info)]
          [kw-names (map (λ (fld)
                           (string->keyword (symbol->string fld)))
                         all-field-names)]
          [create-id (build-name #'id "create-" id-name)]
          [no-default (gensym)]
          [defaults (map (λ (info)
                           (if (= 2 (length info))
                               no-default
                               (caddr info)))
                         unified-info)]
          [create-formals (cons create-id
                                (foldr append '()
                                       (map (λ (kw fld def)
                                              (if (equal? no-default def)
                                                  (list kw fld)
                                                  (list kw (list fld def))))
                                            kw-names all-field-names
defaults)))]
          [contracts (map cadr unified-info)]
          [create-contract (cons '->
                                 (foldr append `(,(build-name #'id id-name "?"))
                                        (map (λ (kw contr)
                                               (list kw contr))
                                             kw-names contracts)))]
          [make-id (build-name #'id "make-" id-name)]
          [id-info (build-name #'id id-name "-info")])
       (with-syntax ([unified-info-syntax unified-info])
         #`(begin
             (define-syntax #,id-info (syntax->datum #'unified-info-syntax))
             (define-struct #,id+maybe-super
               #,subfield-names
               #:transparent)
             (define #,create-formals
               (#,make-id #, at all-field-names))
             (provide/contract [#,create-id #,create-contract]))))]
    [(_ id field-info)
     #'(define-aug-struct (id #f) field-info)]))

and here's date-field.rkt:

#lang racket
(require "aug-struct.rkt")

(define-struct db-date
  (year month day))

(define-aug-struct date-field
  ([name string?]
   [contract any/c db-date?]))

So, it seems to be evaluating db-date? in the context of aug-struct
instead of of date-field.

I'm sure I'm just screwing something minor up that will prove my lack
of understanding of how macro expansion actually works. :-)

Thanks for looking!
Todd

On Tue, Jun 8, 2010 at 10:12 PM, Todd O'Bryan <toddobryan at gmail.com> wrote:
> Let me see if I can make a smaller example that does the same thing.
> The one I'm currently working on is a big mess...
>
> On Tue, Jun 8, 2010 at 9:07 PM, Ryan Culpepper <ryanc at ccs.neu.edu> wrote:
>> Can you post your macro and the example that produces the expansion you
>> included in your previous message? My earlier answer was based on a
>> conjecture about how your macro behaved, and it would be easier to provide a
>> complete answer if I can see exactly what you're doing.
>>
>> Ryan
>>
>> Todd O'Bryan wrote:
>>>
>>> It does, but I'm confused. Does that mean that any macro I define that
>>> includes something like a contract has to require every predicate it
>>> could conceivably want? How do I define a macro that will allow me to
>>> specify a predicate later, maybe even one that didn't exist when I
>>> wrote the macro? Or is that not possible?
>>
>>>
>>>
>>> Or, and this kind of makes sense as I'm writing it, is there a way to
>>> tell a macro to wait to evaluate something in the location it's used,
>>> rather than in its own scope?
>>>
>>> Todd
>>>
>>> On Tue, Jun 8, 2010 at 5:57 PM, Ryan Culpepper <ryanc at ccs.neu.edu> wrote:
>>>>
>>>> Todd O'Bryan wrote:
>>>>>
>>>>> I feel like I'm getting there, but macros still do things that confuse
>>>>> me.
>>>>>
>>>>> According to the Macro Stepper, I've written a macro that expands to:
>>>>>
>>>>> (module fields racket
>>>>>  (#%module-begin
>>>>>  (require "tables.rkt")
>>>>>  (require "../date-utils.rkt")
>>>>>  (begin
>>>>>    (define-struct
>>>>>     date-field
>>>>>     (contract)
>>>>>     #:transparent)
>>>>>    (define (create-date-field
>>>>>             #:contract
>>>>>             (contract db-date?))
>>>>>      (make-date-field contract))
>>>>>    (provide/contract
>>>>>     (create-date-field
>>>>>      (-> #:contract any/c date-field?))))))
>>>>>
>>>>> At the next step of the expansion, I get the error:
>>>>>
>>>>> expand: unbound identifier in module
>>>>> db-date?
>>>>>
>>>>> The only problem is that "../date-utils.rkt" provides db-date? and if
>>>>> I put everything inside the #%module-begin into its own DrRacket
>>>>> definitions window, it runs without error. For some reason, db-date?
>>>>> isn't available when it's needed, but I can't figure out how to make
>>>>> it available.
>>>>>
>>>>> What am I doing wrong?
>>>>
>>>> Is your macro defined in "tables.rkt"? If that's the case, it doesn't
>>>> matter
>>>> whether the module where it's *used* imports date-utils, but whether the
>>>> module where the macro is *defined* imports date-utils. That's the idea
>>>> of
>>>> hygienic macros; they're lexically scoped.
>>>>
>>>> You can use the macro stepper to check an identifier's binding by
>>>> clicking
>>>> on the identifier (here, the reference to 'db-date?'), then opening the
>>>> "Syntax properties" pane using the Stepper window. It'll tell you what
>>>> bindings, if any, the identifier refers to.
>>>>
>>>> Did that help?
>>>>
>>>> Ryan
>>>>
>>>>
>>
>>
>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: aug-struct.zip
Type: application/zip
Size: 1646 bytes
Desc: not available
URL: <http://lists.racket-lang.org/users/archive/attachments/20100609/b6ba4fbb/attachment.zip>