From 62ef3ed1ee72a1396752310d176a3d4d0c0b981f Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 12 Jun 2018 13:40:50 -0400 Subject: [PATCH] Improve flattener. --- racket/src/expander/Makefile | 2 +- .../src/expander/extract/check-and-report.rkt | 12 ++++++--- racket/src/expander/extract/flatten.rkt | 14 +++++----- racket/src/expander/extract/main.rkt | 27 ++++++++++++++----- 4 files changed, 38 insertions(+), 17 deletions(-) diff --git a/racket/src/expander/Makefile b/racket/src/expander/Makefile index 774d4ecf8c..fb148a9646 100644 --- a/racket/src/expander/Makefile +++ b/racket/src/expander/Makefile @@ -25,7 +25,7 @@ DIRECT = ++direct linklet ++direct kernel # The linklet compiler's simple inference cannot tell that this # module's keyword-function declarations will have no side effect, but # 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 `DEPENDSDIR` as the same sort of prefix in the generated diff --git a/racket/src/expander/extract/check-and-report.rkt b/racket/src/expander/extract/check-and-report.rkt index e04c70d8ea..2a059a32e8 100644 --- a/racket/src/expander/extract/check-and-report.rkt +++ b/racket/src/expander/extract/check-and-report.rkt @@ -40,6 +40,7 @@ ;; Check whether any needed linklet needs an instance of a ;; pre-defined instance that is not part of the runtime system: (define complained? #f) + (define needed-vars null) (for ([lnk (in-list (unbox linklets-in-order))]) (define needed-reason (hash-ref needed lnk #f)) (when needed-reason @@ -54,16 +55,19 @@ (not (hash-ref instance-knot-ties p #f)) (hash-ref needed in-lnk #t)) (unless complained? - (log-status "~a\n~a" + (log-status "~a\n ~a" "Unfortunately, some linklets depend on pre-defined host instances" "that are not part of the runtime system:") (set! complained? #t)) (unless complained-this? (log-status " - ~a at ~s" (link-name lnk) (link-phase lnk)) (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? (log-status " needed by ~s" needed-reason)))) - (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)) diff --git a/racket/src/expander/extract/flatten.rkt b/racket/src/expander/extract/flatten.rkt index bcdc70d21f..510d86321f 100644 --- a/racket/src/expander/extract/flatten.rkt +++ b/racket/src/expander/extract/flatten.rkt @@ -17,23 +17,25 @@ #:needed needed #:exports exports #: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...") (define needed-linklets-in-order (for/list ([lnk (in-list (unbox linklets-in-order))] #:when (hash-ref needed lnk #f)) lnk)) - + (define variable-names (pick-variable-names #:linklets linklets #:needed-linklets-in-order needed-linklets-in-order #:instance-knot-ties instance-knot-ties)) (for ([var (in-hash-keys variable-names)] - #:when (symbol? (link-name (variable-link var)))) - (error 'flatten "found a dependency on a non-primitive: ~s from ~s" - (variable-name var) - (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" + (variable-name var) + (link-name (variable-link var)))) `(linklet ;; imports diff --git a/racket/src/expander/extract/main.rkt b/racket/src/expander/extract/main.rkt index 11d4ea54d5..b979579011 100644 --- a/racket/src/expander/extract/main.rkt +++ b/racket/src/expander/extract/main.rkt @@ -13,6 +13,9 @@ "decompile.rkt" "save-and-report.rkt" "underscore.rkt" + "symbol.rkt" + "../run/status.rkt" + "../common/set.rkt" racket/pretty) (provide extract) @@ -97,11 +100,12 @@ #:needed needed))) ;; Check for bootstrap obstacles, and report what we've found - (check-and-report! #:compiled-modules compiled-modules - #:linklets linklets - #:linklets-in-order linklets-in-order - #:needed needed - #:instance-knot-ties instance-knot-ties) + (define needed-vars + (check-and-report! #:compiled-modules compiled-modules + #:linklets linklets + #:linklets-in-order linklets-in-order + #:needed needed + #:instance-knot-ties instance-knot-ties)) ;; If we're in source mode, we can generate a single linklet ;; that combines all the ones we found @@ -121,7 +125,8 @@ #:needed needed #:exports exports #: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 (simplify-definitions flattened-linklet-expr)) @@ -130,6 +135,16 @@ (define gced-linklet-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 ;; expansion (define re-renamed-linklet-expr