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

Have you considered having a separate module that only contains the
structure definitions and then just not requiring it anywhere else?

Robby

At Wed, 1 Jun 2005 22:12:44 -0500, Arjun Guha wrote:
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
> 
> 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