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

Technically what you want are assertions not contracts. -- Matthias


On Jun 1, 2005, at 11:12 PM, 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
>
>