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

fixed bugs

Browse Source 
svn: r4784
This commit is contained in:
John Clements 2006-11-05 17:43:07 +00:00
parent 517bec65c8
commit 311caf733e
4 changed files with 11 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/stepper/private/annotate.ss
View File

@ -383,7 +383,7 @@
. -> . (vector/p syntax? binding-set?))
(lambda (exp tail-bound pre-break? procedure-name-info)
(cond [(stepper-syntax-property exp 'stepper-skipto)
(cond [(stepper-syntax-property exp 'stepper-skipto)
(let* ([free-vars-captured #f] ; this will be set!'ed
;[dont-care (printf "expr: ~a\nskipto: ~a\n" expr (stepper-syntax-property expr 'stepper-skipto))]
; WARNING! I depend on the order of evaluation in application arguments here:
@ -398,7 +398,7 @@
skipto-mark
annotated)
free-vars-captured))]
[(stepper-syntax-property exp 'stepper-skip-completely)
(2vals (wcm-wrap 13 exp) null)]
@ -1143,7 +1143,6 @@
(annotate/top-level/acl2 main-exp)]
[else
(annotate/top-level main-exp)])])
#;(printf "annotated: \n~a\n" (syntax-object->datum annotated-exp))
annotated-exp)
(let*-2vals ([(annotated dont-care)
(annotate/inner (top-level-rewrite main-exp) 'all #f #f)])

4
collects/stepper/private/model.ss
View File

@ -326,8 +326,8 @@
(program-expander
(lambda ()
;; swap these to allow errors to escape (e.g., when debugging)
;;(error-display-handler err-display-handler)
(void)
(error-display-handler err-display-handler)
#;(void)
)
(lambda (expanded continue-thunk) ; iter
(r:reset-special-values)

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

@ -403,6 +403,7 @@
[var-stx
(identifier? expr)
(let* ([var (syntax var-stx)])
var
(cond [(eq? (identifier-binding var) 'lexical)
; has this varref's binding not been evaluated yet?
; (and this varref isn't in the list of must-lookups?)
@ -422,8 +423,8 @@
(recon-value (lookup-binding mark-list var) render-settings))
((let-bound)
(stepper-syntax-property var
'stepper-lifted-name
(binding-lifted-name mark-list var)))
'stepper-lifted-name
(binding-lifted-name mark-list var)))
((stepper-temp)
(error 'recon-source-expr "stepper-temp showed up in source?!?"))
((non-lexical)

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

@ -552,9 +552,10 @@
;; take info from source expressions to reconstructed expressions
(define (attach-info to-exp from-exp)
;; (if (stepper-syntax-property from-exp 'stepper-offset-index)
;; (>>> (stepper-syntax-property from-exp 'stepper-offset-index)))
(let* ([attached (syntax-property to-exp 'stepper-properties (syntax-property from-exp 'stepper-properties))]
(let* ([attached (syntax-property to-exp 'stepper-properties (append (or (syntax-property from-exp 'stepper-properties)
null)
(or (syntax-property to-exp 'stepper-properties)
null)))]
[attached (syntax-property attached 'user-source (syntax-source from-exp))]
[attached (syntax-property attached 'user-position (syntax-position from-exp))])
attached))