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

*** empty log message ***

This commit is contained in:
jottbee 2005-01-20 10:19:30 +00:00
parent 2ee328949e
commit 053efed211
1 changed files with 0 additions and 118 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

118
makros.scm
View File

@ -1,118 +0,0 @@
(define *fname->rule*-table '())
(define rule-set (make-empty-rule-set))
;;; (*fname->rule*-get fname) ---> rule
(define (*fname->rule*-get fname)
(let ((rule-found? (assoc fname *fname->rule*-table)))
(if rule-found? (cdr rule-found?))))
;;; (*fname->rule*-add! fname) ---> {}
(define (*fname->rule*-add! fname rule)
(let ((rule-found? (assoc fname *fname->rule*-table)))
(if rule-found?
(error "There already exists a rule with this fname!")
(begin
(set! *fname->rule*-table
(alist-cons fname rule *fname->rule*-table))
(set! rule-set (rule-set-add rule rule-set))))))
(define-syntax make
(syntax-rules ()
((make ?fname ?state)
(rule-make (*fname->rule*-get ?fname)
?state
rule-set))))
(define-syntax makefile
(syntax-rules ()
((makefile ?rule0 ...)
(begin
(set! rule-set (make-empty-rule-set))
?rule0 ...))))
(define-syntax make-is-out-of-date?
(syntax-rules ()
((make-is-out-of-date? ?target)
(lambda ?args
(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))))))
(define-syntax make-has-md5-digest=?
(syntax-rules ()
((make-has-md5-digest=? ?fingerprint ?target)
(lambda ?args
(cons (or (file-not-exists? ?target)
(=? (md5-digest-for-port (open-input-file ?target))
?fingerprint))
?args)))
((make-has-md5-digest=? ?fingerprint ?target ?prereq0 ...)
(lambda ?args
(cons (or (file-not-exists? ?target)
(=? (md5-digest->number (md5-digest-for-port
(open-input-file ?target)))
(md5-digest->number ?fingerprint)))
(last ?args))))))
(define-syntax makefile-rule
(syntax-rules ()
((makefile-rule ?target (?prereq0 ...) ?thunk)
(makefile-rule-tmpvars () ?target (?prereq0 ...) ?thunk))))
(define-syntax makefile-rule-tmpvars
(syntax-rules ()
((makefile-rule-tmpvars (tmp1 ...) ?target () ?thunk)
;;
;; ?target could be an expr: eval only once
;;
(let ((target ?target))
(*fname->rule*-add! target
(make-rule (list (*fname->rule*-get tmp1)
...)
(make-is-out-of-date? target tmp1 ...)
(lambda ?args (?thunk))))))
;;
;; recursively construct temporary, hygienic variables
;;
((makefile-rule-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...) ?thunk)
(let ((tmp2 ?prereq0))
(makefile-rule-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...) ?thunk)))))
(define-syntax makefile-rule-md5
(syntax-rules ()
((makefile-rule-md5 ?fingerprint ?target (?prereq0 ...) ?thunk)
(makefile-rule-md5-tmpvars () ?fingerprint ?target (?prereq0 ...) ?thunk))))
(define-syntax makefile-rule-md5-tmpvars
(syntax-rules ()
((makefile-rule-md5-tmpvars (tmp1 ...) ?fingerprint ?target () ?thunk)
;;
;; ?target could be an expr: eval only once
;;
(let ((target ?target))
(*fname->rule*-add! target
(make-rule (list (*fname->rule*-get tmp1)
...)
(make-has-md5-digest=? ?fingerprint
target
tmp1 ...)
(lambda ?args (?thunk))))))
;;
;; recursively construct temporary, hygienic variables
;;
((makefile-rule-md5-tmpvars (tmp1 ...)
?fingerprint
?target
(?prereq0 ?prereq1 ...)
?thunk)
(let ((tmp2 ?prereq0))
(makefile-rule-md5-tmpvars (tmp1 ... tmp2)
?fingerprint
?target
(?prereq1 ...)
?thunk)))))