PasteRack.org
Paste # 21883
2017-12-12 18:06:39

Fork as a new paste.

Paste viewed 91 times.


Embed:

  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 (extract-struct-info (syntax-local-value #'qux))))
  29.  
  30. (define f (foo))
  31.  
  32. (printf "Foo with default arguments:\n    ~a\n    ~a\n    ~a\n"
  33.         (foo 7 8)
  34.         (foo 5)
  35.         f)
  36.  
  37. (printf "Using accessors: ~a\n" (foo-bar f))
  38.  
  39. (printf "Match on foo:\n")
  40. (match f
  41.   [(foo a b)
  42.    (printf "a = ~a, b = ~a\n" a b)])

=>