119 lines
3.5 KiB
Scheme
119 lines
3.5 KiB
Scheme
(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)))))
|