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

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

@ -39,27 +39,48 @@
(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* ((pre-results (map (lambda (prereq)
(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!")))
(rule-prereqs rule)))
(wants-build?-result (if (null? prereqs-results)
((rule-wants-build? rule) init-state)
(apply (rule-wants-build? rule)
(append prereqs-results
(list init-state)))))
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?
(if (null? prereqs-results)
(make-rule-result wants-build?-result
((rule-build-func rule)
build-required? cooked-state))
(make-rule-result wants-build?-result
(apply (rule-build-func rule)
(append (list build-required?)
prereqs-results
(list cooked-state)))))
(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))))