PasteRack.org
Paste # 17434
2022-12-10 01:11:24

Fork as a new paste.

Paste viewed 1507 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 (s-op:set-operation lhs:comparison op:binary-comparison-operation ~! rhs:comparison)
  104.   ;              #:attr norm #'(value-compare: #:operand-left lhs.norm
  105.   ;                                            #:operation op.norm
  106.   ;                                            #:operand-right rhs.norm
  107.   ;                                            #:set-operation s-op.norm)
  108.   ;              #:attr type #'boolean
  109.   ;              )
  110.  
  112.   (pattern v:value
  113.            #:when (eq? (syntax->datum #'v.type) 'boolean)
  114.            #:attr norm #'v.norm
  115.            #:attr type #'v.type)
  116.  
  117.   (pattern whatever
  118.            #:fail-when #t "failure"
  119.            #:attr norm #'#f
  120.            #:attr type #'#f)
  121.  
  123.   #;(pattern (lhs:numeric-expression op:binary-comparison-operation ~! rhs:numeric-expression)
  124.              #:attr norm #'(value-compare: #:operand-left lhs.norm
  125.                                            #:operation op.norm
  126.                                            #:operand-right rhs.norm)
  127.              #:attr type #'boolean
  128.              )
  129.   )
  130.  
  132. (define (expression stx)
  133.  
  134.   (syntax-parse stx
  135.     #;([_ expression:numeric-expression]
  136.        #'(list expression.norm 'expression.type)
  137.        )
  138.     ([_ expression:boolean-expression]
  139.      #'(list expression.norm 'expression.type)
  140.      )
  141.     ))
  142.  
  144. (module+ test
  145.   (require racket/match
  146.            syntax/parse)
  147.  
  148.  
  149.   (expression #'(#%-and #t))
  150.  
  151.  
  152.  
  153.   )

=>