diff --git a/collects/stepper/private/annotate.rkt b/collects/stepper/private/annotate.rkt index 984685dced4..cf3e89998c7 100644 --- 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 index abc58e01440..f22d813b51c 100644 --- 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 index 927f6d9e5c6..45bfada54f0 100644 --- 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?