From 718b9709bc7dc1acdc138c2f67288001b328d80b Mon Sep 17 00:00:00 2001
From: Stephen Chang <stchang216@gmail.com>
Date: Tue, 19 Apr 2011 01:21:19 -0400
Subject: [PATCH] fix struct constructor application in lazy racket

---
 collects/lazy/lazy.rkt                    |  4 +++-
 collects/stepper/private/macro-unwind.rkt | 15 ++++++++-------
 collects/tests/lazy/lang.rkt              | 15 ++++++++++++++-
 3 files changed, 25 insertions(+), 9 deletions(-)

diff --git a/collects/lazy/lazy.rkt b/collects/lazy/lazy.rkt
index 6807d2189d..d955723559 100644
--- a/collects/lazy/lazy.rkt
+++ b/collects/lazy/lazy.rkt
@@ -254,6 +254,8 @@
   ;; `!apply': provided as `apply' (no need to provide `~!apply', since all
   ;;           function calls are delayed by `#%app')
 
+  (define (extract-if-lazy-proc f)
+    (or (procedure-extract-target f) f))
   (define-syntax (!*app stx)
     (syntax-case stx ()
       [(_ f x ...)
@@ -271,7 +273,7 @@
                             skipto/first)))])
          (with-syntax ([(y ...) (generate-temporaries #'(x ...))])
            ;; use syntax/loc for better errors etc
-           (with-syntax ([lazy   (syntax/loc stx ((procedure-extract-target p) y ...))]
+           (with-syntax ([lazy   (syntax/loc stx ((extract-if-lazy-proc p) y ...))]
                          [strict (syntax/loc stx (p (hidden-! y) ...))])
              (quasisyntax/loc stx
                ((lambda (p y ...)
diff --git a/collects/stepper/private/macro-unwind.rkt b/collects/stepper/private/macro-unwind.rkt
index 1a61e925c6..78bede05f7 100644
--- a/collects/stepper/private/macro-unwind.rkt
+++ b/collects/stepper/private/macro-unwind.rkt
@@ -59,14 +59,15 @@
       [(define-values dc ...)
        (unwind-define stx settings)]
       ; STC: app special cases from lazy racket
-      ; procedure-extract-target - can't hide this in lazy.rkt bc it's needed
+      ; extract-if-lazy-proc - can't hide this in lazy.rkt bc it's needed
       ; to distinguish the general lazy application
       [(#%plain-app proc-extract p)
-       (or (eq? (syntax->datum #'proc-extract) 'procedure-extract-target)
-           (eq? (with-handlers ; for print output-style
-                    ([(λ (e) #t) (λ (e) #f)]) 
-                  (syntax-e (second (syntax-e #'proc-extract))))
-                procedure-extract-target))
+       (or (eq? (syntax->datum #'proc-extract) 'extract-if-lazy-proc)
+           (eq? (object-name 
+                 (with-handlers ; for print output-style
+                     ([(λ (e) #t) (λ (e) #f)]) 
+                   (syntax-e (second (syntax-e #'proc-extract)))))
+                'extract-if-lazy-proc))
        (unwind #'p settings)]
       ; lazy #%app special case: force and delay
       [(#%plain-app f arg)
@@ -80,7 +81,7 @@
       [(#%plain-app 
         (#%plain-lambda args1 (#%plain-app (#%plain-app proc p) . args2)) 
         . args3)
-       (and (eq? (syntax->datum #'proc) 'procedure-extract-target)
+       (and (eq? (syntax->datum #'proc) 'extract-if-lazy-proc)
             (equal? (syntax->datum (cdr (syntax-e #'args1)))
                     (syntax->datum #'args2)))
        (recur-on-pieces #'args3 settings)]
diff --git a/collects/tests/lazy/lang.rkt b/collects/tests/lazy/lang.rkt
index 535745cb3b..6d579363d4 100644
--- a/collects/tests/lazy/lang.rkt
+++ b/collects/tests/lazy/lang.rkt
@@ -68,8 +68,21 @@
    (!! (take 1 (cons 0 (error "poof")))) => '(0)
    ))
 
+(define (misc-tests)
+  (define-struct a (b c))
+  (define-struct d (e f))
+  (test
+   (! (a-b (make-a 1 2))) => 1
+   (! (a-c (make-a 1 2))) => 2
+   (! (a-b (a 1 2))) => 1
+   (! (a-c (a 1 2))) => 2
+   (! (a? (a 1 2))) => true
+   (! (a? (d 1 2))) => false
+   ))
+
 (provide lang-tests)
 (define (lang-tests)
   (! (begin (basic-tests)
             (list-tests)
-            (take-tests))))
+            (take-tests)
+            (misc-tests))))