PasteRack.org
Paste # 41989
2022-12-10 01:13:39

Fork as a new paste.

Paste viewed 1025 times.


Embed:

  1. #lang racket
  2.  
  3. (require
  4.   (for-syntax
  5.    racket/base
  6.    syntax/parse
  7.    )
  8.   racket/match
  9.   racket/syntax
  10.   syntax/parse
  11.   )
  12.  
  13. (require macro-debugger/stepper)
  14.  
  15. (struct *script-constant (name value type)
  16.   #:property prop:procedure
  17.   (λ (ss stx)
  18.     (raise-syntax-error (*script-constant-name ss)
  19.                         "Illegal use of constant outside of script"
  20.                         stx)))
  21.  
  22. (struct *script-constructor (name transformer type)
  23.   #:property prop:procedure (struct-field-index transformer)
  24.   )
  25.  
  26. (define-syntax-class value
  27.   #:description "literal value"
  28.   #:datum-literals (enum)
  29.   #:attributes (norm type)
  30.   (pattern x:exact-integer
  31.            #:attr norm #'(value-int: #:value x)
  32.            #:attr type (syntax/loc #'x number))
  33.   (pattern x:number
  34.            #:attr norm #'(value-float: #:value x)
  35.            #:attr type #'number)
  36.   (pattern x:boolean
  37.            #:attr norm #'(value-bool: #:value x)
  38.            #:attr type #'boolean)
  39.   (pattern 'x:identifier
  40.            #:attr norm #'(value-symbol: #:value 'x)
  41.            #:attr type #'symbol)
  42.  
  43.   )
  44.  
  45. (define-syntax-class binary-comparison-operation
  46.   #:datum-literals (>= > <= < == !=)
  47.   #:attributes (norm type)
  48.   (pattern >=
  49.            #:attr norm #'(enum condition-op-num greater-or-equal)
  50.            #:attr type #'boolean)
  51.   (pattern >
  52.            #:attr norm #'(enum condition-op-num greater)
  53.            #:attr type #'boolean)
  54.   (pattern <=
  55.            #:attr norm #'(enum condition-op-num less-or-equal)
  56.            #:attr type #'boolean)
  57.   (pattern <
  58.            #:attr norm #'(enum condition-op-num less)
  59.            #:attr type #'boolean)
  60.   (pattern ==
  61.            #:attr norm #'(enum condition-op-num equals)
  62.            #:attr type #'boolean)
  63.   (pattern !=
  64.            #:attr norm #'(enum condition-op-num not-equal)
  65.            #:attr type #'boolean)
  66.   )
  67.  
  68. (define-syntax-class binary-boolean-operation
  69.   #:description "binary boolean operation"
  70.   #:datum-literals (#%-and #%-or)
  71.   #:attributes (constructor type)
  72.   (pattern #%-and
  73.            #:attr constructor #'value-and:
  74.            #:attr type #'boolean
  75.            )
  76.   (pattern #%-or
  77.            #:attr constructor #'value-or:
  78.            #:attr type #'boolean
  79.            ))
  80.  
  81.  
  82. (define-syntax-class boolean-expression
  83.   #:description "boolean expression"
  84.   #:attributes (norm type)
  85.   #:no-delimit-cut
  86.  
  87.   (pattern (op:binary-boolean-operation ~! val0:boolean-expression val1:boolean-expression)
  88.            #:attr norm #'(op.constructor #:values (list val0.norm val1.norm))
  89.            #:attr type #'boolean
  90.            )
  91.  
  92.   #;(pattern (op:binary-comparison-operation ~! lhs:numeric-expression rhs:numeric-expression)
  93.            #:attr norm #'(value-compare: #:operand-left lhs.norm
  94.                                          #:operation op.norm
  95.                                          #:operand-right rhs.norm)
  96.            #:attr type #'boolean
  97.            )
  98.  
  99.   (pattern v:value
  100.            #:when (eq? (syntax->datum #'v.type) 'boolean)
  101.            #:attr norm #'v.norm
  102.            #:attr type #'v.type)
  103.  
  104.   (pattern whatever
  105.            #:fail-when #t "failure"
  106.            #:attr norm #'#f
  107.            #:attr type #'#f)
  108.  
  109.   )
  110.  
  111. (define (expression stx)
  112.  
  113.   (syntax-parse stx
  114.     #;([_ expression:numeric-expression]
  115.        #'(list expression.norm 'expression.type)
  116.        )
  117.     ([_ expression:boolean-expression]
  118.      #'(list expression.norm 'expression.type)
  119.      )
  120.     ))
  121.  
  122. (module+ test
  123.   (require racket/match
  124.            syntax/parse)
  125.  
  126.  
  127.   (expression #'(#%-and #t))
  128.  
  129.  
  130.  
  131.   )

=>