;;; TODO: ;;; ;;; macros -> functions, eg. ;;; ;;; (define make-is-out-of-date! ;;; (lambda (t . p) ;;; (lambda args (cons #t (last args))))) (define-syntax make (syntax-rules () ((make ?rule-trans-set (?target-fname0 ...) ?init-state) ;; ;; ?rule-trans-set or ?target-fname0 could be an expr: eval only once ;; (let ((rule-trans-set ?rule-trans-set)) (let* ((target-fname0 ?target-fname0) (target-rule (known-rules-get rule-trans-set target-fname0))) (if (not (null? (rule-trans-set-rule-candidates rule-trans-set))) (display "rule-candidates not empty.\n")) (if target-rule (rule-make target-rule ?init-state (rule-trans-set-rule-set rule-trans-set)) (error "target-rule not found in rule-set."))) ...)) ((_ ) (error "usage: (make '#{:rule-trans-set} (target0 ...) init-state)\n")))) ;;; (define-syntax makefile ;;; (syntax-rules () ;;; ((makefile ?rule0 ...) ;;; (let ((rule-trans-set (make-empty-rule-trans-set))) ;;; (let* ((rule-trans-set (?rule0 rule-trans-set)) ;;; ...) ;;; rule-trans-set))))) (define-syntax makefile (syntax-rules () ((makefile) (make-empty-rule-trans-set)) ((makefile ?rule0 ?rule1 ...) (?rule0 (makefile ?rule1 ...))))) (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)) (lambda (rule-trans-set) (rule-trans-set-add rule-trans-set target (list 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)) (lambda (rule-trans-set) (rule-trans-set-add rule-trans-set target (list 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))))) (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 (and (file-exists? ?prereq0) ... (or (file-not-exists? ?target) (> (file-last-mod ?prereq0) (file-last-mod ?target))) ...) (last ?args)))))) (define-syntax make-is-out-of-date! (syntax-rules () ((make-is-out-of-date? ?target ?prereq0 ...) (lambda ?args (cons #t (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))))))