[racket] Are there Racket structures similar to Common Lisp's?

(You have reimplemented my macros from 2htdp/universe :-) 


On Aug 17, 2012, at 2:29 PM, Walter Tetzner wrote:

> Here's one that gives you keyword arguments, and builds a Racket
> struct. If you don't give a value for a field, it defaults to #f. It
> also prints with the keyword arguments.
> 
> There's more code than Matthias' example, though. :)
> 
> Also, I might write a patch to have `struct' produce a constructor
> that accepts keyword arguments. It would either generate a new
> constructor that took keyword arguments, or it would have the current
> constructor also be able to take keyword arguments. I also think having
> fields default to #f is probably a bad idea. So, 1) is anyone
> interested in this, and 2) which approach would be better?
> 
> #lang racket
> (require (for-syntax racket/syntax
>                     racket))
> 
> ;; -----------------------------------------------------------------------------
> ;; library code:
> (define-for-syntax (id->keyword id)
>  (datum->syntax #'id
>    (string->keyword
>     (symbol->string
>      (syntax->datum id)))))
> 
> (define-for-syntax (id->keyword-arg id default)
>  (list (id->keyword id)
>        (list (generate-temporary (syntax->datum id)) default)))
> 
> (define-for-syntax (ids->keyword-args ids default)
>  (append-map (λ (id) (id->keyword-arg id default))
>              (syntax->list ids)))
> 
> (define-for-syntax (struct-print id make-id obj fields)
>  (let ([fields (syntax->list fields)])
>    (with-syntax ([format-str (format "(~a ~a)"
>                                (syntax->datum make-id)
>                                (string-join (map (λ (field)
>                                                     (format "#:~a ~~s"
>                                                       (syntax->datum field)))
>                                                  fields) " "))])
>      #`(format format-str #,@(map (λ (field)
>                                      (list (format-id id "~a-~a" id field)
>                                            obj))
>                                   fields)))))
> 
> (define-syntax (defstruct stx)
>  (syntax-case stx ()
>    [(defstruct id field ...)
>     (let* ([key-args (ids->keyword-args #'(field ...) #'#f)])
>       (with-syntax* ([make-id (format-id #'id "make-~a" #'id)]
>                      [(arg ...) (map (λ (item)
>                                         (first item))
>                                      (filter list? key-args))])
>         #`(begin
>             (struct id (field ...)
>                     #:transparent
>                     #:methods gen:custom-write
>                     [(define write-proc
>                        (λ (obj port mode)
>                           (write-string #,(struct-print #'id #'make-id
>                                                         #'obj #'(field ...))
>                                         port)))])
>             (define (make-id #, at key-args)
>               (id arg ...)))))]))
> 
> ;; -----------------------------------------------------------------------------
> ;; client code
> (defstruct person name age waist-size favorite-color)
> 
> (define p (make-person #:age 35 #:favorite-color "blue" #:name "Bob"))
> 
> (person-age p)
> (person-waist-size p)
> 
> -Walter
> 
> On Fri, Aug 17, 2012 at 8:58 AM, Matthias Felleisen
> <matthias at ccs.neu.edu> wrote:
>> 
>> p.s. Here is a naive macro that gets you close, assuming you're willing to expand to classes:
>> 
>> #lang racket
>> 
>> ;; -----------------------------------------------------------------------------
>> ;; library code:
>> (define-syntax-rule
>>  (defstruct s f ...)
>>  (begin (define x (class object% (init-field (f '()) ...) (super-new)))
>>         (define-syntax-rule
>>           (s a (... ...))
>>           (new x a (... ...)))))
>> 
>> ;; -----------------------------------------------------------------------------
>> ;; client code
>> (defstruct person name age waist-size favorite-color)
>> 
>> (define p (person (age 35) (favorite-color "blue") (name "Bob")))
>> 
>> (get-field age p)
>> (get-field waist-size p)
>> 
>> 
>> 
>> 

-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/pkcs7-signature
Size: 4373 bytes
Desc: not available
URL: <http://lists.racket-lang.org/users/archive/attachments/20120817/abce8377/attachment.p7s>