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

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)
>
>
>
>