PasteRack.org
Paste # 82619
2019-05-03 17:39:05

Fork as a new paste.

Paste viewed 348 times.


Embed:

  1. #lang typed/racket
  2.  
  3. (require (for-syntax racket/syntax
  4.                      racket/list
  5.                      syntax/parse))
  6.  
  7. (provide struct/fields)
  8.  
  9.  
  10. (begin-for-syntax
  11.   (define (syntax->keyword stx)
  12.     (string->keyword (symbol->string (syntax->datum stx)))))
  13.  
  14. (define-syntax struct/fields
  15.   (syntax-parser
  16.     [(_ id ([field : type] ...))
  17.      (with-syntax ([constructor/kw (format-id #'id "~a/kw" #'id)]
  18.                    [constructor/fields (format-id #'id "~a/fields" #'id)]
  19.                    [(kw+type ...) (append*
  20.                                    (map (lambda (fld type)
  21.                                           (list (syntax->keyword fld)
  22.                                                 type))
  23.                                         (syntax->list #'(field ...))
  24.                                         (syntax->list #'(type ...))))]
  25.                    [(kw+field ...) (append*
  26.                                     (map (lambda (fld)
  27.                                            (list (syntax->keyword fld)
  28.                                                  fld))
  29.                                          (syntax->list #'(field ...))))])
  30.        #'(begin
  31.            (struct id ([field : type] ...))
  32.            (define constructor/kw
  33.              (ann (lambda (kw+field ...)
  34.                     (id field ...))
  35.                   (kw+type ... -> id)))
  36.            (define-syntax constructor/fields
  37.              (syntax-parser
  38.                [(_ id [field value] ...)
  39.                 #'(cons constructor/kw (flatten (list (syntax->keyword field) value) ...))]))))]))
  40.  
  41. (struct/fields
  42.    foo
  43.    ([a : Integer]
  44.     [b : Symbol]))

=>