From cfd0e35fce7172d317e266c50c7d324a5e2e1267 Mon Sep 17 00:00:00 2001 From: John Clements Date: Tue, 12 Dec 2006 00:07:49 +0000 Subject: [PATCH] added all-bindings-mutable? field to model-settings structure svn: r5084 --- collects/stepper/private/model-settings.ss | 14 +++-- collects/stepper/private/reconstruct.ss | 65 +++++++++++----------- 2 files changed, 42 insertions(+), 37 deletions(-) diff --git a/collects/stepper/private/model-settings.ss b/collects/stepper/private/model-settings.ss index f4d8fb36ce..c76b4a5837 100644 --- a/collects/stepper/private/model-settings.ss +++ b/collects/stepper/private/model-settings.ss @@ -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 diff --git a/collects/stepper/private/reconstruct.ss b/collects/stepper/private/reconstruct.ss index 03d2c842d6..f40f8b5099 100644 --- a/collects/stepper/private/reconstruct.ss +++ b/collects/stepper/private/reconstruct.ss @@ -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)]