[plt-scheme] super-structs and structure type descriptors

Hi,

I'm writing a macro called `define-type/struct' that, as the name suggests, 
allows you to attach 
contracts to fields in the definition.  I want contracts on a structure's 
fields within a module, but I 
cannot export the structure (so I can't use provide/contract on the struct).

I believe I can do structures without super-structures, but I'm having trouble 
getting derived structures 
to work.  Specifically, I can't figure out what I need to send as the 
super-struct-type to make-struct-
type.  Here's a snippit of code from the macro:

---Code---

  (define-syntax (define-struct/contract stx)
    (syntax-case stx ()
      [(_ (name super-struct) ([field type] ...))
       (let* ([fields (syntax->list #'(field ...))]
              [names (build-struct-names #'name fields #f #f #'name)]
              [field-count (length fields)])
         (let-values ([(struct-desc make-struct struct? struct-get 
struct-set!)
                       (make-struct-type (syntax-object->datum #'name)
                                         #f ; INCORRECT
                                         field-count 0)])
           #`(begin
               ; Defines structure type descriptor.
               (define #,(first names) #,struct-desc) ; and so on ...

---End code---

What goes where I have `#f ;INCORRECT' in my code?  If that snippet isn't 
enough, here is all the code I 
have so far:

---Code---

  (require-for-syntax (lib "struct.ss" "syntax")) ; build-struct-names
  (require-for-syntax (lib "contract.ss" "mzlib")) ; the usual
  (require-for-syntax (lib "list.ss" "mzlib")) ; the usual
  (require (lib "contract.ss" "mzlib"))

  (provide define-struct/contract)

  (define-syntax (define-struct/contract stx)
    (syntax-case stx ()
      [(_ (name super-struct) ([field type] ...))
       (let* ([fields (syntax->list #'(field ...))]
              [names (build-struct-names #'name fields #f #f #'name)]
              [types (syntax->list #'(type ...))]
              [super-struct-info (syntax-local-value #'super-struct)]
              [field-count (length fields)])
         (display super-struct-info)
         (let-values ([(struct-desc make-struct struct? struct-get 
struct-set!)
                       (make-struct-type (syntax-object->datum #'name)
                                         #f ; INCORRECT
                                         ;(syntax-object->datum (first 
super-struct-info))
                                         field-count 0)])
           #`(begin
               ; Defines structure type descriptor.
               (define #,(first names) #,struct-desc)

               ; Defines the predicate/type.
               (define #,(third names) #,struct?)

               ; Generates the constructor.
               (define/contract #,(second names)
                 (#, at types . -> . #,struct?)
                 #,make-struct)

               ; Generates accessors.
               #,@(let loop ([n 0])
                    (if (= n field-count)
                        empty
                        (cons #`(define/contract
                                  #,(list-ref names (+ 3 n))
                                  (#,struct? . -> . #,(list-ref types n))
                                  (lambda (s) (#,struct-get s #,n)))
                              (loop (+ n 1)))))

               ; For completeness, I grudgingly provide mutators.  DO NOT USE!
               #,@(let loop ([n 0])
                    (if (= n field-count)
                        empty
                        (cons #`(define/contract
                                  #,(list-ref names (+ 3 field-count n))
                                  (#,struct? #,(list-ref types n) . -> . any)
                                  (lambda (s v) (#,struct-get s #,n)))
                              (loop (+ n 1)))))

               ; Funky thing
               (define-syntax name
                 (list-immutable (quote-syntax #,(first names))
                                 (quote-syntax #,(second names))
                                 (quote-syntax #,(third names))
                                 (list-immutable) ; FIXME!
                                 (list-immutable) ; FIXME!
                                 #,(or #'super-struct #t)))

               )))]))

---End code---

Thanks.

-Arjun