(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)) (make-rule-set (alist-cons rule listen-ch (rule-set-rules rule-set))) (error "make-rule: rule already exists.")))) (define-syntax rule-wants-build?* (syntax-rules () ((rule-wants-build?* ?rule ?init-state) ((rule-wants-build? ?rule) ?init-state)) ((rule-wants-build?* ?rule '() ?init-state) ((rule-wants-build? ?rule) ?init-state)) ((rule-wants-build?* ?rule (?p0-res ?p1-res ...) ?init-state) ((rule-wants-build? ?rule) ?p0-res ?p1-res ... ?init-state)))) (define-syntax rule-build-func* (syntax-rules () ((rule-build-func* ?rule ?cooked-state) (((rule-build-func ?rule) ?cooked-state))) ((rule-build-func* ?rule '() ?cooked-state) (((rule-build-func ?rule) ?cooked-state))) ((rule-build-func* ?rule ?wants-build?-result (?p0 ?p1 ...) ?cooked-state) (((rule-build-func ?rule) ?wants-build?-result ?p0 ?p1 ... ?cooked-state))))) ;;; ;;; 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)) (define (rule-make rule init-state rule-set) (let* ((pre-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!"))) (rule-prereqs rule))) (wants-build?-result (rule-wants-build?* rule pre-results init-state)) (build-required? (car wants-build?-result)) (cooked-state (cdr wants-build?-result))) (if build-required? (make-rule-result wants-build?-result (rule-build-func* rule build-required? pre-results cooked-state)) (make-rule-result wants-build?-result #f))))