PasteRack.org
Paste # 81271
2018-09-28 15:18:56

Fork as a new paste.

Paste viewed 270 times.


Embed:

variant test

  1. #lang racket/base
  2.  
  3. (require
  4.   (for-syntax
  5.    racket/base
  6.    racket/syntax
  7.    syntax/parse
  8.    )
  9.   )
  10.  
  11. (begin-for-syntax
  12.   (define-syntax-class variant-entry
  13.     #:description "variant entry"
  14.     #:attributes (o struct)
  15.  
  16.     (pattern (o:id (n:id t:expr) ...)
  17.              #:attr struct #'`(o (n ,t) ...)
  18.              ))
  19.   )
  20.  
  21. ;;; -------------------------------------------------------------------------------------------- ;;;
  22. (define-syntax (define-variant stx)
  23.   (syntax-parse stx
  24.     ((_ name:id fs:variant-entry ...)
  25.      (with-syntax (
  26.                    ;;[constructor (format-id #'name "create-~a" (syntax-e #'name))]
  27.                    [constructors ((format-id #'name "create-~a-~a" (syntax-e #'name) (syntax-e #' fs.o)) ...)]
  28.                    )
  29.        #'(begin
  30.            `((name constructors ,(list fs.struct ...))
  31.              ...)
  32.            )))))
  33.  
  34. (define-variant my-variant
  35.   (option-1
  36.     (a 1)
  37.     (b 2)
  38.     (c 3)
  39.     )
  40.   (option-2
  41.    (a 1)
  42.    (d 2)
  43.    )
  44.   (option-3 )
  45.   )

=>