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

(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))))