may have fixed cond in stepper tests

4z3 · Oct 20, 2010 · 60dabc8 · 60dabc8
1 parent 027450d
commit 60dabc8
Show file tree

Hide file tree

Showing 3 changed files with 34 additions and 34 deletions.
diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt
@@ -146,36 +146,37 @@
 
 
                [rewritten
-                (kernel:kernel-syntax-case stx #f
-
-                                           ; cond :
-                                           [(if test (begin then) else-stx)
-                                            (let ([origin (syntax-property stx 'origin)]
-                                                  [rebuild-if
-                                                   (lambda (new-cond-test)
-                                                     (let* ([new-then (recur-regular (syntax then))]
-                                                            [rebuilt (stepper-syntax-property
-                                                                      (rebuild-stx `(if ,(recur-regular (syntax test))
-                                                                                        ,new-then
-                                                                                        ,(recur-in-cond (syntax else-stx) new-cond-test))
-                                                                                   stx)
-                                                                      'stepper-hint
-                                                                      'comes-from-cond)])
-                                                       ; move the stepper-else mark to the if, if it's present:
-                                                       (if (stepper-syntax-property (syntax test) 'stepper-else)
-                                                           (stepper-syntax-property rebuilt 'stepper-else #t)
-                                                           rebuilt)))])
-                                              (cond [(cond-test stx) ; continuing an existing 'cond'
-                                                     (rebuild-if cond-test)]
-                                                    [(and origin (pair? origin) (eq? (syntax-e (car origin)) 'cond)) ; starting a new 'cond'
-                                                     (rebuild-if (lambda (test-stx) 
-                                                                   (and (eq? (syntax-source stx) (syntax-source test-stx))
-                                                                        (eq? (syntax-position stx) (syntax-position test-stx)))))]
-                                                    [else ; not from a 'cond' at all.
-                                                     (rebuild-stx `(if ,@(map recur-regular (list (syntax test) (syntax (begin then)) (syntax else-stx)))) stx)]))]
-                                           [(begin body) ; else clauses of conds; ALWAYS AN ERROR CALL
-                                            (cond-test stx)
-                                            (stepper-syntax-property stx 'stepper-skip-completely #t)]
+                (kernel:kernel-syntax-case 
+                 stx
+                 #f
+                 ; cond :
+                 [(#%if test (#%let () then) else-stx)
+                  (let ([origin (syntax-property stx 'origin)]
+                        [rebuild-if
+                         (lambda (new-cond-test)
+                           (let* ([new-then (recur-regular (syntax then))]
+                                  [rebuilt (stepper-syntax-property
+                                            (rebuild-stx `(if ,(recur-regular (syntax test))
+                                                              ,new-then
+                                                              ,(recur-in-cond (syntax else-stx) new-cond-test))
+                                                         stx)
+                                            'stepper-hint
+                                            'comes-from-cond)])
+                             ; move the stepper-else mark to the if, if it's present:
+                             (if (stepper-syntax-property (syntax test) 'stepper-else)
+                                 (stepper-syntax-property rebuilt 'stepper-else #t)
+                                 rebuilt)))])
+                    (cond [(cond-test stx) ; continuing an existing 'cond'
+                           (rebuild-if cond-test)]
+                          [(and origin (pair? origin) (eq? (syntax-e (car origin)) 'cond)) ; starting a new 'cond'
+                           (rebuild-if (lambda (test-stx) 
+                                         (and (eq? (syntax-source stx) (syntax-source test-stx))
+                                              (eq? (syntax-position stx) (syntax-position test-stx)))))]
+                          [else ; not from a 'cond' at all.
+                           (rebuild-stx `(if ,@(map recur-regular (list (syntax test) (syntax (begin then)) (syntax else-stx)))) stx)]))]
+                 [(begin body) ; else clauses of conds; ALWAYS AN ERROR CALL
+                  (cond-test stx)
+                  (stepper-syntax-property stx 'stepper-skip-completely #t)]
 
                                            ; wrapper on a local.  This is necessary because teach.ss expands local into a trivial let wrapping a bunch of
                                            ;  internal defines, and therefore the letrec-values on which I want to hang the 'stepper-hint doesn't yet

diff --git a/collects/stepper/private/macro-unwind.rkt b/collects/stepper/private/macro-unwind.rkt
@@ -244,7 +244,7 @@
                              (syntax-property stx 'user-source))
                         (eq? user-position
                              (syntax-property stx 'user-position)))
-                   (syntax-case stx (if begin)
+                   (syntax-case stx (if begin let-values)
                      ;; the else clause disappears when it's a
                      ;; language-inserted else clause
                      [(if test result)
@@ -254,7 +254,7 @@
                             (loop (syntax else-clause)))]
                      ;; else clause appears momentarily in 'before,' even
                      ;; though it's a 'skip-completely'
-                     [(begin . rest) null]
+                     [(let-values () . rest) null]
                      [else-stx
                       (error 'unwind-cond
                              "expected an if, got: ~.s"

diff --git a/collects/stepper/private/reconstruct.rkt b/collects/stepper/private/reconstruct.rkt
@@ -13,8 +13,7 @@
            "model-settings.ss"
            "shared.ss"
            "my-macros.ss"
-           (for-syntax scheme/base)
-           #;(file "/Users/clements/clements/scheme-scraps/eli-debug.ss"))
+           (for-syntax scheme/base))
 
   (provide/contract 
    [reconstruct-completed (syntax?