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

expander: more determinsitic machine-independent "bytecode"

Browse Source 
Discard local-variable names to avoid `gensym` artifacts in the same
way that a more complete compilation would discard the names. This
change does not affect function names, which are preserved through
separate properties.
This commit is contained in:
Matthew Flatt 2018-11-27 20:00:10 -07:00
parent 8c6af1a234
commit a7499ab854
8 changed files with 1073 additions and 946 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
racket/src/expander/expand/body.rkt
View File

@ -128,8 +128,11 @@
(log-expand body-ctx 'rename-one (datum->syntax #f (list ids (m 'rhs))))
(define new-dups (check-no-duplicate-ids ids phase exp-body dups))
(define counter (root-expand-context-counter ctx))
(define local-sym (and (expand-context-normalize-locals? ctx) 'loc))
(define keys (for/list ([id (in-list ids)])
(add-local-binding! id phase counter #:frame-id frame-id #:in exp-body)))
(add-local-binding! id phase counter
#:frame-id frame-id #:in exp-body
#:local-sym local-sym)))
(define extended-env (for/fold ([env (expand-context-env body-ctx)]) ([key (in-list keys)]
[id (in-list ids)])
(env-extend env key (local-variable id))))
@ -174,8 +177,11 @@
(log-expand body-ctx 'rename-one (datum->syntax #f (list ids (m 'rhs))))
(define new-dups (check-no-duplicate-ids ids phase exp-body dups))
(define counter (root-expand-context-counter ctx))
(define local-sym (and (expand-context-normalize-locals? ctx) 'mac))
(define keys (for/list ([id (in-list ids)])
(add-local-binding! id phase counter #:frame-id frame-id #:in exp-body)))
(add-local-binding! id phase counter
#:frame-id frame-id #:in exp-body
#:local-sym local-sym)))
(log-expand body-ctx 'prepare-env)
(prepare-next-phase-namespace ctx)
(log-expand body-ctx 'enter-bind)

2
racket/src/expander/expand/context.rkt
View File

@ -69,6 +69,7 @@
observer ; logging observer (for the macro debugger)
for-serializable? ; accumulate submodules as serializable?
to-correlated-linklet? ; compile to machine-independent linklets?
normalize-locals? ; forget original local-variable names
should-not-encounter-macros?)) ; #t when "expanding" to parse
(define (make-expand-context ns
@ -117,6 +118,7 @@
observer
for-serializable?
to-correlated-linklet?
to-correlated-linklet? ; normalize-locals?
#f))
(define (copy-root-expand-context ctx root-ctx)

7
racket/src/expander/expand/definition-context.rkt
View File

@ -83,9 +83,12 @@
(add-intdef-scopes (add-intdef-scopes pre-id intdef #:always? #t)
extra-intdefs)))
(log-expand ctx 'rename-list intdef-ids)
(define counter (root-expand-context-counter ctx))
(define local-sym (and (expand-context-normalize-locals? ctx) 'loc))
(define syms (for/list ([intdef-id (in-list intdef-ids)])
(add-local-binding! intdef-id phase (root-expand-context-counter ctx)
#:frame-id (internal-definition-context-frame-id intdef))))
(add-local-binding! intdef-id phase counter
#:frame-id (internal-definition-context-frame-id intdef)
#:local-sym local-sym)))
(define vals
(cond
[s

7
racket/src/expander/expand/env.rkt
View File

@ -96,12 +96,15 @@
#:shadow-except shadow-except))
;; Helper for registering a local binding in a set of scopes:
(define (add-local-binding! id phase counter #:frame-id [frame-id #f] #:in [in-s #f])
(define (add-local-binding! id phase counter
#:local-sym local-sym
#:frame-id [frame-id #f]
#:in [in-s #f])
(check-id-taint id in-s)
(define c (add1 (unbox counter)))
(set-box! counter c)
(define sym (syntax-content id))
(define key (string->uninterned-symbol (string-append (symbol->string sym)
(define key (string->uninterned-symbol (string-append (symbol->string (or local-sym sym))
"_"
(number->string c))))
(add-binding-in-scopes! (syntax-scope-set id phase) sym (make-local-binding key #:frame-id frame-id))

12
racket/src/expander/expand/expr.rkt
View File

@ -39,8 +39,9 @@
;; Bind each argument and generate a corresponding key for the
;; expand-time environment:
(define counter (root-expand-context-counter ctx))
(define local-sym (and (expand-context-normalize-locals? ctx) 'arg))
(define keys (for/list ([id (in-list ids)])
(add-local-binding! id phase counter #:in s)))
(add-local-binding! id phase counter #:in s #:local-sym local-sym)))
(define body-env (for/fold ([env (expand-context-env ctx)]) ([key (in-list keys)]
[id (in-list ids)])
(env-extend env key (local-variable id))))
@ -198,12 +199,17 @@
;; Bind each left-hand identifier and generate a corresponding key
;; fo the expand-time environment:
(define counter (root-expand-context-counter ctx))
(define local-sym (and (expand-context-normalize-locals? ctx) 'loc))
(define trans-keyss (for/list ([ids (in-list trans-idss)])
(for/list ([id (in-list ids)])
(add-local-binding! id phase counter #:frame-id frame-id #:in s))))
(add-local-binding! id phase counter
#:frame-id frame-id #:in s
#:local-sym local-sym))))
(define val-keyss (for/list ([ids (in-list val-idss)])
(for/list ([id (in-list ids)])
(add-local-binding! id phase counter #:frame-id frame-id #:in s))))
(add-local-binding! id phase counter
#:frame-id frame-id #:in s
#:local-sym local-sym))))
;; Add new scope to body:
(define bodys (for/list ([body (in-list (if syntaxes? (stx-m 'body) (val-m 'body)))])
(define new-body (add-scope body sc))

4
racket/src/expander/expand/lift-context.rkt
View File

@ -71,11 +71,11 @@
(define (get-and-clear-lifts! lifts)
(box-clear! (lift-context-lifts lifts)))
(define (make-local-lift lift-env counter)
(define (make-local-lift lift-env counter local-sym)
(lambda (ids rhs phase)
(define keys
(for/list ([id (in-list ids)])
(define key (add-local-binding! id phase counter))
(define key (add-local-binding! id phase counter #:local-sym local-sym))
(set-box! lift-env (env-extend (unbox lift-env) key variable))
key))
(values ids (lifted-bind ids keys rhs))))

4
racket/src/expander/expand/main.rkt
View File

@ -544,7 +544,9 @@
(define lift-env (and local? (box empty-env)))
(define lift-ctx (make-lift-context
(if local?
(make-local-lift lift-env (root-expand-context-counter ctx))
(make-local-lift lift-env
(root-expand-context-counter ctx)
(and (expand-context-normalize-locals? ctx) 'lift))
(make-top-level-lift ctx))
#:module*-ok? (and (not local?) (eq? context 'module))))
(define capture-ctx (struct*-copy expand-context ctx

1973
racket/src/racket/src/startup.inc
View File

File diff suppressed because it is too large Load Diff