scsh-make/rule-trans-set.scm

;;;
;;; RULE-TRANS-SET
;;;
;;; (make-empty-rule-trans-set) ---> rule-trans-set
;;; 
;;; (make-rule-trans-set rule-candidates known-rules rule-set)
;;; 
;;; (rule-trans-set-rule-candidates rts) ---> (rule-candidate0 ...)
;;; (rule-trans-set-known-rules rts) ---> (known-rule0 ...)
;;; (rule-trans-set-rule-set rts) ---> rule-set
;;;
;;; (rule-trans-set-add! rule-trans-set target prereqs wants-build? build-func)
;;;   ---> rule-trans-set
;;; 
(define-record-type :rule-trans-set
  (make-rule-trans-set rule-candidates known-rules rule-set)
  is-rule-trans-set?
  (rule-candidates rule-trans-set-rule-candidates)
  (known-rules rule-trans-set-known-rules)
  (rule-set rule-trans-set-rule-set))

(define (make-empty-rule-trans-set)
  (let ((rule-candidates '())
	(known-rules (alist-cons '() '() '()))
	(rule-set (make-empty-rule-set)))
    (make-rule-trans-set rule-candidates known-rules rule-set)))

(define rule-trans-set-add! 
  (lambda (rule-trans-set target prereqs wants-build? build-func)
    (let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
	   (known-rules (rule-trans-set-known-rules rule-trans-set))
	   (rule-set (rule-trans-set-rule-set rule-trans-set))
	   (args (list rule-candidates target prereqs wants-build? build-func)))
      (apply rule-candidate-add! args)
      (known-rules-update rule-trans-set))))

;;; o  every incoming rule is considered as a rule-candidate so it is added
;;;    here first
(define rule-candidate-add! 
  (lambda (rule-candidates target prereqs wants-build? build-func)
    (let ((rule-args (list prereqs wants-build? build-func)))
      (set! rule-candidates (alist-cons target rule-args rule-candidates)))))

(define (rule-candidate-del! rule-candidates target)
  (alist-delete! target rule-candidates))

(define (rule-candidate-get rule-trans-set target)
  (let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
	 (maybe-rule-candidate (assq target rule-candidates)))
    (if maybe-rule-candidate
	(cons target (cdr (assq target rule-candidates)))
	maybe-rule-candidate)))

;;; o  if a target's prereqs are all in known-rules then the rule-candidate
;;;    can be added to the known-rules as a freshly created rule
;;; o  any rule-candidate with () as prereqs can be added to the known-rules
;;;    as well, so this will be the first element of the known-rules
(define (known-rules-add! rule-trans-set target prereqs wants-build? build-func)
  (let ((rule (make-rule prereqs wants-build? build-func))
	(rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
	(known-rules (rule-trans-set-known-rules rule-trans-set))
        (rule-set (rule-trans-set-rule-set rule-trans-set)))
    (set! known-rules (alist-cons target rule known-rules))
    (make-rule-trans-set rule-candidates 
			 known-rules 
			 (rule-set-add rule rule-set))))

;;; look for all rule-candidates that can be added to known-rules
(define (known-rules-update rule-trans-set)
  (let ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)))
    (map (lambda (candidate-desc) 
	   (apply (lambda (target prereqs wants-build? build-func)
		    (let ((rules (rule-trans-set-known-rules rule-trans-set)))
		      (if (not (memq #f (map (lambda (prereq) 
					       (assq prereq rules))
					     prereqs)))
			  (begin 
			    (rule-candidate-del! rule-trans-set target)
			    (set! rule-trans-set 
				  (apply known-rules-add! 
					 (append (list rule-trans-set)
						 candidate-desc))))
			  rule-trans-set)))
		    candidate-desc))
	 ;;
	 ;; get the (target prereqs wants-build? build-func)-list
	 ;; for each target
	 ;;
	 (map (lambda (target) 
		(rule-candidate-get rule-trans-set target))
	      ;;
	      ;; get all targets 
	      ;;
	      (map car rule-candidates)))))