39 lines
1.1 KiB
Scheme
39 lines
1.1 KiB
Scheme
|
(define-record-type :rule
|
||
|
|
(really-make-rule prereqs wants-build? build-func)
|
||
|
|
is-rule?
|
||
|
|
(prereqs rule-prereqs)
|
||
|
|
(wants-build? rule-wants-build?)
|
||
|
|
(build-func rule-build-func))
|
||
|
|
|
||
|
|
(define rules (list))
|
||
|
|
(define lock-rules (make-lock))
|
||
|
|
|
||
|
|
(define (rule-make rule init-state)
|
||
|
|
(let* ((res-pres (map (lambda (prereq)
|
||
|
|
(rule-make prereq init-state))
|
||
|
|
(rule-prereqs rule)))
|
||
|
|
(res-wants-build? (call-with-values
|
||
|
|
(lambda ()
|
||
|
|
(apply values (append res-pres
|
||
|
|
(list init-state))))
|
||
|
|
(rule-wants-build? rule)))
|
||
|
|
(build? (car res-wants-build?))
|
||
|
|
(cooked-state (cdr res-wants-build?)))
|
||
|
|
(if build?
|
||
|
|
(call-with-values
|
||
|
|
(lambda ()
|
||
|
|
(apply values (append (list build?)
|
||
|
|
res-pres
|
||
|
|
(list cooked-state))))
|
||
|
|
(rule-build-func rule))
|
||
|
|
res-wants-build?)))
|
||
|
|
|
||
|
|
(define (make-rule prereqs wants-build? build-func)
|
||
|
|
(let ((rule (really-make-rule prereqs wants-build? build-func)))
|
||
|
|
(with-lock lock-rules
|
||
|
|
(lambda ()
|
||
|
|
(if (not (find (lambda (r) (eq? r rule)) rules))
|
||
|
|
(set! rules (cons rule rules))
|
||
|
|
(error "make-rule: rule already exists."))))
|
||
|
|
rule))
|