86 lines
2.9 KiB
Scheme
86 lines
2.9 KiB
Scheme
(define-syntax makefile
|
|
(syntax-rules (pred)
|
|
((makefile ?clauses ...)
|
|
(let ((id=? string=?))
|
|
(clauses->lists id=? () () ?clauses ...)))
|
|
((makefile (pred id=?) ?clauses ...)
|
|
(clauses->lists id=? () () ?clauses ...))))
|
|
|
|
(define-syntax clauses->lists
|
|
(syntax-rules (common-% common-rx)
|
|
((clauses->lists pred (?rc0 ...) (?func1 ...) (common-% ?%0 ...) ?clause1 ...)
|
|
(clauses->lists pred
|
|
(?rc0 ...)
|
|
(?func1 ... (common-%-clause->func pred ?%0) ...)
|
|
?clause1 ...))
|
|
((clauses->lists pred (?rc0 ...) (?func1 ...) (common-rx ?rx0 ...) ?clause1 ...)
|
|
(clauses->lists pred
|
|
(?rc0 ...)
|
|
(?func1 ... (common-rx-clause->func pred ?rx0) ...)
|
|
?clause1 ...))
|
|
((clauses->lists pred (?rc1 ...) (?func0 ...) ?clause0 ?clause1 ...)
|
|
(clauses->lists pred
|
|
(?rc1 ... (clause->rc pred ?clause0))
|
|
(?func0 ...)
|
|
?clause1 ...))
|
|
((clauses->lists pred (?rc0 ...) (?func0 ...))
|
|
(rcs+commons->rules pred
|
|
(list ?rc0 ...)
|
|
(list ?func0 ...)))))
|
|
|
|
(define-syntax common-rx-clause->func
|
|
(syntax-rules ()
|
|
((common-rx-clause->func pred
|
|
(?out-of-date?-func ?target-rx
|
|
(?prereq-pattern0 ...)
|
|
?action0 ...))
|
|
(lambda (maybe-target)
|
|
(let ((target-rx ?target-rx)
|
|
(thunk (lambda () ?action0 ...))
|
|
(prereqs (list ?prereq-pattern0 ...)))
|
|
(common->func maybe-target target-rx pred
|
|
?out-of-date?-func ?target-rx prereqs thunk))))))
|
|
|
|
(define-syntax common-%-clause->func
|
|
(syntax-rules ()
|
|
((common-%-clause->func pred
|
|
(?out-of-date?-func ?target-pattern
|
|
(?prereq-pattern0 ...)
|
|
?action0 ...))
|
|
(lambda (maybe-target)
|
|
(let ((target-rx (%-pattern->rx ?target-pattern))
|
|
(thunk (lambda () ?action0 ...))
|
|
(prereqs (list ?prereq-pattern0 ...)))
|
|
(common->func maybe-target target-rx pred
|
|
?out-of-date?-func ?target-pattern prereqs thunk))))))
|
|
|
|
(define-syntax clause->rc
|
|
(syntax-rules ()
|
|
((clause->rc pred (?func ?target (?prereq0 ...) ?action0 ...))
|
|
(clause->rc-tmp () pred (?func ?target (?prereq0 ...) ?action0 ...)))))
|
|
|
|
(define-syntax clause->rc-tmp
|
|
(syntax-rules ()
|
|
((clause->rc-tmp (tmp1 ...) pred (?func ?target () ?action0 ...))
|
|
(let ((target ?target)
|
|
(prereqs (list tmp1 ...)))
|
|
(make-rule-cand target
|
|
prereqs
|
|
(lambda args
|
|
(let ((init-state (last args)))
|
|
(cons (?func target (list tmp1 ...))
|
|
init-state)))
|
|
(lambda args
|
|
(let ((cooked-state (last args))
|
|
(results (cdr (reverse (cdr args)))))
|
|
(cons (bind-all-fluids target prereqs results
|
|
(lambda () ?action0 ...))
|
|
cooked-state))))))
|
|
((clause->rc-tmp (tmp1 ...)
|
|
pred
|
|
(?func ?target (?prereq0 ?prereq1 ...) ?action0 ...))
|
|
(let ((tmp2 ?prereq0))
|
|
(clause->rc-tmp (tmp1 ... tmp2)
|
|
pred
|
|
(?func ?target (?prereq1 ...) ?action0 ...))))))
|