87 lines
3.0 KiB
Scheme
87 lines
3.0 KiB
Scheme
(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))))
|