Improve flattener.

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

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))

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

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