Macro stepper: changed rep/parsing of local-expand etc

svn: r5849

collects/macro-debugger/model/deriv-c.ss

@@ -20,13 +20,15 @@
   (define-struct transformation (e1 e2 resolves me1 me2 locals seq) #f)
 
   ;; A LocalAction is one of
-  ;;  - (make-local-expansion Syntax Syntax Syntax Syntax Derivation)
+  ;;  - (make-local-expansion Syntax Syntax Syntax Syntax boolean Derivation)
+  ;;  - (make-local-expansion/expr Syntax Syntax Syntax Syntax boolean Derivation)
   ;;  - (make-local-lift Syntax Identifier)
-  (define-struct local-expansion (e1 e2 me1 me2 deriv) #f)
+  (define-struct local-expansion (e1 e2 me1 me2 for-stx? deriv) #f)
+  (define-struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv) #f)
   (define-struct local-lift (expr id) #f)
   (define-struct local-lift-end (decl) #f)
   (define-struct local-bind (deriv) #f)
-  
+
   ;; A PRule is one of ...
   (define-struct (prule deriv) (resolves) #f)
 

collects/macro-debugger/model/deriv-parser.ss

@@ -45,7 +45,7 @@
                            enter-block block->list block->letrec splice
                            enter-list exit-list
                            enter-check exit-check
-                           local-post exit-local
+                           local-post exit-local exit-local/expr
                            phase-up module-body
                            renames-lambda
                            renames-case-lambda
@@ -155,7 +155,13 @@
       (LocalAction
        (#:no-wrap)
        [(enter-local local-pre (? EE) local-post exit-local)
-        (make-local-expansion $1 $5 $2 $4 $3)]
+        (make-local-expansion $1 $5 $2 $4 #f $3)]
+       [(enter-local phase-up local-pre (? EE) local-post exit-local)
+        (make-local-expansion $1 $6 $3 $5 #t $4)]
+       [(enter-local/expr local-pre (? EE) local-post exit-local/expr)
+        (make-local-expansion/expr $1 (car $5) $2 $4 #f (cdr $5) $3)]
+       [(enter-local/expr local-pre phase-up (? EE) local-post exit-local/expr)
+        (make-local-expansion/expr $1 (car $6) $3 $5 #t (cdr $6) $4)]
        [(lift)
         (make-local-lift (cdr $1) (car $1))]
        [(lift-statement)

collects/macro-debugger/model/deriv-tokens.ss

@@ -3,7 +3,7 @@
   (require (lib "lex.ss" "parser-tools")
            "deriv.ss")
   (provide (all-defined))
-  
+
   (define-tokens basic-tokens
     (visit                ; syntax
      resolve              ; identifier
@@ -39,6 +39,9 @@
      local-pre            ; syntax
      local-post           ; syntax
      exit-local           ; syntax
+
+     enter-local/expr     ; syntax
+     exit-local/expr      ; (cons syntax expanded-expression)
      
      variable            ; (cons identifier identifier)
 
@@ -133,6 +136,8 @@
       (136 . ,token-lift/let-loop)
       (137 . ,token-module-lift-loop)
       (138 . prim-expression)
+      (139 . ,token-enter-local/expr)
+      (140 . ,token-exit-local/expr)
       ))
   
   (define (tokenize sig-n val pos)

collects/macro-debugger/model/deriv-util.ss

@@ -176,7 +176,9 @@
          (join (loop first) (loop second))]
         [(AnyQ transformation (_ _ _ _ _ locals _))
          (loops locals)]
-        [(struct local-expansion (_ _ _ _ deriv))
+        [(struct local-expansion (_ _ _ _ _ deriv))
+         (loop deriv)]
+        [(struct local-expansion/expr (_ _ _ _ _ _ deriv))
          (loop deriv)]
         [(struct local-bind (deriv))
          (loop deriv)]

collects/macro-debugger/model/hide.ss

@@ -419,9 +419,11 @@
     ;; for-local-action : LocalAction -> LocalAction
     (define (for-local-action la)
       (match la
-        [(struct local-expansion (e1 e2 me1 me2 deriv))
+        [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
          (let-values ([(deriv e2) (for-deriv deriv)])
-           (make-local-expansion e1 e2 me1 me2 deriv))]
+           (make-local-expansion e1 e2 me1 me2 for-stx? deriv))]
+        [(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
+         (error 'hide:for-local-action "not implemented for local-expand-expr")]
         [(struct local-lift (expr id))
          (add-unhidden-lift (extract/remove-unvisited-lift id))
          la]
@@ -725,7 +727,9 @@
     ;; for-local-action : LocalAction -> (list-of Subterm)
     (define (for-local-action local)
       (match local
-        [(struct local-expansion (e1 e2 me1 me2 deriv))
+        [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
+         (raise (make-localactions))]
+        [(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
          (raise (make-localactions))]
         [(struct local-lift (expr id))
          ;; FIXME: seek in the lifted deriv, transplant subterm expansions *here*

collects/macro-debugger/model/reductions.ss

@@ -389,7 +389,11 @@
   ;; reductions-local : LocalAction -> ReductionSequence
   (define (reductions-local local)
     (match/with-derivation local
-      [(struct local-expansion (e1 e2 me1 me2 deriv))
+      [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
+       (reductions* deriv)]
+      [(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
+       (fprintf (current-error-port)
+                "reductions: local-expand-expr not fully implemented")
        (reductions* deriv)]
       [(struct local-lift (expr id))
        (list (walk expr id 'local-lift))]