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

Fixing some ugly line-widths in DrDr

Browse Source
This commit is contained in:
Jay McCarthy 2012-11-24 07:31:31 -07:00
parent 7d6dc98e0e
commit ecb88afd21
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
collects/meta/drdr/job-queue.rkt
View File

@ -28,26 +28,30 @@
jobs-ch jobs-ch
(match-lambda (match-lambda
[(? job? the-job) [(? job? the-job)
(working-manager (sub1 spaces) accept-new? (list* the-job jobs) continues)] (working-manager (sub1 spaces) accept-new?
(list* the-job jobs) continues)]
[(? done?) [(? done?)
(working-manager spaces #f jobs continues)])) (working-manager spaces #f jobs continues)]))
never-evt) never-evt)
(handle-evt (handle-evt
done-ch done-ch
(lambda (reply-ch) (lambda (reply-ch)
(working-manager spaces accept-new? jobs (list* reply-ch continues)))) (working-manager spaces accept-new?
jobs (list* reply-ch continues))))
(if (empty? jobs) (if (empty? jobs)
never-evt never-evt
(handle-evt (handle-evt
(async-channel-put-evt work-ch (first jobs)) (async-channel-put-evt work-ch (first jobs))
(lambda (_) (lambda (_)
(working-manager spaces accept-new? (rest jobs) continues)))) (working-manager spaces accept-new?
(rest jobs) continues))))
(map (map
(lambda (reply-ch) (lambda (reply-ch)
(handle-evt (handle-evt
(async-channel-put-evt reply-ch 'continue) (async-channel-put-evt reply-ch 'continue)
(lambda (_) (lambda (_)
(working-manager (add1 spaces) accept-new? jobs (remq reply-ch continues))))) (working-manager (add1 spaces) accept-new?
jobs (remq reply-ch continues)))))
continues)))) continues))))
(define (killing-manager left) (define (killing-manager left)
(unless (zero? left) (unless (zero? left)
@ -95,6 +99,7 @@
(provide/contract (provide/contract
[current-worker (parameter/c (or/c false/c exact-nonnegative-integer?))] [current-worker (parameter/c (or/c false/c exact-nonnegative-integer?))]
[job-queue? (any/c . -> . boolean?)] [job-queue? (any/c . -> . boolean?)]
[rename make-queue make-job-queue (exact-nonnegative-integer? . -> . job-queue?)] [rename make-queue make-job-queue
(exact-nonnegative-integer? . -> . job-queue?)]
[submit-job! (job-queue? (-> any) . -> . void)] [submit-job! (job-queue? (-> any) . -> . void)]
[stop-job-queue! (job-queue? . -> . void)]) [stop-job-queue! (job-queue? . -> . void)])