From a2ebc93bd8b75b7815275cf96780e138be343d75 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Wed, 1 Apr 2009 02:15:09 +0000
Subject: [PATCH] macro stepper:   fixed bug with opaque result of
 syntax-local-expand-expression   fixed debug-file support

svn: r14395
---
 collects/macro-debugger/model/deriv-c.ss     |  7 +----
 collects/macro-debugger/model/reductions.ss  | 28 +++++++++++++-------
 collects/macro-debugger/view/debug-format.ss |  2 +-
 collects/macro-debugger/view/debug.ss        |  6 ++---
 4 files changed, 22 insertions(+), 21 deletions(-)

diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss
index 3efb19f094..de974b9e19 100644
--- a/collects/macro-debugger/model/deriv-c.ss
+++ b/collects/macro-debugger/model/deriv-c.ss
@@ -31,12 +31,7 @@
 ;;   (make-mrule <Base(Stx)> ?Stx (listof LocalAction) ?exn ?Stx ?Deriv)
 (define-struct (mrule base) (me1 locals me2 ?2 etx next) #:transparent)
 
-;; A LocalAction is one of
-;;   (make-local-expansion <Node(Stx)> Stx ?Stx Boolean Deriv)
-;;   (make-local-expansion/expr <Node(Stx)> Stx ?Stx Boolean ?Opaque Deriv)
-;;   (make-local-lift Stx Identifier)
-;;   (make-local-lift-end Stx)
-;;   (make-local-bind BindSyntaxes)
+;; A LocalAction is one of ???
 (define-struct (local-expansion node) (for-stx? me1 inner lifted me2 opaque)
   #:transparent)
 (define-struct local-lift (expr id) #:transparent)
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index bb92f312be..037d68eb04 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -41,6 +41,9 @@
   (match/count d
     [(Wrap deriv (e1 e2))
      (R [#:pattern ?form]
+        [#:let transparent-stx (hash-ref opaque-table (syntax-e #'?form) #f)]
+        [#:when transparent-stx
+                [#:set-syntax transparent-stx]]
         [#:expect-syntax e1 (list d)]
         [#:when (base? d)
                 [#:learn (or (base-resolves d) null)]]
@@ -366,20 +369,16 @@
 (define (LocalAction local)
   (match/count local
     [(struct local-expansion (e1 e2 for-stx? me1 inner #f me2 opaque))
-     (R [#:do (when opaque
-                (fprintf (current-error-port)
-                         "LocalAction: local-expand-expr\n"))]
-        [#:parameterize ((phase (if for-stx? (add1 (phase)) (phase))))
+     (R [#:parameterize ((phase (if for-stx? (add1 (phase)) (phase))))
          [#:set-syntax e1]
          [#:pattern ?form]
          [#:rename/mark ?form e1 me1]
          [Expr ?form inner]
-         [#:rename/mark ?form me2 e2]])]
+         [#:rename/mark ?form me2 e2]
+         [#:do (when opaque
+                 (hash-set! opaque-table (syntax-e opaque) e2))]])]
     [(struct local-expansion (e1 e2 for-stx? me1 inner lifted me2 opaque))
-     (R [#:do (when opaque
-                (fprintf (current-error-port)
-                         "LocalAction: not handling opaque val\n"))]
-        [#:let begin-stx (stx-car lifted)]
+     (R [#:let begin-stx (stx-car lifted)]
         [#:let lift-stxs (cdr (reverse (stx->list (stx-cdr lifted))))]
         [#:parameterize ((phase (if for-stx? (add1 (phase)) (phase)))
                          (available-lift-stxs lift-stxs)
@@ -400,7 +399,9 @@
           [#:step 'splice-lifts visible-lifts]]
          [#:pass2]
          [#:set-syntax lifted]
-         [#:rename/mark ?form me2 e2]])]
+         [#:rename/mark ?form me2 e2]
+         [#:do (when opaque
+                 (hash-set! opaque-table (syntax-e opaque) e2))]])]
     [(struct local-lift (expr id))
      ;; FIXME: add action
      (R [#:do (unless (pair? (available-lift-stxs))
@@ -613,3 +614,10 @@
   (apply fprintf (current-error-port) args)
   (when #t
     (apply error sym args)))
+
+;; opaque-table
+;; Weakly remembers assoc between opaque values and
+;; actual syntax, so that actual can be substituted in
+;; for destructuring.
+;; FIXME: perhaps add event for opaque-stx unwrapping?
+(define opaque-table (make-weak-hasheq))
diff --git a/collects/macro-debugger/view/debug-format.ss b/collects/macro-debugger/view/debug-format.ss
index 0cdb024bee..07c938ad7e 100644
--- a/collects/macro-debugger/view/debug-format.ss
+++ b/collects/macro-debugger/view/debug-format.ss
@@ -22,7 +22,7 @@
         [(symbol? d) `(quote ,d)]
         [(string? d) `(quote ,d)]
         [(pair? d) `(cons ,(serialize-datum (car d)) ,(serialize-datum (cdr d)))]
-        [(null? d) '()]
+        [(null? d) ''()]
         [(exn? d) `(make-exn ,(exn-message d) (current-continuation-marks))]
         [(syntax? d) `(datum->syntax #f ',(syntax->datum d))]
         #;[(syntax? d) `(eval (quote ,(compile `(,#'quote-syntax ,d))))]
diff --git a/collects/macro-debugger/view/debug.ss b/collects/macro-debugger/view/debug.ss
index efa0a3e04d..1b12f0f7ab 100644
--- a/collects/macro-debugger/view/debug.ss
+++ b/collects/macro-debugger/view/debug.ss
@@ -22,10 +22,8 @@
     (super-new)))
 
 (define (make-stepper)
-  (let ([f (new macro-stepper-frame%
-                (config (new macro-stepper-config/prefs%)))])
-    (send f show #t)
-    (send f get-widget)))
+  (define director (new macro-stepper-director%))
+  (send director new-stepper))
 
 (define (debug-file file)
   (let-values ([(events msg ctx) (load-debug-file file)])