scsh-conservatory
/
scsh-make
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

rewrote (make-rule-result ...) using two named functions for tracing purposes 

fixed: build-func-result now returns (res . end-state)
This commit is contained in:
jottbee 2005-02-15 18:32:01 +00:00
parent bf7f4e2afb
commit 113cd54a71
1 changed files with 40 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
make-rule-no-cml.scm
View File

@ -39,27 +39,48 @@
(wants-build?-result rule-result-wants-build?) (wants-build?-result rule-result-wants-build?)
(build-func-result rule-result-build-func)) (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) (define (rule-make rule init-state rule-set)
(let* ((pre-results (map (lambda (prereq) (let* ((prereqs (rule-prereqs rule))
(if (assq prereq (rule-set-rules rule-set)) (prereqs-results (map (lambda (prereq)
(rule-make prereq init-state rule-set) (if (assq prereq (rule-set-rules rule-set))
(error "prerequisite is not in rule-set!"))) (rule-make prereq init-state rule-set)
(rule-prereqs rule))) (error "prerequisite is not in rule-set!")))
(wants-build?-result (if (null? prereqs-results) prereqs))
((rule-wants-build? rule) init-state) (wants-build?-result (apply-wants-build? rule prereqs
(apply (rule-wants-build? rule) prereqs-results init-state))
(append prereqs-results ;;; (wants-build?-result (if (null? prereqs)
(list init-state))))) ;;; ((rule-wants-build? rule) init-state)
;;; (apply (rule-wants-build? rule)
;;; (append prereqs-results
;;; (list init-state)))))
(build-required? (car wants-build?-result)) (build-required? (car wants-build?-result))
(cooked-state (cdr wants-build?-result))) (cooked-state (cdr wants-build?-result)))
(if build-required? (if build-required?
(if (null? prereqs-results) (let* ((build-func (rule-build-func rule))
(make-rule-result wants-build?-result ;;; (build-func-result (if (null? prereqs)
((rule-build-func rule) ;;; (build-func build-required? cooked-state)
build-required? cooked-state)) ;;; (apply build-func
(make-rule-result wants-build?-result ;;; (append (list build-required?)
(apply (rule-build-func rule) ;;; prereqs-results
(append (list build-required?) ;;; (list cooked-state)))))
prereqs-results (build-func-result (apply-build-func build-required? rule prereqs
(list cooked-state))))) 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)))) (make-rule-result wants-build?-result #f))))