added record type rule-cand

common-rules.scm

@@ -9,13 +9,13 @@
 (define (error-if-nonexistant target)
   (error "file (assumed leaf) doesn't exist:" target))
 
-(define (match-all-func default-target)
+(define (match-all-func will-be-target)
-  (list default-target 
+  (make-rule-cand will-be-target
 		  (list)
 		  (lambda args 
 		    (let ((target (car args))
 			  (init-state (last args)))
-	    (cons (file-not-exists? default-target) init-state)))
+		      (cons (file-not-exists? will-be-target) init-state)))
 		  (lambda args 
 		    (let ((target (car args))
 			  (cooked-state (last args)))

dfs.scm

@@ -181,7 +181,8 @@
       (cons (really-make-dfs name adjs (color black) time ignored)
 	    (delete current-node current-dag)))))
 
-(define (dfs-dag-show dag node)
+(define (dfs-dag-show dag . maybe-arg)
+  (let-optionals maybe-arg ((node (make-dfs "show dag" '() #f)))
     (newline) (newline) (newline) (newline)
     (display "************************************************************\n")
     (display (dfs-name node)) (newline)
@@ -209,7 +210,4 @@
 	    (dfs-node-show current-node)
 	    (if (not (null? nodes-to-do))
 		(visit-each-node (car nodes-to-do) (cdr nodes-to-do))
-	      (begin 
+		(newline)))))))
-		(display "************************************************************\n")
-		(display "************************************************************\n")
-		(newline) (newline) (newline) (newline)))))))

macros.scm

@@ -110,7 +110,7 @@
 					     (common-s/%/match prereq target-match)
 					     prereq))
 				       prereqs)))
-	     (list target-name
+	     (make-rule-cand target-name
 			     cooked-prereqs
 			     ;;out-to-date?-func 
 			     (lambda args 
@@ -131,7 +131,8 @@
 					  (bind-all-fluids target-name 
 							   cooked-prereqs 
 							   prereqs-results 
-						 (lambda () ?action0 ...))))
+							   (lambda () 
+							     ?action0 ...))))
 				       cooked-state)))))
 	   #f)))))
 
@@ -145,7 +146,7 @@
     ((clause->rc-tmp (tmp1 ...) pred (?func ?target () ?action0 ...))
      (let ((target ?target)
 	   (prereqs (list tmp1 ...)))
-       (list target 
+       (make-rule-cand target 
 		       prereqs 
 		       (lambda args 
 			 (let ((init-state (last args)))

packages.scm

@@ -181,6 +181,7 @@
   (open scheme-with-scsh
 	srfi-1
 	to-rule-set
+	rule-cand
 	dfs
 	autovars
 	templates
@@ -199,9 +200,11 @@
 (define-structure to-rule-set to-rule-set-interface
   (open scheme-with-scsh
 	srfi-1
+	srfi-9
 	templates
 	make-rule
 	common-rules
+	rule-cand
 	dfs)
   (files to-rule-set))
 
@@ -298,20 +301,33 @@
   (files autovars))
 
 (define-interface common-rules-interface
-  (export make-empty-common-rules
+  (export common-rcs->common-rules
+	  make-empty-common-rules
 	  add-common-rules
-	  search-match-in-common-rules
+	  search-match-in-common-rules))
-	  common-rcs->common-rules))
 
 (define-structure common-rules common-rules-interface
   (open scheme-with-scsh
 	autovars
 	srfi-1
 	srfi-9
-;	big-util
+	rule-cand
 	srfi-13)
   (files common-rules))
 
+(define-interface rule-cand-interface
+  (export make-rule-cand
+	  is-rule-cand?
+	  rule-cand-target
+	  rule-cand-prereqs
+	  rule-cand-up-to-date?-func
+	  rule-cand-build-func))
+
+(define-structure rule-cand rule-cand-interface
+  (open scheme-with-scsh
+	srfi-9)
+  (files rule-cand))
+
 (define-structure make (export make)
   (open scheme-with-scsh
 	srfi-1

rule-cand.scm

@@ -0,0 +1,7 @@
+(define-record-type :rule-cand
+  (make-rule-cand target prereqs up-to-date?-func build-func)
+  is-rule-cand?
+  (target rule-cand-target)
+  (prereqs rule-cand-prereqs)
+  (up-to-date?-func rule-cand-up-to-date?-func)
+  (build-func rule-cand-build-func))

templates.scm

@@ -140,4 +140,3 @@
 
 (define (paranoid target prereqs)
   (not (same-checksum? target digest-extensions prereqs)))
-

to-rule-set.scm

@@ -1,16 +1,16 @@
 (define (rc->dfs-node rc)
-  (let ((target (list-ref rc 0))
+  (let ((target (rule-cand-target rc))
-	(prereqs (list-ref rc 1))
+ 	(prereqs (rule-cand-prereqs rc))
-	(wants-build? (list-ref rc 2))
+	(wants-build? (rule-cand-up-to-date?-func rc))
-	(build-func (list-ref rc 3)))
+	(build-func (rule-cand-build-func rc)))
     (make-dfs target prereqs (list wants-build? build-func))))
 
 (define (rcs->dag rcs)
   (map (lambda (rc)
-	 (let ((target (list-ref rc 0))
+	 (let ((target (rule-cand-target rc))
-	       (prereqs (list-ref rc 1))
+	       (prereqs (rule-cand-prereqs rc))
-	       (wants-build? (list-ref rc 2))
+	       (wants-build? (rule-cand-up-to-date?-func rc))
-	       (build-func (list-ref rc 3)))
+	       (build-func (rule-cand-build-func rc)))
 	   (make-dfs target prereqs (list wants-build? build-func))))
        rcs))
 
@@ -23,19 +23,19 @@
 	   (if ignored
 	       (let ((wants-build? (car ignored))
 		     (build-func (cadr ignored)))
-		 (list target prereqs wants-build? build-func))
+		 (make-rule-cand target prereqs wants-build? build-func))
 	       (error "node without wants-build? and build-func"))))
        dag))
 
-(define (lookup-rc rc rcs)
+(define (lookup-rc pred rc rcs)
   (let ((maybe-rc (find (lambda (current) 
-			  (eq? (car rc) (car current))) 
+			  (pred (car rc) (car current))) 
 			rcs)))
     (if maybe-rc maybe-rc (error "lookup-rc: rc not found."))))
 
-(define (lookup-fname fname rcs)
+(define (lookup-fname pred fname rcs)
   (let ((maybe-fname (find (lambda (current)
-			     (eq? fname (car current)))
+			     (pred fname (car current)))
 			   rcs)))
     (if maybe-fname maybe-fname (error "lookup-fname: fname not found."))))
 
@@ -53,16 +53,18 @@
 			(rc->dfs-node 
 			 (search-match-in-common-rules common-rules
 						       maybe-target))))
-	 (sorted-dag (dfs (rcs->dag rule-candidates) pred #t create-leaf))
+	 (unsorted-dag (rcs->dag rule-candidates))
+	 (sorted-dag (dfs unsorted-dag pred #t create-leaf))
 	 (sorted-rcs (dag->rcs sorted-dag)))
+    ;; (dfs-dag-show sorted-dag)
     (if (not (null? sorted-rcs))
 	(let for-all-rcs ((rc (car sorted-rcs))
 			  (todo (cdr sorted-rcs))
 			  (last-done '()))
-	  (let* ((target (list-ref rc 0))
+	  (let* ((target (rule-cand-target rc))
-		 (prereqs (list-ref rc 1))
+		 (prereqs (rule-cand-prereqs rc))
-		 (wants-build? (list-ref rc 2))
+		 (wants-build? (rule-cand-up-to-date?-func rc))
-		 (build-func (list-ref rc 3))
+		 (build-func (rule-cand-build-func rc))
 		 (done (cons (cons target 
 				   (make-rule (map (lambda (prereq)
 						     (lookup-rule pred