From d29f1d82fc8e479e5bc35a97e9751a3132726c41 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 13 Apr 2007 21:26:49 +0000
Subject: [PATCH] Macro stepper:   added option to force letrec transformation 
  made macro hiding slightly more resilient in presence of local actions

svn: r5932
---
 collects/macro-debugger/model/hide.ss         | 32 +++++++++++++------
 collects/macro-debugger/model/synth-engine.ss |  4 +++
 2 files changed, 26 insertions(+), 10 deletions(-)

diff --git a/collects/macro-debugger/model/hide.ss b/collects/macro-debugger/model/hide.ss
index 52862382f9..d6970470d5 100644
--- a/collects/macro-debugger/model/hide.ss
+++ b/collects/macro-debugger/model/hide.ss
@@ -11,6 +11,7 @@
 
   (provide hide/policy
            macro-policy
+           force-letrec-transformation
            seek-syntax
            current-hiding-warning-handler
            (struct nonlinearity (message paths))
@@ -473,18 +474,23 @@
 
     ;; for-bderiv : BlockDerivation -> (values BlockDerivation (list-of syntax))
     (define (for-bderiv bd)
-      (match bd
-        [(IntQ bderiv (es1 es2 pass1 trans pass2))
-         (let ([pass2 (bderiv->lderiv bd)])
-           (recv [(pass2 es2) (for-lderiv pass2)]
-                 (values (rewrap/nt bd (make-bderiv es1 es2 null 'list pass2))
-                         es2)))]
-        [#f (values #f #f)]))
+      (if (force-letrec-transformation)
+          (match bd
+            [(IntQ bderiv (es1 es2 pass1 trans pass2))
+             (recv [(pass2 es2) (for-lderiv pass2)]
+                   (values (rewrap/nt bd (make-bderiv es1 es2 pass1 trans pass2))
+                           es2))])
+          (match bd
+            [(IntQ bderiv (es1 es2 pass1 trans pass2))
+             (let ([pass2 (bderiv->lderiv bd)])
+               (recv [(pass2 es2) (for-lderiv pass2)]
+                     (values (rewrap/nt bd (make-bderiv es1 es2 null 'list pass2))
+                             es2)))]
+            [#f (values #f #f)])))
 
     (for-deriv deriv))
 
 
-
 ;                                      
 ;                              ;;      
 ;                              ;;      
@@ -728,9 +734,15 @@
     (define (for-local-action local)
       (match local
         [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
-         (raise (make-localactions))]
+         (let-values ([(rename-subtersm2 table2) (do-rename me1 e1)])
+           (let ([subterms (for-deriv deriv)])
+             (when (pair? (filter s:subterm? subterms))
+               (raise (make-localactions)))))]
         [(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
-         (raise (make-localactions))]
+         (let-values ([(rename-subtersm2 table2) (do-rename me1 e1)])
+           (let ([subterms (for-deriv deriv)])
+             (when (pair? (filter s:subterm? subterms))
+               (raise (make-localactions)))))]
         [(struct local-lift (expr id))
          ;; FIXME: seek in the lifted deriv, transplant subterm expansions *here*
          (extract/remove-unvisited-lift id)]
diff --git a/collects/macro-debugger/model/synth-engine.ss b/collects/macro-debugger/model/synth-engine.ss
index 0f17aa1def..774e73e66d 100644
--- a/collects/macro-debugger/model/synth-engine.ss
+++ b/collects/macro-debugger/model/synth-engine.ss
@@ -11,6 +11,7 @@
            >>Prim
            >>Seek
            macro-policy
+           force-letrec-transformation
            subterms-table
            lifts-available
            lifts-retained
@@ -20,6 +21,9 @@
   ;; macro-policy : parameter of (identifier -> boolean)
   (define macro-policy (make-parameter (lambda (id) #t)))
 
+  ;; force-letrec-transformation : parameter of boolean
+  (define force-letrec-transformation (make-parameter #f))
+
   ;; subterms-table : parameter of hashtable[syntax => (list-of Path)]
   (define subterms-table (make-parameter #f))