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
parent
5277066db6
commit
2ee328949e
43
macros.scm
43
macros.scm
|
|
@ -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,11 +101,12 @@
|
||||||
(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) ...
|
||||||
(> (file-last-mod ?prereq0)
|
(or (file-not-exists? ?target)
|
||||||
(file-last-mod ?target))
|
(> (file-last-mod ?prereq0)
|
||||||
...)
|
(file-last-mod ?target)))
|
||||||
(last ?args))))))
|
...)
|
||||||
|
(last ?args))))))
|
||||||
|
|
||||||
(define-syntax make-is-out-of-date!
|
(define-syntax make-is-out-of-date!
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
|
|
||||||
90
makefile.scm
90
makefile.scm
|
|
@ -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 work-dir (run (dvipdfm -o ,pdf-file ,dvi-file)))))
|
||||||
(with-cwd "/home/bruegman/.tmp"
|
(makefile-rule dvi-file
|
||||||
(run (latex ,"/home/bruegman/.tmp/skills.tex")))))
|
(tex-file)
|
||||||
(makefile-rule "/home/bruegman/.tmp/skills.pdf"
|
(lambda ()
|
||||||
("/home/bruegman/.tmp/skills.dvi")
|
(with-cwd work-dir (run (latex ,tex-file))))))
|
||||||
(lambda ()
|
(pdf-file)
|
||||||
(with-cwd "/home/bruegman/.tmp"
|
"this is an empty init-state")
|
||||||
(run (dvipdfm -o ,"/home/bruegman/.tmp/skills.pdf"
|
|
||||||
,"/home/bruegman/.tmp/skills.dvi"))))))
|
;;; (make
|
||||||
("/home/bruegman/.tmp/skills.pdf"
|
;;; (makefile
|
||||||
"/home/bruegman/.tmp/skills.dvi"
|
;;; (makefile-rule "/home/johannes/.tmp/skills.tex"
|
||||||
"/home/bruegman/.tmp/skills.tex")
|
;;; ()
|
||||||
"this is an empty init-state...")
|
;;; (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
12
packages.scm
|
|
@ -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?
|
||||||
|
|
|
||||||
|
|
@ -86,35 +86,42 @@
|
||||||
|
|
||||||
(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* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
|
(let until-no-change ((last-rcs (length (rule-trans-set-rule-candidates rts)))
|
||||||
(candidate-descs (map cons (map car rule-candidates)
|
(rule-trans-set rts))
|
||||||
(map cdr rule-candidates))))
|
(let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
|
||||||
(let for-candidates ((current-candidate-desc (car candidate-descs))
|
(candidate-descs (map cons (map car rule-candidates)
|
||||||
(to-do-candidate-desc (cdr candidate-descs))
|
(map cdr rule-candidates))))
|
||||||
(current-rts rule-trans-set))
|
(let for-candidates ((current-candidate-desc (car candidate-descs))
|
||||||
(let ((target (list-ref current-candidate-desc 0))
|
(to-do-candidate-desc (cdr candidate-descs))
|
||||||
(prereqs (list-ref current-candidate-desc 1))
|
(current-rts rule-trans-set))
|
||||||
(wants-build? (list-ref current-candidate-desc 2))
|
(let ((target (list-ref current-candidate-desc 0))
|
||||||
(build-func (list-ref current-candidate-desc 3)))
|
(prereqs (list-ref current-candidate-desc 1))
|
||||||
(let* ((known-rules (rule-trans-set-known-rules current-rts))
|
(wants-build? (list-ref current-candidate-desc 2))
|
||||||
(new-rts (if (not (memq #f (map (lambda (prereq)
|
(build-func (list-ref current-candidate-desc 3)))
|
||||||
(assq prereq known-rules))
|
(let* ((known-rules (rule-trans-set-known-rules current-rts))
|
||||||
prereqs)))
|
(new-rts (if (not (memq #f
|
||||||
(known-rules-add (rule-candidate-del current-rts target)
|
(map (lambda (prereq)
|
||||||
target
|
(assoc prereq known-rules))
|
||||||
prereqs
|
prereqs)))
|
||||||
wants-build?
|
(known-rules-add (rule-candidate-del
|
||||||
build-func)
|
current-rts
|
||||||
current-rts)))
|
target)
|
||||||
(if (not (null? to-do-candidate-desc))
|
target prereqs
|
||||||
(for-candidates (car to-do-candidate-desc)
|
wants-build? build-func)
|
||||||
(cdr to-do-candidate-desc)
|
current-rts)))
|
||||||
new-rts)
|
(if (not (null? to-do-candidate-desc))
|
||||||
new-rts))))))
|
(for-candidates (car to-do-candidate-desc)
|
||||||
|
(cdr to-do-candidate-desc)
|
||||||
|
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
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue