suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

setup/dirs et al.: thread-safe promises

Browse Source 
Use `delay/sync` instead of `delay`.
This commit is contained in:
Matthew Flatt 2014-05-13 08:59:43 -06:00
parent 7ac92703dc
commit d96bfb6e29
3 changed files with 39 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/collects/racket/date.rkt
View File

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

43
racket/collects/setup/dirs.rkt
View File

@ -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:

25
racket/collects/setup/variant.rkt
View File

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