scsh-conservatory
/
scsh-make
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

make-rule now uses the sort function of dfs, added the predicate 

function position< therefore and changed the rule-node/sort-msgs
function accordingly.
fixed rule-node/make: now prereqs-results is checked for being an
empty list -> init-state is now passed properly, prereqs-results are
well-formed now. apply is only used for non-empty prereqs-results
(then the number of prereqs is unknown here).
This commit is contained in:
jottbee 2005-02-14 07:13:14 +00:00
parent 2479676e2d
commit b4382fa7b7
1 changed files with 48 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
make-rule.scm
View File

@ -86,51 +86,61 @@
rule-cmd-index
(make link shutdown))
(define (rule-node/sort-msgs unsorted to-order)
(map (lambda (pos)
(map (lambda (tmsg)
(let ((msg (tagged-msg-stripped tmsg))
(sender (tagged-msg-tag tmsg)))
(if (eq? sender pos)
msg)))
unsorted))
to-order))
(define (position< maybe-lesser maybe-greater objects)
(if (null? objects)
(error "position< has empty objects-list.")
(let search-objects ((current (car objects))
(todo (cdr objects)))
(cond
((= (tagged-msg-tag maybe-lesser) current) #t)
((= (tagged-msg-tag maybe-greater) current) #f)
((null? todo)
(error "position< maybe-lesser or maybe-greater not found."))
(else (search-objects (car todo) (cdr todo)))))))
;;; send each prereq-thread a make command and the init-state
;;; then wait for the results to return
;;; sort to the order they were sent and ciao
(define (rule-node/get-prereqs-results rule connect-ch recipients init-state)
(rule-node/sort-msgs (map
(lambda (recipient)
(send&collect/send connect-ch
(make-tagged-msg recipient
(rule-cmd make)))
(send&collect/receive connect-ch))
recipients)
recipients))
(define (rule-node/sort-msgs unsorted to-order)
(map tagged-msg-stripped
(sort (lambda (maybe-lesser maybe-greater)
(position< maybe-lesser maybe-greater to-order))
unsorted (list))))
(define (rule-node/prereqs-results rule connect-ch recipients)
(let ((unsorted-msgs (map (lambda (recipient)
(let ((tmsg (make-tagged-msg recipient
(rule-cmd make))))
(send&collect/send connect-ch tmsg)
(send&collect/receive connect-ch)))
recipients)))
(rule-node/sort-msgs unsorted-msgs recipients)))
(define (rule-node/make rule listen-ch connect-ch recipients init-state)
(let* ((prereqs-results (rule-node/get-prereqs-results rule connect-ch
recipients init-state))
(wants-build?-result (apply (rule-wants-build? rule)
(append prereqs-results (list init-state))))
(build-required? (car wants-build?-result))
(cooked-state (cdr wants-build?-result)))
(if build-required?
(make-rule-result wants-build?-result
(apply (rule-build-func rule)
(append (list build-required?)
prereqs-results
(list cooked-state))))
(make-rule-result wants-build?-result #f))))
(let ((prereqs-results (rule-node/prereqs-results rule connect-ch recipients)))
(let ((wants-build?-result (if (null? prereqs-results)
((rule-wants-build? rule) init-state)
(apply (rule-wants-build? rule)
(append prereqs-results
(list init-state))))))
(let ((build-required? (car wants-build?-result))
(cooked-state (cdr wants-build?-result)))
(if build-required?
(if (null? prereqs-results)
(make-rule-result wants-build?-result
((rule-build-func rule)
build-required? cooked-state))
(make-rule-result wants-build?-result
(apply (rule-build-func rule)
(append (list build-required?)
prereqs-results
(list cooked-state)))))
(make-rule-result wants-build?-result #f))))))
(define (rule-node/make-links rule connect-ch rule-set)
(let ((listen-chs (map (lambda (r)
(cdr (assq r (rule-set-rules rule-set))))
(rule-prereqs rule))))
(cdr (assq r (rule-set-rules rule-set))))
(rule-prereqs rule))))
(map (lambda (listen-ch)
(make-link connect-ch listen-ch))
listen-chs)))
(make-link connect-ch listen-ch))
listen-chs)))
(define (rule-node rule listen-ch init-state rule-set)
(let ((connect-ch (send&collect/make-channel)))