diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss index c7113c44f2..a81ad12dec 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 826eaccd6d..8549c95976 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 9bc2ad3bda..c63cbd4667 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 d8bfbc2c89..5df7c859d5 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/hide.ss b/collects/macro-debugger/model/hide.ss index 2dc1c46e27..318893dbb0 100644 --- a/collects/macro-debugger/model/hide.ss +++ b/collects/macro-debugger/model/hide.ss @@ -197,6 +197,10 @@ (>>P d (make-p:define-values rhs) (define-values variables RHS) ([for-deriv RHS rhs]))] + [(AnyQ p:expression (e1 e2 rs inner)) + (>>P d (make-p:expression inner) + (#%expression INNER) + ([for-deriv INNER inner]))] [(AnyQ p:if (e1 e2 rs full? test then else)) (if full? (>>P d (make-p:if full? test then else) @@ -603,6 +607,8 @@ (>>Seek (for-deriv rhs))] [(AnyQ p:define-values (e1 e2 rs rhs)) (>>Seek (for-deriv rhs))] + [(AnyQ p:expression (e1 e2 rs inner)) + (>>Seek (for-deriv inner))] [(AnyQ p:if (e1 e2 rs full? test then else)) (>>Seek (for-deriv test) (for-deriv then) diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss index 11c9c76d90..75bcf7bf54 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