2005-03-07 12:37:46 -05:00
|
|
|
(define (make rules targets . maybe-args)
|
|
|
|
(let-optionals maybe-args ((pred string=?)
|
|
|
|
(init-state (list)))
|
|
|
|
(let* ((rule-set (rules->rule-set rules))
|
|
|
|
(target-rules (map (lambda (target)
|
|
|
|
(lookup-rule pred target rules))
|
2005-02-04 03:05:55 -05:00
|
|
|
targets)))
|
2005-02-14 02:35:46 -05:00
|
|
|
(map (lambda (t)
|
|
|
|
(rule-make t init-state rule-set))
|
|
|
|
target-rules))))
|
2005-03-09 09:49:13 -05:00
|
|
|
|
|
|
|
(define (make-rc target prereqs out-of-date?-func thunk)
|
|
|
|
(make-rule-cand target
|
|
|
|
prereqs
|
|
|
|
(lambda args
|
|
|
|
(let ((init-state (last args)))
|
|
|
|
(cons (out-of-date?-func target prereqs)
|
|
|
|
init-state)))
|
|
|
|
(lambda args
|
|
|
|
(let ((cooked-state (last args))
|
|
|
|
(results (cdr (reverse (cdr args)))))
|
|
|
|
(cons (bind-all-fluids target prereqs results thunk)
|
|
|
|
cooked-state)))))
|
|
|
|
|
|
|
|
(define (file->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs file thunk))
|
|
|
|
|
2005-04-11 15:57:15 -04:00
|
|
|
(define (head->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs head thunk))
|
|
|
|
|
|
|
|
(define (tail->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs tail thunk))
|
|
|
|
|
2005-03-09 09:49:13 -05:00
|
|
|
(define (once->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs once thunk))
|
|
|
|
|
|
|
|
(define (all->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs all thunk))
|
|
|
|
|
|
|
|
(define (always->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs always thunk))
|
|
|
|
|
|
|
|
(define (perms->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs perms thunk))
|
|
|
|
|
|
|
|
(define (md5->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs md5 thunk))
|
|
|
|
|
|
|
|
(define (md5-perms->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs md5-perms thunk))
|
|
|
|
|
|
|
|
(define (paranoid->rc target prereqs thunk)
|
|
|
|
(make-rc target prereqs paranoid thunk))
|
|
|
|
|
|
|
|
(define (subst-% pattern match)
|
|
|
|
(regexp-substitute/global #f (rx (: (submatch (: bos (* any)))
|
|
|
|
(submatch "%")
|
|
|
|
(submatch (: (* any) eos))))
|
|
|
|
pattern 'pre 1 match 3 'post))
|
|
|
|
|
|
|
|
(define (%-pattern->match pattern no)
|
2005-04-11 15:57:15 -04:00
|
|
|
(let ((re (rx (: (submatch (: bos (* any)))
|
|
|
|
(submatch "%")
|
|
|
|
(submatch (: (* any) eos)))))
|
|
|
|
(found-%? (regexp-search (rx (: "%")) pattern)))
|
|
|
|
(if found-%?
|
|
|
|
(match:substring (regexp-search re pattern) no)
|
|
|
|
(if (= no 2) pattern ""))))
|
2005-03-09 09:49:13 -05:00
|
|
|
|
|
|
|
(define (%-pattern->rx pattern)
|
|
|
|
(let* ((left (%-pattern->match pattern 1))
|
|
|
|
(middle (%-pattern->match pattern 2))
|
|
|
|
(right (%-pattern->match pattern 3))
|
|
|
|
(target-rx (if (string=? "%" middle)
|
|
|
|
(rx (: (submatch (: bos ,left))
|
|
|
|
(submatch (* any))
|
|
|
|
(submatch (: ,right eos))))
|
|
|
|
(rx (: (submatch (: bos ,left))
|
|
|
|
(submatch ,middle)
|
|
|
|
(submatch (: ,right eos)))))))
|
|
|
|
target-rx))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (file-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs file thunk))
|
|
|
|
|
2005-04-11 15:57:15 -04:00
|
|
|
(define (head-rx target prereqs thunk)
|
|
|
|
(rx->func string=? target prereqs head thunk))
|
|
|
|
|
|
|
|
(define (tail-rx target prereqs thunk)
|
|
|
|
(rx->func string=? target prereqs tail thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (once-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs once thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (all-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs all thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (always-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs always thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (perms-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs perms thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (md5-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs md5 thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (md5-perms-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs md5-perms thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (paranoid-rx target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(rx->func string=? target prereqs paranoid thunk))
|
|
|
|
|
|
|
|
(define (rx->func pred target-rx prereqs out-of-date?-func thunk)
|
|
|
|
(lambda (maybe-target)
|
|
|
|
(common->func maybe-target target-rx pred
|
|
|
|
out-of-date?-func target-rx prereqs thunk)))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (file-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs file thunk))
|
|
|
|
|
2005-04-11 15:57:15 -04:00
|
|
|
(define (head-% target prereqs thunk)
|
|
|
|
(%->func string=? target prereqs head thunk))
|
|
|
|
|
|
|
|
(define (tail-% target prereqs thunk)
|
|
|
|
(%->func string=? target prereqs tail thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (once-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs once thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (all-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs all thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (always-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs always thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (perms-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs perms thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (md5-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs md5 thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (md5-perms-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs md5-perms thunk))
|
|
|
|
|
2005-03-09 10:24:10 -05:00
|
|
|
(define (paranoid-% target prereqs thunk)
|
2005-03-09 09:49:13 -05:00
|
|
|
(%->func string=? target prereqs paranoid thunk))
|
|
|
|
|
|
|
|
(define (%->func pred target-pattern prereqs out-of-date?-func thunk)
|
|
|
|
(lambda (maybe-target)
|
|
|
|
(let ((target-rx (%-pattern->rx target-pattern)))
|
|
|
|
(common->func maybe-target target-rx pred
|
|
|
|
out-of-date?-func target-pattern prereqs thunk))))
|
|
|
|
|
|
|
|
(define (common->func maybe-target target-rx pred
|
|
|
|
out-of-date?-func target-pattern prereqs thunk)
|
|
|
|
(let* ((match-data (regexp-search target-rx maybe-target))
|
|
|
|
(maybe-target-matches (if match-data
|
|
|
|
(map (lambda (no)
|
|
|
|
(match:substring match-data no))
|
|
|
|
(list 1 2 3))
|
|
|
|
#f)))
|
|
|
|
(if maybe-target-matches
|
|
|
|
(let* ((left (list-ref maybe-target-matches 0))
|
|
|
|
(target-match (list-ref maybe-target-matches 1))
|
|
|
|
(right (list-ref maybe-target-matches 2))
|
|
|
|
(target-name (string-append left target-match right))
|
|
|
|
(cooked-prereqs (map (lambda (prereq)
|
|
|
|
(if (string? prereq)
|
|
|
|
(subst-% prereq target-match)
|
|
|
|
prereq))
|
|
|
|
prereqs)))
|
|
|
|
(make-rule-cand target-name
|
|
|
|
cooked-prereqs
|
|
|
|
(lambda args
|
|
|
|
(let ((init-state (last args)))
|
|
|
|
(cons (bind-fluids-common
|
|
|
|
target-name left target-match right
|
|
|
|
(lambda ()
|
|
|
|
(out-of-date?-func target-name
|
|
|
|
cooked-prereqs)))
|
|
|
|
init-state)))
|
|
|
|
(lambda args
|
|
|
|
(let ((cooked-state (last args))
|
|
|
|
(prereqs-results (cdr (reverse (cdr args)))))
|
|
|
|
(cons (bind-fluids-common
|
|
|
|
target-name left target-match right
|
|
|
|
(lambda ()
|
|
|
|
(bind-all-fluids target-name
|
|
|
|
cooked-prereqs
|
|
|
|
prereqs-results
|
|
|
|
thunk)))
|
|
|
|
cooked-state)))))
|
|
|
|
#f)))
|