From fc7322a4b3481adeae1732e42b5fffc0ba03d28f Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Sat, 23 Sep 2006 11:21:17 +0000
Subject: [PATCH] just checking it in

svn: r4426
---
 collects/lazy/lazy.ss | 30 +++++++++++++++++++++---------
 1 file changed, 21 insertions(+), 9 deletions(-)

diff --git a/collects/lazy/lazy.ss b/collects/lazy/lazy.ss
index bdbab5ebce..edc556a110 100644
--- a/collects/lazy/lazy.ss
+++ b/collects/lazy/lazy.ss
@@ -43,13 +43,15 @@
 
   ;; --------------------------------------------------------------------------
   ;; Delay/force etc
-
+  
   (provide ~)
   (defsubst (~ x) (delay x))
 
   (define (! x) (if (promise? x) (! (force x)) x))
   ;; the exposed `!' must be a special form
   (provide (rename special-form-! !))
+  ;; hack to see if it solves a certificate problem:
+  (provide (rename ! crazythingthatwillneverbereferredto))
   (defsubst (special-form-! x) (! x) special-form-! !)
 
   ;; These things are useful too, to write strict functions (with various
@@ -256,18 +258,26 @@
   ;; `!apply': provided as `apply' (no need to provide `~!apply', since all
   ;;           function calls are delayed by `#%app')
 
+  (define-syntax (jbc! stx)
+      (syntax-case stx (!)
+        [(_ arg) (syntax-property #`(! arg) 'stepper-skipto '(syntax-e cdr syntax-e cdr car))]))
+  
   (define-syntax (!*app stx)
     (syntax-case stx (~ ! !! !list !!list !values !!values)
       [(_ f x ...)
+       (let ([$$ (lambda (stx) (syntax-property stx 'stepper-skipto '(syntax-e cdr cdr both-l () (car))))]
+             [$ (lambda (stx) (syntax-property stx 'stepper-skipto '(syntax-e cdr syntax-e car)))])
        (with-syntax ([(y ...) (generate-temporaries #'(x ...))])
+         (with-syntax ([(!y ...) (map (lambda (stx) (syntax-property stx 'stepper-skipto '(syntax-e cdr syntax-e cdr car)))
+                                      (syntax->list #`((! y) ...)))])
          ;; use syntax/loc for better errors etc
-         (with-syntax ([lazy   (syntax/loc stx (p y     ...))]
-                       [strict (syntax/loc stx (p (! y) ...))])
-           (syntax/loc stx
-             (let ([p f] [y x] ...)
-               (if (lazy? p) lazy strict)))))]))
+         (with-syntax ([lazy   (quasisyntax/loc stx (p y     ...))]
+                       [strict (quasisyntax/loc stx (p !y ...))])
+           (quasisyntax/loc stx
+              (let ([p f] [y x] ...)
+                #,($$ #`(if (lazy? p) lazy strict))))))))]))
 
-  (defsubst (!app   f x ...) (!*app (! f) x ...))
+  (defsubst (!app   f x ...) (!*app (jbc! f) x ...))
   (defsubst (~!*app f x ...) (~ (!*app f x ...)))
   (defsubst (~!app  f x ...) (~ (!app f x ...)))
 
@@ -768,8 +778,10 @@
   ;; --------------------------------------------------------------------------
   ;; Initialize special evaluation hooks
 
-  (let ([prim-eval (current-eval)])
-    (current-eval (lambda (expr) (!! (prim-eval expr)))))
+  ;; taking this out so that stepper test cases will work correctly:
+  
+  #;(let ([prim-eval (current-eval)])
+      (current-eval (lambda (expr) (!! (prim-eval expr)))))
 
 )