Improve flattener.
This commit is contained in:
parent
daa7ddeef8
commit
62ef3ed1ee
|
@ -25,7 +25,7 @@ DIRECT = ++direct linklet ++direct kernel
|
||||||
# The linklet compiler's simple inference cannot tell that this
|
# The linklet compiler's simple inference cannot tell that this
|
||||||
# module's keyword-function declarations will have no side effect, but
|
# module's keyword-function declarations will have no side effect, but
|
||||||
# we promise that it's pure:
|
# we promise that it's pure:
|
||||||
PURE = ++pure $(TREE)/collects/racket/private/collect.rkt
|
PURE =
|
||||||
|
|
||||||
# Set `BUILDDIR` as a prefix on "compiled" output (defaults to empty).
|
# Set `BUILDDIR` as a prefix on "compiled" output (defaults to empty).
|
||||||
# Set `DEPENDSDIR` as the same sort of prefix in the generated
|
# Set `DEPENDSDIR` as the same sort of prefix in the generated
|
||||||
|
|
|
@ -40,6 +40,7 @@
|
||||||
;; Check whether any needed linklet needs an instance of a
|
;; Check whether any needed linklet needs an instance of a
|
||||||
;; pre-defined instance that is not part of the runtime system:
|
;; pre-defined instance that is not part of the runtime system:
|
||||||
(define complained? #f)
|
(define complained? #f)
|
||||||
|
(define needed-vars null)
|
||||||
(for ([lnk (in-list (unbox linklets-in-order))])
|
(for ([lnk (in-list (unbox linklets-in-order))])
|
||||||
(define needed-reason (hash-ref needed lnk #f))
|
(define needed-reason (hash-ref needed lnk #f))
|
||||||
(when needed-reason
|
(when needed-reason
|
||||||
|
@ -54,16 +55,19 @@
|
||||||
(not (hash-ref instance-knot-ties p #f))
|
(not (hash-ref instance-knot-ties p #f))
|
||||||
(hash-ref needed in-lnk #t))
|
(hash-ref needed in-lnk #t))
|
||||||
(unless complained?
|
(unless complained?
|
||||||
(log-status "~a\n~a"
|
(log-status "~a\n ~a"
|
||||||
"Unfortunately, some linklets depend on pre-defined host instances"
|
"Unfortunately, some linklets depend on pre-defined host instances"
|
||||||
"that are not part of the runtime system:")
|
"that are not part of the runtime system:")
|
||||||
(set! complained? #t))
|
(set! complained? #t))
|
||||||
(unless complained-this?
|
(unless complained-this?
|
||||||
(log-status " - ~a at ~s" (link-name lnk) (link-phase lnk))
|
(log-status " - ~a at ~s" (link-name lnk) (link-phase lnk))
|
||||||
(set! complained-this? #t))
|
(set! complained-this? #t))
|
||||||
(log-status "~a" (lines (format " needs ~s:" p) in-vars))))
|
(log-status "~a" (lines (format " needs ~s:" p) in-vars))
|
||||||
|
(set! needed-vars (append in-vars needed-vars))))
|
||||||
(when complained-this?
|
(when complained-this?
|
||||||
(log-status " needed by ~s" needed-reason))))
|
(log-status " needed by ~s" needed-reason))))
|
||||||
|
|
||||||
(when complained?
|
(when complained?
|
||||||
(exit 1)))
|
(log-status "~a\n ~a"
|
||||||
|
"If these dependencies are not removed by subsequent flattening"
|
||||||
|
"and simplification, extraction cannot succeed."))
|
||||||
|
(and complained? needed-vars))
|
||||||
|
|
|
@ -17,7 +17,8 @@
|
||||||
#:needed needed
|
#:needed needed
|
||||||
#:exports exports
|
#:exports exports
|
||||||
#:instance-knot-ties instance-knot-ties
|
#:instance-knot-ties instance-knot-ties
|
||||||
#:primitive-table-directs primitive-table-directs)
|
#:primitive-table-directs primitive-table-directs
|
||||||
|
#:check-later-names check-later-names)
|
||||||
(log-status "Flattening to a single linklet...")
|
(log-status "Flattening to a single linklet...")
|
||||||
(define needed-linklets-in-order
|
(define needed-linklets-in-order
|
||||||
(for/list ([lnk (in-list (unbox linklets-in-order))]
|
(for/list ([lnk (in-list (unbox linklets-in-order))]
|
||||||
|
@ -30,7 +31,8 @@
|
||||||
#:instance-knot-ties instance-knot-ties))
|
#:instance-knot-ties instance-knot-ties))
|
||||||
|
|
||||||
(for ([var (in-hash-keys variable-names)]
|
(for ([var (in-hash-keys variable-names)]
|
||||||
#:when (symbol? (link-name (variable-link var))))
|
#:when (symbol? (link-name (variable-link var)))
|
||||||
|
#:unless (memq (variable-name var) check-later-names))
|
||||||
(error 'flatten "found a dependency on a non-primitive: ~s from ~s"
|
(error 'flatten "found a dependency on a non-primitive: ~s from ~s"
|
||||||
(variable-name var)
|
(variable-name var)
|
||||||
(link-name (variable-link var))))
|
(link-name (variable-link var))))
|
||||||
|
|
|
@ -13,6 +13,9 @@
|
||||||
"decompile.rkt"
|
"decompile.rkt"
|
||||||
"save-and-report.rkt"
|
"save-and-report.rkt"
|
||||||
"underscore.rkt"
|
"underscore.rkt"
|
||||||
|
"symbol.rkt"
|
||||||
|
"../run/status.rkt"
|
||||||
|
"../common/set.rkt"
|
||||||
racket/pretty)
|
racket/pretty)
|
||||||
|
|
||||||
(provide extract)
|
(provide extract)
|
||||||
|
@ -97,11 +100,12 @@
|
||||||
#:needed needed)))
|
#:needed needed)))
|
||||||
|
|
||||||
;; Check for bootstrap obstacles, and report what we've found
|
;; Check for bootstrap obstacles, and report what we've found
|
||||||
|
(define needed-vars
|
||||||
(check-and-report! #:compiled-modules compiled-modules
|
(check-and-report! #:compiled-modules compiled-modules
|
||||||
#:linklets linklets
|
#:linklets linklets
|
||||||
#:linklets-in-order linklets-in-order
|
#:linklets-in-order linklets-in-order
|
||||||
#:needed needed
|
#:needed needed
|
||||||
#:instance-knot-ties instance-knot-ties)
|
#:instance-knot-ties instance-knot-ties))
|
||||||
|
|
||||||
;; If we're in source mode, we can generate a single linklet
|
;; If we're in source mode, we can generate a single linklet
|
||||||
;; that combines all the ones we found
|
;; that combines all the ones we found
|
||||||
|
@ -121,7 +125,8 @@
|
||||||
#:needed needed
|
#:needed needed
|
||||||
#:exports exports
|
#:exports exports
|
||||||
#:instance-knot-ties instance-knot-ties
|
#:instance-knot-ties instance-knot-ties
|
||||||
#:primitive-table-directs primitive-table-directs))
|
#:primitive-table-directs primitive-table-directs
|
||||||
|
#:check-later-names needed-vars))
|
||||||
|
|
||||||
(define simplified-expr
|
(define simplified-expr
|
||||||
(simplify-definitions flattened-linklet-expr))
|
(simplify-definitions flattened-linklet-expr))
|
||||||
|
@ -130,6 +135,16 @@
|
||||||
(define gced-linklet-expr
|
(define gced-linklet-expr
|
||||||
(garbage-collect-definitions simplified-expr))
|
(garbage-collect-definitions simplified-expr))
|
||||||
|
|
||||||
|
(log-status "Checking that references to the runtime were removed by simplification ...")
|
||||||
|
(define used-names (all-used-symbols gced-linklet-expr))
|
||||||
|
(define still-needed (filter (lambda (v) (set-member? used-names v)) needed-vars))
|
||||||
|
(unless (null? still-needed)
|
||||||
|
(log-status "Simplification failed to remove references to: ~a"
|
||||||
|
(lines still-needed))
|
||||||
|
(exit 1))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; Avoid gratuitous differences due to names generated during
|
;; Avoid gratuitous differences due to names generated during
|
||||||
;; expansion
|
;; expansion
|
||||||
(define re-renamed-linklet-expr
|
(define re-renamed-linklet-expr
|
||||||
|
|
Loading…
Reference in New Issue
Block a user