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

added all-bindings-mutable? field to model-settings structure

Browse Source 
svn: r5084
This commit is contained in:
John Clements 2006-12-12 00:07:49 +00:00
parent e01ec2dc9d
commit cfd0e35fce
2 changed files with 42 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/stepper/private/model-settings.ss
View File

@ -16,7 +16,8 @@
; the reconstructor gets the right invocation of the unit, it needs to be a
; unit as well. Pretty soon, everything is units.
(define-struct render-settings (true-false-printed? constructor-style-printing? abbreviate-cons-as-list? render-to-sexp lifting?))
(define-struct render-settings (true-false-printed? constructor-style-printing? abbreviate-cons-as-list? render-to-sexp lifting?
all-bindings-mutable?))
(provide/contract [check-global-defined (-> symbol? boolean?)]
[global-lookup (-> any/c any)]
@ -26,7 +27,8 @@
[constructor-style-printing? boolean?]
[abbreviate-cons-as-list? boolean?]
[render-to-sexp (any/c . -> . any)]
[lifting? boolean?])]
[lifting? boolean?]
[all-bindings-are-mutable? boolean?])]
@ -57,10 +59,10 @@
; FIXME : #f totally unacceptable as 'render-to-string'
(define fake-beginner-render-settings
(make-render-settings #t #t #f (make-fake-render-to-sexp #t #t #f) #t))
(make-render-settings #t #t #f (make-fake-render-to-sexp #t #t #f) #t #f))
(define fake-beginner-wla-render-settings
(make-render-settings #t #t #t (make-fake-render-to-sexp #t #t #t) #t))
(make-render-settings #t #t #t (make-fake-render-to-sexp #t #t #t) #t #f))
(define fake-intermediate-render-settings
fake-beginner-wla-render-settings)
@ -77,6 +79,7 @@
(constructor-style-printing)
(abbreviate-cons-as-list)
print-convert
#f
#f))
(define-struct test-struct () (make-inspector))
@ -97,7 +100,8 @@
constructor-style-printing?
abbreviate-cons-as-list?
render-to-sexp
lifting?)))
lifting?
#f)))
(define (check-global-defined identifier)
(with-handlers

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

@ -403,38 +403,39 @@
[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?)
(if (and (ormap (lambda (binding)
(bound-identifier=? binding var))
dont-lookup)
(not (ormap (lambda (binding)
(bound-identifier=? binding var))
use-lifted-names)))
var
(case (stepper-syntax-property var 'stepper-binding-type)
((lambda-bound)
(recon-value (lookup-binding mark-list var) render-settings))
((macro-bound)
; for the moment, let-bound vars occur only in and/or :
(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-temp)
(error 'recon-source-expr "stepper-temp showed up in source?!?"))
((non-lexical)
(error 'recon-source-expr "can't get here: lexical identifier labeled as non-lexical"))
(else
(error 'recon-source-expr "unknown 'stepper-binding-type property: ~a"
(stepper-syntax-property var 'stepper-binding-type)))))]
[else ; top-level-varref
(fixup-name
var)]))]
(if (render-settings-all-bindings-mutable? render-settings)
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?)
(if (and (ormap (lambda (binding)
(bound-identifier=? binding var))
dont-lookup)
(not (ormap (lambda (binding)
(bound-identifier=? binding var))
use-lifted-names)))
var
(case (stepper-syntax-property var 'stepper-binding-type)
((lambda-bound)
(recon-value (lookup-binding mark-list var) render-settings))
((macro-bound)
; for the moment, let-bound vars occur only in and/or :
(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-temp)
(error 'recon-source-expr "stepper-temp showed up in source?!?"))
((non-lexical)
(error 'recon-source-expr "can't get here: lexical identifier labeled as non-lexical"))
(else
(error 'recon-source-expr "unknown 'stepper-binding-type property: ~a"
(stepper-syntax-property var 'stepper-binding-type)))))]
[else ; top-level-varref
(fixup-name
var)])))]
[(#%top . var)
(syntax var)]