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 ()
|
||||
((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 ((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
|
||||
(rule-make target-rule
|
||||
?init-state
|
||||
(rule-trans-set-rule-set rule-trans-set))
|
||||
(error "target-rule not found in rule-set.")))
|
||||
...))
|
||||
((_ ) (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)))))
|
||||
((_ )
|
||||
(error "usage: (make '#{:rule-trans-set} (target0 ...) init-state)\n"))))
|
||||
|
||||
;;; (define-syntax makefile
|
||||
;;; (syntax-rules ()
|
||||
;;; ((makefile) (make-empty-rule-trans-set))
|
||||
;;; ((makefile ?rule0 ?rule1 ...)
|
||||
;;; (?rule0 (makefile ?rule1 ...)))))
|
||||
;;; ((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
|
||||
(syntax-rules ()
|
||||
((makefile) (make-empty-rule-trans-set))
|
||||
((makefile ?rule0 ?rule1 ...)
|
||||
(?rule0 (makefile ?rule1 ...)))))
|
||||
|
||||
(define-syntax makefile-rule
|
||||
(syntax-rules ()
|
||||
|
|
@ -97,11 +101,12 @@
|
|||
(cons (file-not-exists? ?target) ?args)))
|
||||
((make-is-out-of-date? ?target ?prereq0 ...)
|
||||
(lambda ?args
|
||||
(cons (or (file-not-exists? ?target)
|
||||
(> (file-last-mod ?prereq0)
|
||||
(file-last-mod ?target))
|
||||
...)
|
||||
(last ?args))))))
|
||||
(cons (and (file-exists? ?prereq0) ...
|
||||
(or (file-not-exists? ?target)
|
||||
(> (file-last-mod ?prereq0)
|
||||
(file-last-mod ?target)))
|
||||
...)
|
||||
(last ?args))))))
|
||||
|
||||
(define-syntax make-is-out-of-date!
|
||||
(syntax-rules ()
|
||||
|
|
|
|||
90
makefile.scm
90
makefile.scm
|
|
@ -1,48 +1,46 @@
|
|||
;;; (define work-dir (expand-file-name "~/.tmp"))
|
||||
;;;
|
||||
;;; (make
|
||||
;;; (makefile
|
||||
;;; (makefile-rule (expand-file-name "skills.tex" work-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")
|
||||
(define scsh-doc-dir (expand-file-name "~/src/scsh-0.6.6/doc/scsh-manual"))
|
||||
(define work-dir scsh-doc-dir)
|
||||
|
||||
(define tex-file (expand-file-name "test.tex" scsh-doc-dir))
|
||||
(define dvi-file (expand-file-name "test.dvi" scsh-doc-dir))
|
||||
(define pdf-file (expand-file-name "test.pdf" scsh-doc-dir))
|
||||
|
||||
(make
|
||||
(makefile
|
||||
(makefile-rule "/home/bruegman/.tmp/skills.tex"
|
||||
()
|
||||
(lambda ()
|
||||
(with-cwd "/home/bruegman/.tmp"
|
||||
(display "Top: /home/bruegman/.tmp/skills.tex"))))
|
||||
(makefile-rule "/home/bruegman/.tmp/skills.dvi"
|
||||
("/home/bruegman/.tmp/skills.tex")
|
||||
(lambda ()
|
||||
(with-cwd "/home/bruegman/.tmp"
|
||||
(run (latex ,"/home/bruegman/.tmp/skills.tex")))))
|
||||
(makefile-rule "/home/bruegman/.tmp/skills.pdf"
|
||||
("/home/bruegman/.tmp/skills.dvi")
|
||||
(lambda ()
|
||||
(with-cwd "/home/bruegman/.tmp"
|
||||
(run (dvipdfm -o ,"/home/bruegman/.tmp/skills.pdf"
|
||||
,"/home/bruegman/.tmp/skills.dvi"))))))
|
||||
("/home/bruegman/.tmp/skills.pdf"
|
||||
"/home/bruegman/.tmp/skills.dvi"
|
||||
"/home/bruegman/.tmp/skills.tex")
|
||||
"this is an empty init-state...")
|
||||
(makefile
|
||||
(makefile-rule tex-file
|
||||
()
|
||||
(lambda ()
|
||||
(with-cwd work-dir (display "Top: skills.tex"))))
|
||||
(makefile-rule pdf-file
|
||||
(dvi-file)
|
||||
(lambda ()
|
||||
(with-cwd work-dir (run (dvipdfm -o ,pdf-file ,dvi-file)))))
|
||||
(makefile-rule dvi-file
|
||||
(tex-file)
|
||||
(lambda ()
|
||||
(with-cwd work-dir (run (latex ,tex-file))))))
|
||||
(pdf-file)
|
||||
"this is an empty init-state")
|
||||
|
||||
;;; (make
|
||||
;;; (makefile
|
||||
;;; (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
12
packages.scm
|
|
@ -169,18 +169,6 @@
|
|||
srfi-9)
|
||||
(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
|
||||
(export make-rule-trans-set
|
||||
is-rule-trans-set?
|
||||
|
|
|
|||
|
|
@ -86,35 +86,42 @@
|
|||
|
||||
(define (known-rules-get rule-trans-set target)
|
||||
(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)))
|
||||
|
||||
(define (known-rules-update rule-trans-set)
|
||||
(let* ((rule-candidates (rule-trans-set-rule-candidates rule-trans-set))
|
||||
(candidate-descs (map cons (map car rule-candidates)
|
||||
(map cdr rule-candidates))))
|
||||
(let for-candidates ((current-candidate-desc (car candidate-descs))
|
||||
(to-do-candidate-desc (cdr candidate-descs))
|
||||
(current-rts rule-trans-set))
|
||||
(let ((target (list-ref current-candidate-desc 0))
|
||||
(prereqs (list-ref current-candidate-desc 1))
|
||||
(wants-build? (list-ref current-candidate-desc 2))
|
||||
(build-func (list-ref current-candidate-desc 3)))
|
||||
(let* ((known-rules (rule-trans-set-known-rules current-rts))
|
||||
(new-rts (if (not (memq #f (map (lambda (prereq)
|
||||
(assq prereq known-rules))
|
||||
prereqs)))
|
||||
(known-rules-add (rule-candidate-del current-rts target)
|
||||
target
|
||||
prereqs
|
||||
wants-build?
|
||||
build-func)
|
||||
current-rts)))
|
||||
(if (not (null? to-do-candidate-desc))
|
||||
(for-candidates (car to-do-candidate-desc)
|
||||
(cdr to-do-candidate-desc)
|
||||
new-rts)
|
||||
new-rts))))))
|
||||
(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))
|
||||
(candidate-descs (map cons (map car rule-candidates)
|
||||
(map cdr rule-candidates))))
|
||||
(let for-candidates ((current-candidate-desc (car candidate-descs))
|
||||
(to-do-candidate-desc (cdr candidate-descs))
|
||||
(current-rts rule-trans-set))
|
||||
(let ((target (list-ref current-candidate-desc 0))
|
||||
(prereqs (list-ref current-candidate-desc 1))
|
||||
(wants-build? (list-ref current-candidate-desc 2))
|
||||
(build-func (list-ref current-candidate-desc 3)))
|
||||
(let* ((known-rules (rule-trans-set-known-rules current-rts))
|
||||
(new-rts (if (not (memq #f
|
||||
(map (lambda (prereq)
|
||||
(assoc prereq known-rules))
|
||||
prereqs)))
|
||||
(known-rules-add (rule-candidate-del
|
||||
current-rts
|
||||
target)
|
||||
target prereqs
|
||||
wants-build? build-func)
|
||||
current-rts)))
|
||||
(if (not (null? to-do-candidate-desc))
|
||||
(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
|
||||
;;; and add them to known-rules
|
||||
|
|
|
|||
Loading…
Reference in New Issue