scsh-make/macros.scm

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