92 lines
2.9 KiB
Scheme
92 lines
2.9 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-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 '() ?prereqs ?action-thunk)
|
|
(error "Target specification in makefile-rule matches '()!"))
|
|
((makefile-rule (?target0 ...) ?prereqs ?action-thunk)
|
|
(begin
|
|
(makefile-rule ?target0 ?prereqs ?action-thunk)
|
|
...))
|
|
((makefile-rule ?target '() ?action-thunk)
|
|
(*fname->rule*-add! ?target
|
|
(make-rule '()
|
|
(make-is-out-of-date? ?target)
|
|
(lambda ?args (?action-thunk)))))
|
|
((makefile-rule ?target (?prereq0 ...) ?action-thunk)
|
|
(begin
|
|
(*fname->rule*-add! ?target
|
|
(make-rule (list (*fname->rule*-get ?prereq0)
|
|
...)
|
|
(make-is-out-of-date? ?target ?prereq0 ...)
|
|
(lambda ?args (?action-thunk))))))
|
|
((makefile-rule ?target ?prereq0 ?action-thunk)
|
|
(*fname->rule*-add! ?target
|
|
(make-rule (list (*fname->rule*-get ?prereq0))
|
|
(make-is-out-of-date? ?target ?prereq0)
|
|
(lambda ?args (?action-thunk)))))))
|
|
|
|
(define-syntax with-is-out-of-date?-check-func
|
|
(syntax-rules ()
|
|
((with-is-out-of-date?-producer ?make-is-out-of-date? ?makefile-rule
|
|
|
|
(define-syntax makefile
|
|
(syntax-rules ()
|
|
; ((makefile ()) '())
|
|
((makefile ?rule0 ...)
|
|
(begin
|
|
(set! rule-set (make-empty-rule-set))
|
|
?rule0 ...))))
|
|
|
|
(define-syntax make
|
|
(syntax-rules ()
|
|
((make ?fname)
|
|
(rule-make (*fname->rule*-get ?fname)
|
|
"This is not an empty initial state."
|
|
rule-set))))
|