(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))))