diff --git a/collects/stepper/private/annotate.ss b/collects/stepper/private/annotate.ss index 2e4c8c5ddb..5a2a69a785 100644 --- a/collects/stepper/private/annotate.ss +++ b/collects/stepper/private/annotate.ss @@ -1116,9 +1116,6 @@ [(require module-name) exp] ; the 'dynamic-require' form is used by the actual expander - ;; RIGHT HERE, basically: the test harness breaks because of multiple definitions of identifiers. Probably we want - ;; to mangle the output of run-teaching-program so that the module is required with some kind of temporary prefix? - [(let-values ([(done-already?) . rest1]) (#%plain-app dynamic-wind void @@ -1192,13 +1189,15 @@ [(begin . bodies) #`(begin #,@(map annotate/module-top-level (syntax->list #`bodies)))] [(#%plain-app call-with-values (#%plain-lambda () body) print-values) - #`(call-with-values - (lambda () #,(top-level-annotate/inner (top-level-rewrite #`body) exp #f)) - (lambda vals - (begin - (#,exp-finished-break (list (list #,(lambda () exp) #f (lambda () vals)))) - (call-with-values (lambda () vals) - print-values))))] + (stepper-recertify + #`(call-with-values + (lambda () #,(top-level-annotate/inner (top-level-rewrite #`body) exp #f)) + (lambda vals + (begin + (#,exp-finished-break (list (list #,(lambda () exp) #f (lambda () vals)))) + (call-with-values (lambda () vals) + print-values)))) + exp)] [any (stepper-syntax-property exp 'stepper-test-suite-hint) (top-level-annotate/inner (top-level-rewrite exp) exp #f)] diff --git a/collects/stepper/private/marks.ss b/collects/stepper/private/marks.ss index f4787574ae..ad416445e2 100644 --- a/collects/stepper/private/marks.ss +++ b/collects/stepper/private/marks.ss @@ -1,4 +1,4 @@ -(module marks mzscheme +(module marks scheme/base (require mzlib/list mzlib/contract @@ -38,10 +38,10 @@ #;lookup-binding-list debug-key extract-mark-list - (struct normal-breakpoint-info (mark-list kind)) - (struct error-breakpoint-info (message)) - (struct breakpoint-halt ()) - (struct expression-finished (returned-value-list))) + (struct-out normal-breakpoint-info) + (struct-out error-breakpoint-info) + (struct-out breakpoint-halt) + (struct-out expression-finished)) ; BREAKPOINT STRUCTURES @@ -72,7 +72,7 @@ ; see module top for type (define (make-full-mark location label bindings) - (datum->syntax-object #'here `(lambda () (,(make-make-full-mark-varargs location label bindings) + (datum->syntax #'here `(lambda () (,(make-make-full-mark-varargs location label bindings) ,@(map make-mark-binding-stx bindings))))) (define (mark-source mark) @@ -109,7 +109,7 @@ (define (display-mark mark) (apply string-append - (format "source: ~a\n" (syntax-object->datum (mark-source mark))) + (format "source: ~a\n" (syntax->datum (mark-source mark))) (format "label: ~a\n" (mark-label mark)) (format "bindings:\n") (map (lambda (binding) @@ -135,11 +135,11 @@ (define (lookup-binding mark-list id) (mark-binding-value - (lookup-first-binding (lambda (id2) (module-identifier=? id id2)) + (lookup-first-binding (lambda (id2) (free-identifier=? id id2)) mark-list (lambda () (error 'lookup-binding "variable not found in environment: ~a~n" (if (syntax? id) - (syntax-object->datum id) + (syntax->datum id) id)))))) (define (all-bindings mark) diff --git a/collects/stepper/private/model.ss b/collects/stepper/private/model.ss index 144814e275..e281a90fe4 100644 --- a/collects/stepper/private/model.ss +++ b/collects/stepper/private/model.ss @@ -36,20 +36,19 @@ ; late-let(x) : ERROR -(module model mzscheme - (require mzlib/contract - mzlib/etc +(module model scheme/base + (require scheme/contract scheme/match - mzlib/class + scheme/class scheme/list - (prefix a: "annotate.ss") - (prefix r: "reconstruct.ss") + (prefix-in a: "annotate.ss") + (prefix-in r: "reconstruct.ss") "shared.ss" "marks.ss" "model-settings.ss" "macro-unwind.ss" "lifting.ss" - (prefix test-engine: test-engine/scheme-tests) + (prefix-in test-engine: test-engine/scheme-tests) #;(file "/Users/clements/clements/scheme-scraps/eli-debug.ss") ;; for breakpoint display ;; (commented out to allow nightly testing) @@ -156,7 +155,7 @@ (define steps-received 0) (define break - (opt-lambda (mark-set break-kind [returned-value-list #f]) + (lambda (mark-set break-kind [returned-value-list #f]) (set! steps-received (+ steps-received 1)) ;; have to be careful else this won't be looked up right away: