#lang racket
;; -----------------------------------------------------------------------------
;; library module
;; syntax def
;; definition = ... | (struct/kw name (field ...) options ...)
;; meaning: (struct name (field ...) options ...)
;; plus keyword-based constructor: name/kw
;; WARNING: the introduction of name/kw is non-hygienic
;; NEW: allow optional default expressions on field-s
;; WARNING: this new option will interfere with the #:auto field option
(define-syntax (struct/kw stx)
(syntax-case stx ()
[(_ name (field ...) . stuff)
(let* ([field* (syntax->list #'(field ...))]
[fields (map (lambda (f)
(syntax-case f ()
[(name default) #'name]
[name f]))
field*)]
[field-to-kw-param
(lambda (f)
`(,(string->keyword (symbol->string (syntax-e f))) ,f))]
[field-with-default-to-kw-param
(lambda (f)
(define-values (name default) (apply values (syntax->list f)))
(define name-as-keyword
(string->keyword (symbol->string (syntax-e name))))
`(,name-as-keyword (,name ,default)))]
[parameters
(foldr (lambda (f r)
(append
(syntax-case f ()
[[name default] (field-with-default-to-kw-param f)]
[name (field-to-kw-param f)])
r))
'[] field*)]
[name/kw
(datum->syntax stx
(string->symbol
(string-append (symbol->string (syntax-e #'name))
"/kw")))])
#`(begin
(struct name #,fields . stuff)
(define (#,name/kw #,@parameters)
(name #,@fields))))]))
;; -----------------------------------------------------------------------------
;; usage example (could be separate module)
(struct/kw book (author title [details ""]) #:transparent)
(define book1 (book/kw #:title "The Client" #:author "John Grisham"))
(define book2 (book/kw #:title "The Client" #:author "John Grisham" #:details
"???"))
(and (string=? (book-author book1) "John Grisham")
(string=? (book-details book2) "???"))
_________________________________________________
For list-related administrative tasks:
http://lists.racket-lang.org/listinfo/users