From ba7441b3a504a906d58915d0a50b8c0aad75a4f9 Mon Sep 17 00:00:00 2001
From: John Clements <clements@racket-lang.org>
Date: Wed, 5 Sep 2007 00:23:34 +0000
Subject: [PATCH] ...

svn: r7276
---
 collects/stepper/internal-docs.txt       |  1 +
 collects/stepper/private/macro-unwind.ss | 85 +++++++++++++-----------
 2 files changed, 47 insertions(+), 39 deletions(-)

diff --git a/collects/stepper/internal-docs.txt b/collects/stepper/internal-docs.txt
index eaf779f8e4..1e582a0d33 100644
--- a/collects/stepper/internal-docs.txt
+++ b/collects/stepper/internal-docs.txt
@@ -86,6 +86,7 @@ stepper-hint :
  [ 'from-splice-box ] : expression was expanded from a scheme splice
 		        box (inside an xml box)
  [ 'comes-from-recur ] : expression was expanded from a 'recur'
+ [ 'comes-from-check-expect ] : expression was expanded from a 'check-expect'
 
 stepper-define-type:
  this is attached to the right-hand sides of defines to indicate what
diff --git a/collects/stepper/private/macro-unwind.ss b/collects/stepper/private/macro-unwind.ss
index fa310cb601..0862f31ce7 100644
--- a/collects/stepper/private/macro-unwind.ss
+++ b/collects/stepper/private/macro-unwind.ss
@@ -1,4 +1,4 @@
- (module macro-unwind mzscheme
+(module macro-unwind mzscheme
   (require (prefix kernel: (lib "kerncase.ss" "syntax"))
            (lib "etc.ss")
            (lib "contract.ss")
@@ -117,44 +117,51 @@
                                      (error 'reconstruct
                                             "reconstruct fails on multiple-values define: ~v\n"
                                             (syntax-object->datum stx)))
-                                   (let* ([printed-name
-                                           (or (stepper-syntax-property #`name 'stepper-lifted-name)
-                                               (stepper-syntax-property #'name 'stepper-orig-name)
-                                               #'name)]
-                                          [unwound-body (unwind #'body settings)]
-                                          ;; see notes in internal-docs.txt
-                                          [define-type (stepper-syntax-property
-                                                        unwound-body 'stepper-define-type)])
-                                     (if define-type
-                                         (kernel:kernel-syntax-case unwound-body #f
-                                                                    [(lambda arglist lam-body ...)
-                                                                     (case define-type
-                                                                       [(shortened-proc-define)
-                                                                        (let ([proc-define-name
-                                                                               (stepper-syntax-property
-                                                                                unwound-body
-                                                                                'stepper-proc-define-name)])
-                                                                          (if (or (module-identifier=? proc-define-name
-                                                                                                       #'name)
-                                                                                  (and (stepper-syntax-property #'name
-                                                                                                        'stepper-orig-name)
-                                                                                       (module-identifier=?
-                                                                                        proc-define-name
-                                                                                        (stepper-syntax-property
-                                                                                         #'name 'stepper-orig-name))))
-                                                                              #`(define (#,printed-name . arglist)
-                                                                                  lam-body ...)
-                                                                              #`(define #,printed-name
-                                                                                  #,unwound-body)))]
-                                                                       [(lambda-define)
-                                                                        #`(define #,printed-name #,unwound-body)]
-                                                                       [else (error 'unwind-define
-                                                                                    "unknown value for syntax property 'stepper-define-type: ~e"
-                                                                                    define-type)])]
-                                                                    [else (error 'unwind-define
-                                                                                 "expr with stepper-define-type is not a lambda: ~e"
-                                                                                 (syntax-object->datum unwound-body))])
-                                         #`(define #,printed-name #,unwound-body))))]
+                                   (if (eq? (stepper-syntax-property #`body 'stepper-hint) 'comes-from-check-expect)
+                                       (kernel:kernel-syntax-case
+                                        (unwind #`body settings) #f
+                                        [(c-e (lambda () a1) a2 a3)
+                                         #`(check-expect a1 a2)]
+                                        [else #`(c-e body)])
+                                       (let* ([printed-name
+                                               (or (stepper-syntax-property #`name 'stepper-lifted-name)
+                                                   (stepper-syntax-property #'name 'stepper-orig-name)
+                                                   #'name)]
+                                              [unwound-body (unwind #'body settings)]
+                                              ;; see notes in internal-docs.txt
+                                              [define-type (stepper-syntax-property
+                                                            unwound-body 'stepper-define-type)])
+                                         (if define-type
+                                             (kernel:kernel-syntax-case 
+                                              unwound-body #f
+                                              [(lambda arglist lam-body ...)
+                                               (case define-type
+                                                 [(shortened-proc-define)
+                                                  (let ([proc-define-name
+                                                         (stepper-syntax-property
+                                                          unwound-body
+                                                          'stepper-proc-define-name)])
+                                                    (if (or (module-identifier=? proc-define-name
+                                                                                 #'name)
+                                                            (and (stepper-syntax-property #'name
+                                                                                          'stepper-orig-name)
+                                                                 (module-identifier=?
+                                                                  proc-define-name
+                                                                  (stepper-syntax-property
+                                                                   #'name 'stepper-orig-name))))
+                                                        #`(define (#,printed-name . arglist)
+                                                            lam-body ...)
+                                                        #`(define #,printed-name
+                                                            #,unwound-body)))]
+                                                 [(lambda-define)
+                                                  #`(define #,printed-name #,unwound-body)]
+                                                 [else (error 'unwind-define
+                                                              "unknown value for syntax property 'stepper-define-type: ~e"
+                                                              define-type)])]
+                                              [else (error 'unwind-define
+                                                           "expr with stepper-define-type is not a lambda: ~e"
+                                                           (syntax-object->datum unwound-body))])
+                                             #`(define #,printed-name #,unwound-body)))))]
                                 [else (error 'unwind-define
                                              "expression is not a define-values: ~e"
                                              (syntax-object->datum stx))]))