suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more stepper cleanup

Browse Source
This commit is contained in:
John Clements 2010-12-08 16:36:29 -08:00
parent ff973b628b
commit 368f345901
6 changed files with 1129 additions and 1122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1775
collects/stepper/private/annotate.rkt
View File

File diff suppressed because it is too large Load Diff

265
collects/stepper/private/lifting.rkt
View File

@ -1,14 +1,11 @@
(module lifting scheme/base #lang racket
(require mzlib/etc
mzlib/contract
(prefix-in kernel: syntax/kerncase)
mzlib/match
"testing-shared.ss"
"shared.ss"
"my-macros.ss"
(for-syntax scheme/base))
(define-struct context-record (stx index kind)) (require (prefix-in kernel: syntax/kerncase)
"testing-shared.ss"
"shared.ss"
(for-syntax racket/base))
(define-struct context-record (stx index kind))
; context-records are used to represent syntax context frames. That is, ; context-records are used to represent syntax context frames. That is,
; a list of context records represents a path through a syntax tree ; a list of context records represents a path through a syntax tree
@ -24,7 +21,7 @@
(define (lift stx lift-in-highlight?) (define (lift stx lift-in-highlight?)
(let*-2vals ([(context-records highlight) (find-highlight stx)]) (match-let* ([(vector context-records highlight) (find-highlight stx)])
(lift-local-defs context-records highlight lift-in-highlight?))) (lift-local-defs context-records highlight lift-in-highlight?)))
; [find-highlight (-> syntax? (listof context-record?))] ; [find-highlight (-> syntax? (listof context-record?))]
@ -34,123 +31,131 @@
(define (find-highlight stx) (define (find-highlight stx)
(let/ec success-escape (let/ec success-escape
(local (let ()
((define (make-try-all-subexprs stx kind context-so-far) (define (make-try-all-subexprs stx kind context-so-far)
(lambda (index-mangler list-of-subtries) (lambda (index-mangler list-of-subtries)
(let loop ([index 0] [remaining list-of-subtries]) (let loop ([index 0] [remaining list-of-subtries])
(unless (null? remaining) (unless (null? remaining)
(let* ([try (car remaining)] (let* ([try (car remaining)]
[corrected-index (index-mangler index)]) [corrected-index (index-mangler index)])
((car try) (cadr try) (cons (make-context-record stx corrected-index kind) context-so-far)) ((car try) (cadr try) (cons (make-context-record stx corrected-index kind) context-so-far))
(loop (+ index 1) (cdr remaining))))))) (loop (+ index 1) (cdr remaining)))))))
(define try->offset-try
(lambda (try)
(lambda (offset subtries)
(try (lambda (index) (list (+ offset index))) subtries))))
;; WHOA: this code uses the template for fully-expanded syntax; what the code
;; actually gets is reconstructed code. This is a problem, because you can't
;; distinguish a top-level begin from one that's the result of some evaluation.
;; I think for the moment that it will solve our problem simply to remove the
;; special case for begin at the top level. JBC, 2006-10-09
;; ... aaaand, yep, there's a bug. The input is not fully-expanded syntax, and
;; therefore _can_ include a two-branched 'if' (because the reconstructor produces it.)
;;
(define (top-level-expr-iterator stx context-so-far)
(let ([try (try->offset-try (make-try-all-subexprs stx 'top-level context-so-far))])
(kernel:kernel-syntax-case stx #f
[(module identifier name (#%plain-module-begin . module-level-exprs))
(try 3 (map (lambda (expr) `(,module-level-expr-iterator ,expr))
(syntax->list #'module-level-exprs)))]
[else-stx
(general-top-level-expr-iterator stx context-so-far)])))
(define (module-level-expr-iterator stx context-so-far)
(kernel:kernel-syntax-case stx #f
[(#%provide . provide-specs)
(void)]
[else-stx
(general-top-level-expr-iterator stx context-so-far)]))
(define (general-top-level-expr-iterator stx context-so-far)
(let ([try (try->offset-try (make-try-all-subexprs stx 'general-top-level context-so-far))])
(kernel:kernel-syntax-case stx #f
[(define-values (var ...) expr)
(try 2 `((,expr-iterator ,#'expr)))]
[(define-syntaxes (var ...) expr)
(try 2 `((,expr-iterator ,#'expr)))]
;; this code is buggy, but I believe it doesn't belong here at all
;; per above discussion. JBC, 2006-10-09
#;[(begin . top-level-exprs)
(try 1 (map (lambda (expr) `(,top-level-expr-iterator ,expr))
(syntax->list #'exprs)))]
[(#%require . require-specs)
(void)]
[else
(expr-iterator stx context-so-far)])))
(define (expr-iterator stx context-so-far)
(when (stepper-syntax-property stx 'stepper-highlight)
(success-escape (2vals context-so-far stx)))
(let* ([try (make-try-all-subexprs stx 'expr context-so-far)]
[try-exprs (lambda (index-mangler exprs) (try index-mangler (map (lambda (expr) (list expr-iterator expr))
(syntax->list exprs))))]
[try-exprs-offset (try->offset-try try-exprs)]
[let-values-abstraction
(lambda (stx)
(kernel:kernel-syntax-case stx #f
[(kwd (((variable ...) rhs) ...) . bodies)
(begin
(try-exprs (lambda (index) (list 1 index 1)) #'(rhs ...))
(try-exprs-offset 2 #'bodies))]
[else
(error 'expr-syntax-object-iterator
"unexpected let(rec) expression: ~a"
(syntax->datum stx))]))])
(kernel:kernel-syntax-case stx #f
[var-stx
(identifier? (syntax var-stx))
(void)]
[(#%plain-lambda vars . bodies)
(try-exprs-offset 2 #'bodies)]
[(case-lambda (vars . bodies) ...)
(let loop ([count 1] [clauses (syntax->list #'(bodies ...))])
(unless (null? clauses)
(try-exprs (lambda (index) (list count (+ index 1))) (cdar clauses))
(loop (+ count 1) (cdr clauses))))]
[(if test then else)
(try-exprs-offset 1 #'(test then else))]
[(if test then)
(try-exprs-offset 1 #'(test then))]
[(begin . bodies)
(try-exprs-offset 1 #'bodies)]
[(begin0 . bodies)
(try-exprs-offset 1 #'bodies)]
[(let-values . _)
(let-values-abstraction stx)]
[(letrec-values . _)
(let-values-abstraction stx)]
[(set! var val)
(try-exprs-offset 2 #'(val))]
[(quote _)
(void)]
[(quote-syntax _)
(void)]
[(with-continuation-mark key mark body)
(try-exprs-offset 1 #'(key mark body))]
[(#%plain-app . exprs)
(try-exprs-offset 1 #'exprs)]
[(#%top . var)
(void)]
[else
(error 'expr-iterator "unknown expr: ~a"
(syntax->datum stx))]))))
(begin (top-level-expr-iterator stx null) (define try->offset-try
(error 'find-highlight "couldn't find highlight-placeholder in expression: ~v" (syntax->datum stx)))))) (lambda (try)
(lambda (offset subtries)
(try (lambda (index) (list (+ offset index))) subtries))))
;; WHOA: this code uses the template for fully-expanded syntax; what the code
;; actually gets is reconstructed code. This is a problem, because you can't
;; distinguish a top-level begin from one that's the result of some evaluation.
;; I think for the moment that it will solve our problem simply to remove the
;; special case for begin at the top level. JBC, 2006-10-09
;; ... aaaand, yep, there's a bug. The input is not fully-expanded syntax, and
;; therefore _can_ include a two-branched 'if' (because the reconstructor produces it.)
;;
(define (top-level-expr-iterator stx context-so-far)
(let ([try (try->offset-try (make-try-all-subexprs stx 'top-level context-so-far))])
(kernel:kernel-syntax-case
stx #f
[(module identifier name (#%plain-module-begin . module-level-exprs))
(try 3 (map (lambda (expr) `(,module-level-expr-iterator ,expr))
(syntax->list #'module-level-exprs)))]
[else-stx
(general-top-level-expr-iterator stx context-so-far)])))
(define (module-level-expr-iterator stx context-so-far)
(kernel:kernel-syntax-case
stx #f
[(#%provide . provide-specs)
(void)]
[else-stx
(general-top-level-expr-iterator stx context-so-far)]))
(define (general-top-level-expr-iterator stx context-so-far)
(let ([try (try->offset-try (make-try-all-subexprs stx 'general-top-level context-so-far))])
(kernel:kernel-syntax-case
stx #f
[(define-values (var ...) expr)
(try 2 `((,expr-iterator ,#'expr)))]
[(define-syntaxes (var ...) expr)
(try 2 `((,expr-iterator ,#'expr)))]
;; this code is buggy, but I believe it doesn't belong here at all
;; per above discussion. JBC, 2006-10-09
#;[(begin . top-level-exprs)
(try 1 (map (lambda (expr) `(,top-level-expr-iterator ,expr))
(syntax->list #'exprs)))]
[(#%require . require-specs)
(void)]
[else
(expr-iterator stx context-so-far)])))
(define (expr-iterator stx context-so-far)
(when (stepper-syntax-property stx 'stepper-highlight)
(success-escape (vector context-so-far stx)))
(let* ([try (make-try-all-subexprs stx 'expr context-so-far)]
[try-exprs (lambda (index-mangler exprs) (try index-mangler (map (lambda (expr) (list expr-iterator expr))
(syntax->list exprs))))]
[try-exprs-offset (try->offset-try try-exprs)]
[let-values-abstraction
(lambda (stx)
(kernel:kernel-syntax-case stx #f
[(kwd (((variable ...) rhs) ...) . bodies)
(begin
(try-exprs (lambda (index) (list 1 index 1)) #'(rhs ...))
(try-exprs-offset 2 #'bodies))]
[else
(error 'expr-syntax-object-iterator
"unexpected let(rec) expression: ~a"
(syntax->datum stx))]))])
(kernel:kernel-syntax-case
stx #f
[var-stx
(identifier? (syntax var-stx))
(void)]
[(#%plain-lambda vars . bodies)
(try-exprs-offset 2 #'bodies)]
[(case-lambda (vars . bodies) ...)
(let loop ([count 1] [clauses (syntax->list #'(bodies ...))])
(unless (null? clauses)
(try-exprs (lambda (index) (list count (+ index 1))) (cdar clauses))
(loop (+ count 1) (cdr clauses))))]
[(if test then else)
(try-exprs-offset 1 #'(test then else))]
[(if test then)
(try-exprs-offset 1 #'(test then))]
[(begin . bodies)
(try-exprs-offset 1 #'bodies)]
[(begin0 . bodies)
(try-exprs-offset 1 #'bodies)]
[(let-values . _)
(let-values-abstraction stx)]
[(letrec-values . _)
(let-values-abstraction stx)]
[(set! var val)
(try-exprs-offset 2 #'(val))]
[(quote _)
(void)]
[(quote-syntax _)
(void)]
[(with-continuation-mark key mark body)
(try-exprs-offset 1 #'(key mark body))]
[(#%plain-app . exprs)
(try-exprs-offset 1 #'exprs)]
[(#%top . var)
(void)]
[else
(error 'expr-iterator "unknown expr: ~a"
(syntax->datum stx))])))
;; this should exit before reaching the error:
(top-level-expr-iterator stx null)
(error 'find-highlight "couldn't find highlight-placeholder in expression: ~v" (syntax->datum stx)))))
; TESTING: ; TESTING:
@ -186,12 +191,12 @@
(list `(define-values (f) (lambda (x) (letrec-values ([(a) (lambda (x) (#%app b (#%app (#%top . -) x (quote 1))))] [(b) (lambda (x) (#%app a x))]) (#%app a x)))) '(2) (list `(define-values (f) (lambda (x) (letrec-values ([(a) (lambda (x) (#%app b (#%app (#%top . -) x (quote 1))))] [(b) (lambda (x) (#%app a x))]) (#%app a x)))) '(2)
'general-top-level))) 'general-top-level)))
(let*-2vals ([(context-records highlight) (find-highlight test-datum)]) (match-let* ([(vector context-records highlight) (find-highlight test-datum)])
(test expected map datum-ize-context-record context-records)) (test expected map datum-ize-context-record context-records))
(test null (lambda () (test null (lambda ()
(let*-2vals ([(context-records dc) (match-let* ([(vector context-records dc)
(find-highlight (car (build-stx-with-highlight `((hilite foo)))))]) (find-highlight (car (build-stx-with-highlight `((hilite foo)))))])
context-records)))) context-records))))
@ -312,5 +317,5 @@
) )
(report-errs) (report-errs)
)) )

35
collects/stepper/private/marks.rkt
View File

@ -160,23 +160,24 @@
;;;;;;;;;; ;;;;;;;;;;
(define (make-debug-info source tail-bound free-vars label lifting?) (define (make-debug-info source tail-bound free-vars label lifting?)
(let*-2vals ([kept-vars (binding-set-varref-set-intersect tail-bound free-vars)]) (define kept-vars (binding-set-varref-set-intersect tail-bound free-vars))
(if lifting? (define (let-binding? var)
(let*-2vals ([let-bindings (filter (lambda (var) (and
(and (not (stepper-syntax-property var 'stepper-no-lifting-info))
(case (stepper-syntax-property var 'stepper-binding-type) (case (stepper-syntax-property var 'stepper-binding-type)
((let-bound macro-bound) #t) ((let-bound macro-bound) #t)
((lambda-bound stepper-temp non-lexical) #f) ((lambda-bound stepper-temp non-lexical) #f)
(else (error 'make-debug-info (else (error 'make-debug-info
"varref ~a's binding-type info was not recognized: ~a" "varref ~a's binding-type info was not recognized: ~a"
(syntax-e var) (syntax-e var)
(stepper-syntax-property var 'stepper-binding-type)))) (stepper-syntax-property var 'stepper-binding-type))))))
(not (stepper-syntax-property var 'stepper-no-lifting-info)))) (cond [lifting?
kept-vars)] (define let-bindings (filter let-binding? kept-vars))
[lifter-syms (map get-lifted-var let-bindings)]) (define lifter-syms (map get-lifted-var let-bindings))
(make-full-mark source label (append kept-vars lifter-syms))) (make-full-mark source label (append kept-vars lifter-syms))]
;; I'm not certain that non-lifting is currently tested: 2005-12, JBC [else
(make-full-mark source label kept-vars)))) ;; I'm not certain that non-lifting is currently tested: 2005-12, JBC
(make-full-mark source label kept-vars)]))
(define (make-top-level-mark source-expr) (define (make-top-level-mark source-expr)

33
collects/stepper/private/my-macros.rkt
View File

@ -44,30 +44,7 @@
;; honestly, match-let* supersedes all of this, if I ever have time to redo it... ;; honestly, match-let* supersedes all of this, if I ever have time to redo it...
(provide 2vals let*-2vals 2vals-first 2vals-second 2vals-map apply-to-first-of-2vals) (provide 2vals-map apply-to-first-of-2vals)
(define 2vals vector)
(define-syntax (let*-2vals stx)
(syntax-case stx (let*-2vals)
[(let*-2vals () . bodies)
(syntax/loc stx (begin . bodies))]
[(let*-2vals ([(id-a id-b) rhs] binding ...) . bodies) ; 2 values in a vector
(syntax/loc stx (let* ([_a rhs] [id-a (vector-ref _a 0)] [id-b (vector-ref _a 1)])
(let*-2vals (binding ...) . bodies)))]
[(let*-2vals ([id-a rhs] binding ...) . bodies) ; just 1 value
(quasisyntax/loc stx (let* ([id-a rhs])
#,(syntax/loc stx (let*-2vals (binding ...) . bodies))))]))
(define-syntax (2vals-first stx)
(syntax-case stx (2vals-first)
[(2vals-first a)
(syntax (vector-ref a 0))]))
(define-syntax (2vals-second stx)
(syntax-case stx (2vals-second)
[(2vals-second a)
(syntax (vector-ref a 1))]))
(define (apply-to-first-of-2vals proc 2vals) (define (apply-to-first-of-2vals proc 2vals)
(vector (proc (vector-ref 2vals 0)) (vector (proc (vector-ref 2vals 0))
@ -79,10 +56,10 @@
(define (2vals-map f . lsts) (define (2vals-map f . lsts)
(if (null? (car lsts)) (if (null? (car lsts))
(2vals null null) (vector null null)
(let*-2vals ([(a b) (apply f (map car lsts))] (match-let* ([(vector a b) (apply f (map car lsts))]
[(a-rest b-rest) (apply 2vals-map f (map cdr lsts))]) [(vector a-rest b-rest) (apply 2vals-map f (map cdr lsts))])
(2vals (cons a a-rest) (cons b b-rest))))) (vector (cons a a-rest) (cons b b-rest)))))
; test cases ; test cases
; (require my-macros) ; (require my-macros)

139
collects/stepper/private/reconstruct.rkt
View File

@ -54,7 +54,7 @@
(define-struct let-glump (name-set exp val-set)) (define-struct let-glump (name-set exp val-set))
; split-list : ('a -> boolean) (listof 'a) -> (2vals (listof 'a) (listof 'a)) ; split-list : ('a -> boolean) (listof 'a) -> (vector (listof 'a) (listof 'a))
; split-list splits a list into two lists at the first element s.t. (fn element) => true). ; split-list splits a list into two lists at the first element s.t. (fn element) => true).
; that is, split-list yields the lists A and B such that (append A B) gives the original ; that is, split-list yields the lists A and B such that (append A B) gives the original
; list, and (fn element) => false for all elements in A, and B is either empty or ; list, and (fn element) => false for all elements in A, and B is either empty or
@ -63,15 +63,15 @@
(define (split-list fn lst) (define (split-list fn lst)
(let loop ([remaining lst] [so-far null]) (let loop ([remaining lst] [so-far null])
(cond [(null? remaining) (cond [(null? remaining)
(2vals (reverse so-far) null)] (vector (reverse so-far) null)]
[else [else
(if (fn (car remaining)) (if (fn (car remaining))
(2vals (reverse so-far) remaining) (vector (reverse so-far) remaining)
(loop (cdr remaining) (cons (car remaining) so-far)))]))) (loop (cdr remaining) (cons (car remaining) so-far)))])))
; test cases ; test cases
; (test (2vals '(93 4 2) '(0 2 1)) split-list (lambda (x) (= x 0)) '(93 4 2 0 2 1)) ; (test (vector '(93 4 2) '(0 2 1)) split-list (lambda (x) (= x 0)) '(93 4 2 0 2 1))
; (test (2vals '(3 4 5) '()) split-list (lambda (x) (= x 0)) '(3 4 5)) ; (test (vector '(3 4 5) '()) split-list (lambda (x) (= x 0)) '(3 4 5))
; n-split-list : num ('a list) -> ('a list) ('a list) ; n-split-list : num ('a list) -> ('a list) ('a list)
; n-split-list splits a given list A into two lists B and C, such that B contains the ; n-split-list splits a given list A into two lists B and C, such that B contains the
@ -82,11 +82,11 @@
(error 'n-split-list "can't split list ~a after ~ath element; not long enough" lst num)) (error 'n-split-list "can't split list ~a after ~ath element; not long enough" lst num))
(let loop ([count num] [remaining lst] [so-far null]) (let loop ([count num] [remaining lst] [so-far null])
(if (= count 0) (if (= count 0)
(2vals (reverse so-far) remaining) (vector (reverse so-far) remaining)
(loop (- count 1) (cdr remaining) (cons (car remaining) so-far))))) (loop (- count 1) (cdr remaining) (cons (car remaining) so-far)))))
; test cases ; test cases
; (test (2vals '(a b c) '(d e f)) n-split-list 3 '(a b c d e f)) ; (test (vector '(a b c) '(d e f)) n-split-list 3 '(a b c d e f))
(define (mark-as-highlight stx) (define (mark-as-highlight stx)
@ -646,68 +646,69 @@
[recon-let [recon-let
(lambda () (lambda ()
(with-syntax ([(label ((vars rhs) ...) . bodies) exp]) (with-syntax ([(label ((vars rhs) ...) . bodies) exp])
(let*-2vals ([binding-sets (map syntax->list (syntax->list #'(vars ...)))] (match-let*
[binding-list (apply append binding-sets)] ([binding-sets (map syntax->list (syntax->list #'(vars ...)))]
[glumps [binding-list (apply append binding-sets)]
(map (lambda (binding-set rhs) [glumps
(make-let-glump (map (lambda (binding-set rhs)
(map (lambda (binding) (make-let-glump
(stepper-syntax-property binding (map (lambda (binding)
'stepper-lifted-name (stepper-syntax-property binding
(binding-lifted-name mark-list binding))) 'stepper-lifted-name
binding-set) (binding-lifted-name mark-list binding)))
rhs binding-set)
(map (lambda (arg-binding) rhs
(lookup-binding mark-list arg-binding)) (map (lambda (arg-binding)
binding-set))) (lookup-binding mark-list arg-binding))
binding-sets binding-set)))
(syntax->list #`(rhs ...)))] binding-sets
[num-defns-done (lookup-binding mark-list let-counter)] (syntax->list #`(rhs ...)))]
[(done-glumps not-done-glumps) [num-defns-done (lookup-binding mark-list let-counter)]
(n-split-list num-defns-done glumps)] [(vector done-glumps not-done-glumps)
[recon-lifted (n-split-list num-defns-done glumps)]
(lambda (names expr) [recon-lifted
#`(#,names #,expr))] (lambda (names expr)
[before-bindings #`(#,names #,expr))]
(map [before-bindings
(lambda (glump) (map
(let* ([name-set (let-glump-name-set glump)] (lambda (glump)
[rhs-val-set (map (lambda (val) (let* ([name-set (let-glump-name-set glump)]
(if (> (length name-set) 0) [rhs-val-set (map (lambda (val)
(recon-value val render-settings (car name-set)) (if (> (length name-set) 0)
(recon-value val render-settings))) (recon-value val render-settings (car name-set))
(let-glump-val-set glump))]) (recon-value val render-settings)))
(if (= (length rhs-val-set) 1) (let-glump-val-set glump))])
#`(#,name-set #,@rhs-val-set) (if (= (length rhs-val-set) 1)
#`(#,name-set (values #,rhs-val-set))))) #`(#,name-set #,@rhs-val-set)
done-glumps)] #`(#,name-set (values #,rhs-val-set)))))
[reconstruct-remaining-def done-glumps)]
(lambda (glump) [reconstruct-remaining-def
(let ([rhs-source (let-glump-exp glump)] (lambda (glump)
[rhs-name-set (let-glump-name-set glump)]) (let ([rhs-source (let-glump-exp glump)]
(recon-lifted rhs-name-set [rhs-name-set (let-glump-name-set glump)])
(recon-source-current-marks rhs-source))))] (recon-lifted rhs-name-set
[after-bindings (recon-source-current-marks rhs-source))))]
(if (pair? not-done-glumps) [after-bindings
(if (eq? so-far nothing-so-far) (if (pair? not-done-glumps)
(map reconstruct-remaining-def not-done-glumps) (if (eq? so-far nothing-so-far)
(cons (recon-lifted (let-glump-name-set (car not-done-glumps)) so-far) (map reconstruct-remaining-def not-done-glumps)
(map reconstruct-remaining-def (cdr not-done-glumps)))) (cons (recon-lifted (let-glump-name-set (car not-done-glumps)) so-far)
null)] (map reconstruct-remaining-def (cdr not-done-glumps))))
[recon-bindings (append before-bindings after-bindings)] null)]
;; there's a terrible tangle of invariants here. Among them: [recon-bindings (append before-bindings after-bindings)]
;; num-defns-done = (length binding-sets) IFF the so-far has a 'stepper-offset' index ;; there's a terrible tangle of invariants here. Among them:
;; that is not #f (that is, we're evaluating the body...) ;; num-defns-done = (length binding-sets) IFF the so-far has a 'stepper-offset' index
[so-far-offset-index (and (not (eq? so-far nothing-so-far)) ;; that is not #f (that is, we're evaluating the body...)
(stepper-syntax-property so-far 'stepper-offset-index))] [so-far-offset-index (and (not (eq? so-far nothing-so-far))
[bodies (syntax->list (syntax bodies))] (stepper-syntax-property so-far 'stepper-offset-index))]
[rectified-bodies [bodies (syntax->list (syntax bodies))]
(map (lambda (body offset-index) [rectified-bodies
(if (eq? offset-index so-far-offset-index) (map (lambda (body offset-index)
so-far (if (eq? offset-index so-far-offset-index)
(recon-source-expr body mark-list binding-list binding-list render-settings))) so-far
bodies (recon-source-expr body mark-list binding-list binding-list render-settings)))
(iota (length bodies)))]) bodies
(iota (length bodies)))])
(attach-info #`(label #,recon-bindings #,@rectified-bodies) exp))))]) (attach-info #`(label #,recon-bindings #,@rectified-bodies) exp))))])
(if (stepper-syntax-property exp 'stepper-fake-exp) (if (stepper-syntax-property exp 'stepper-fake-exp)

4
collects/tests/stepper/through-tests.rkt
View File

@ -1504,7 +1504,7 @@
(provide ggg) (provide ggg)
;; run whatever tests are enabled (intended for interactive use): ;; run whatever tests are enabled (intended for interactive use):
(define (ggg) (define (ggg)
(parameterize (#;[disable-stepper-error-handling #t] (parameterize ([disable-stepper-error-handling #t]
#;[display-only-errors #t] #;[display-only-errors #t]
#;[store-steps #f] #;[store-steps #f]
#;[show-all-steps #t]) #;[show-all-steps #t])
@ -1512,5 +1512,5 @@
check-error check-error-bad)) check-error check-error-bad))
#;(run-tests '(teachpack-universe)) #;(run-tests '(teachpack-universe))
#;(run-all-tests) #;(run-all-tests)
(run-tests '(mz-app2)) (run-tests '(simple-if))
)) ))