From 0d2a4b98db4abbe6229d5f9e9c4dcc5a29495fd8 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Sun, 5 Dec 2010 23:40:54 -0800
Subject: [PATCH] moving to another machine

---
 collects/stepper/private/annotate.rkt    | 64 ++++++++++++------------
 collects/tests/stepper/through-tests.rkt | 20 +++++---
 2 files changed, 47 insertions(+), 37 deletions(-)

diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt
index 4e61c924ad..f6f5cf6995 100644
--- a/collects/stepper/private/annotate.rkt
+++ b/collects/stepper/private/annotate.rkt
@@ -522,9 +522,8 @@
                   [outer-lambda-abstraction
                    (lambda (annotated-lambda free-varrefs)
                      (match-let*
-                      ([ap-struct-maker 
-                        #`(#,annotated-proc #,annotated-lambda #f)]
-                       [closure-info (make-debug-info-app 'all free-varrefs 'none)]
+                      ([closure-info (make-debug-info-app 'all free-varrefs 'none)]
+                       
                        ;; if we manually disable the storage of 
                        ;; names, lambdas get rendered as lambdas.
                        [closure-name 
@@ -534,38 +533,41 @@
                                   [(pair? procedure-name-info) 
                                    (car procedure-name-info)]
                                   [else #f]))]
-                       [closure-storing-proc
-                        (opt-lambda (closure debug-info [lifted-index #f])
-                          (closure-table-put! closure
-                                              (make-closure-record 
-                                               closure-name
-                                               debug-info
-                                               #f
-                                               lifted-index))
-                          closure)]
-                       ;; gnarr! I can't find a test case
-                       ;; that depends on the attachment of the inferred name...
-                       [inferred-name-lambda
-                        (if closure-name
-                            (syntax-property
-                             annotated-lambda
-                             'inferred-name
-                             (syntax-e closure-name))
-                            annotated-lambda)]
-                       [captured
+                       
+                       [make-ap-struct
+                        (lambda (clo debug-info maybe-index)
+                          (annotated-proc
+                           clo
+                           (make-closure-record 
+                            closure-name
+                            debug-info
+                            #f
+                            maybe-index)))]
+                       
+                       [ap-struct-maker 
                         (cond [(pair? procedure-name-info)
-                               #`(#%plain-app 
-                                  #,closure-storing-proc
-                                  #,inferred-name-lambda
-                                  #,closure-info 
+                               #`(#%app
+                                  #,make-ap-struct
+                                  #,closure-info
                                   #,(cadr procedure-name-info))]
                               [else
-                               #`(#%plain-app
-                                  #,closure-storing-proc
-                                  #,inferred-name-lambda
-                                  #,closure-info)])])
+                               #`(#%app
+                                  #,make-ap-struct
+                                  #,closure-info
+                                  #f)])]
+                       
+                       ;; gnarr! I can't find a test case
+                       ;; that depends on the attachment of the inferred name...
+                       [inferred-name-struct
+                        (if closure-name
+                            (syntax-property
+                             ap-struct-maker
+                             'inferred-name
+                             (syntax-e closure-name))
+                            ap-struct-maker)])
                       
-                      (normal-bundle free-varrefs captured)))]
+                      (normal-bundle free-varrefs
+                                     inferred-name-struct)))]
                   
                   
                   ;    @@                 
diff --git a/collects/tests/stepper/through-tests.rkt b/collects/tests/stepper/through-tests.rkt
index 72ec65401d..643028d9bc 100755
--- a/collects/tests/stepper/through-tests.rkt
+++ b/collects/tests/stepper/through-tests.rkt
@@ -214,13 +214,21 @@
      -> ,@defs {21}))
 
 ;;intermediate/lambda hof
-(let ([defs `((define (a x)
-                (lambda (y) (+ x y)))
-              (define b (a 9)))])
+(let ([a-def `(define (a x)
+                (lambda (y) (+ x y)))])
   (t 'intermediate-lambda-hof m:intermediate-lambda
-     ,@defs (b 5)
-   :: ,@defs {(b 5)}
-   -> @defs {'zoofrenzy}))
+     ,a-def (define b (a 9)) (b 5)
+     :: ,a-def (define b ({a} 9))
+     -> ,a-def (define b ({(lambda (x) (lambda (y) (+ x y)))} 9))
+     :: ,a-def (define b {((lambda (x) (lambda (y) (+ x y))) 9)})
+     -> ,a-def (define b {(lambda (y) (+ 9 y))})
+     :: ,a-def (define b (lambda (y) (+ 9 y))) ({b} 5)
+     -> ,a-def (define b (lambda (y) (+ 9 y))) 
+     ({(lambda (y) (+ 9 y))} 5)
+     :: ,a-def (define b (lambda (y) (+ 9 y)))
+     {((lambda (y) (+ 9 y)) 5)}
+     -> ,a-def (define b (lambda (y) (+ 9 y))) {(+ 9 5)}
+     -> ,a-def (define b (lambda (y) (+ 9 y))) {14}))
 
 ;;;;;;;;;;;;
 ;;