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

fixed a bug in same-mtime?, all-same-mtime? (behaviour) 

fixed a bug in same-perms, wrong port, out -> in
added head, tail
This commit is contained in:
jottbee 2005-04-11 19:45:25 +00:00
parent 93609c80fd
commit 0257dc23a1
1 changed files with 48 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
templates.scm
View File

@ -9,9 +9,8 @@
(let for-each-prereq ((prereq (car prereqs))
(todo (cdr prereqs)))
(cond
((file-not-exists? prereq)
(error "nonexistent prerequisite" prereq))
((> (file-last-mod prereq) target-mtime) #t)
((and (file-exists? prereq)
(> (file-last-mod prereq) target-mtime)) #t)
((null? todo) #f)
(else (for-each-prereq (car todo) (cdr todo)))))))))
@ -24,11 +23,10 @@
(let for-each-prereq ((prereq (car prereqs))
(todo (cdr prereqs)))
(cond
((file-not-exists? prereq)
(error "nonexistent prerequisite" prereq))
((and (null? todo)
(> (file-last-mod prereq) target-mtime)) #t)
(else (and (> (file-last-mod prereq) target-mtime)
((and (file-exists? prereq) (null? todo))
(> (file-last-mod prereq) target-mtime))
(else (and (and (file-exists? prereq)
(> (file-last-mod prereq) target-mtime))
(for-each-prereq (car todo) (cdr todo))))))))))
(define (same-perms? target prereqs)
@ -45,8 +43,8 @@
(let* ((bname (string-append basename extension))
(file (expand-file-name bname (cwd))))
(if (file-exists? file)
(let* ((outport (open-input-file file))
(strls (port->string-list outport)))
(let* ((inport (open-input-file file))
(strls (port->string-list inport)))
;; (display ";;; using : ") (display bname) (newline)
(if (null? strls)
#f
@ -83,20 +81,21 @@
(+ current-file-sum previous-total)
previous-total)))
(cond
((and (not (null? todo-prereqs)))
(for-each-prereq (car todo-prereqs)
((not (null? todo-prereqs))
(for-each-prereq (car todo-prereqs)
current-total
(cdr todo-prereqs)))
((and (null? todo-prereqs) (not (null? extensions)))
((not (null? extensions))
(let for-each-ext ((ext (car extensions))
(todo-exts (cdr extensions)))
(let ((known-sum (checksum-from-file target ext)))
(let ((known-sum (checksum-from-file target ext))
(target-name (string-append target ext)))
(cond
((and (file-not-exists? target) known-sum)
((and (file-not-exists? target-name) known-sum)
(begin
(checksum-into-file target ext current-total)
#f))
((and (file-not-exists? target) (null? todo-exts))
((and (file-not-exists? target-name) (null? todo-exts))
(begin
(checksum-into-file target
(last (reverse extensions))
@ -116,6 +115,32 @@
(else (error "no match in same-checksum?"))))))
(else (error "no match in same-checksum?")))))))
(define (head target prereqs)
(if (file-not-exists? target)
#t
(if (null? prereqs)
#f
(let ((prereq (car prereqs)))
(if (file-not-exists? prereq)
(error "nonexistent prerequisite" prereq)
(> (file-last-mod prereq) (file-last-mod target)))))))
(define (tail target prereqs)
(if (file-not-exists? target)
#t
(if (null? prereqs)
#f
(if (null? (cdr prereqs))
#f
(let ((target-mtime (file-last-mod target)))
(let for-each-prereq ((prereq (cadr prereqs))
(todo (cddr prereqs)))
(cond
((and (file-exists? prereq)
(> (file-last-mod prereq) target-mtime)) #t)
((null? todo) #f)
(else (for-each-prereq (car todo) (cdr todo))))))))))
(define (always target prereqs) #t)
(define (once target prereqs)
@ -134,9 +159,11 @@
(not (same-perms? target prereqs)))
(define (md5-perms target prereqs)
(and (not (same-checksum? target digest-extensions prereqs))
(not (same-perms? target prereqs))
(not (same-mtime? target prereqs))))
(or (not (same-perms? target prereqs))
(not (same-checksum? target digest-extensions prereqs))))
(define (paranoid target prereqs)
(not (same-checksum? target digest-extensions prereqs)))
(or (not (same-perms? target prereqs))
(same-mtime? target prereqs)
(not (same-checksum? target digest-extensions prereqs))))