106 lines
3.7 KiB
Scheme
106 lines
3.7 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 (?func ?target (?pre0 ...) ?act0 ...))
|
|
(common-rx-clause->func-tmp () pred (?func ?target (?pre0 ...) ?act0 ...)))))
|
|
|
|
|
|
(define-syntax common-rx-clause->func-tmp
|
|
(syntax-rules ()
|
|
((common-rx-clause->func (tmp1 ...) pred (?func ?target-rx () ?act0 ...))
|
|
(lambda (maybe-target)
|
|
(let ((trx ?target-rx)
|
|
(thunk (lambda () ?act0 ...))
|
|
(prereqs (list tmp1 ...)))
|
|
(common->func maybe-target trx pred ?func ?target-rx prereqs thunk))))
|
|
((common-rx-clause->func-tmp (tmp1 ...)
|
|
pred
|
|
(?func ?target (?pre0 ?pre1 ...) ?act0 ...))
|
|
(let ((tmp2 ?pre0))
|
|
(common-rx-clause->func-tmp (tmp1 ... tmp2)
|
|
pred
|
|
(?func ?target (?pre1 ...) ?act0 ...))))))
|
|
|
|
(define-syntax common-%-clause->func
|
|
(syntax-rules ()
|
|
((common-%-clause->func pred (?func ?target ?prereqs ?act0 ...))
|
|
(common-%-clause->func-tmp () pred (?func ?target ?prereqs ?act0 ...)))))
|
|
|
|
(define-syntax common-%-clause->func-tmp
|
|
(syntax-rules ()
|
|
((common-%-clause->func-tmp (tmp1 ...) pred (?func ?target () ?act0 ...))
|
|
(lambda (maybe-target)
|
|
(let ((trx (%-pattern->rx ?target))
|
|
(thunk (lambda () ?act0 ...))
|
|
(prereqs (list tmp1 ...)))
|
|
(common->func maybe-target trx pred ?func ?target prereqs thunk))))
|
|
((common-%-clause->func-tmp (tmp1 ...)
|
|
pred
|
|
(?func ?target (?pre0 ?pre1 ...) ?act0 ...))
|
|
(let ((tmp2 ?pre0))
|
|
(common-%-clause->func-tmp (tmp1 ... tmp2)
|
|
pred
|
|
(?func ?target (?pre1 ...) ?act0 ...))))
|
|
((common-%-clause->func-tmp () pred (?func ?target ?prereqs ?act0 ...))
|
|
(let ((prereqs ?prereqs))
|
|
(common-%-clause->func-tmp () pred (?func ?target prereqs ?act0 ...))))))
|
|
|
|
(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 ...))))))
|