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

...

Browse Source 
svn: r9580
This commit is contained in:
John Clements 2008-05-01 23:49:55 +00:00
parent fe552e2483
commit d14b6d12d2
3 changed files with 20 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/stepper/internal-docs.txt
View File

@ -234,6 +234,11 @@ stepper-args-of-call [ADDED BY RECONSTRUCTOR] :
this reconstructed (...) expression is the result of a call with these args. this reconstructed (...) expression is the result of a call with these args.
used by the check-expect unwinder to figure out the expected values. used by the check-expect unwinder to figure out the expected values.
stepper-hide-completed : don't show the final top-level expression binding
for this identifier.
stepper-hide-reduction : don't show the reduction for this term.
STEPPER-HINT COLLISIONS STEPPER-HINT COLLISIONS
The major concern with the stepper-hint is that two of them may The major concern with the stepper-hint is that two of them may

7
collects/stepper/private/reconstruct.ss
View File

@ -150,7 +150,7 @@
[(result-value-break) [(result-value-break)
(and (pair? mark-list) (and (pair? mark-list)
(let ([expr (mark-source (car mark-list))]) (let ([expr (mark-source (car mark-list))])
(equal? (stepper-syntax-property expr 'stepper-hint) 'comes-from-check-expect)))] (stepper-syntax-property expr 'stepper-hide-reduction)))]
[(result-exp-break) [(result-exp-break)
;; skip if clauses that are the result of and/or reductions ;; skip if clauses that are the result of and/or reductions
(let ([and/or-clauses-consumed (stepper-syntax-property (mark-source (car mark-list)) 'stepper-and/or-clauses-consumed)]) (let ([and/or-clauses-consumed (stepper-syntax-property (mark-source (car mark-list)) 'stepper-and/or-clauses-consumed)])
@ -185,7 +185,7 @@
(and (pair? mark-list) (and (pair? mark-list)
(let ([expr (mark-source (car mark-list))]) (let ([expr (mark-source (car mark-list))])
(or (equal? (stepper-syntax-property expr 'stepper-hint) 'comes-from-check-expect) (or (stepper-syntax-property expr 'stepper-hide-reduction)
(kernel:kernel-syntax-case expr #f (kernel:kernel-syntax-case expr #f
[id [id
(identifier? expr) (identifier? expr)
@ -584,8 +584,7 @@
(define (hide-completed? stx) (define (hide-completed? stx)
(syntax-case stx () (syntax-case stx ()
[(define-values (v) rhs) [(define-values (v) rhs)
(equal? (stepper-syntax-property #'v 'stepper-hint) 'comes-from-check-expect) (stepper-syntax-property #'v 'stepper-hide-completed)]
#t]
[else #f])) [else #f]))

13
collects/stepper/private/shared.ss
View File

@ -8,6 +8,8 @@
srfi/26 srfi/26
mzlib/class) mzlib/class)
(require (for-syntax mzlib/list))
; CONTRACTS ; CONTRACTS
(define varref-set? (listof identifier?)) (define varref-set? (listof identifier?))
@ -92,6 +94,7 @@
language-level->name language-level->name
stepper-syntax-property stepper-syntax-property
with-stepper-syntax-properties
skipto/cdr skipto/cdr
skipto/cddr skipto/cddr
@ -101,7 +104,6 @@
skipto/fourth skipto/fourth
skipto/firstarg) skipto/firstarg)
;; stepper-syntax-property : like syntax property, but adds properties to an association ;; stepper-syntax-property : like syntax property, but adds properties to an association
;; list associated with the syntax property 'stepper-properties ;; list associated with the syntax property 'stepper-properties
(define stepper-syntax-property (define stepper-syntax-property
@ -118,6 +120,15 @@
(or (syntax-property stx 'stepper-properties) (or (syntax-property stx 'stepper-properties)
null)))])) null)))]))
;; with-stepper-syntax-properties : like stepper-syntax-property, but in a "let"-like form
(define-syntax (with-stepper-syntax-properties stx)
(syntax-case stx ()
[(_ ([property val] ...) body)
(foldl (lambda (property val b) #`(stepper-syntax-property #,b #,property #,val))
#'body
(syntax->list #`(property ...))
(syntax->list #`(val ...)))]))
; A step-result is either: ; A step-result is either:
; (make-before-after-result finished-exps exp redex reduct) ; (make-before-after-result finished-exps exp redex reduct)
; or (make-before-error-result finished-exps exp redex err-msg) ; or (make-before-error-result finished-exps exp redex err-msg)