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

make-is-out-of-date? is more readable now; small improvement 

target-mtime doesn't need to be checked for each prereq.
This commit is contained in:
jottbee 2005-02-15 18:54:47 +00:00
parent 9e1b812cfd
commit c411f67a2c
1 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
templates.scm
View File

@ -6,7 +6,7 @@
(let ((cooked-state (last args))
(prereqs-results (cdr (reverse (cdr args)))))
(cons (begin
(display ";;; rule : ")
(display ";;; file : ")
(display target)
(newline)
(bind-fluids-gnu target prereqs prereqs-results thunk))
@ -61,18 +61,22 @@
(cons (file-not-exists? target) init-state))))
(define (make-is-out-of-date? target . prereqs)
(lambda args
(lambda args
; (breakpoint "make-is-out-of-date?")
(let ((init-state (last args)))
(cons (or (file-not-exists? target)
(and (not (null? prereqs))
(let for-each-prereq ((prereq (car prereqs))
(todo (cdr prereqs)))
(cond
((file-not-exists? prereq) #t)
((> (file-last-mod prereq) (file-last-mod target)) #t)
((null? todo) #f)
(else (for-each-prereq (car todo) (cdr todo)))))))
(cons (if (file-not-exists? target)
#t
(if (null? prereqs)
#f
(let ((target-mtime (file-last-mod target)))
(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)
((null? todo) #f)
(else (for-each-prereq (car todo) (cdr todo))))))))
init-state))))
(define (make-md5-sum-changed? target . prereqs)
@ -86,13 +90,13 @@
(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)))
;; (display ";;; using : ") (display bname) (newline)
(if (null? strls)
#f
(string->number (car strls))))
#f)))
(let* ((outport (open-input-file file))
(strls (port->string-list outport)))
;; (display ";;; using : ") (display bname) (newline)
(if (null? strls)
#f
(string->number (car strls))))
#f)))
(define (checksum-into-file basename extension checksum)
(let* ((bname (string-append basename extension))