From 98ae91e0ba8d1c503730b993d835ed6dee47c65b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 14 Jun 2018 17:27:00 -0600
Subject: [PATCH] expander: repair and further improve flattener

Delay reporting of potential problems until an actual problem
is detected. Correct a mismatch between original and renamed
symbols to restore detection of problems.
---
 racket/src/expander/Makefile                  | 13 ++--
 .../src/expander/extract/check-and-report.rkt | 62 +++++++++++--------
 racket/src/expander/extract/flatten.rkt       | 57 +++++++++--------
 racket/src/expander/extract/main.rkt          | 34 +++++-----
 racket/src/io/Makefile                        |  7 +--
 racket/src/regexp/Makefile                    |  9 +--
 racket/src/thread/Makefile                    |  7 +--
 7 files changed, 91 insertions(+), 98 deletions(-)

diff --git a/racket/src/expander/Makefile b/racket/src/expander/Makefile
index fb148a9646..bffa338b1f 100644
--- a/racket/src/expander/Makefile
+++ b/racket/src/expander/Makefile
@@ -22,11 +22,6 @@ KNOT = ++knot read read/api.rkt \
 # a direct use of the primitive name:
 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 =
-
 # Set `BUILDDIR` as a prefix on "compiled" output (defaults to empty).
 # Set `DEPENDSDIR` as the same sort of prefix in the generated
 # makefile-dependency file (also defaults to empty). The `BUILDDIR`
@@ -36,7 +31,7 @@ PURE =
 
 expander:
 	$(RACO) make bootstrap-run.rkt
-	$(RACKET) bootstrap-run.rkt -c compiled/cache-src $(KNOT) $(DIRECT) $(PURE) -O $(TREE)
+	$(RACKET) bootstrap-run.rkt -c compiled/cache-src $(KNOT) $(DIRECT) -O $(TREE)
 
 expander-src:
 	$(RACO) make bootstrap-run.rkt
@@ -47,7 +42,7 @@ GENERATE_ARGS = -c $(BUILDDIR)compiled/cache-src \
                 ++depend-module bootstrap-run.rkt \
                 --depends $(BUILDDIR)compiled/expander-dep.rktd \
                 --makefile-depends $(DEPENDSDIR)compiled/expander.rktl $(BUILDDIR)compiled/expander.d \
-                $(KNOT) $(DIRECT) $(PURE) -k $(TREE) -s -x \
+                $(KNOT) $(DIRECT) -k $(TREE) -s -x \
                 -o $(BUILDDIR)compiled/expander.rktl
 
 # This target can be used with a `RACKET` that builds via `-l- setup --chain ...`
@@ -75,11 +70,11 @@ run-no-cache:
 # Writes the extracted, compiled, decompiled expander to compiled/exp.rkt
 decompile:
 	$(RACO) make bootstrap-run.rkt
-	$(RACKET) $(RKT_ARGS) bootstrap-run.rkt -c compiled/cache-src $(KNOT) $(PURE) -s -x -D -o compiled/exp.rkt
+	$(RACKET) $(RKT_ARGS) bootstrap-run.rkt -c compiled/cache-src $(KNOT) -s -x -D -o compiled/exp.rkt
 
 # Writes the extracted, compiled expander to compiled/exp.zo
 bytecode:
 	$(RACO) make bootstrap-run.rkt
-	$(RACKET) $(RKT_ARGS) bootstrap-run.rkt -c compiled/cache-src $(KNOT) $(PURE) -s -x -B -o compiled/exp.zo
+	$(RACKET) $(RKT_ARGS) bootstrap-run.rkt -c compiled/cache-src $(KNOT) -s -x -B -o compiled/exp.zo
 
 .PHONY: expander expander-src expander-src-generate demo run run-no-cache
diff --git a/racket/src/expander/extract/check-and-report.rkt b/racket/src/expander/extract/check-and-report.rkt
index 2a059a32e8..d2f834515a 100644
--- a/racket/src/expander/extract/check-and-report.rkt
+++ b/racket/src/expander/extract/check-and-report.rkt
@@ -1,18 +1,21 @@
 #lang racket/base
-(require "../run/status.rkt"
+(require "../common/set.rkt"
+         "../run/status.rkt"
          "../boot/runtime-primitive.rkt"
          "link.rkt"
          "linklet-info.rkt"
-         "linklet.rkt")
+         "linklet.rkt"
+         "variable.rkt")
 
-(provide check-and-report!)
+(provide check-and-record-report!)
 
-;; Check for bootstrap obstacles and report the results
-(define (check-and-report! #:compiled-modules compiled-modules
-                           #:linklets linklets
-                           #:linklets-in-order linklets-in-order
-                           #:needed needed
-                           #:instance-knot-ties instance-knot-ties)
+;; Check for bootstrap obstacles, and prepare to report if the
+;; obstacles persist
+(define (check-and-record-report! #:compiled-modules compiled-modules
+                                  #:linklets linklets
+                                  #:linklets-in-order linklets-in-order
+                                  #:needed needed
+                                  #:instance-knot-ties instance-knot-ties)
 
   (log-status "Traversed ~s modules" (hash-count compiled-modules))
   (log-status "Got ~s relevant linklets" (hash-count linklets))
@@ -40,7 +43,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)
+  (define check-later-vars (make-hash)) ; variable -> (listof complain-proc)
   (for ([lnk (in-list (unbox linklets-in-order))])
     (define needed-reason (hash-ref needed lnk #f))
     (when needed-reason
@@ -54,20 +57,25 @@
                    (not (eq? p '#%linklet))
                    (not (hash-ref instance-knot-ties p #f))
                    (hash-ref needed in-lnk #t))
-          (unless complained?
-            (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))
-          (set! needed-vars (append in-vars needed-vars))))
-      (when complained-this?
-        (log-status "   needed by ~s" needed-reason))))
-  (when complained?
-    (log-status "~a\n ~a"
-                "If these dependencies are not removed by subsequent flattening"
-                "and simplification, extraction cannot succeed."))
-  (and complained? needed-vars))
+          ;; Delay the complaint until we know whether the name is
+          ;; actually used after flattening and pruning
+          (define (complain really-used-var?)
+            (unless complained?
+              (log-status "~a\n ~a\n ~a\n ~a\n ~a"
+                          "Unfortunately, some linklets depend on pre-defined host instances"
+                          "that are not part of the runtime system; at least one the following"
+                          "references is a problem, but not necessarily all of them, because"
+                          "some references may be detected as unused by the flattener (but"
+                          "we've lost track of the connection):")
+              (set! complained? #t))
+            (unless complained-this?
+              (log-status "  - ~a at ~s" (link-name lnk) (link-phase lnk))
+              (log-status "~a" (lines (format "   needs ~s:" p)
+                                      (for/list ([in-var (in-list in-vars)]
+                                                 #:when (really-used-var? (variable in-lnk in-var)))
+                                        in-var)))
+              (log-status "   needed by ~s" needed-reason)
+              (set! complained-this? #t)))
+          (for ([in-var (in-list in-vars)])
+            (hash-update! check-later-vars (variable in-lnk in-var) (lambda (l) (cons complain l)) null))))))
+  check-later-vars)
diff --git a/racket/src/expander/extract/flatten.rkt b/racket/src/expander/extract/flatten.rkt
index 510d86321f..a905ba94e0 100644
--- a/racket/src/expander/extract/flatten.rkt
+++ b/racket/src/expander/extract/flatten.rkt
@@ -18,13 +18,14 @@
                   #:exports exports
                   #:instance-knot-ties instance-knot-ties
                   #:primitive-table-directs primitive-table-directs
-                  #:check-later-names check-later-names)
+                  #:check-later-vars check-later-vars)
   (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))
 
+  ;; variable -> symbol
   (define variable-names (pick-variable-names
                           #:linklets linklets
                           #:needed-linklets-in-order needed-linklets-in-order
@@ -32,32 +33,34 @@
 
   (for ([var (in-hash-keys variable-names)]
         #: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
-    ()
-    ;; exports
-    ,(for/list ([ex-sym (in-list (sort (hash-keys exports) symbol<?))])
-       (define var (hash-ref exports ex-sym))
-       (define int-sym (hash-ref variable-names var #f))
-       (unless int-sym
-         (error 'flatten "export does not map to an instance variable: ~s" ex-sym))
-       `[,int-sym ,ex-sym])
-    ;; body
-    ,@(apply
-       append
-       (for/list ([lnk (in-list (reverse needed-linklets-in-order))])
-         (define body
-           (body-with-substituted-variable-names lnk
-                                                 (hash-ref linklets lnk)
-                                                 variable-names
-                                                 #:linklets linklets
-                                                 #:instance-knot-ties instance-knot-ties))
-         (substitute-primitive-table-access body primitive-table-directs)))))
+        #:unless (hash-ref check-later-vars var #f))
+    (error 'flatten "found a dependency on a non-primitive: ~s from ~s"
+           (variable-name var)
+           (link-name (variable-link var))))
+
+  (values
+   variable-names
+   `(linklet
+     ;; imports
+     ()
+     ;; exports
+     ,(for/list ([ex-sym (in-list (sort (hash-keys exports) symbol<?))])
+        (define var (hash-ref exports ex-sym))
+        (define int-sym (hash-ref variable-names var #f))
+        (unless int-sym
+          (error 'flatten "export does not map to an instance variable: ~s" ex-sym))
+        `[,int-sym ,ex-sym])
+     ;; body
+     ,@(apply
+        append
+        (for/list ([lnk (in-list (reverse needed-linklets-in-order))])
+          (define body
+            (body-with-substituted-variable-names lnk
+                                                  (hash-ref linklets lnk)
+                                                  variable-names
+                                                  #:linklets linklets
+                                                  #:instance-knot-ties instance-knot-ties))
+          (substitute-primitive-table-access body primitive-table-directs))))))
 
 (define (pick-variable-names #:linklets linklets
                              #:needed-linklets-in-order needed-linklets-in-order
diff --git a/racket/src/expander/extract/main.rkt b/racket/src/expander/extract/main.rkt
index b979579011..64601dd6e1 100644
--- a/racket/src/expander/extract/main.rkt
+++ b/racket/src/expander/extract/main.rkt
@@ -100,12 +100,12 @@
                #:needed needed)))
   
   ;; Check for bootstrap obstacles, and report what we've found
-  (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))
+  (define check-later-vars
+    (check-and-record-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
@@ -118,7 +118,7 @@
                                    #:cache cache))
 
     ;; Generate the flattened linklet
-    (define flattened-linklet-expr
+    (define-values (variable-names flattened-linklet-expr)
       (flatten! start-link
                 #:linklets linklets
                 #:linklets-in-order linklets-in-order
@@ -126,7 +126,7 @@
                 #:exports exports
                 #:instance-knot-ties instance-knot-ties
                 #:primitive-table-directs primitive-table-directs
-                #:check-later-names needed-vars))
+                #:check-later-vars check-later-vars))
     
     (define simplified-expr
       (simplify-definitions flattened-linklet-expr))
@@ -135,16 +135,18 @@
     (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))
+    (log-status "Checking that references outside the runtime were removed by simplification...")
+    (define really-used-names (all-used-symbols gced-linklet-expr))
+    (define complained? #f)
+    (for ([(var complains) (in-hash check-later-vars)])
+      (when (set-member? really-used-names (hash-ref variable-names var))
+        (for ([complain (in-list (reverse complains))])
+          (complain (lambda (var)
+                      (set-member? really-used-names (hash-ref variable-names var))))
+          (set! complained? #t))))
+    (when complained?
       (exit 1))
 
-
-
     ;; Avoid gratuitous differences due to names generated during
     ;; expansion
     (define re-renamed-linklet-expr
diff --git a/racket/src/io/Makefile b/racket/src/io/Makefile
index 20f1b941a7..3974c8f3ab 100644
--- a/racket/src/io/Makefile
+++ b/racket/src/io/Makefile
@@ -4,11 +4,6 @@
 RACKET = ../../bin/racket
 RACO = $(RACKET) -N raco -l- raco
 
-# Ignoring functions from `#%read` works beause they won't appear in
-# the simplified expansion, and declaring "collect.rkt" pure works
-# around a limitation of the flattener:
-IGNORE = ++knot read - ++pure ../../collects/racket/private/collect.rkt
-
 # Can be set to empty to avoid building rktio
 RKTIO_DEP=../build/so-rktio/Makefile
 
@@ -23,7 +18,7 @@ GENERATE_ARGS = -t main.rkt --submod main \
                 --depends $(BUILDDIR)compiled/io-dep.rktd \
                 --makefile-depends $(DEPENDSDIR)compiled/io.rktl $(BUILDDIR)compiled/io.d \
                 -c $(BUILDDIR)compiled/cache-src \
-                -k ../.. $(IGNORE) -s -x \
+                -k ../.. -s -x \
                 -o $(BUILDDIR)compiled/io.rktl
 
 # This target can be used with a `RACKET` that builds via `-l- setup --chain ...`
diff --git a/racket/src/regexp/Makefile b/racket/src/regexp/Makefile
index 61a5c7f435..6ef1f9e833 100644
--- a/racket/src/regexp/Makefile
+++ b/racket/src/regexp/Makefile
@@ -4,11 +4,6 @@
 RACKET = ../../bin/racket
 RACO = $(RACKET) -N raco -l- raco
 
-# Ignoring functions from `#%read` works beause they won't appear in
-# the simplified expansion, and declaring "collect.rkt" pure works
-# around a limitation of the flattener:
-IGNORE = ++knot read - ++pure ../../collects/racket/private/collect.rkt
-
 regexp-src:
 	$(RACO) make ../expander/bootstrap-run.rkt
 	$(MAKE) regexp-src-generate
@@ -19,7 +14,7 @@ GENERATE_ARGS = -t main.rkt \
                 --depends $(BUILDDIR)compiled/regexp-dep.rktd \
                 --makefile-depends $(DEPENDSDIR)compiled/regexp.rktl $(BUILDDIR)compiled/regexp.d \
                 -c $(BUILDDIR)compiled/cache-src \
-                -k ../.. $(IGNORE) -s -x \
+                -k ../.. -s -x \
                 -o $(BUILDDIR)compiled/regexp.rktl
 
 # This target can be used with a `RACKET` that builds via `-l- setup --chain ...`
@@ -33,6 +28,6 @@ demo:
 # Writes the extracted, compiled, decompiled expander to compiled/regexp.rkt
 decompile:
 	$(RACO) make ../expander/bootstrap-run.rkt
-	$(RACKET) $(RKT_ARGS) ../expander/bootstrap-run.rkt -t main.rkt -c compiled/cache-src $(IGNORE) -s -x -D -o compiled/regexp.rkt
+	$(RACKET) $(RKT_ARGS) ../expander/bootstrap-run.rkt -t main.rkt -c compiled/cache-src -s -x -D -o compiled/regexp.rkt
 
 .PHONY: regexp-src regexp-src-generate demo decompile
diff --git a/racket/src/thread/Makefile b/racket/src/thread/Makefile
index 06f95d9f79..f40d96392d 100644
--- a/racket/src/thread/Makefile
+++ b/racket/src/thread/Makefile
@@ -4,11 +4,6 @@
 RACKET = ../../bin/racket
 RACO = $(RACKET) -N raco -l- raco
 
-# Ignoring functions from `#%read` works beause they won't appear in
-# the simplified expansion, and declaring "collect.rkt" pure works
-# around a limitation of the flattener:
-IGNORE = ++knot read - ++direct pthread ++pure ../../collects/racket/private/collect.rkt
-
 thread-src:
 	$(RACO) make ../expander/bootstrap-run.rkt
 	$(MAKE) thread-src-generate
@@ -19,7 +14,7 @@ GENERATE_ARGS = -t main.rkt --submod main \
                 --depends $(BUILDDIR)compiled/thread-dep.rktd \
                 --makefile-depends $(DEPENDSDIR)compiled/thread.rktl $(BUILDDIR)compiled/thread.d \
                 -c $(BUILDDIR)compiled/cache-src \
-                -k ../.. $(IGNORE) -s -x \
+                -k ../.. -s -x \
                 -o $(BUILDDIR)compiled/thread.rktl
 
 # This target can be used with a `RACKET` that builds via `-l- setup --chain ...`