(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)) targets))) (map (lambda (t) (rule-make t init-state rule-set)) target-rules)))) (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)) (define (head->rc target prereqs thunk) (make-rc target prereqs head thunk)) (define (tail->rc target prereqs thunk) (make-rc target prereqs tail thunk)) (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) (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 "")))) (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)) (define (file-rx target prereqs thunk) (rx->func string=? target prereqs file thunk)) (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)) (define (once-rx target prereqs thunk) (rx->func string=? target prereqs once thunk)) (define (all-rx target prereqs thunk) (rx->func string=? target prereqs all thunk)) (define (always-rx target prereqs thunk) (rx->func string=? target prereqs always thunk)) (define (perms-rx target prereqs thunk) (rx->func string=? target prereqs perms thunk)) (define (md5-rx target prereqs thunk) (rx->func string=? target prereqs md5 thunk)) (define (md5-perms-rx target prereqs thunk) (rx->func string=? target prereqs md5-perms thunk)) (define (paranoid-rx target prereqs thunk) (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))) (define (file-% target prereqs thunk) (%->func string=? target prereqs file thunk)) (define (head-% target prereqs thunk) (%->func string=? target prereqs head thunk)) (define (tail-% target prereqs thunk) (%->func string=? target prereqs tail thunk)) (define (once-% target prereqs thunk) (%->func string=? target prereqs once thunk)) (define (all-% target prereqs thunk) (%->func string=? target prereqs all thunk)) (define (always-% target prereqs thunk) (%->func string=? target prereqs always thunk)) (define (perms-% target prereqs thunk) (%->func string=? target prereqs perms thunk)) (define (md5-% target prereqs thunk) (%->func string=? target prereqs md5 thunk)) (define (md5-perms-% target prereqs thunk) (%->func string=? target prereqs md5-perms thunk)) (define (paranoid-% target prereqs thunk) (%->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)))