PasteRack.org
Paste # 54993
2017-12-12 17:18:48

Fork as a new paste.

Paste viewed 88 times.


Embed:

Custom Constructor Through Struct Info

  1. #lang racket/base
  2.  
  3. (require racket/match
  4.          (for-syntax racket/base racket/struct-info racket/list
  5.                      syntax/parse))
  6.  
  7. (struct foo (bar baz)
  8.   #:name qux
  9.   #:constructor-name mk-foo-intern
  10.   #:transparent)
  11.  
  12. (define (mk-foo [bar 'bar-quux] [baz 'baz-quux])
  13.   (mk-foo-intern bar baz))
  14.  
  15. (begin-for-syntax
  16.   (struct foo-type-id (info)
  17.     #:property
  18.     prop:procedure
  19.     (λ (unused-info stx)
  20.       (syntax-parse stx
  21.         [_:id #'mk-foo]
  22.         [(_ args ...) #'(mk-foo args ...)]))
  23.     #:property
  24.     prop:struct-info
  25.     (λ (a-foo) (foo-type-id-info a-foo))))
  26.  
  27. (define-syntax foo
  28.   (foo-type-id
  29.    (list-set
  30.     (extract-struct-info (syntax-local-value #'qux))
  31.     1
  32.     #'mk-foo)))
  33.  
  34. (foo 7 8)
  35. (foo 5)
  36. (foo)
  37.  
  38. (foo-bar (foo))
  39.  
  40. (match (foo 5 6)
  41.   [(foo a b)
  42.    (printf "a = ~a, b = ~a\n" a b)])

=>