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

Fork as a new paste.

Paste viewed 1514 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.  
  27. (define-syntax-class value
  28.   #:description "literal value"
  29.   #:datum-literals (enum)
  30.   #:attributes (norm type)
  31.   (pattern x:exact-integer
  32.            #:attr norm #'(value-int: #:value x)
  33.            #:attr type (syntax/loc #'x number))
  34.   (pattern x:number
  35.            #:attr norm #'(value-float: #:value x)
  36.            #:attr type #'number)
  37.   (pattern x:boolean
  38.            #:attr norm #'(value-bool: #:value x)
  39.            #:attr type #'boolean)
  40.   (pattern 'x:identifier
  41.            #:attr norm #'(value-symbol: #:value 'x)
  42.            #:attr type #'symbol)
  43.  
  45.   )
  46.  
  48. (define-syntax-class binary-comparison-operation
  49.   #:datum-literals (>= > <= < == !=)
  50.   #:attributes (norm type)
  51.   (pattern >=
  52.            #:attr norm #'(enum condition-op-num greater-or-equal)
  53.            #:attr type #'boolean)
  54.   (pattern >
  55.            #:attr norm #'(enum condition-op-num greater)
  56.            #:attr type #'boolean)
  57.   (pattern <=
  58.            #:attr norm #'(enum condition-op-num less-or-equal)
  59.            #:attr type #'boolean)
  60.   (pattern <
  61.            #:attr norm #'(enum condition-op-num less)
  62.            #:attr type #'boolean)
  63.   (pattern ==
  64.            #:attr norm #'(enum condition-op-num equals)
  65.            #:attr type #'boolean)
  66.   (pattern !=
  67.            #:attr norm #'(enum condition-op-num not-equal)
  68.            #:attr type #'boolean)
  69.   )
  70.  
  71. (define-syntax-class binary-boolean-operation
  72.   #:description "binary boolean operation"
  73.   #:datum-literals (#%-and #%-or)
  74.   #:attributes (constructor type)
  75.   (pattern #%-and
  76.            #:attr constructor #'value-and:
  77.            #:attr type #'boolean
  78.            )
  79.   (pattern #%-or
  80.            #:attr constructor #'value-or:
  81.            #:attr type #'boolean
  82.            ))
  83.  
  85.  
  86. (define-syntax-class boolean-expression
  87.   #:description "boolean expression"
  88.   #:attributes (norm type)
  89.   #:no-delimit-cut
  90.  
  91.   (pattern (op:binary-boolean-operation ~! val0:boolean-expression val1:boolean-expression)
  92.            #:attr norm #'(op.constructor #:values (list val0.norm val1.norm))
  93.            #:attr type #'boolean
  94.            )
  95.  
  96.   #;(pattern (op:binary-comparison-operation ~! lhs:numeric-expression rhs:numeric-expression)
  97.            #:attr norm #'(value-compare: #:operand-left lhs.norm
  98.                                          #:operation op.norm
  99.                                          #:operand-right rhs.norm)
  100.            #:attr type #'boolean
  101.            )
  102.  
  103.   (pattern v:value
  104.            #:when (eq? (syntax->datum #'v.type) 'boolean)
  105.            #:attr norm #'v.norm
  106.            #:attr type #'v.type)
  107.  
  108.   (pattern whatever
  109.            #:fail-when #t "failure"
  110.            #:attr norm #'#f
  111.            #:attr type #'#f)
  112.  
  113.   )
  114.  
  116. (define (expression stx)
  117.  
  118.   (syntax-parse stx
  119.     #;([_ expression:numeric-expression]
  120.        #'(list expression.norm 'expression.type)
  121.        )
  122.     ([_ expression:boolean-expression]
  123.      #'(list expression.norm 'expression.type)
  124.      )
  125.     ))
  126.  
  128. (module+ test
  129.   (require racket/match
  130.            syntax/parse)
  131.  
  132.  
  133.   (expression #'(#%-and #t))
  134.  
  135.  
  136.  
  137.   )

=>