scsh-make/macros.scm

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