scsh-make/makros.scm

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."))))