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

Remove unused code

Browse Source
This commit is contained in:
Kevin Tew 2011-01-17 11:50:37 -07:00
parent e5cc1dec84
commit d94281bb96
1 changed files with 3 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/setup/parallel-build.rkt
View File

@ -8,6 +8,9 @@
setup/parallel-do
racket/class)
(provide parallel-compile)
(define Lock-Manager% (class object%
(field (locks (make-hash)))
(define/public (lock fn wrkr)
@ -31,10 +34,6 @@
(lm/lock lock fn wrkr)
(lm/unlock unlock fn))
(provide parallel-compile
parallel-build-worker)
(define CollectsQueue% (class* object% (WorkQueue<%>)
(init-field cclst collects-dir printer append-error)
(field (lock-mgr (new Lock-Manager%)))
@ -157,41 +156,3 @@
"setup/parallel-build-worker.rkt")
(make-object CollectsQueue% collects-tree collects-dir setup-fprintf append-error)
worker-count 999999999)))
(define (parallel-build-worker)
(define prev-uncaught-exception-handler (uncaught-exception-handler))
(uncaught-exception-handler (lambda (x)
(when (exn:break? x) (exit 1))
(prev-uncaught-exception-handler x)))
(let ([cmc (make-caching-managed-compile-zo)]
[worker-id (read)])
(let loop ()
(match (read)
[(list 'DIE) void]
[(list name dir file)
(let ([dir (bytes->path dir)]
[file (bytes->path file)])
(let ([out-str-port (open-output-string)]
[err-str-port (open-output-string)])
(define (send/resp type)
(let ([msg (list type (get-output-string out-str-port) (get-output-string err-str-port))])
(write msg)))
(let ([cep (current-error-port)])
(define (pp x)
(fprintf cep "COMPILING ~a ~a ~a ~a\n" worker-id name file x))
(with-handlers ([exn:fail? (lambda (x)
(send/resp (list 'ERROR (exn-message x))))])
(parameterize (
[current-namespace (make-base-empty-namespace)]
[current-directory dir]
[current-load-relative-directory dir]
[current-output-port out-str-port]
[current-error-port err-str-port]
;[manager-compile-notify-handler pp]
)
(cmc (build-path dir file)))
(send/resp 'DONE))))
(flush-output)
(loop))]))))