cosmetics

jobd.scm

@@ -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-sig->signal: unknown jobber-sig."))))
-   (else (error "jobber: jobber-sig->signal received unknown object."))))
+   (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)
+(define (make-jobd)
-  (let-optionals maybe-args ((jobd-vers "jobd-version"))
+  (let* ((job-ch (cml-async-ch/make-async-channel))
-    (let* ((version jobd-vers) 
+	 (sig-m-ch (cml-mcast-ch/make-mcast-channel))
-	   (job-ch (cml-async-ch/make-async-channel))
+	 (start-jobber (lambda (id) 
-	   (sig-m-ch (cml-mcast-ch/make-mcast-channel))
+			 (let ((new-mport (cml-mcast-ch/mcast-port sig-m-ch)))
-	   (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))
+    (for-each start-jobber (enumerate jobbers))
-      (really-make-jobd version job-ch sig-m-ch))))
+    (really-make-jobd job-ch sig-m-ch))))
 
-(define (version jobd)
+(define (execute-rv job-desc jobd)
-  (jobd-version-s jobd))
-
-(define (execute 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)))
 

macros.scm

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