expander: remove obsolete and broken to-source? compile mode

Source mode was a leftover from early iterations of the expander. A
bootstrapping mode that uses replacement `compile-linklet`, etc.,
turned out better.
This commit is contained in:
Matthew Flatt 2018-11-16 16:20:32 -07:00
parent 709258d88c
commit 624918d399
9 changed files with 636 additions and 776 deletions

View File

@ -60,12 +60,12 @@ Running:
Expands the given file, instead of compiling and running it.
% racket run.rkt -c <dir> --linklets -l <module-path>
% racket bootstrap-run.rkt -s -c <dir> --linklets -l <module-path>
Compiles the given file to a set of linklets in S-expression form,
instead of compiling and running it.
% racket run.rkt -c <dir> -x
% racket bootstrap-run.rkt -s -c <dir> -x
Checks possibility of converting a module to a stand-alone linklet
with no imports --- used mainly to extract the expander itself.

View File

@ -44,7 +44,6 @@
#:definition-callback [definition-callback void]
#:other-form-callback [other-form-callback void]
#:get-module-linklet-info [get-module-linklet-info (lambda (mod-name p) #f)] ; to support submodules
#:to-source? [to-source? #f]
#:serializable? [serializable? #t]
#:cross-linklet-inlining? [cross-linklet-inlining? #t])
(define phase (compile-context-phase cctx))
@ -252,10 +251,8 @@
(define-values (linklet new-module-use*s)
(performance-region
['compile '_ 'linklet]
((if to-source?
(lambda (l name keys getter) (values l keys))
(lambda (l name keys getter)
(compile-linklet l name keys getter (if serializable? '(serializable) '()))))
((lambda (l name keys getter)
(compile-linklet l name keys getter (if serializable? '(serializable) '())))
`(linklet
;; imports
(,@body-imports

View File

@ -27,12 +27,10 @@
(provide compile-module)
;; Compiles module to a set of linklets that is returned as a
;; `compiled-in-memory` --- or a hash table containing S-expression
;; linklets if `to-source?` is true.
;; `compiled-in-memory`
(define (compile-module p cctx
#:force-linklet-directory? [force-linklet-directory? #f]
#:serializable? [serializable? #f]
#:to-source? [to-source? #f]
#:modules-being-compiled [modules-being-compiled (make-hasheq)]
#:need-compiled-submodule-rename? [need-compiled-submodule-rename? #t])
@ -75,7 +73,6 @@
#:full-module-name full-module-name
#:force-linklet-directory? force-linklet-directory?
#:serializable? serializable?
#:to-source? to-source?
#:modules-being-compiled modules-being-compiled
#:pre-submodules pre-submodules
#:post-submodules post-submodules
@ -87,7 +84,6 @@
#:full-module-name full-module-name
#:force-linklet-directory? force-linklet-directory?
#:serializable? serializable?
#:to-source? to-source?
#:modules-being-compiled modules-being-compiled
#:pre-submodules pre-submodules
#:post-submodules post-submodules
@ -170,7 +166,6 @@
(define ht (and modules-being-compiled
(hash-ref modules-being-compiled mod-name #f)))
(and ht (hash-ref ht phase #f)))
#:to-source? to-source?
#:serializable? serializable?))
(when modules-being-compiled
@ -193,9 +188,9 @@
;; declaration, and is shared among instances
(define declaration-linklet
(and serializable?
((if to-source? values (lambda (s) (performance-region
['compile 'module 'linklet]
(compile-linklet s 'decl))))
((lambda (s) (performance-region
['compile 'module 'linklet]
(compile-linklet s 'decl)))
`(linklet
;; imports
(,deserialize-imports
@ -217,18 +212,18 @@
;; objects in the module.
(define syntax-literals-linklet
(and (not (syntax-literals-empty? syntax-literals))
((if to-source? values (lambda (s)
(performance-region
['compile 'module 'linklet]
(define-values (linklet new-keys)
(compile-linklet s 'syntax-literals
(vector deserialize-instance
empty-top-syntax-literal-instance
empty-syntax-literals-data-instance
empty-instance-instance)
(lambda (inst) (values inst #f))
(if serializable? '(serializable) '())))
linklet)))
((lambda (s)
(performance-region
['compile 'module 'linklet]
(define-values (linklet new-keys)
(compile-linklet s 'syntax-literals
(vector deserialize-instance
empty-top-syntax-literal-instance
empty-syntax-literals-data-instance
empty-instance-instance)
(lambda (inst) (values inst #f))
(if serializable? '(serializable) '())))
linklet))
`(linklet
;; imports
(,deserialize-imports
@ -266,9 +261,9 @@
(define syntax-literals-data-linklet
(and serializable?
(not (syntax-literals-empty? syntax-literals))
((if to-source? values (lambda (s) (performance-region
['compile 'module 'linklet]
(compile-linklet s 'syntax-literals-data))))
((lambda (s) (performance-region
['compile 'module 'linklet]
(compile-linklet s 'syntax-literals-data)))
`(linklet
;; imports
(,deserialize-imports
@ -288,9 +283,9 @@
;; across module instances.
(define data-linklet
(and serializable?
((if to-source? values (lambda (s) (performance-region
['compile 'module 'linklet]
(compile-linklet s 'data))))
((lambda (s) (performance-region
['compile 'module 'linklet]
(compile-linklet s 'data)))
`(linklet
;; imports
(,deserialize-imports)
@ -352,30 +347,27 @@
;; Just use the bundle representation directly:
bundle]
[else
((if to-source? values hash->linklet-directory)
(hash->linklet-directory
(for/fold ([ht (hasheq #f bundle)]) ([sm (in-list (append pre-submodules post-submodules))])
(hash-set ht
(car sm)
((if to-source? values compiled-in-memory-linklet-directory)
(compiled-in-memory-linklet-directory
(cdr sm)))))]))
(cond
[to-source? ld]
[else
;; Save mpis and syntax for direct evaluation, instead of unmarshaling:
(compiled-in-memory ld
self
requires
provides
phase-to-link-module-uses
(current-code-inspector)
phase-to-link-extra-inspectorsss
(mpis-as-vector mpis)
(syntax-literals-as-vector syntax-literals)
(map cdr pre-submodules)
(map cdr post-submodules)
#f ; no namespace scopes
#f)]))) ; not purely functional, since it declares a module
;; Save mpis and syntax for direct evaluation, instead of unmarshaling:
(compiled-in-memory ld
self
requires
provides
phase-to-link-module-uses
(current-code-inspector)
phase-to-link-extra-inspectorsss
(mpis-as-vector mpis)
(syntax-literals-as-vector syntax-literals)
(map cdr pre-submodules)
(map cdr post-submodules)
#f ; no namespace scopes
#f))) ; not purely functional, since it declares a module
;; ----------------------------------------

View File

@ -18,7 +18,6 @@
;; top of a tree, we repeat work only twice and avoid non-linear
;; behavior.)
(define (compiled-tops->compiled-top all-cims
#:to-source? [to-source? #f]
#:merge-serialization? [merge-serialization? #f]
#:namespace [ns #f]) ; need for `merge-serialization?`
(define cims (remove-nontail-purely-functional all-cims))
@ -30,7 +29,7 @@
(for/hasheq ([cim (in-list cims)]
[i (in-naturals)])
(values (string->symbol (number->string i))
((if to-source? values compiled-in-memory-linklet-directory)
(compiled-in-memory-linklet-directory
cim))))
(define ht (if merge-serialization?
(hash-set sequence-ht
@ -42,22 +41,19 @@
0
(build-shared-data-linklet cims ns))))))
sequence-ht))
(cond
[to-source? ht]
[else
(compiled-in-memory (hash->linklet-directory ht)
#f ; self
#f ; requires
#f ; provides
#hasheqv()
#f
#hasheqv()
#() ; mpis
#() ; syntax-literals
cims
null
#f
#f)])]))
(compiled-in-memory (hash->linklet-directory ht)
#f ; self
#f ; requires
#f ; provides
#hasheqv()
#f
#hasheqv()
#() ; mpis
#() ; syntax-literals
cims
null
#f
#f)]))
;; Decode a sequence of compiled top-level forms by unpacking the
;; linklet directory into a list of linklet directories

View File

@ -35,13 +35,10 @@
;; `define-syntaxes` form, or an expression (where `begin` is treated
;; as an expression form). If `serializable?` is false, don't bother
;; generating the linklet for serialized data, because it won't be
;; used. If `to-source?` is true, the result is a hash table containing
;; S-expression linkets, instead of a `compiled-in-memory` containing
;; compiled linklets.
;; used.
(define (compile-top p cctx
#:serializable? [serializable? #t]
#:single-expression? [single-expression? #f]
#:to-source? [to-source? #f])
#:single-expression? [single-expression? #f])
(performance-region
['compile (if single-expression? 'transformer 'top)]
@ -72,7 +69,6 @@
#:body-import-instances (list top-level-instance
empty-top-syntax-literal-instance
empty-instance-instance)
#:to-source? to-source?
#:serializable? serializable?
#:definition-callback (lambda () (set! purely-functional? #f))
#:compiled-expression-callback
@ -91,7 +87,7 @@
ht))
(define bundle
((if to-source? values hash->linklet-bundle)
(hash->linklet-bundle
(add-metadata
(cond
[serializable?
@ -108,16 +104,16 @@
(compile-context-namespace cctx))))
(define link-linklet
((if to-source? values (lambda (s)
(performance-region
['compile 'top 'linklet]
(define-values (linklet new-keys)
(compile-linklet s
#f
(vector deserialize-instance
empty-eager-instance-instance)
(lambda (inst) (values inst #f))))
linklet)))
((lambda (s)
(performance-region
['compile 'top 'linklet]
(define-values (linklet new-keys)
(compile-linklet s
#f
(vector deserialize-instance
empty-eager-instance-instance)
(lambda (inst) (values inst #f))))
linklet))
`(linklet
;; imports
(,deserialize-imports
@ -139,25 +135,21 @@
;; Will combine the linking unit with non-serialized link info
body-linklets]))))
(cond
[to-source?
(hasheq #f bundle)]
[else
;; If the compiled code is executed directly, it must be in its
;; original phase, and we'll share the original values
(compiled-in-memory (hash->linklet-directory (hasheq #f bundle))
#f ; self
#f ; requires
#f ; provides
phase-to-link-module-uses
(current-code-inspector)
phase-to-link-extra-inspectorss
(mpis-as-vector mpis)
(syntax-literals-as-vector syntax-literals)
null
null
(extract-namespace-scopes (compile-context-namespace cctx))
purely-functional?)])))
;; If the compiled code is executed directly, it must be in its
;; original phase, and we'll share the original values
(compiled-in-memory (hash->linklet-directory (hasheq #f bundle))
#f ; self
#f ; requires
#f ; provides
phase-to-link-module-uses
(current-code-inspector)
phase-to-link-extra-inspectorss
(mpis-as-vector mpis)
(syntax-literals-as-vector syntax-literals)
null
null
(extract-namespace-scopes (compile-context-namespace cctx))
purely-functional?)))
;; Callback for compiling a sequence of expressions: handle `require`
;; (which is handled separately for modules)

View File

@ -34,9 +34,7 @@
compile
expand
expand-once
expand-to-top-form
compile-to-linklets)
expand-to-top-form)
;; This `eval` is suitable as an eval handler that will be called by
;; the `eval` and `eval-syntax` of '#%kernel.
@ -71,7 +69,7 @@
;; by the `compile` and `compile-syntax` of '#%kernel
;; [Don't use keyword arguments here, because the function is
;; exported for use by an embedding runtime system.]
(define (compile s [ns (current-namespace)] [serializable? #t] [expand expand] [to-source? #f])
(define (compile s [ns (current-namespace)] [serializable? #t] [expand expand])
;; The given `s` might be an already-compiled expression because it
;; went through some strange path, such as a `load` on a bytecode
;; file, which would wrap `#%top-interaction` around the compiled
@ -86,47 +84,35 @@
(per-top-level s ns
#:single (lambda (s ns as-tail?)
(list (compile-single s ns expand
serializable?
to-source?)))
serializable?)))
#:combine append
#:observer #f)]))
(if (and (= 1 (length cs))
(not (compiled-multiple-top? (car cs))))
(car cs)
(compiled-tops->compiled-top cs
#:to-source? to-source?
#:merge-serialization? serializable?
#:namespace ns)))
;; Result is a hash table containing S-expressons that may have
;; "correlated" parts in the sense of "host/correlate.rkt"; use
;; `datum->correlated` plus `correlated->datum` to get a plain
;; S-expression
(define (compile-to-linklets s [ns (current-namespace)])
(compile s ns #t expand #t))
;; To communicate lifts from `expand-single` to `compile-single`:
(struct lifted-parsed-begin (seq last))
(define (compile-single s ns expand serializable? to-source?)
(define (compile-single s ns expand serializable?)
(define exp-s (expand s ns #f #t serializable?))
(let loop ([exp-s exp-s])
(cond
[(parsed-module? exp-s)
(compile-module exp-s (make-compile-context #:namespace ns)
#:serializable? serializable?
#:to-source? to-source?)]
#:serializable? serializable?)]
[(lifted-parsed-begin? exp-s)
;; expansion must have captured lifts
(compiled-tops->compiled-top
(for/list ([e (in-list (append (lifted-parsed-begin-seq exp-s)
(list (lifted-parsed-begin-last exp-s))))])
(loop e))
#:to-source? to-source?)]
(loop e)))]
[else
(compile-top exp-s (make-compile-context #:namespace ns)
#:serializable? serializable?
#:to-source? to-source?)])))
#:serializable? serializable?)])))
;; This `expand` is suitable as an expand handler (if such a thing
;; existed) to be called by `expand` and `expand-syntax`.

View File

@ -75,8 +75,6 @@
use-collection-link-paths
use-user-specific-search-paths
compile-to-linklets
syntax?
read-syntax
datum->syntax syntax->datum

View File

@ -313,7 +313,7 @@
[linklets?
(pretty-write (correlated->datum
(datum->correlated
(apply-to-module compile-to-linklets startup-module) #f)))]
(apply-to-module compile startup-module) #f)))]
[else
;; Load and run the requested module
(parameterize ([current-command-line-arguments (list->vector args)])

File diff suppressed because it is too large Load Diff