From 0b5b000078fc8a162744f0400cf16b2ac5aaf969 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 8 May 2007 20:56:37 +0000
Subject: [PATCH] Macro stepper:   - removed dead seek-syntax code   - fixed
 bug related to hiding + errors   - fixed bug finding bindings in interrrupted
 expansion

svn: r6182

original commit: e4e5ec407498cbe36faa26ff37c55c445a236748
---
 collects/macro-debugger/model/debug.ss      |  4 +++-
 collects/macro-debugger/model/deriv-util.ss | 22 ++++++++++++---------
 collects/macro-debugger/model/reductions.ss | 10 ++++++----
 3 files changed, 22 insertions(+), 14 deletions(-)

diff --git a/collects/macro-debugger/model/debug.ss b/collects/macro-debugger/model/debug.ss
index 1eb41ba..1e03645 100644
--- a/collects/macro-debugger/model/debug.ss
+++ b/collects/macro-debugger/model/debug.ss
@@ -5,12 +5,14 @@
            "deriv-util.ss"
            "hide.ss"
            "hiding-policies.ss"
-           "deriv.ss")
+           "deriv.ss"
+           "steps.ss")
 
   (provide (all-from "trace.ss")
            (all-from "deriv.ss")
            (all-from "deriv-util.ss")
            (all-from "hiding-policies.ss")
            (all-from "hide.ss")
+           (all-from "steps.ss")
            (all-from (lib "plt-match.ss")))
   )
diff --git a/collects/macro-debugger/model/deriv-util.ss b/collects/macro-debugger/model/deriv-util.ss
index aeb1630..95cea98 100644
--- a/collects/macro-debugger/model/deriv-util.ss
+++ b/collects/macro-debugger/model/deriv-util.ss
@@ -272,7 +272,11 @@
   ;; FIXME: Missing case-lambda
   (define (extract-all-fresh-names d)
     (define (renaming-node? x)
-      (or (p:lambda? x)
+      (or (and (error-wrap? x)
+               (renaming-node? (error-wrap-inner x)))
+          (and (interrupted-wrap? x)
+               (renaming-node? (interrupted-wrap-inner x)))
+          (p:lambda? x)
           (p:case-lambda? x)
           (p:let-values? x)
           (p:letrec-values? x)
@@ -284,22 +288,22 @@
           (p:define-syntaxes? x)))
     (define (extract-fresh-names d)
       (match d
-        [(struct p:lambda (e1 e2 rs renames body))
+        [(AnyQ p:lambda (e1 e2 rs renames body))
          (if renames
              (with-syntax ([(?formals . ?body) renames])
                #'?formals)
              null)]
-        [(struct p:let-values (e1 e2 rs renames rhss body))
+        [(AnyQ p:let-values (e1 e2 rs renames rhss body))
          (if renames
              (with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
                #'(?vars ...))
              null)]
-        [(struct p:letrec-values (e1 e2 rs renames rhss body))
+        [(AnyQ p:letrec-values (e1 e2 rs renames rhss body))
          (if renames
              (with-syntax ([(((?vars ?rhs) ...) . ?body) renames])
                #'(?vars ...))
              null)]
-        [(struct p:letrec-syntaxes+values (e1 e2 rs srenames srhss vrenames vrhss body))
+        [(AnyQ p:letrec-syntaxes+values (e1 e2 rs srenames srhss vrenames vrhss body))
          (cons
           (if srenames
               (with-syntax ([(((?svars ?srhs) ...) ((?vvars ?vrhs) ...) . ?body)
@@ -310,24 +314,24 @@
               (with-syntax ([(((?vvars ?vrhs) ...) . ?body) vrenames])
                 #'(?vvars ...))
               null))]
-        [(struct b:defvals (rename head))
+        [(AnyQ b:defvals (rename head))
          (let ([head-e2 (lift/deriv-e2 head)])
            (if head-e2
                (with-syntax ([(?dv ?vars ?rhs) head-e2])
                  #'?vars)
                null))]
-        [(struct b:defstx (rename head rhs))
+        [(AnyQ b:defstx (rename head rhs))
          (let ([head-e2 (lift/deriv-e2 head)])
            (if head-e2
                (with-syntax ([(?ds ?svars ?rhs) head-e2])
                  #'?svars)
                null))]
-        [(struct p:define-values (e1 e2 rs rhs))
+        [(AnyQ p:define-values (e1 e2 rs rhs))
          (if rhs
              (with-syntax ([(?dv ?vars ?rhs) e1])
                #'?vars)
              null)]
-        [(struct p:define-syntaxes (e1 e2 rs rhs))
+        [(AnyQ p:define-syntaxes (e1 e2 rs rhs))
          (if rhs
              (with-syntax ([(?ds ?svars ?srhs) e1])
                #'?svars)
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index c3323bd..e896afc 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -317,7 +317,8 @@
                   (let ([ctx (lambda (x) (path-replace term path0 x))])
                     (append (with-context ctx
                               (reductions* deriv0))
-                            (loop (and (deriv? deriv0)
+                            (loop (and term
+                                       (deriv? deriv0)
                                        (path-replace term path0 (deriv-e2 deriv0)))
                                   (cdr subterms)))))]
                [(s:rename? (car subterms))
@@ -326,9 +327,10 @@
                   ;; FIXME: if so, coalesce?
                   (rename-frontier (s:rename-before subterm0)
                                    (s:rename-after subterm0))
-                  (loop (path-replace term
-                                      (s:rename-path subterm0)
-                                      (s:rename-after subterm0))
+                  (loop (and term
+                             (path-replace term
+                                           (s:rename-path subterm0)
+                                           (s:rename-after subterm0)))
                         (cdr subterms)))]))]
 
       ;; FIXME