2005-01-18 10:45:27 -05:00
|
|
|
;;;
|
|
|
|
;;; 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)))
|
|
|
|
|
2005-01-18 14:28:50 -05:00
|
|
|
(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))))
|
2005-01-18 10:45:27 -05:00
|
|
|
|
|
|
|
;;; o every incoming rule is considered as a rule-candidate so it is added
|
|
|
|
;;; here first
|
2005-01-18 14:28:50 -05:00
|
|
|
(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)))))
|
2005-01-18 10:45:27 -05:00
|
|
|
|
|
|
|
(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))
|
2005-01-18 14:28:50 -05:00
|
|
|
(rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
|
2005-01-18 10:45:27 -05:00
|
|
|
(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))
|
2005-01-18 14:28:50 -05:00
|
|
|
(make-rule-trans-set rule-candidates
|
|
|
|
known-rules
|
|
|
|
(rule-set-add rule rule-set))))
|
2005-01-18 10:45:27 -05:00
|
|
|
|
|
|
|
;;; look for all rule-candidates that can be added to known-rules
|
|
|
|
(define (known-rules-update rule-trans-set)
|
2005-01-18 14:28:50 -05:00
|
|
|
(let ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)))
|
2005-01-18 10:45:27 -05:00
|
|
|
(map (lambda (candidate-desc)
|
|
|
|
(apply (lambda (target prereqs wants-build? build-func)
|
2005-01-18 14:28:50 -05:00
|
|
|
(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))
|
2005-01-18 10:45:27 -05:00
|
|
|
;;
|
|
|
|
;; get the (target prereqs wants-build? build-func)-list
|
|
|
|
;; for each target
|
|
|
|
;;
|
2005-01-18 14:28:50 -05:00
|
|
|
(map (lambda (target)
|
|
|
|
(rule-candidate-get rule-trans-set target))
|
2005-01-18 10:45:27 -05:00
|
|
|
;;
|
|
|
|
;; get all targets
|
|
|
|
;;
|
2005-01-18 14:28:50 -05:00
|
|
|
(map car rule-candidates)))))
|