working on check-expect

svn: r9468
This commit is contained in:
John Clements 2008-04-25 00:33:35 +00:00
parent 2116c4b0eb
commit c88c7fd4c5
2 changed files with 18 additions and 8 deletions

View File

@ -173,6 +173,13 @@ stepper-binding-type :
[ 'let-bound ] : this variable's binding was in a let/*/rec [ 'let-bound ] : this variable's binding was in a let/*/rec
[ 'lambda-bound ] : this variable's binding was in a lambda [ 'lambda-bound ] : this variable's binding was in a lambda
stepper-no-lifting-info :
this label is applied to a let-bound-variable whose binding is not
being annotated (because the annotator is skipping inward past it).
For such a binding, no corresponding lifting variable is generated,
and so the marks shouldn't try to capture it.
stepper-and/or-clauses-consumed : stepper-and/or-clauses-consumed :
indicates the number of clauses to the left of the one associated indicates the number of clauses to the left of the one associated
with a given 'if' in the expansion of an 'and' or 'or'. with a given 'if' in the expansion of an 'and' or 'or'.

View File

@ -3,7 +3,8 @@
(require mzlib/list (require mzlib/list
mzlib/contract mzlib/contract
"my-macros.ss" "my-macros.ss"
"shared.ss") "shared.ss"
#;(file "/Users/clements/clements/scheme-scraps/eli-debug.ss"))
(define-struct full-mark-struct (source label bindings values)) (define-struct full-mark-struct (source label bindings values))
@ -162,13 +163,15 @@
(let*-2vals ([kept-vars (binding-set-varref-set-intersect tail-bound free-vars)]) (let*-2vals ([kept-vars (binding-set-varref-set-intersect tail-bound free-vars)])
(if lifting? (if lifting?
(let*-2vals ([let-bindings (filter (lambda (var) (let*-2vals ([let-bindings (filter (lambda (var)
(case (stepper-syntax-property var 'stepper-binding-type) (and
((let-bound macro-bound) #t) (case (stepper-syntax-property var 'stepper-binding-type)
((lambda-bound stepper-temp non-lexical) #f) ((let-bound macro-bound) #t)
(else (error 'make-debug-info ((lambda-bound stepper-temp non-lexical) #f)
"varref ~a's binding-type info was not recognized: ~a" (else (error 'make-debug-info
(syntax-e var) "varref ~a's binding-type info was not recognized: ~a"
(stepper-syntax-property var 'stepper-binding-type))))) (syntax-e var)
(stepper-syntax-property var 'stepper-binding-type))))
(not (stepper-syntax-property var 'stepper-no-lifting-info))))
kept-vars)] kept-vars)]
[lifter-syms (map get-lifted-var let-bindings)]) [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)))