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

compile the tool files in addition to the framework and drracket when PLTDRPAR is set

Browse Source
This commit is contained in:
Robby Findler 2011-02-09 18:44:07 -06:00
parent 4d9c150b7b
commit 00152d2482
1 changed files with 48 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
collects/drracket/drracket.rkt
View File

@ -63,12 +63,43 @@
(run-trace-thread)))] (run-trace-thread)))]
[first-parallel? [first-parallel?
(flprintf "PLTDRPAR: loading compilation manager\n") (flprintf "PLTDRPAR: loading compilation manager\n")
(define tools? (not (getenv "PLTNOTOOLS")))
(define (files-in-coll coll) (define (files-in-coll coll)
(define dir (collection-path coll)) (define dir (collection-path coll))
(map (λ (x) (build-path dir x)) (map (λ (x) (build-path dir x))
(filter (filter
(λ (x) (regexp-match #rx"rkt$" (path->string x))) (λ (x) (regexp-match #rx"rkt$" (path->string x)))
(directory-list dir)))) (directory-list dir))))
(define (randomize lst)
(define vec (make-vector (length lst) #f))
(let loop ([i 0]
[lst lst])
(cond
[(= i (vector-length vec)) (void)]
[else
(define index (random (- (vector-length vec) i)))
(define ele (list-ref lst index))
(vector-set! vec i ele)
(loop (+ i 1) (remq ele lst))]))
(vector->list vec))
(define (tool-files id)
(apply
append
(map
(λ (x)
(define-values (base name dir) (split-path x))
(define proc (get-info/full x))
(if proc
(map (λ (dirs)
(apply build-path base
(if (list? dirs)
dirs
(list dirs))))
(proc id (λ () '())))
'()))
(find-relevant-directories (list id)))))
(define make-compilation-manager-load/use-compiled-handler (define make-compilation-manager-load/use-compiled-handler
(parameterize ([current-namespace (make-base-empty-namespace)]) (parameterize ([current-namespace (make-base-empty-namespace)])
(dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler))) (dynamic-require 'compiler/cm 'make-compilation-manager-load/use-compiled-handler)))
@ -76,15 +107,27 @@
(flprintf "PLTDRPAR: enabling CM tracing\n") (flprintf "PLTDRPAR: enabling CM tracing\n")
(run-trace-thread)) (run-trace-thread))
(flprintf "PLTDRPAR: loading setup/parallel-build\n") (flprintf "PLTDRPAR: loading setup/parallel-build\n")
(define parallel-compile-files (define-values (parallel-compile-files get-info/full find-relevant-directories)
(parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)]) (parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler)])
(dynamic-require 'setup/parallel-build 'parallel-compile-files))) (values (dynamic-require 'setup/parallel-build 'parallel-compile-files)
(flprintf "PLTDRPAR: parallel compile of framework & drracket\n") (and tools? (dynamic-require 'setup/getinfo 'get-info/full))
(parallel-compile-files (append (files-in-coll "drracket") (files-in-coll "framework")) (and tools? (dynamic-require 'setup/getinfo 'find-relevant-directories)))))
(if tools?
(flprintf "PLTDRPAR: parallel compile of framework, drracket, and tools\n")
(flprintf "PLTDRPAR: parallel compile of framework and drracket\n"))
(parallel-compile-files (randomize (append (files-in-coll "drracket")
(files-in-coll "framework")
(if tools?
(append (tool-files 'drracket-tools)
(tool-files 'tools))
'())))
#:handler #:handler
(λ (handler-type path msg out err) (λ (handler-type path msg out err)
(case handler-type (case handler-type
[(done) (void)] [(done)
(when cm-trace?
(printf "PLTDRPAR: made ~a\n" path))]
[else [else
(printf "~a\n" msg) (printf "~a\n" msg)
(printf "stdout from compiling ~a:\n~a\n" path out) (printf "stdout from compiling ~a:\n~a\n" path out)