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

setup: change made to making

Browse Source 
Much easier a change than I was imagining.
This commit is contained in:
Kevin Tew 2011-05-11 11:46:30 -06:00
parent 7918d921ee
commit 2bc97ccf59
1 changed files with 12 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -70,7 +70,7 @@
(define (string-!empty? s) (not (zero? (string-length s)))) (define (string-!empty? s) (not (zero? (string-length s))))
(when (ormap string-!empty? (list out err)) (when (ormap string-!empty? (list out err))
(append-error cc "making" null out err "output")) (append-error cc "making" null out err "output"))
(when last (printer (current-output-port) "made" "~a" (cc-name cc))) ;(when last (printer (current-output-port) "made" "~a" (cc-name cc)))
#t] #t]
[else (eprintf "Failed trying to match:\n~v\n" result-type)]))] [else (eprintf "Failed trying to match:\n~v\n" result-type)]))]
[else [else
@ -89,6 +89,9 @@
;; assigns a collection to each worker to be compiled ;; assigns a collection to each worker to be compiled
;; when it runs out of collections, steals work from other workers collections ;; when it runs out of collections, steals work from other workers collections
(define/public (get-job workerid) (define/public (get-job workerid)
(define (say-making x)
(unless (null? x)
(printer (current-output-port) "making" "~a" (cc-name (car (car x))))))
(define (find-job-in-cc cc id) (define (find-job-in-cc cc id)
(define (retry) (get-job workerid)) (define (retry) (get-job workerid))
(define (build-job cc file last) (define (build-job cc file last)
@ -103,11 +106,16 @@
[(list (list cc (list) (list))) ;empty collect [(list (list cc (list) (list))) ;empty collect
(hash-remove! hash id) (retry)] (hash-remove! hash id) (retry)]
[(cons (list cc (list) (list)) tail) ;empty parent collect [(cons (list cc (list) (list)) tail) ;empty parent collect
(say-making tail)
(hash-set! hash id tail) (retry)] (hash-set! hash id tail) (retry)]
[(cons (list cc (list) subs) tail) ;empty srcs list [(cons (list cc (list) subs) tail) ;empty srcs list
(hash-set! hash id (append subs tail)) (retry)] (define nl (append subs tail))
(say-making nl)
(hash-set! hash id nl) (retry)]
[(cons (list cc (list file) subs) tail) [(cons (list cc (list file) subs) tail)
(hash-set! hash id (append subs tail)) (define nl (append subs tail))
(hash-set! hash id nl)
(say-making nl)
(build-job cc file #t)] (build-job cc file #t)]
[(cons (list cc (cons file ft) subs) tail) [(cons (list cc (cons file ft) subs) tail)
(hash-set! hash id (cons (list cc ft subs) tail)) (hash-set! hash id (cons (list cc ft subs) tail))
@ -125,6 +133,7 @@
; get next cc from cclst ; get next cc from cclst
[(pair? cclst) [(pair? cclst)
(define workercc (list (car cclst))) (define workercc (list (car cclst)))
(say-making workercc)
(set! cclst (cdr cclst)) (set! cclst (cdr cclst))
(hash-set! hash workerid workercc) (hash-set! hash workerid workercc)
(find-job-in-cc workercc workerid)] (find-job-in-cc workercc workerid)]