svn: r9999
This commit is contained in:
John Clements 2008-05-28 07:55:42 +00:00
parent a299e333ba
commit b180fe980c
3 changed files with 328 additions and 301 deletions

View File

@ -241,7 +241,11 @@ stepper-args-of-call [ADDED BY RECONSTRUCTOR] :
stepper-hide-completed : don't show the final top-level expression binding
for this identifier.
stepper-hide-reduction : don't show the "before" step for this term.
stepper-hide-reduction : don't show any reductions where this term is
associated with the topmost mark
stepper-use-val-as-final : use the return value of this expression as a
"completed" val in the stepper. Used for test cases.
STEPPER-HINT COLLISIONS

View File

@ -253,9 +253,9 @@
; h e h o m e o f t h e b r a v e ? . . . .
; .. . . . . . . . . . . . . . . . . . ............................................................
; . . . . . . . . . . . . . . . . . . . . .
; .................................................................................................
; .........you-know,-this-flag-doesn't-feel-quite-as...............................................
; . .
; .................................................................................................
; ..........lighthearted-as-it-did-when-I-created-it-in-1998.......................................
; . .
; .................................................................................................
; . .
@ -774,6 +774,22 @@
(syntax-recertify b exp (current-code-inspector) #f))
bindings))))]
;; this is a terrible hack... until some other language form needs it. It wraps the
;; given annotated expression with a break that adds the result to the list of completed
;; expressions
[maybe-final-val-wrap
(match-lambda
[(vector annotated free-vars)
(vector (if (stepper-syntax-property exp 'stepper-use-val-as-final)
#`(call-with-values
(lambda () #,annotated)
(lambda results
(#,exp-finished-break (list (list #,(lambda () exp) #f (lambda () results))))
(values results)))
annotated)
free-vars)]
[error 'maybe-final-val-wrap "stepper internal error 20080527"])]
)
; find the source expression and associate it with the parsed expression
; (when (and red-exprs foot-wrap?)
@ -781,6 +797,7 @@
(recertifier
(maybe-final-val-wrap
(kernel:kernel-syntax-case exp #f
[(#%plain-lambda . clause)
@ -1075,7 +1092,7 @@
(varref-abstraction #`var-stx)]
[else
(error 'annotate "unexpected syntax for expression: ~v" (syntax->datum exp))])))])))
(error 'annotate "unexpected syntax for expression: ~v" (syntax->datum exp))]))))])))
(define (stepper-recertify new-stx old-stx)
(syntax-recertify new-stx old-stx (current-code-inspector) #f))

View File

@ -148,7 +148,9 @@
(define (skip-step? break-kind mark-list render-settings)
(case break-kind
[(result-value-break)
#f]
(and (pair? mark-list)
(let ([expr (mark-source (car mark-list))])
(stepper-syntax-property expr 'stepper-hide-reduction)))]
[(result-exp-break)
;; 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)])
@ -521,8 +523,9 @@
; Accepts the source expression, a lifting-index which is either a number (indicating
; a lifted binding) or false (indicating a top-level expression), a list of values
; currently bound to the bindings, and the language level's render-settings.
;; returns a vectory containing a reconstructed expression and a boolean indicating whether this is source syntax
;; from a define-struct and therefore should not be unwound.
;; returns a vector containing a reconstructed expression and a boolean indicating
;; whether this should not be unwound (e.g., is source syntax
;; from a define-struct).
(define (reconstruct-completed exp lifting-indices vals-getter render-settings)
(if lifting-indices
@ -537,6 +540,9 @@
[(stepper-syntax-property exp 'stepper-define-struct-hint)
;; the hint contains the original syntax
(vector (stepper-syntax-property exp 'stepper-define-struct-hint) #t)]
;; for test cases, use the result here as the final result of the expression:
[(stepper-syntax-property exp 'stepper-use-val-as-final)
(vector (recon-value (car (vals-getter)) render-settings) #f)]
[else
(vector
(kernel:kernel-syntax-case exp #f