From 225c0115022c354b7436559fd7cfa4e863514c6d Mon Sep 17 00:00:00 2001
From: Stephen Chang <stchang216@gmail.com>
Date: Sat, 9 Apr 2011 15:55:12 -0400
Subject: [PATCH] fix toplevel variable dereferencing in lazy stepper

in lazy/lazy.rkt
- add 'lazy-op stepper-syntax-property to op in lazy #%app

in stepper/private/annotate.rkt
- in varref-abstraction, check for 'lazy-op operator for toplevel vars, and use
  varref-break-wrap if property = #t
---
 collects/lazy/lazy.rkt                | 8 +++++++-
 collects/stepper/private/annotate.rkt | 5 ++++-
 2 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/collects/lazy/lazy.rkt b/collects/lazy/lazy.rkt
index d5f5f317ec..6807d2189d 100644
--- a/collects/lazy/lazy.rkt
+++ b/collects/lazy/lazy.rkt
@@ -60,6 +60,8 @@
 
   (define-for-syntax (stepper-hide-operator stx)
     (stepper-syntax-property stx 'stepper-skipto (append skipto/cdr skipto/second)))
+  (define-for-syntax (stepper-add-lazy-op-prop stx)
+    (stepper-syntax-property stx 'lazy-op #t))
   
   (define-syntax (hidden-car stx)
     (syntax-case stx ()
@@ -72,6 +74,10 @@
   (define-syntax (hidden-! stx)
     (syntax-case stx ()
       [(_ arg) (stepper-hide-operator (syntax/loc stx (! arg)))]))
+  
+  (define-syntax (mark-as-lazy-op stx)
+    (syntax-case stx ()
+      [(_ arg) (stepper-add-lazy-op-prop (syntax/loc stx arg))]))
     
   (define-syntax (hidden-~ stx)
     (syntax-case stx ()
@@ -275,7 +281,7 @@
                  ;; #,($$ #`(if (lazy? p) lazy strict))
                  (if (lazy? p) lazy strict))))))]))
 
-  (defsubst (!app   f x ...) (!*app (hidden-! f) x ...))
+  (defsubst (!app   f x ...) (!*app (hidden-! (mark-as-lazy-op f)) x ...))
   (defsubst (~!*app f x ...) (hidden-~ (!*app f x ...)))
   (defsubst (~!app  f x ...) (hidden-~ (!app f x ...)))
 
diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt
index 7106ea06ed..c0a2f98158 100644
--- a/collects/stepper/private/annotate.rkt
+++ b/collects/stepper/private/annotate.rkt
@@ -811,9 +811,12 @@
              [varref-no-break-wrap
               (lambda ()
                 (outer-wcm-wrap (make-debug-info-normal free-varrefs) var))]
+             [base-namespace-symbols (namespace-mapped-symbols (make-base-namespace))]
              [top-level-varref-break-wrap
               (lambda ()
-                (if (memq (syntax-e var) beginner-defined:must-reduce)
+                (if (or (memq (syntax-e var) beginner-defined:must-reduce)
+                        (and (stepper-syntax-property var 'lazy-op)
+                             (not (memq (syntax->datum var) base-namespace-symbols))))
                     (varref-break-wrap)
                     (varref-no-break-wrap)))])
           (vector