From f4d14edaac382e1784b252eb3dbbd6a2cbc75e7f Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Thu, 10 Jun 2010 16:40:52 -0600
Subject: [PATCH] macro-stepper: added emit-local-step

original commit: 3d21f97f3f7fe71663a6224ee28bb47ecae44ff1
---
 collects/macro-debugger/emit.rkt               | 12 +++++++++++-
 collects/macro-debugger/macro-debugger.scrbl   | 11 +++++++++++
 collects/macro-debugger/model/deriv-parser.rkt | 12 ++++++++++++
 collects/macro-debugger/model/deriv-tokens.rkt |  2 ++
 4 files changed, 36 insertions(+), 1 deletion(-)

diff --git a/collects/macro-debugger/emit.rkt b/collects/macro-debugger/emit.rkt
index 6b24190..e5ea883 100644
--- a/collects/macro-debugger/emit.rkt
+++ b/collects/macro-debugger/emit.rkt
@@ -4,7 +4,9 @@
 (provide/contract
  [emit-remark
   (->* () (#:unmark? any/c) #:rest (listof (or/c string? syntax?))
-       any)])
+       any)]
+ [emit-local-step
+  (-> syntax? syntax? #:id identifier? any)])
 
 (define current-expand-observe
   (dynamic-require ''#%expobs 'current-expand-observe))
@@ -20,3 +22,11 @@
                        arg))
                  args)])
         (observe 'local-remark args)))))
+
+(define (emit-local-step before after #:id id)
+  (let ([observe (current-expand-observe)])
+    (when observe
+      (observe 'local-artificial-step
+               (list (list id)
+                     before (syntax-local-introduce before)
+                     (syntax-local-introduce after) after)))))
diff --git a/collects/macro-debugger/macro-debugger.scrbl b/collects/macro-debugger/macro-debugger.scrbl
index 6fbfe33..051ce25 100644
--- a/collects/macro-debugger/macro-debugger.scrbl
+++ b/collects/macro-debugger/macro-debugger.scrbl
@@ -142,6 +142,17 @@ transformer returns. Unmarking is suppressed if @scheme[unmark?] is
 
 }
 
+@defproc[(emit-local-step [before syntax?] [after syntax?]
+                          [#:id id identifier?])
+         void?]{
+
+Emits an event that simulates a local expansion step from
+@scheme[before] to @scheme[after].
+
+The @scheme[id] argument acts as the step's ``macro'' for the purposes
+of macro hiding.
+
+}
 
 @section{Macro stepper text interface}
 
diff --git a/collects/macro-debugger/model/deriv-parser.rkt b/collects/macro-debugger/model/deriv-parser.rkt
index 3c3c153..f4f8ca0 100644
--- a/collects/macro-debugger/model/deriv-parser.rkt
+++ b/collects/macro-debugger/model/deriv-parser.rkt
@@ -204,6 +204,18 @@
       (make local-bind $1 #f $2 $3)]
      [(local-remark)
       (make local-remark $1)]
+     [(local-artificial-step)
+      (let ([ids (list-ref $1 0)]
+            [before (list-ref $1 1)]
+            [mbefore (list-ref $1 2)]
+            [mafter (list-ref $1 3)]
+            [after (list-ref $1 4)])
+        (make local-expansion
+          before after #f mbefore
+          (make mrule mbefore mafter ids #f
+                before null after #f mafter
+                (make p:stop mafter mafter null #f))
+          #f after #f))]
      ;; -- Not really local actions, but can occur during evaluation
      ;; called 'expand' (not 'local-expand') within transformer
      [(start (? EE)) #f]
diff --git a/collects/macro-debugger/model/deriv-tokens.rkt b/collects/macro-debugger/model/deriv-tokens.rkt
index 9f7d48a..6448e7a 100644
--- a/collects/macro-debugger/model/deriv-tokens.rkt
+++ b/collects/macro-debugger/model/deriv-tokens.rkt
@@ -61,6 +61,7 @@
    top-non-begin        ; .
 
    local-remark         ; (listof (U string syntax))
+   local-artificial-step ; (list syntax syntax syntax syntax)
    ))
 
 (define-tokens renames-tokens
@@ -96,6 +97,7 @@
     (#f  top-begin               ,token-top-begin)
     (#f  top-non-begin           ,token-top-non-begin)
     (#f  local-remark            ,token-local-remark)
+    (#f  local-artificial-step   ,token-local-artificial-step)
 
     ;; Standard signals
     (0   visit                   ,token-visit)