(define-record-type :rule (make-rule prereqs wants-build? build-func) is-rule? (prereqs rule-prereqs) (wants-build? rule-wants-build?) (build-func rule-build-func)) (define-record-type :rule-set (make-rule-set rules) is-rule-set? (rules rule-set-rules)) (define (make-empty-rule-set) (make-rule-set '())) ;;; listen-ch is a dummy here ;;; now this and the one in make-rule.scm ;;; are almost the same functions (define (rule-set-add rule rule-set) (let ((listen-ch #f)) (if (not (assq rule (rule-set-rules rule-set))) (make-rule-set (alist-cons rule listen-ch (rule-set-rules rule-set))) (error "make-rule: rule already exists.")))) ;;; ;;; RULE-RESULT ;;; ;;; (rule-result-wants-build? rule-result) ---> ;;; (wants-build?-result . cooked-state) oder (#f . cooked-state) ;;; ;;; (rule-result-build-func rule-result) ---> ;;; (build-func-result . end-state) oder #f ;;; ;;; (rule-make rule init-state rule-set) ---> rule-result ;;; (define-record-type :rule-result (make-rule-result wants-build?-result build-func-result) is-rule-result? (wants-build?-result rule-result-wants-build?) (build-func-result rule-result-build-func)) ;;; a named function mainly for tracing purposes (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)))))) ;;; a named function mainly for tracing purposes (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-make rule init-state rule-set) (let* ((prereqs (rule-prereqs rule)) (prereqs-results (map (lambda (prereq) (if (assq prereq (rule-set-rules rule-set)) (rule-make prereq init-state rule-set) (error "prerequisite is not in rule-set!"))) prereqs)) (wants-build?-result (apply-wants-build? rule prereqs prereqs-results init-state)) ;;; (wants-build?-result (if (null? prereqs) ;;; ((rule-wants-build? rule) init-state) ;;; (apply (rule-wants-build? rule) ;;; (append prereqs-results ;;; (list init-state))))) (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) ;;; (build-func build-required? cooked-state) ;;; (apply build-func ;;; (append (list build-required?) ;;; prereqs-results ;;; (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))))