diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss index c7113c4..a81ad12 100644 --- a/collects/macro-debugger/model/deriv-c.ss +++ b/collects/macro-debugger/model/deriv-c.ss @@ -38,6 +38,7 @@ (define-struct (p:define-values prule) (rhs) #f) ;; Simple expressions + (define-struct (p:expression prule) (inner) #f) (define-struct (p:if prule) (full? test then else) #f) (define-struct (p:wcm prule) (key mark body) #f) (define-struct (p:set! prule) (id-resolves rhs) #f) diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss index 826eacc..8549c95 100644 --- a/collects/macro-debugger/model/deriv-parser.ss +++ b/collects/macro-debugger/model/deriv-parser.ss @@ -205,6 +205,7 @@ [((? Prim#%ModuleBegin)) ($1 e1 e2 rs)] [((? PrimDefineSyntaxes)) ($1 e1 e2 rs)] [((? PrimDefineValues)) ($1 e1 e2 rs)] + [((? PrimExpression)) ($1 e1 e2 rs)] [((? PrimIf)) ($1 e1 e2 rs)] [((? PrimWCM)) ($1 e1 e2 rs)] [((? PrimSet)) ($1 e1 e2 rs)] @@ -326,6 +327,11 @@ (make-p:define-values e1 e2 rs $3)]) ;; Simple expressions + (PrimExpression + (#:args e1 e2 rs) + [(prim-expression ! (? EE 'inner)) + (make-p:expression e1 e2 rs $3)]) + (PrimIf (#:args e1 e2 rs) [(prim-if ! (? EE 'test) next (? EE 'then) next (? EE 'else)) diff --git a/collects/macro-debugger/model/deriv-tokens.ss b/collects/macro-debugger/model/deriv-tokens.ss index 9bc2ad3..c63cbd4 100644 --- a/collects/macro-debugger/model/deriv-tokens.ss +++ b/collects/macro-debugger/model/deriv-tokens.ss @@ -40,6 +40,8 @@ local-post ; syntax exit-local ; syntax + variable ; (cons identifier identifier) + IMPOSSIBLE ; useful for error-handling clauses that have no NoError counterpart )) @@ -50,7 +52,7 @@ renames-letrec-syntaxes ; (cons (listof syntax) (cons (listof syntax) syntax)) renames-block ; (cons syntax syntax) ... different, contains both pre+post )) - (define-tokens prim-tokens + (define-empty-tokens prim-tokens (prim-module prim-#%module-begin prim-define-syntaxes prim-define-values prim-if prim-wcm prim-begin prim-begin0 prim-#%app prim-lambda @@ -59,8 +61,7 @@ prim-quote prim-quote-syntax prim-require prim-require-for-syntax prim-require-for-template prim-provide prim-set! - - variable ; (cons identifier identifier) + prim-expression )) ;; ** Signals to tokens @@ -131,6 +132,7 @@ (135 . ,token-module-lift-end-loop) (136 . ,token-lift/let-loop) (137 . ,token-module-lift-loop) + (138 . prim-expression) )) (define (tokenize sig-n val pos) diff --git a/collects/macro-debugger/model/deriv-util.ss b/collects/macro-debugger/model/deriv-util.ss index d8bfbc2..5df7c85 100644 --- a/collects/macro-debugger/model/deriv-util.ss +++ b/collects/macro-debugger/model/deriv-util.ss @@ -184,6 +184,8 @@ (loop rhs)] [(AnyQ p:define-values (_ _ _ rhs)) (loop rhs)] + [(AnyQ p:expression (_ _ _ inner)) + (loop inner)] [(AnyQ p:if (_ _ _ _ test then else)) (join (loop test) (loop then) (loop else))] [(AnyQ p:wcm (_ _ _ key value body)) diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss index 11c9c76..75bcf7b 100644 --- a/collects/macro-debugger/model/reductions.ss +++ b/collects/macro-debugger/model/reductions.ss @@ -102,6 +102,11 @@ [#:frontier (list #'RHS)] [#:if rhs [Expr RHS rhs]])] + [(AnyQ p:expression (e1 e2 rs inner) exni) + (R e1 + [! exni] + [#:pattern (?expr INNER)] + [Expr INNER inner])] [(AnyQ p:if (e1 e2 rs full? test then else) exni) (if full? (R e1