133 lines
4.1 KiB
Scheme
133 lines
4.1 KiB
Scheme
;;; 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))))))
|
|
|