added start/stop threads; multiple rule-make commands do work now.

make-rule.scm

@@ -64,17 +64,31 @@
   (wants-build?-result rule-result-wants-build?)
   (build-func-result rule-result-build-func))
 
+(define (start-threads init-state rule-set)
+  (map (lambda (rule) 
+	 (let ((listen-ch (rule-set-get-listen-ch rule rule-set)))
+	   (rule-node rule listen-ch init-state rule-set)))
+       (map car (rule-set-rules rule-set))))
+
+(define (stop-threads init-state rule-set)
+  (map (lambda (rule) 
+	 (let* ((server (rule-set-get-listen-ch rule rule-set))
+		(client (send&collect/make-channel))
+		(link (make-link client server))
+		(recipient (car link))
+		(shutdown (make-tagged-msg recipient (rule-cmd shutdown))))
+	   (send&collect/send client shutdown)))
+       (map car (rule-set-rules rule-set))))
+
 (define (rule-make rule init-state rule-set)
-  (map (lambda (r) 
+  (start-threads init-state rule-set)
-	 (rule-node r (rule-set-get-listen-ch r rule-set) init-state rule-set))
-       (map car (rule-set-rules rule-set)))
   (let* ((server (rule-set-get-listen-ch rule rule-set))
 	 (client (send&collect/make-channel))
 	 (link (make-link client server))
-	 (recipient (car link)))
+ 	 (recipient (car link)))
     (send&collect/send client (make-tagged-msg recipient (rule-cmd make)))
     (let ((res (tagged-msg-stripped (send&collect/receive client))))
-;      (send&collect/send client (make-tagged-msg recipient (rule-cmd shutdown)))
+      (stop-threads init-state rule-set)
       res)))
 
 (define-enumerated-type rule-cmd :rule-cmd
@@ -123,23 +137,45 @@
 			    recipients)))
     (rule-node/sort-msgs unsorted-msgs recipients)))
 
+;;; named function for tracing
+(define (apply-build-func build-required? rule prereqs prereqs-results cooked-state)
+  (let ((build-func (rule-build-func rule)))
+    (if (null? prereqs)
+	(build-func build-required? cooked-state)
+	(apply build-func
+	       (append (list build-required?) 
+		       prereqs-results (list cooked-state))))))
+
+;;; named function for tracing
+(define (apply-wants-build? rule prereqs prereqs-results init-state)
+  (let ((wants-build? (rule-wants-build? rule)))
+    (if (null? prereqs)
+	(wants-build? init-state)
+	(apply wants-build? (append prereqs-results (list init-state))))))
+
 (define (rule-node/make rule listen-ch connect-ch recipients init-state)
-  (let ((prereqs-results (rule-node/prereqs-results rule connect-ch recipients)))
+  (let ((prereqs (rule-prereqs rule))
-    (let ((wants-build?-result (if (null? prereqs-results)
+	(prereqs-results (rule-node/prereqs-results rule connect-ch recipients)))
-				   ((rule-wants-build? rule) init-state)
+    (let ((wants-build?-result 
-				   (apply (rule-wants-build? rule)
+	   (apply-wants-build? rule prereqs prereqs-results init-state)))
-					  (append prereqs-results 
+;;;     (let ((wants-build?-result (if (null? prereqs-results)
-						  (list init-state))))))
+;;; 				   ((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? 
 	    (let* ((build-func (rule-build-func rule))
-		   (build-func-result (if (null? prereqs-results)
+;;; 		   (build-func-result (if (null? prereqs-results)
-					  (build-func build-required? cooked-state)
+;;; 					  (build-func build-required? cooked-state)
-					  (apply build-func
+;;; 					  (apply build-func
-						 (append (list build-required?)
+;;; 						 (append (list build-required?)
-							 prereqs-results 
+;;; 							 prereqs-results 
-							 (list cooked-state)))))
+;;; 							 (list cooked-state)))))
+		   (build-func-result 
+		    (apply-build-func build-required? rule prereqs 
+				      prereqs-results cooked-state))
 		   (end-state (cdr build-func-result)))
 	      (make-rule-result wants-build?-result build-func-result))
 	    (make-rule-result wants-build?-result #f))))))
@@ -152,6 +188,15 @@
            (make-link connect-ch listen-ch))
          listen-chs)))
 
+;;; (define (lookup-target rule rule-alist)
+;;;   (let ((maybe-targets (filter (lambda (r) (eq? (cdr r) rule)) rule-alist)))
+;;;     (if (not (null? maybe-targets))
+;;; 	(car (car maybe-targets))
+;;; 	(error "lookup-target: rule not found in rule-alist."))))
+;;; 
+;;; (define target/rule-alist '())
+;;; (define (set!-target/rule-alist alist) (set! target/rule-alist alist))
+
 (define (rule-node rule listen-ch init-state rule-set)
   (let* ((connect-ch (send&collect/make-channel))
 	 (get-rcpts (lambda ()
@@ -165,11 +210,14 @@
 			(collect&reply/send listen-ch reply)))))
     (spawn
       (lambda () 
+;;;	(display (lookup-target rule target/rule-alist)) (newline)
 	(let node-loop ((tmsg (collect&reply/receive listen-ch))
 			(rcpts (get-rcpts)))
 	  (cond
 	   ((eq? (rule-cmd-name (tagged-msg-stripped tmsg)) 'make)
 	    (do-answer tmsg rcpts))
+	   ((eq? (rule-cmd-name (tagged-msg-stripped tmsg)) 'shutdown)
+	    (terminate-current-thread))
 	   (else (error "rule-node: no match")))
 	  (node-loop (collect&reply/receive listen-ch) rcpts)))
       'rule-node)))