From d96bfb6e29c0505364c7048623797d92cd4050f0 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 13 May 2014 08:59:43 -0600
Subject: [PATCH] setup/dirs et al.: thread-safe promises

Use `delay/sync` instead of `delay`.
---
 racket/collects/racket/date.rkt   |  4 +--
 racket/collects/setup/dirs.rkt    | 43 +++++++++++++++++--------------
 racket/collects/setup/variant.rkt | 25 +++++++++---------
 3 files changed, 39 insertions(+), 33 deletions(-)

diff --git a/racket/collects/racket/date.rkt b/racket/collects/racket/date.rkt
index 4a34bdea40..b604c03146 100644
--- a/racket/collects/racket/date.rkt
+++ b/racket/collects/racket/date.rkt
@@ -221,11 +221,11 @@
           (loop hi (* 2 offset)))))))
 
 (define get-min-seconds
-  (let ([d (delay (find-extreme-date-seconds (current-seconds) -1))])
+  (let ([d (delay/sync (find-extreme-date-seconds (current-seconds) -1))])
     (lambda ()
       (force d))))
 (define get-max-seconds
-  (let ([d (delay (find-extreme-date-seconds (current-seconds) 1))])
+  (let ([d (delay/sync (find-extreme-date-seconds (current-seconds) 1))])
     (lambda ()
       (force d))))
 
diff --git a/racket/collects/setup/dirs.rkt b/racket/collects/setup/dirs.rkt
index c02579ffcd..7966062bd2 100644
--- a/racket/collects/setup/dirs.rkt
+++ b/racket/collects/setup/dirs.rkt
@@ -18,18 +18,19 @@
 ;; config: definitions
 
 (define config-table
-  (delay (let ([d (find-config-dir)])
-           (if d
-               (let ([p (build-path d "config.rktd")])
-                 (if (file-exists? p)
-                     (call-with-input-file* 
-                      p
-                      (lambda (in) 
-                        (call-with-default-reading-parameterization
-                         (lambda ()
-                           (read in)))))
-                     #hash()))
-               #hash()))))
+  (delay/sync
+   (let ([d (find-config-dir)])
+     (if d
+         (let ([p (build-path d "config.rktd")])
+           (if (file-exists? p)
+               (call-with-input-file* 
+                p
+                (lambda (in) 
+                  (call-with-default-reading-parameterization
+                   (lambda ()
+                     (read in)))))
+               #hash()))
+         #hash()))))
 
 (define (to-path l)
   (cond [(string? l) (simplify-path (complete-path (string->path l)))]
@@ -45,7 +46,7 @@
           (find-main-collects))]))
 
 (define-syntax-rule (define-config name key wrap)
-  (define name (delay
+  (define name (delay/sync
                  (wrap 
                   (hash-ref (force config-table) key #f)))))
 
@@ -104,7 +105,9 @@
   (combine-search (force config:collects-search-dirs)
                   (list (find-collects-dir))))
 (define user-collects-dir
-  (delay (simplify-path (build-path (find-system-path 'addon-dir) (get-installation-name) "collects"))))
+  (delay/sync (simplify-path (build-path (find-system-path 'addon-dir)
+                                         (get-installation-name)
+                                         "collects"))))
 (define (find-user-collects-dir)
   (force user-collects-dir))
 (define (get-collects-search-dirs)
@@ -139,7 +142,9 @@
        (define-finder provide config:id id get-false default)
        (provide user-id)
        (define user-dir
-         (delay (simplify-path (build-path (find-system-path 'addon-dir) (get-installation-name) user-default))))
+         (delay/sync (simplify-path (build-path (find-system-path 'addon-dir)
+                                                (get-installation-name)
+                                                user-default))))
        (define (user-id)
          (force user-dir)))]
     [(_ provide config:id id user-id config:search-id search-id default)
@@ -165,7 +170,7 @@
        #'(begin
            (provide id)
            (define dir
-             (delay
+             (delay/sync
                (or (force config:id) (get-default))))
            (define (id)
              (force dir))))]
@@ -174,7 +179,7 @@
        #'(begin
            (provide id)
            (define dir
-             (delay
+             (delay/sync
                (or (force config:id)
                    (let ([p (find-collects-dir)])
                      (and p (simplify-path (build-path p 'up default)))))))
@@ -188,7 +193,7 @@
 ;; ----------------------------------------
 ;; "doc"
 
-(define delayed-#f (delay #f))
+(define delayed-#f (delay/sync #f))
 
 (provide find-doc-dir
          find-user-doc-dir
@@ -280,7 +285,7 @@
 
 (provide find-dll-dir)
 (define dll-dir
-  (delay
+  (delay/sync
     (case (system-type)
       [(windows)
        ;; Extract "lib" location from binary:
diff --git a/racket/collects/setup/variant.rkt b/racket/collects/setup/variant.rkt
index a8424e6036..09ead3e51e 100644
--- a/racket/collects/setup/variant.rkt
+++ b/racket/collects/setup/variant.rkt
@@ -5,18 +5,19 @@
 (provide variant-suffix)
 
 (define plain-mz-is-cgc?
-  (delay (let* ([dir (find-console-bin-dir)]
-                [exe (cond [(eq? 'windows (system-type)) "Racket.exe"]
-                           [(equal? #".dll" (system-type 'so-suffix))
-                            ;; in cygwin so-suffix is ".dll"
-                            "racket.exe"]
-                           [else "racket"])]
-                [f (build-path dir exe)])
-           (and (file-exists? f)
-                (with-input-from-file f
-                  (lambda ()
-                    (regexp-match? #rx#"bINARy tYPe:..c"
-                                   (current-input-port))))))))
+  (delay/sync
+   (let* ([dir (find-console-bin-dir)]
+          [exe (cond [(eq? 'windows (system-type)) "Racket.exe"]
+                     [(equal? #".dll" (system-type 'so-suffix))
+                      ;; in cygwin so-suffix is ".dll"
+                      "racket.exe"]
+                     [else "racket"])]
+          [f (build-path dir exe)])
+     (and (file-exists? f)
+          (with-input-from-file f
+            (lambda ()
+              (regexp-match? #rx#"bINARy tYPe:..c"
+                             (current-input-port))))))))
 
 (define (variant-suffix variant cased?)
   (let ([r (case variant