From 8c1dbae88b45c9333c8c1d52c191e47cadfcd089 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 25 Jun 2019 08:41:45 -0600
Subject: [PATCH] expander: improve extractor to recognize once-set variables

When `set!` is used to tie a recursove knot in a flattened linklet,
the expander can recognize that pattern and not complain that a
mutable variable might be shared across places. Improving that
inference means fewer `++global-ok` flags in Makefiles.

This commit also avoids single-quote as an escaping form in a
makefile, which doesn't work with nmake on Windows.
---
 racket/src/expander/extract/global.rkt | 77 +++++++++++++++++++++++---
 racket/src/thread/Makefile             | 13 +----
 2 files changed, 71 insertions(+), 19 deletions(-)

diff --git a/racket/src/expander/extract/global.rkt b/racket/src/expander/extract/global.rkt
index 935605c42b..fdf92d183f 100644
--- a/racket/src/expander/extract/global.rkt
+++ b/racket/src/expander/extract/global.rkt
@@ -6,14 +6,15 @@
 (define (check-global linklet global-ok)
   (define es (cdddr linklet))
 
+  ;; Variables that are not under `lambda`:
   (define vars (make-hasheq))
 
-  ;; Get all variables that are not under `lambda`. That's not
-  ;; necessarily all variables that act like globals, since a
+  ;; Get all variables that are declared not under `lambda`. That's
+  ;; not necessarily all variables that act like globals, since a
   ;; top-level expression could call a function that allocates a
   ;; mutable variable, but it's close enough to be useful.
   (for ([e (in-list es)])
-    (let loop ([e e])
+    (define (loop e)
       (match e
         [`(define-values (,ids ...) ,rhs)
          (for ([id (in-list ids)])
@@ -21,18 +22,77 @@
          (loop rhs)]
         [`(lambda . ,_) (void)]
         [`(case-lambda . ,_) (void)]
-        [`(let-values ([,idss ,rhss] ...) ,bodys ...)
+        [`(let-values . ,_)
+         (not-under-lambda-let e)]
+        [`(letrec-values . ,_)
+         (not-under-lambda-let e)]
+        [`(,es ...)
+         (for ([e (in-list es)])
+           (loop e))]
+        [_ #f]))
+    (define (not-under-lambda-let e)
+      (match e
+        [`(,_ ([,idss ,rhss] ...) ,bodys ...)
          (for* ([ids (in-list idss)]
                 [id (in-list ids)])
            (hash-set! vars id #t))
          (for ([rhs (in-list rhss)])
            (loop rhs))
          (for ([body (in-list bodys)])
-           (loop body))]
+           (loop body))]))
+    (loop e))
+
+  ;; Variables that are potentially used after the
+  ;; linklet body completes
+  (define used-later-vars (make-hasheq))
+
+  ;; Exported variable are used later
+  (for ([ex (in-list (caddr linklet))])
+    (define sym (if (pair? ex) (car ex) ex))
+    (hash-set! used-later-vars sym #t))
+
+  ;; Fill `used-later-vars`, because any function not in that set is
+  ;; something that we don't need to worry about being called later,
+  ;; so we can ignore any side effects it may have. For example,
+  ;; `set!`s that just set up recursive bindings are ok, because they
+  ;; happen before the linklet body completes, and those are usually
+  ;; initialed by functions that are called only on startup.
+  (for ([e (in-list es)])
+    (define (now e)
+      (match e
+        [`(define-values (,ids ...) ,rhs)
+         (now rhs)]
+        [`(lambda ,_  ,bodys ...)
+         (for ([body (in-list bodys)])
+           (later body))]
+        [`(case-lambda [,_ ,bodyss ...] ...)
+         (for* ([bodys (in-list bodyss)]
+                [body (in-list bodys)])
+           (later body))]
+        [`(quote ,_) (void)]
+        [`(,es ...)
+         (unless (null? es)
+           (case (car es)
+             [(begin begin0 set! if) (void)]
+             [else
+              ;; The value of any identifier in an argument position
+              ;; might be used later
+              (for ([e (in-list (cdr es))])
+                (when (symbol? e)
+                  (later e)))]))
+         (for ([e (in-list es)])
+           (now e))]
+        [_ (void)]))
+    (define (later e)
+      (match e
+        [`(quote ,_) (void)]
         [`(,es ...)
          (for ([e (in-list es)])
-           (loop e))]
-        [_ #f])))
+           (later e))]
+        [_
+         (when (symbol? e)
+           (hash-set! used-later-vars e #t))]))
+    (now e))
 
   (define complained (make-hasheq))
 
@@ -51,6 +111,9 @@
   (for ([e (in-list es)])
     (let loop ([e e])
       (match e
+        [`(define-values (,id) (lambda ,_ ,bodys ...))
+         (when (hash-ref used-later-vars id #f)
+           (loop bodys))]
         [`(set! ,id ,rhs)
          (found-state! id e)
          (loop rhs)]
diff --git a/racket/src/thread/Makefile b/racket/src/thread/Makefile
index b53c75c2d3..c43f097521 100644
--- a/racket/src/thread/Makefile
+++ b/racket/src/thread/Makefile
@@ -20,25 +20,14 @@ DISALLOW = ++disallow error
 # global state to be ok:
 GLOBALS = --no-global \
           ++global-ok the-sandman \
-          ++global-ok sync-on-channel \
           ++global-ok post-shutdown-action \
           ++global-ok get-subprocesses-time \
-          ++global-ok force-atomic-timeout-callback \
           ++global-ok pre-poll-callbacks \
           ++global-ok queued-shutdowns \
-          ++global-ok place-ensure-wakeup! \
-          ++global-ok place-wakeup-initial \
-          ++global-ok place-wakeup \
           ++global-ok compute-memory-sizes \
-          ++global-ok check-place-activity \
           ++global-ok make-place-ports+fds \
-          ++global-ok future-block-for-atomic \
           ++global-ok pthread-count \
-          ++global-ok wakeup-this-place \
-          ++global-ok ensure-place-wakeup-handle \
-          ++global-ok futures-sync-for-custodian-shutdown \
-          ++global-ok 'future-scheduler-add-thread-custodian-mapping!' \
-          ++global-ok 'logging-future-events?' \
+          ++global-ok "logging-future-events?" \
           ++global-ok log-future-event