*** empty log message ***

This commit is contained in:
jottbee 2005-01-18 19:28:50 +00:00
parent af7d20c1b2
commit dbda21b92a
4 changed files with 51 additions and 46 deletions

View File

@ -2,12 +2,12 @@
(syntax-rules () (syntax-rules ()
((make ?rule-trans-set (?target-fname0 ...) ?init-state) ((make ?rule-trans-set (?target-fname0 ...) ?init-state)
(begin (begin
(let ((?target-rule (rule-candidate-get ?rule-trans-set ?target-fname0))) (let ((target-rule (rule-candidate-get ?rule-trans-set ?target-fname0)))
(if (not (null? (rule-trans-set-rule-candidates ?rule-trans-set))) (if (not (null? (rule-trans-set-rule-candidates ?rule-trans-set)))
(display "warning: rule-candidates not empty!\n")) (display "warning: rule-candidates not empty!\n"))
(if (?target-rule) (if target-rule
(rule-make ?target-rule (rule-make target-rule
init-state ?init-state
(rule-trans-set-rule-set ?rule-trans-set)) (rule-trans-set-rule-set ?rule-trans-set))
(error "target-rule not found in rule-set."))) (error "target-rule not found in rule-set.")))
...)))) ...))))
@ -16,7 +16,9 @@
(syntax-rules () (syntax-rules ()
((makefile ?rule0 ...) ((makefile ?rule0 ...)
(let ((rule-trans-set (make-empty-rule-trans-set))) (let ((rule-trans-set (make-empty-rule-trans-set)))
((?rule0) rule-trans-set) ...)))) (let ((rule-trans-set (?rule0 rule-trans-set)))
...
rule-trans-set)))))
(define-syntax make-is-out-of-date? (define-syntax make-is-out-of-date?
(syntax-rules () (syntax-rules ()
@ -94,7 +96,9 @@
(rule-trans-set-add! rule-trans-set (rule-trans-set-add! rule-trans-set
target target
(list tmp1 ...) (list tmp1 ...)
(make-has-md5-digest=? ?fingerprint target tmp1 ...) (make-has-md5-digest=? ?fingerprint
target
tmp1 ...)
(lambda ?args (?thunk)))))) (lambda ?args (?thunk))))))
;; ;;
;; recursively construct temporary, hygienic variables ;; recursively construct temporary, hygienic variables

View File

@ -20,7 +20,7 @@
;;; ;;;
;;; (make (expand-file-name "skills.pdf" d) "this is an empty init-state") ;;; (make (expand-file-name "skills.pdf" d) "this is an empty init-state")
(define rule-set (make
(makefile (makefile
(makefile-rule "/home/bruegman/.tmp/skills.tex" (makefile-rule "/home/bruegman/.tmp/skills.tex"
() ()
@ -37,13 +37,6 @@
(lambda () (lambda ()
(with-cwd "/home/bruegman/.tmp" (with-cwd "/home/bruegman/.tmp"
(run (dvipdfm -o ,"/home/bruegman/.tmp/skills.pdf" (run (dvipdfm -o ,"/home/bruegman/.tmp/skills.pdf"
,"/home/bruegman/.tmp/skills.dvi"))))))) ,"/home/bruegman/.tmp/skills.dvi"))))))
(define-syntax make ("/home/bruegman/.tmp/skills.pdf")
(syntax-rules () "this is an empty init-state...")
((make ?fname ?state)
(rule-make (*fname->rule*-get ?fname)
?state
rule-set))))
(make "/home/bruegman/.tmp/skills.pdf" "this is an empty init-state...")

View File

@ -189,7 +189,8 @@
rule-trans-set-rule-candidates rule-trans-set-rule-candidates
rule-trans-set-known-rules rule-trans-set-known-rules
rule-trans-set-rule-set rule-trans-set-rule-set
rule-trans-set-add!)) rule-trans-set-add!
rule-candidate-get))
(define-structure rule-trans-set rule-trans-set-interface (define-structure rule-trans-set rule-trans-set-interface
(open scheme-with-scsh (open scheme-with-scsh
@ -199,13 +200,15 @@
(files rule-trans-set)) (files rule-trans-set))
(define-interface macros-interface (define-interface macros-interface
(export (makefile :syntax) (export (make :syntax)
(makefile :syntax)
(makefile-rule :syntax) (makefile-rule :syntax)
(make-is-out-of-date? :syntax))) (make-is-out-of-date? :syntax)))
(define-structure macros macros-interface (define-structure macros macros-interface
(open scheme-with-scsh (open scheme-with-scsh
srfi-1 srfi-1
make-rule
rule-trans-set) rule-trans-set)
(files macros)) (files macros))

View File

@ -25,18 +25,21 @@
(rule-set (make-empty-rule-set))) (rule-set (make-empty-rule-set)))
(make-rule-trans-set rule-candidates known-rules rule-set))) (make-rule-trans-set rule-candidates known-rules rule-set)))
(define (rule-trans-set-add! rule-trans-set target prereqs wants-build? build-func) (define rule-trans-set-add!
(let ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)) (lambda (rule-trans-set target prereqs wants-build? build-func)
(known-rules (rule-trans-set-known-rules rule-trans-set)) (let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
(rule-set (rule-trans-set-rule-set rule-trans-set))) (known-rules (rule-trans-set-known-rules rule-trans-set))
(rule-candidate-add! rule-candidates target prereqs wants-build? build-func) (rule-set (rule-trans-set-rule-set rule-trans-set))
(known-rules-update rule-trans-set))) (args (list rule-candidates target prereqs wants-build? build-func)))
(apply rule-candidate-add! args)
(known-rules-update rule-trans-set))))
;;; o every incoming rule is considered as a rule-candidate so it is added ;;; o every incoming rule is considered as a rule-candidate so it is added
;;; here first ;;; here first
(define (rule-candidate-add! rule-candidates target prereqs wants-build? build-func) (define rule-candidate-add!
(set! rule-candidates (lambda (rule-candidates target prereqs wants-build? build-func)
(alist-cons target (list prereqs wants-build? build-func)))) (let ((rule-args (list prereqs wants-build? build-func)))
(set! rule-candidates (alist-cons target rule-args rule-candidates)))))
(define (rule-candidate-del! rule-candidates target) (define (rule-candidate-del! rule-candidates target)
(alist-delete! target rule-candidates)) (alist-delete! target rule-candidates))
@ -54,36 +57,38 @@
;;; as well, so this will be the first element of the known-rules ;;; as well, so this will be the first element of the known-rules
(define (known-rules-add! rule-trans-set target prereqs wants-build? build-func) (define (known-rules-add! rule-trans-set target prereqs wants-build? build-func)
(let ((rule (make-rule prereqs wants-build? build-func)) (let ((rule (make-rule prereqs wants-build? build-func))
(rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
(known-rules (rule-trans-set-known-rules rule-trans-set)) (known-rules (rule-trans-set-known-rules rule-trans-set))
(rule-set (rule-trans-set-rule-set rule-trans-set))) (rule-set (rule-trans-set-rule-set rule-trans-set)))
(set! known-rules (alist-cons target rule known-rules)) (set! known-rules (alist-cons target rule known-rules))
(rule-set-add rule rule-set))) (make-rule-trans-set rule-candidates
known-rules
(rule-set-add rule rule-set))))
;;; look for all rule-candidates that can be added to known-rules ;;; look for all rule-candidates that can be added to known-rules
(define (known-rules-update rule-trans-set) (define (known-rules-update rule-trans-set)
(let ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)) (let ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)))
(known-rules (rule-trans-set-known-rules rule-trans-set))
(rule-set (rule-trans-set-rule-set rule-trans-set)))
(map (lambda (candidate-desc) (map (lambda (candidate-desc)
;;
;; candidate-desc is a list with these four elements
;; target prereqs wants-build? build-func
;;
(apply (lambda (target prereqs wants-build? build-func) (apply (lambda (target prereqs wants-build? build-func)
(if (not (memq #f (map (lambda (prereq) (let ((rules (rule-trans-set-known-rules rule-trans-set)))
(assq prereq known-rules)) (if (not (memq #f (map (lambda (prereq)
prereqs))) (assq prereq rules))
(rule-candidate-del! rule-trans-set target) prereqs)))
(apply known-rules-add! (append (list rule-trans-set) (begin
candidate-desc)))) (rule-candidate-del! rule-trans-set target)
candidate-desc)) (set! rule-trans-set
(apply known-rules-add!
(append (list rule-trans-set)
candidate-desc))))
rule-trans-set)))
candidate-desc))
;; ;;
;; get the (target prereqs wants-build? build-func)-list ;; get the (target prereqs wants-build? build-func)-list
;; for each target ;; for each target
;; ;;
(map rule-candidate-get (map (lambda (target)
(rule-candidate-get rule-trans-set target))
;; ;;
;; get all targets ;; get all targets
;; ;;
(map car rule-candidates))) (map car rule-candidates)))))
(make-rule-trans-set rule-candidates known-rules rule-set)))