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

makefile.scm: (expand-file-name ...) works now due to s,assq,assoc, in 

macros.scm and rule-trans-set.scm

rule-trans-set.scm: known-rules-update is now really ugly! (but working)
		    will be replaced with topological sort

		    known-rules-update now loops until there are no
		    further changes in the rule-candidates-list (each
		    time). this should really make it work now.

makros.scm replaced with macros.scm

macros.scm: in make-is-out-of-date? there was no check for
            file-existence of each prereq
This commit is contained in:
jottbee 2005-01-20 10:18:07 +00:00
parent 5277066db6
commit 2ee328949e
4 changed files with 102 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
macros.scm
View File

@ -10,31 +10,35 @@
(syntax-rules () (syntax-rules ()
((make ?rule-trans-set (?target-fname0 ...) ?init-state) ((make ?rule-trans-set (?target-fname0 ...) ?init-state)
;; ;;
;; ?rule-trans-set could be an expr: eval only once ;; ?rule-trans-set or ?target-fname0 could be an expr: eval only once
;; ;;
(let ((rule-trans-set ?rule-trans-set)) (let ((rule-trans-set ?rule-trans-set))
(let ((target-rule (known-rules-get rule-trans-set ?target-fname0))) (let* ((target-fname0 ?target-fname0)
(target-rule (known-rules-get rule-trans-set target-fname0)))
(if (not (null? (rule-trans-set-rule-candidates rule-trans-set)))
(display "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.")))
...)) ...))
((_ ) (error "usage: (make '#{:rule-trans-set} (target0 ...) init-state)\n")))) ((_ )
(error "usage: (make '#{:rule-trans-set} (target0 ...) init-state)\n"))))
(define-syntax makefile
(syntax-rules ()
((makefile ?rule0 ...)
(let ((rule-trans-set (make-empty-rule-trans-set)))
(let* ((rule-trans-set (?rule0 rule-trans-set))
...)
rule-trans-set)))))
;;; (define-syntax makefile ;;; (define-syntax makefile
;;; (syntax-rules () ;;; (syntax-rules ()
;;; ((makefile) (make-empty-rule-trans-set)) ;;; ((makefile ?rule0 ...)
;;; ((makefile ?rule0 ?rule1 ...) ;;; (let ((rule-trans-set (make-empty-rule-trans-set)))
;;; (?rule0 (makefile ?rule1 ...))))) ;;; (let* ((rule-trans-set (?rule0 rule-trans-set))
;;; ...)
;;; rule-trans-set)))))
(define-syntax makefile
(syntax-rules ()
((makefile) (make-empty-rule-trans-set))
((makefile ?rule0 ?rule1 ...)
(?rule0 (makefile ?rule1 ...)))))
(define-syntax makefile-rule (define-syntax makefile-rule
(syntax-rules () (syntax-rules ()
@ -97,9 +101,10 @@
(cons (file-not-exists? ?target) ?args))) (cons (file-not-exists? ?target) ?args)))
((make-is-out-of-date? ?target ?prereq0 ...) ((make-is-out-of-date? ?target ?prereq0 ...)
(lambda ?args (lambda ?args
(cons (or (file-not-exists? ?target) (cons (and (file-exists? ?prereq0) ...
(or (file-not-exists? ?target)
(> (file-last-mod ?prereq0) (> (file-last-mod ?prereq0)
(file-last-mod ?target)) (file-last-mod ?target)))
...) ...)
(last ?args)))))) (last ?args))))))

80
makefile.scm
View File

@ -1,48 +1,46 @@
;;; (define work-dir (expand-file-name "~/.tmp")) (define scsh-doc-dir (expand-file-name "~/src/scsh-0.6.6/doc/scsh-manual"))
;;; (define work-dir scsh-doc-dir)
;;; (make
;;; (makefile (define tex-file (expand-file-name "test.tex" scsh-doc-dir))
;;; (makefile-rule (expand-file-name "skills.tex" work-dir) (define dvi-file (expand-file-name "test.dvi" scsh-doc-dir))
;;; () (define pdf-file (expand-file-name "test.pdf" scsh-doc-dir))
;;; (lambda ()
;;; (with-cwd work-dir (display "Top: skills.tex"))))
;;; (makefile-rule (expand-file-name "skills.dvi" work-dir)
;;; ((expand-file-name "skills.tex" work-dir))
;;; (lambda ()
;;; (with-cwd
;;; work-dir
;;; (run (latex ,(expand-file-name "skills.tex" work-dir))))))
;;; (makefile-rule (expand-file-name "skills.pdf" work-dir)
;;; ((expand-file-name "skills.dvi" work-dir))
;;; (lambda ()
;;; (with-cwd
;;; work-dir
;;; (run
;;; (dvipdfm -o
;;; ,(expand-file-name "skills.pdf" work-dir)
;;; ,(expand-file-name "skills.dvi" work-dir)))))))
;;; ((expand-file-name "skills.pdf" work-dir))
;;; "this is an empty init-state")
(make (make
(makefile (makefile
(makefile-rule "/home/bruegman/.tmp/skills.tex" (makefile-rule tex-file
() ()
(lambda () (lambda ()
(with-cwd "/home/bruegman/.tmp" (with-cwd work-dir (display "Top: skills.tex"))))
(display "Top: /home/bruegman/.tmp/skills.tex")))) (makefile-rule pdf-file
(makefile-rule "/home/bruegman/.tmp/skills.dvi" (dvi-file)
("/home/bruegman/.tmp/skills.tex")
(lambda () (lambda ()
(with-cwd "/home/bruegman/.tmp" (with-cwd work-dir (run (dvipdfm -o ,pdf-file ,dvi-file)))))
(run (latex ,"/home/bruegman/.tmp/skills.tex"))))) (makefile-rule dvi-file
(makefile-rule "/home/bruegman/.tmp/skills.pdf" (tex-file)
("/home/bruegman/.tmp/skills.dvi")
(lambda () (lambda ()
(with-cwd "/home/bruegman/.tmp" (with-cwd work-dir (run (latex ,tex-file))))))
(run (dvipdfm -o ,"/home/bruegman/.tmp/skills.pdf" (pdf-file)
,"/home/bruegman/.tmp/skills.dvi")))))) "this is an empty init-state")
("/home/bruegman/.tmp/skills.pdf"
"/home/bruegman/.tmp/skills.dvi" ;;; (make
"/home/bruegman/.tmp/skills.tex") ;;; (makefile
"this is an empty init-state...") ;;; (makefile-rule "/home/johannes/.tmp/skills.tex"
;;; ()
;;; (lambda ()
;;; (with-cwd "/home/johannes/.tmp"
;;; (display "Top: /home/johannes/.tmp/skills.tex"))))
;;; (makefile-rule "/home/johannes/.tmp/skills.dvi"
;;; ("/home/johannes/.tmp/skills.tex")
;;; (lambda ()
;;; (with-cwd "/home/johannes/.tmp"
;;; (run (latex ,"/home/johannes/.tmp/skills.tex")))))
;;; (makefile-rule "/home/johannes/.tmp/skills.pdf"
;;; ("/home/johannes/.tmp/skills.dvi")
;;; (lambda ()
;;; (with-cwd "/home/johannes/.tmp"
;;; (run (dvipdfm -o ,"/home/johannes/.tmp/skills.pdf"
;;; ,"/home/johannes/.tmp/skills.dvi"))))))
;;; ("/home/johannes/.tmp/skills.pdf"
;;; "/home/johannes/.tmp/skills.dvi"
;;; "/home/johannes/.tmp/skills.tex")
;;; "this is an empty init-state...")

12
packages.scm
View File

@ -169,18 +169,6 @@
srfi-9) srfi-9)
(files make-rule-no-cml)) (files make-rule-no-cml))
(define-interface makros-interface
(export (make-is-out-of-date? :syntax)
(makefile :syntax)
(makefile-rule :syntax)
(make :syntax)))
(define-structure makros makros-interface
(open scheme-with-scsh
srfi-1
make-rule-no-cml)
(files makros))
(define-interface rule-trans-set-interface (define-interface rule-trans-set-interface
(export make-rule-trans-set (export make-rule-trans-set
is-rule-trans-set? is-rule-trans-set?

27
rule-trans-set.scm
View File

@ -86,10 +86,12 @@
(define (known-rules-get rule-trans-set target) (define (known-rules-get rule-trans-set target)
(let* ((known-rules (rule-trans-set-known-rules rule-trans-set)) (let* ((known-rules (rule-trans-set-known-rules rule-trans-set))
(maybe-rule (assq target known-rules))) (maybe-rule (assoc target known-rules)))
(if maybe-rule (cdr maybe-rule) maybe-rule))) (if maybe-rule (cdr maybe-rule) maybe-rule)))
(define (known-rules-update rule-trans-set) (define (known-rules-update rts)
(let until-no-change ((last-rcs (length (rule-trans-set-rule-candidates rts)))
(rule-trans-set rts))
(let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set)) (let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
(candidate-descs (map cons (map car rule-candidates) (candidate-descs (map cons (map car rule-candidates)
(map cdr rule-candidates)))) (map cdr rule-candidates))))
@ -101,20 +103,25 @@
(wants-build? (list-ref current-candidate-desc 2)) (wants-build? (list-ref current-candidate-desc 2))
(build-func (list-ref current-candidate-desc 3))) (build-func (list-ref current-candidate-desc 3)))
(let* ((known-rules (rule-trans-set-known-rules current-rts)) (let* ((known-rules (rule-trans-set-known-rules current-rts))
(new-rts (if (not (memq #f (map (lambda (prereq) (new-rts (if (not (memq #f
(assq prereq known-rules)) (map (lambda (prereq)
(assoc prereq known-rules))
prereqs))) prereqs)))
(known-rules-add (rule-candidate-del current-rts target) (known-rules-add (rule-candidate-del
target current-rts
prereqs target)
wants-build? target prereqs
build-func) wants-build? build-func)
current-rts))) current-rts)))
(if (not (null? to-do-candidate-desc)) (if (not (null? to-do-candidate-desc))
(for-candidates (car to-do-candidate-desc) (for-candidates (car to-do-candidate-desc)
(cdr to-do-candidate-desc) (cdr to-do-candidate-desc)
new-rts) new-rts)
new-rts)))))) (let ((current-rcs (length (rule-trans-set-rule-candidates
new-rts))))
(if (or (= current-rcs last-rcs) (= current-rcs 0))
new-rts
(until-no-change current-rcs new-rts))))))))))
;;; look for all rule-candidates that can be added to known-rules ;;; look for all rule-candidates that can be added to known-rules
;;; and add them to known-rules ;;; and add them to known-rules