[racket] structure question

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Wed Dec 8 14:39:52 EST 2010



#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 #, at parameters)
             (name #, at 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) "???"))




Posted on the users mailing list.