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

cosmetics

This commit is contained in:
jottbee 2005-04-11 19:49:11 +00:00
parent 2b8a9709a6
commit b161de726d
2 changed files with 51 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
jobd.scm
View File

@ -1,7 +1,6 @@
(define-record-type :jobd
(really-make-jobd version-s job-c sig-mc)
jobd?
(version-s jobd-version-s)
(job-c jobd-job-c)
(sig-mc jobd-sig-mc))
@ -40,8 +39,8 @@
(cml-sync-ch/send to-process-element signal/stop))
((eq? (jobber-sig-name sig) 'continue)
(cml-sync-ch/send to-process-element signal/cont))
(else (error "jobber: jobber-sig->signal received unknown jobber-sig."))))
(else (error "jobber: jobber-sig->signal received unknown object."))))
(else (error "jobber-sig->signal: unknown jobber-sig."))))
(else (error "jobber-sig->signal: unknown object."))))
(define (job-desc->job-res id sig-mport j-des+res-ch)
(let* ((j-des (car j-des+res-ch))
@ -76,25 +75,23 @@
(loop))))
(format #t "jobber (no. ~a)\n" id)))
(define (make-jobd . maybe-args)
(let-optionals maybe-args ((jobd-vers "jobd-version"))
(let* ((version jobd-vers)
(job-ch (cml-async-ch/make-async-channel))
(sig-m-ch (cml-mcast-ch/make-mcast-channel))
(start-jobber (lambda (id)
(let ((new-mport (cml-mcast-ch/mcast-port sig-m-ch)))
(define (make-jobd)
(let* ((job-ch (cml-async-ch/make-async-channel))
(sig-m-ch (cml-mcast-ch/make-mcast-channel))
(start-jobber (lambda (id)
(let ((new-mport (cml-mcast-ch/mcast-port sig-m-ch)))
(jobber id job-ch new-mport)))))
(for-each start-jobber (enumerate jobbers))
(really-make-jobd version job-ch sig-m-ch))))
(for-each start-jobber (enumerate jobbers))
(really-make-jobd job-ch sig-m-ch))))
(define (version jobd)
(jobd-version-s jobd))
(define (execute job-desc jobd)
(define (execute-rv job-desc jobd)
(let ((res-ch (cml-async-ch/make-async-channel)))
(cml-async-ch/send-async (jobd-job-c jobd) (cons job-desc res-ch))
(cml-async-ch/receive-async-rv res-ch)))
(define (execute job-desc jobd)
(cml-rv/sync (execute-rv job-desc jobd)))
(define (shutdown jobd)
(cml-mcast-ch/mcast (jobd-sig-mc jobd) (jobber-sig shutdown)))

56
macros.scm
View File

@ -30,29 +30,49 @@
(define-syntax common-rx-clause->func
(syntax-rules ()
((common-rx-clause->func pred
(?out-of-date?-func ?target-rx
(?prereq-pattern0 ...)
?action0 ...))
((common-rx-clause->func pred (?func ?target (?pre0 ...) ?act0 ...))
(common-rx-clause->func-tmp () pred (?func ?target (?pre0 ...) ?act0 ...)))))
(define-syntax common-rx-clause->func-tmp
(syntax-rules ()
((common-rx-clause->func (tmp1 ...) pred (?func ?target-rx () ?act0 ...))
(lambda (maybe-target)
(let ((target-rx ?target-rx)
(thunk (lambda () ?action0 ...))
(prereqs (list ?prereq-pattern0 ...)))
(common->func maybe-target target-rx pred
?out-of-date?-func ?target-rx prereqs thunk))))))
(let ((trx ?target-rx)
(thunk (lambda () ?act0 ...))
(prereqs (list tmp1 ...)))
(common->func maybe-target trx pred ?func ?target-rx prereqs thunk))))
((common-rx-clause->func-tmp (tmp1 ...)
pred
(?func ?target (?pre0 ?pre1 ...) ?act0 ...))
(let ((tmp2 ?pre0))
(common-rx-clause->func-tmp (tmp1 ... tmp2)
pred
(?func ?target (?pre1 ...) ?act0 ...))))))
(define-syntax common-%-clause->func
(syntax-rules ()
((common-%-clause->func pred
(?out-of-date?-func ?target-pattern
(?prereq-pattern0 ...)
?action0 ...))
((common-%-clause->func pred (?func ?target ?prereqs ?act0 ...))
(common-%-clause->func-tmp () pred (?func ?target ?prereqs ?act0 ...)))))
(define-syntax common-%-clause->func-tmp
(syntax-rules ()
((common-%-clause->func-tmp (tmp1 ...) pred (?func ?target () ?act0 ...))
(lambda (maybe-target)
(let ((target-rx (%-pattern->rx ?target-pattern))
(thunk (lambda () ?action0 ...))
(prereqs (list ?prereq-pattern0 ...)))
(common->func maybe-target target-rx pred
?out-of-date?-func ?target-pattern prereqs thunk))))))
(let ((trx (%-pattern->rx ?target))
(thunk (lambda () ?act0 ...))
(prereqs (list tmp1 ...)))
(common->func maybe-target trx pred ?func ?target prereqs thunk))))
((common-%-clause->func-tmp (tmp1 ...)
pred
(?func ?target (?pre0 ?pre1 ...) ?act0 ...))
(let ((tmp2 ?pre0))
(common-%-clause->func-tmp (tmp1 ... tmp2)
pred
(?func ?target (?pre1 ...) ?act0 ...))))
((common-%-clause->func-tmp () pred (?func ?target ?prereqs ?act0 ...))
(let ((prereqs ?prereqs))
(common-%-clause->func-tmp () pred (?func ?target prereqs ?act0 ...))))))
(define-syntax clause->rc
(syntax-rules ()