www

commit ce40ab867297c9c736796028576a51332bf71eb0
parent d5f3866188e4c87532bfbed77e36123d874161b6
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date:   Fri, 30 Mar 2007 20:09:44 +0000

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

svn: r5849

original commit: ea00e7a68b09700e09b53753db9c475eb192f3ac

Diffstat:
M
collects/macro-debugger/model/deriv-c.ss
 | 
8
+++++---
M
collects/macro-debugger/model/deriv-parser.ss
 | 
10
++++++++--
M
collects/macro-debugger/model/deriv-tokens.ss
 | 
7
++++++-
M
collects/macro-debugger/model/deriv-util.ss
 | 
4
+++-
M
collects/macro-debugger/model/reductions.ss
 | 
6
+++++-

5 files changed, 27 insertions(+), 8 deletions(-)
diff --git a/collects/macro-debugger/model/deriv-c.ss b/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)
 
diff --git a/collects/macro-debugger/model/deriv-parser.ss b/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)
diff --git a/collects/macro-debugger/model/deriv-tokens.ss b/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)
diff --git a/collects/macro-debugger/model/deriv-util.ss b/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)]
diff --git a/collects/macro-debugger/model/reductions.ss b/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))]