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

thanks for this work.  I'm using hash tables at
present but this code will inform my Scheme if not my
scheme.

(The pleausure of such puns aside, in this day of
internet and keyword search, isn't it time to misplace
another char and beget, e.g., "Sceme"?)

george 
--- jos koot <jos.koot at telefonica.net> wrote:

> Got it now. See line tagged with <=====. Thanks for
> your help.
> Soon I will add let-struct-type and let-struct-var.
> Jos
> 
> (module for-dot-transformers mzscheme
>    (define-struct type (name fields))
>    (provide (struct type (name fields))))
> 
> (module dot mzscheme ; for dotted notation of
> struct-fields for both references and assignments.
> 
>    (require-for-syntax
>     for-dot-transformers
>     (prefix srfi: (lib "1.ss" "srfi"))) ; for
> srfi:assoc
> 
>    (begin-for-syntax
>      (define types '())
>      (define (register-type! name type)
>        (set! types (cons (cons name type) types)))
>      (define (lookup-type name)
>        (cond
>          [(srfi:assoc name types
> module-identifier=?)
>           => cdr]
>          [else
>           (error 'lookup-type "unknown type: ~a\n"
> name)]))
> 
>      (define (->string o)
>        (cond
>          [(identifier? o) (symbol->string (syntax-e
> o))]
>          [(symbol? o)     (symbol->string o)]
>          [(string? o)     o]
>          [else
>            (error '->string
>             "expected, identifier, symbol, or
> string, got: ~a\n" o)]))
> 
>      (define (make-identifier stx . x) ; allow anu
> number of components
>        (datum->syntax-object
>         stx (string->symbol
>              (apply string-append (map ->string
> x))))))
> 
>    ; (define-struct-type d c p (x y z)
> (make-inspector))
>    (define-syntax (define-struct-type stx)
>      (syntax-case stx ()
>        ((define-struct-type name constr pred (field
> ...))
>         #'(define-struct-type (name constr pred #f)
>                               (field ...) #f      
> ))
>        ((define-struct-type name constr pred (field
> ...) inspector)
>         #'(define-struct-type (name constr pred #f  
> )
>                               (field ...)
> inspector))
>        ((define-struct-type (name constr pred)
> (field ...))
>         #'(define-struct-type (name constr pred #f  
> )
>                               (field ...) #f      
> ))
>        ((define-struct-type (name constr pred super)
>                             (field ...)          )
>         #'(define-struct-type (name constr pred
> super)
>                               (field ...) #f      
> ))
>        ((define-struct-type (name constr pred      )
>                             (field ...) inspector)
>         #'(define-struct-type (name constr pred #f  
> )
>                               (field ...)
> inspector))
>        ((define-struct-type (name constr pred super)
>                             (field ...) inspector)
>         (register-type! #'name
>                        (make-type #'name
>                                  
> (syntax-object->datum #'(field ...))))
>         #`(begin
>             #,(syntax-case #'super ()
>                 [#f    #`(define-struct name (field
> ...) inspector)]
>                 [super #`(define-struct (name super)
>                                         (field ...)
> inspector)])
>             (define name   #,(make-identifier stx
> 'struct ":" #'name))
>             (define constr #,(make-identifier stx
> 'make "-" #'name))
>             (define pred   #,(make-identifier stx
> #'name "" "?"))))))
> 
>    (define-syntax (define-struct-var stx)
>      (syntax-case stx ()
>        ((define-struct-var var type-name (constr
> expr ...))
>         #`(begin
>             (define var (constr expr ...))
>             (define-dotted-accessors s
> type-name)))))
> 
>    (define-syntax (define-dotted-accessors stx)
>      (syntax-case stx ()
>        [(define-dotted-accessors var type-name)
>         #`(begin
>             #,@(map (lambda (field)
>                       (with-syntax
>                           ([var.field
>                             (syntax-local-introduce
>                               (make-identifier #'stx
> #'var "." field))]
>                            [type-name-field
>                             (make-identifier
>                                #'var #'type-name "-"
> field)]
>                            [set-type-name-field
>                             (make-identifier #'var
> 'set- #'type-name "-" field "!")])
>                         #'(define-syntax var.field
>                             (make-set!-transformer
> ;<===========
>                              (lambda (stx)
>                               (syntax-case stx
> (set!)
>                                [(set! ref v)
> #'(set-type-name-field var v)]
>                                [ref
> #'(type-name-field var)]))))))
>                     (type-fields (lookup-type
> #'type-name))))]))
>    
> 
> 
>    (provide define-struct-type define-struct-var))
> 
> ;;; test
> 
> (require dot)
> 
> "one"                                              
> ; --> "one"
> (define-struct-type d c p (x y z) (make-inspector))
> "two"                                              
> ; --> "two"
> (define-struct-var s d (make-d 1 2 add1))
> "three"                                            
> ; --> "three"
> struct:d                                            
>       ; --> #<struct-type:d>
> c                                                  
> ; --> #<primitive:make-d>
> d?                                                  
> ; --> #<primitive:d?>
> s                                                  
> ; --> #(struct:d 1 2 3)
> (p s)
> "four"                                             
> ; --> "four"
> s.x
> (set! s.x 3)
> s.x ; --> 3
> 
> (((((lambda(x)((((((((x x)x)x)x)x)x)x)x))
>     (lambda(x)(lambda(y)(x(x y)))))
>    (lambda(x)(x)x))
>   (lambda()(printf "Greetings, Jos~n"))))
>   ----- Original Message ----- 
>   From: Jens Axel Søgaard 
>   To: Jens Axel Søgaard 
>   Cc: jos koot ; plt-scheme at list.cs.brown.edu ; Sam
> TH 
>   Sent: Sunday, March 11, 2007 5:10 PM
>   Subject: Re: [plt-scheme] Dot-notation for
> structure field access
> 
> 
>   Jens Axel Søgaard skrev:
>   > jos koot skrev:
>   >> Hi Jens Axel,
>   >> Thanks, Yes I guessed the problem was located
> there.
>   >> I understand that the two transformers produce
> syntactically distinct 
>   >> identifiers, but I would not know how to make
> them identical. I have 
>   >> tried (quasi)syntax/loc, but that did not work
> either. Is there a 
>   >> solution for this problem? If so, can you give
> me some extra hint? 
>   > 
>   > Haven't figured it out yet.
> 
> 
=== message truncated ===>
_________________________________________________
>   For list-related administrative tasks:
>  
> http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>