scsh-make/make-rule-no-cml.scm

74 lines
2.5 KiB
Scheme
Raw Normal View History

2005-01-13 06:30:05 -05:00
(define-record-type :rule
2005-01-17 02:56:42 -05:00
(make-rule prereqs wants-build? build-func)
2005-01-13 06:30:05 -05:00
is-rule?
(prereqs rule-prereqs)
(wants-build? rule-wants-build?)
(build-func rule-build-func))
2005-01-17 02:56:42 -05:00
(define-record-type :rule-set
(make-rule-set rules)
is-rule-set?
(rules rule-set-rules))
2005-01-13 06:30:05 -05:00
2005-01-17 02:56:42 -05:00
(define (make-empty-rule-set)
(make-rule-set '()))
2005-01-13 06:30:05 -05:00
2005-01-17 02:56:42 -05:00
;;; 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))))