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

shorten some lines

Browse Source
This commit is contained in:
Kevin Tew 2010-11-02 14:11:26 -06:00
parent c7700dbe06
commit 3ec54a61c2
1 changed files with 43 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/setup/parallel-do.rkt
View File

@ -93,15 +93,13 @@
(send/msg cmd-list in))])
(loop idle (cons (list job wrkr) inflight) count error-count)))]
;; Queue empty and all workers idle, we are all done
[(list (and (? empty?) idle) (list) count error-count)
(set! workers idle)]
[(list (and (? empty?) idle) (list) count error-count) (set! workers idle)]
;; Wait for reply from worker
[(list idle inflight count error-count)
(apply sync (map (λ (node-worker) (match node-worker
[(list node (and wrkr (worker id sh out in err)))
(handle-evt out (λ (e)
(let ([msg
(with-handlers* ([exn:fail? (lambda (e)
(let ([msg (with-handlers* ([exn:fail? (lambda (e)
(printf "MASTER READ ERROR - reading from worker: ~a\n" (exn-message e))
(kill-worker wrkr)
(loop (cons (spawn id) idle)
@ -110,8 +108,7 @@
(add1 error-count)))])
(read out))])
(work-done jobqueue node id msg)
(loop
(cons wrkr idle)
(loop (cons wrkr idle)
(remove node-worker inflight)
(add1 count)
error-count))))]))
@ -119,9 +116,7 @@
inflight))])])
(loop workers null 0 0)))
(lambda ()
(for ([p workers])
(with-handlers ([exn? void])
(send/msg (list 'DIE) (worker-in p))))
(for ([p workers]) (with-handlers ([exn? void]) (send/msg (list 'DIE) (worker-in p))))
(for ([p workers]) (subprocess-wait (worker-process-handle p))))))
(define (parallel-do-default-error-handler work error-message outstr errstr)
@ -129,9 +124,8 @@
(printf "STDOUT\n~a=====\n" outstr)
(printf "STDERR\n~a=====\n" errstr))
(define-struct list-queue (queue results create-job-thunk success-thunk failure-thunk) #:transparent
#:mutable
#:property prop:jobqueue
(define-struct list-queue (queue results create-job-thunk success-thunk failure-thunk)
#:transparent #:mutable #:property prop:jobqueue
(define-methods jobqueue
(define (work-done jobqueue work workerid msg)
(match msg