linklet flattener: repair to name simplifier
The linklet flattener's name-simplification pass (intended to avoid gratuitious changes in "startup.inc") didn't recognize all binding forms.
This commit is contained in:
parent
107d1e42a7
commit
7cbeebbb89
|
@ -92,7 +92,7 @@
|
||||||
(define input-s (flip-introduction-scopes (add-intdef-scopes s all-intdefs) ctx))
|
(define input-s (flip-introduction-scopes (add-intdef-scopes s all-intdefs) ctx))
|
||||||
(define tmp-env (for/fold ([env (expand-context-env ctx)]) ([sym (in-list syms)]
|
(define tmp-env (for/fold ([env (expand-context-env ctx)]) ([sym (in-list syms)]
|
||||||
[intdef-id (in-list intdef-ids)])
|
[intdef-id (in-list intdef-ids)])
|
||||||
(hash-set env sym (local-variable intdef-id))))
|
(env-extend env sym (local-variable intdef-id))))
|
||||||
(log-expand ctx 'enter-bind)
|
(log-expand ctx 'enter-bind)
|
||||||
(define vals
|
(define vals
|
||||||
(eval-for-syntaxes-binding 'syntax-local-bind-syntaxes
|
(eval-for-syntaxes-binding 'syntax-local-bind-syntaxes
|
||||||
|
|
|
@ -39,6 +39,8 @@
|
||||||
(define empty-env #hasheq())
|
(define empty-env #hasheq())
|
||||||
(define (env-extend env key val)
|
(define (env-extend env key val)
|
||||||
(hash-set env key val))
|
(hash-set env key val))
|
||||||
|
(define (lookup env key default)
|
||||||
|
(hash-ref env key default))
|
||||||
|
|
||||||
;; `variable` is a token to represent a binding to a run-time variable
|
;; `variable` is a token to represent a binding to a run-time variable
|
||||||
(define variable (gensym 'variable))
|
(define variable (gensym 'variable))
|
||||||
|
@ -134,13 +136,13 @@
|
||||||
(define insp (and mi (module-instance-module mi) (module-inspector (module-instance-module mi))))
|
(define insp (and mi (module-instance-module mi) (module-inspector (module-instance-module mi))))
|
||||||
(values t primitive? insp protected?)]
|
(values t primitive? insp protected?)]
|
||||||
[(local-binding? b)
|
[(local-binding? b)
|
||||||
(define t (hash-ref env (local-binding-key b) missing))
|
(define t (lookup env (local-binding-key b) missing))
|
||||||
(cond
|
(cond
|
||||||
[(eq? t missing)
|
[(eq? t missing)
|
||||||
(values (or
|
(values (or
|
||||||
;; check in lift envs, if any
|
;; check in lift envs, if any
|
||||||
(for/or ([lift-env (in-list lift-envs)])
|
(for/or ([lift-env (in-list lift-envs)])
|
||||||
(hash-ref (unbox lift-env) (local-binding-key b) #f))
|
(lookup (unbox lift-env) (local-binding-key b) #f))
|
||||||
(if out-of-context-as-variable?
|
(if out-of-context-as-variable?
|
||||||
variable
|
variable
|
||||||
(error "identifier used out of context:" id)))
|
(error "identifier used out of context:" id)))
|
||||||
|
|
|
@ -76,7 +76,7 @@
|
||||||
(define keys
|
(define keys
|
||||||
(for/list ([id (in-list ids)])
|
(for/list ([id (in-list ids)])
|
||||||
(define key (add-local-binding! id phase counter))
|
(define key (add-local-binding! id phase counter))
|
||||||
(set-box! lift-env (hash-set (unbox lift-env) key variable))
|
(set-box! lift-env (env-extend (unbox lift-env) key variable))
|
||||||
key))
|
key))
|
||||||
(values ids (lifted-bind ids keys rhs))))
|
(values ids (lifted-bind ids keys rhs))))
|
||||||
|
|
||||||
|
|
|
@ -80,8 +80,8 @@
|
||||||
(rename-vars formals replacements base-counts))
|
(rename-vars formals replacements base-counts))
|
||||||
`[,new-formals . ,(collapse-in-body body new-replacements new-base-counts)]))]
|
`[,new-formals . ,(collapse-in-body body new-replacements new-base-counts)]))]
|
||||||
[`(quote . ,_) e]
|
[`(quote . ,_) e]
|
||||||
[`(let-values . _) (collapse-in-let e #f replacements base-counts)]
|
[`(let-values . ,_) (collapse-in-let e #f replacements base-counts)]
|
||||||
[`(letrec-values . _) (collapse-in-let e #t replacements base-counts)]
|
[`(letrec-values . ,_) (collapse-in-let e #t replacements base-counts)]
|
||||||
[`(,pseudo-es ...) ; catch-all for remaining syntactic forms
|
[`(,pseudo-es ...) ; catch-all for remaining syntactic forms
|
||||||
(collapse-in-body pseudo-es replacements base-counts)]
|
(collapse-in-body pseudo-es replacements base-counts)]
|
||||||
[_ (if (symbol? e)
|
[_ (if (symbol? e)
|
||||||
|
@ -96,7 +96,7 @@
|
||||||
(match e
|
(match e
|
||||||
[`(,let-form ([,idss ,rhss] ...) ,body ...)
|
[`(,let-form ([,idss ,rhss] ...) ,body ...)
|
||||||
(define-values (new-idss body-replacements body-base-counts)
|
(define-values (new-idss body-replacements body-base-counts)
|
||||||
(rename-vars idss replacements body-base-counts))
|
(rename-vars idss replacements base-counts))
|
||||||
(define-values (rhs-replacements rhs-base-counts)
|
(define-values (rhs-replacements rhs-base-counts)
|
||||||
(if rec?
|
(if rec?
|
||||||
(values body-replacements body-base-counts)
|
(values body-replacements body-base-counts)
|
||||||
|
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user