www

commit 2d29222912a5da59b951d539c6f2e481e09bc9bf
parent 4e3fc8fc9903dcd7d3e89b85dc83f979c6d1ad8b
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date:   Fri,  2 Jul 2010 11:02:47 -0600

macro-stepper: track syntax-local-value and syntax-track-origin (not done)

original commit: dbdf00c5f713ab5eaed70b8e6d35f32b2349aa5c

Diffstat:
M
collects/macro-debugger/model/deriv-c.rkt
 | 
2
++
M
collects/macro-debugger/model/deriv-parser.rkt
 | 
5
+++++
M
collects/macro-debugger/model/deriv-tokens.rkt
 | 
10
++++++++--
M
collects/macro-debugger/model/reductions.rkt
 | 
9
+++++++++
M
collects/macro-debugger/model/steps.rkt
 | 
1
+

5 files changed, 25 insertions(+), 2 deletions(-)
diff --git a/collects/macro-debugger/model/deriv-c.rkt b/collects/macro-debugger/model/deriv-c.rkt
@@ -39,6 +39,8 @@
 (define-struct local-lift-require (req expr mexpr) #:transparent)
 (define-struct local-lift-provide (prov) #:transparent)
 (define-struct local-bind (names ?1 renames bindrhs) #:transparent)
+(define-struct local-value (name ?1 resolves bound?) #:transparent)
+(define-struct track-origin (before after) #:transparent)
 (define-struct local-remark (contents) #:transparent)
   ;; contents : (listof (U string syntax))
 
diff --git a/collects/macro-debugger/model/deriv-parser.rkt b/collects/macro-debugger/model/deriv-parser.rkt
@@ -43,6 +43,7 @@
     enter-check exit-check
     local-post exit-local exit-local/expr
     local-bind enter-bind exit-bind
+    local-value-result
     phase-up module-body
     renames-lambda
     renames-case-lambda
@@ -201,6 +202,10 @@
       (make local-bind $1 $2 $3 #f)]
      [(local-bind rename-list (? BindSyntaxes))
       (make local-bind $1 #f $2 $3)]
+     [(track-origin)
+      (make track-origin (car $1) (cdr $1))]
+     [(local-value ! Resolves local-value-result)
+      (make local-value $1 $2 $3 $4)]
      [(local-remark)
       (make local-remark $1)]
      [(local-artificial-step)
diff --git a/collects/macro-debugger/model/deriv-tokens.rkt b/collects/macro-debugger/model/deriv-tokens.rkt
@@ -61,6 +61,10 @@
 
    local-remark         ; (listof (U string syntax))
    local-artificial-step ; (list syntax syntax syntax syntax)
+
+   track-origin         ; (cons stx stx)
+   local-value          ; identifier
+   local-value-result   ; boolean
    ))
 
 (define-tokens renames-tokens
@@ -175,8 +179,10 @@
     (149 prim-varref)
     (150 lift-require            ,token-lift-require)
     (151 lift-provide            ,token-lift-provide)
-    (155 prim-#%stratified-body)
-    ))
+    (152 track-origin            ,token-track-origin)
+    (153 local-value             ,token-local-value)
+    (154 local-value-result      ,token-local-value-result)
+    (155 prim-#%stratified-body)))
 
 (define (signal->symbol sig)
   (if (symbol? sig)
diff --git a/collects/macro-debugger/model/reductions.rkt b/collects/macro-debugger/model/reductions.rkt
@@ -454,6 +454,15 @@
         ;; FIXME: use renames
         [#:binders names]
         [#:when bindrhs => (BindSyntaxes bindrhs)]]]
+    [(struct track-origin (before after))
+     [R [#:set-syntax before]
+        [#:pattern ?form]
+        [#:rename ?form after 'track-origin]]]
+    [(struct local-value (name ?1 resolves bound?))
+     [R [! ?1]
+        ;; [#:learn (list name)]
+        ;; Add remark step?
+        ]]
     [(struct local-remark (contents))
      (R [#:reductions (list (walk/talk 'remark contents))])]))
 
diff --git a/collects/macro-debugger/model/steps.rkt b/collects/macro-debugger/model/steps.rkt
@@ -92,6 +92,7 @@
     (splice-module-lifts . "Splice lifted module declarations")
 
     (remark           . "Macro made a remark")
+    (track-origin     . "Macro called syntax-track-origin")
 
     (error            . "Error")))