Macro stepper: fixed handling of #%expression

svn: r5848

original commit: a056844d337d60ede84e531f5c763601c4a44d89

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)

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))

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)

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))

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