65 lines
2.0 KiB
Scheme
65 lines
2.0 KiB
Scheme
|
(define *fname->rule*-table '())
|
||
|
|
|
||
|
|
;;; (*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? (assq fname *fname->rule*-table)))
|
||
|
|
(if rule-found?
|
||
|
|
(error "There already exists a rule with this fname!")
|
||
|
|
(set! *fname->rule*-table
|
||
|
|
(alist-cons fname rule *fname->rule*-table)))))
|
||
|
|
|
||
|
|
(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 makefile-rule
|
||
|
|
(syntax-rules ()
|
||
|
|
((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)
|
||
|
|
(*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)
|
||
|
|
(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 (?target0 ...) ?prereqs ?action-thunk)
|
||
|
|
(begin
|
||
|
|
(makefile-rule ?target0 ?prereqs ?action-thunk)
|
||
|
|
...))))
|
||
|
|
|
||
|
|
(define-syntax makefile
|
||
|
|
(syntax-rules ()
|
||
|
|
; ((makefile ()) '())
|
||
|
|
((makefile ?rule0 ...)
|
||
|
|
(list ?rule0 ...))))
|
||
|
|
|
||
|
|
(define-syntax make
|
||
|
|
(syntax-rules ()
|
||
|
|
((make ?fname)
|
||
|
|
(rule-make (*fname->rule*-get ?fname)
|
||
|
|
"This is not an empty initial state."))))
|