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

*** 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
macros.scm
View File

@ -2,12 +2,12 @@
(syntax-rules ()
((make ?rule-trans-set (?target-fname0 ...) ?init-state)
(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)))
(display "warning: rule-candidates not empty!\n"))
(if (?target-rule)
(rule-make ?target-rule
init-state
(if target-rule
(rule-make target-rule
?init-state
(rule-trans-set-rule-set ?rule-trans-set))
(error "target-rule not found in rule-set.")))
...))))
@ -16,7 +16,9 @@
(syntax-rules ()
((makefile ?rule0 ...)
(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?
(syntax-rules ()
@ -94,7 +96,9 @@
(rule-trans-set-add! rule-trans-set
target
(list tmp1 ...)
(make-has-md5-digest=? ?fingerprint target tmp1 ...)
(make-has-md5-digest=? ?fingerprint
target
tmp1 ...)
(lambda ?args (?thunk))))))
;;
;; recursively construct temporary, hygienic variables

15
makefile.scm
View File

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

7
packages.scm
View File

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

59
rule-trans-set.scm
View File

@ -25,18 +25,21 @@
(rule-set (make-empty-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)
(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)))
(rule-candidate-add! rule-candidates target prereqs wants-build? build-func)
(known-rules-update rule-trans-set)))
(define rule-trans-set-add!
(lambda (rule-trans-set target prereqs wants-build? build-func)
(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))
(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
;;; here first
(define (rule-candidate-add! rule-candidates target prereqs wants-build? build-func)
(set! rule-candidates
(alist-cons target (list prereqs wants-build? build-func))))
(define rule-candidate-add!
(lambda (rule-candidates target 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)
(alist-delete! target rule-candidates))
@ -54,36 +57,38 @@
;;; 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)
(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))
(rule-set (rule-trans-set-rule-set rule-trans-set)))
(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
(define (known-rules-update 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)))
(let ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)))
(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)
(if (not (memq #f (map (lambda (prereq)
(assq prereq known-rules))
prereqs)))
(rule-candidate-del! rule-trans-set target)
(apply known-rules-add! (append (list rule-trans-set)
candidate-desc))))
candidate-desc))
(let ((rules (rule-trans-set-known-rules rule-trans-set)))
(if (not (memq #f (map (lambda (prereq)
(assq prereq rules))
prereqs)))
(begin
(rule-candidate-del! rule-trans-set target)
(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
;; for each target
;;
(map rule-candidate-get
(map (lambda (target)
(rule-candidate-get rule-trans-set target))
;;
;; get all targets
;;
(map car rule-candidates)))
(make-rule-trans-set rule-candidates known-rules rule-set)))
(map car rule-candidates)))))