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