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:
parent
709258d88c
commit
624918d399
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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`.
|
||||
|
|
|
@ -75,8 +75,6 @@
|
|||
use-collection-link-paths
|
||||
use-user-specific-search-paths
|
||||
|
||||
compile-to-linklets
|
||||
|
||||
syntax?
|
||||
read-syntax
|
||||
datum->syntax syntax->datum
|
||||
|
|
|
@ -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
Loading…
Reference in New Issue
Block a user