added common rules: (common-file "%.o" ("%.c" "%.h") ...)
This commit is contained in:
jottbee
parent
6fe70b47e3
commit
0898ffd43d
40
autovars.scm
40
autovars.scm
|
|
@ -4,10 +4,13 @@
|
|||
(define fluid-$^ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$+ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$* (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$=* (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$*= (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$=*= (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$@/ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-/$@ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$*/ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-/$* (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$=*=/ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-/$=*= (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$</ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-/$< (make-preserved-thread-fluid (list)))
|
||||
(define fluid-$^/ (make-preserved-thread-fluid (list)))
|
||||
|
|
@ -17,6 +20,21 @@
|
|||
(define fluid-$?/ (make-preserved-thread-fluid (list)))
|
||||
(define fluid-/$? (make-preserved-thread-fluid (list)))
|
||||
|
||||
(define (bind-fluids-common target-name prefix match suffix thunk)
|
||||
(let (($* match)
|
||||
($*= suffix)
|
||||
($=* prefix)
|
||||
($=*= target-name))
|
||||
;; $* : The stem with which an implicit rule matches.
|
||||
(let-thread-fluids fluid-$* $*
|
||||
fluid-$=* $=*
|
||||
fluid-$*= $*=
|
||||
fluid-$=*= $=*=
|
||||
;; $(*D), $(*F) : directory part and file-within-directory
|
||||
fluid-$=*=/ (file-name-directory $=*=)
|
||||
fluid-/$=*= (file-name-nondirectory $=*=)
|
||||
thunk)))
|
||||
|
||||
(define (bind-fluids-gnu target prereqs prereqs-results thunk)
|
||||
(let (($@ target)
|
||||
($< (cond
|
||||
|
|
@ -59,9 +77,7 @@
|
|||
newer-prereqs)))))
|
||||
(else (error "no match in bind-fluids-gnu fluid-$?"))))
|
||||
($^ (delete-duplicates! prereqs))
|
||||
($+ prereqs)
|
||||
($* ""))
|
||||
|
||||
($+ prereqs))
|
||||
(let-thread-fluids fluid-$@ $@ ;; $@ : file name of the target
|
||||
;; $% : target member name, when target is an archive member.
|
||||
;; fluid-$% target
|
||||
|
|
@ -77,9 +93,6 @@
|
|||
fluid-$^ $^
|
||||
fluid-$+ $+
|
||||
|
||||
;; $* : The stem with which an implicit rule matches.
|
||||
fluid-$* $*
|
||||
|
||||
;; we have no parens so we will use the following *scheme*:
|
||||
;; e.g. for $@: $@/ denotes directory part of $@
|
||||
;; while /$@ denotes file within directory of $@
|
||||
|
|
@ -88,10 +101,6 @@
|
|||
fluid-$@/ (file-name-directory $@)
|
||||
fluid-/$@ (file-name-nondirectory $@)
|
||||
|
||||
;; $(*D), $(*F) : directory part and file-within-directory
|
||||
fluid-$*/ (file-name-directory $*)
|
||||
fluid-/$* (file-name-nondirectory $*)
|
||||
|
||||
;; $(%D), $(%F) : directory part and file-within-directory
|
||||
; $%/ (file-name-directory fluid-$%)
|
||||
; /$% (file-name-nondirectory fluid-$%)
|
||||
|
|
@ -132,10 +141,13 @@
|
|||
(define ($^) (thread-fluid fluid-$^))
|
||||
(define ($+) (thread-fluid fluid-$+))
|
||||
(define ($*) (thread-fluid fluid-$*))
|
||||
(define ($=*) (thread-fluid fluid-$=*))
|
||||
(define ($*=) (thread-fluid fluid-$*=))
|
||||
(define ($=*=) (thread-fluid fluid-$=*=))
|
||||
(define ($@/) (thread-fluid fluid-$@/))
|
||||
(define (/$@) (thread-fluid fluid-/$@))
|
||||
(define ($*/) (thread-fluid fluid-$*/))
|
||||
(define (/$*) (thread-fluid fluid-/$*))
|
||||
(define ($=*=/) (thread-fluid fluid-$=*=/))
|
||||
(define (/$=*=) (thread-fluid fluid-/$=*=))
|
||||
(define ($</) (thread-fluid fluid-$</))
|
||||
(define (/$<) (thread-fluid fluid-/$<))
|
||||
(define ($^/) (thread-fluid fluid-$^/))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,139 @@
|
|||
(define-record-type :common-rule
|
||||
(really-make-common-rule target prereqs wants-build? build-func)
|
||||
is-common-rule?
|
||||
(target common-rule-target)
|
||||
(prereqs common-rule-prereqs)
|
||||
(wants-build? common-rule-wants-build?)
|
||||
(build-func common-rule-build-func))
|
||||
|
||||
(define (make-empty-common-rules)
|
||||
(let* ((target-pattern "%")
|
||||
(make-does-file-exist? (lambda (target-name . cooked-prereqs)
|
||||
(lambda args
|
||||
(cons (file-not-exists? target-name)
|
||||
(last args)))))
|
||||
(make-error-if-not-exists (lambda (target-name . cooked-prereqs)
|
||||
(lambda args
|
||||
(error "file (assumed leaf) does not exist:"
|
||||
target-name))))
|
||||
(common-rule (really-make-common-rule target-pattern
|
||||
(list)
|
||||
make-does-file-exist?
|
||||
make-error-if-not-exists)))
|
||||
(list common-rule)))
|
||||
|
||||
(define (common-rules-add common-rules descr)
|
||||
(let ((target (list-ref descr 0))
|
||||
(prereqs (list-ref descr 1))
|
||||
(wants-build? (list-ref descr 2))
|
||||
(build-func (list-ref descr 3)))
|
||||
(cons (really-make-common-rule target prereqs wants-build? build-func)
|
||||
common-rules)))
|
||||
|
||||
(define (search-match-in-common-rules common-rules target)
|
||||
(if (null? common-rules)
|
||||
#f
|
||||
(let next-common-rule ((current (car common-rules))
|
||||
(todo (cdr common-rules)))
|
||||
(let ((maybe-target (is-matched-by? (common-rule-target current) target)))
|
||||
(if maybe-target
|
||||
(let* ((prefix (list-ref maybe-target 0))
|
||||
(match (list-ref maybe-target 1))
|
||||
(suffix (list-ref maybe-target 2))
|
||||
(target-name (string-append prefix match suffix))
|
||||
(cooked-prereqs (map (lambda (prereq)
|
||||
(replace-by-match prereq match))
|
||||
(common-rule-prereqs current)))
|
||||
(make-wants-build? (common-rule-wants-build? current))
|
||||
(wants-build? (apply make-wants-build?
|
||||
(append (list target-name)
|
||||
cooked-prereqs)))
|
||||
(make-build-func (common-rule-build-func current))
|
||||
(build-func
|
||||
(lambda args
|
||||
(bind-fluids-common target-name prefix match suffix
|
||||
(lambda ()
|
||||
(apply
|
||||
(make-build-func target-name
|
||||
cooked-prereqs)
|
||||
args))))))
|
||||
(list target-name cooked-prereqs wants-build? build-func))
|
||||
(if (null? todo)
|
||||
#f
|
||||
(next-common-rule (car todo) (cdr todo))))))))
|
||||
|
||||
(define (common-rcs->common-rules common-rules)
|
||||
(let ((empty-rules (make-empty-common-rules))
|
||||
(common-rcs common-rules)) ; maybe reverse list
|
||||
(if (null? common-rcs)
|
||||
empty-rules
|
||||
(let each-rc ((rc (car common-rcs))
|
||||
(todo (cdr common-rcs))
|
||||
(done empty-rules))
|
||||
(if (null? todo)
|
||||
(common-rules-add done rc)
|
||||
(each-rc (car todo) (cdr todo) (common-rules-add done rc)))))))
|
||||
|
||||
;;;
|
||||
;;; returns a list containing three elements or false
|
||||
;;; the first element is the left part of the match
|
||||
;;; the second element is the middle part of the match
|
||||
;;; the third element is the right part of the match
|
||||
;;;
|
||||
;;; (is-matched-by? "%.o" "bar.o") ---> '("" "bar" ".o")
|
||||
;;; (is-matched-by? "%.tex" "bar.o") ---> #f
|
||||
;;;
|
||||
(define (is-matched-by? target-descr target-name)
|
||||
(let* ((submatches (map (lambda (match-no)
|
||||
(match:substring
|
||||
(regexp-search (rx (: (submatch (* any))
|
||||
(submatch "%")
|
||||
(submatch (* any))))
|
||||
target-descr)
|
||||
match-no))
|
||||
(list 1 2 3)))
|
||||
(left (list-ref submatches 0))
|
||||
(middle (list-ref submatches 1))
|
||||
(right (list-ref submatches 2))
|
||||
(constructed-rx (if (string=? "%" middle)
|
||||
(rx (: (submatch ,left)
|
||||
(submatch (* any))
|
||||
(submatch ,right)))
|
||||
(rx (: (submatch ,left)
|
||||
(submatch ,middle)
|
||||
(submatch ,right)))))
|
||||
(maybe-match (regexp-search constructed-rx target-name)))
|
||||
(if maybe-match
|
||||
(map (lambda (match-no)
|
||||
(match:substring maybe-match match-no))
|
||||
(list 1 2 3))
|
||||
#f)))
|
||||
|
||||
;;;
|
||||
;;; returns the string where the match is replaced with replacement
|
||||
;;; or the identity of maybe-match
|
||||
;;;
|
||||
;;; (replace-by-match "no-percents.c" "foo") ---> "no-percents.c"
|
||||
;;; (replace-by-match "%.c" "foo") ---> "foo.c"
|
||||
;;;
|
||||
(define (replace-by-match maybe-match replacement)
|
||||
(regexp-substitute/global
|
||||
#f
|
||||
(rx (: (submatch (* any)) (submatch "%") (submatch (* any))))
|
||||
maybe-match
|
||||
'pre 1 replacement 3 'post))
|
||||
|
||||
(define (common-rules-show common-rules)
|
||||
(display "\n=== \n=== COMMON RULES") (newline)
|
||||
(for-each (lambda (common-rule)
|
||||
(display "=== ") (newline)
|
||||
(let* ((target (common-rule-target common-rule))
|
||||
(prereqs (common-rule-prereqs common-rule))
|
||||
(wants-build? (common-rule-wants-build? common-rule))
|
||||
(build-func (common-rule-build-func common-rule)))
|
||||
(display "=== target : ") (display target) (newline)
|
||||
(display "=== prereqs : ") (display prereqs) (newline)
|
||||
(display "=== wants-build? : ") (display wants-build?) (newline)
|
||||
(display "=== build-func : ") (display build-func) (newline)))
|
||||
common-rules)
|
||||
(newline))
|
||||
280
macros.scm
280
macros.scm
|
|
@ -1,24 +1,60 @@
|
|||
;;;
|
||||
;;; MAKEFILE:
|
||||
;;; =========
|
||||
|
||||
;;;
|
||||
;;;
|
||||
;;; <makefile> ::= '(' + "makefile" + <makerule-clause>* + ')'
|
||||
;;; <makerule-clause> ::= <file-clause>
|
||||
;;; | <all-clause>
|
||||
;;; | <md5-clause>
|
||||
;;; | <always-clause>
|
||||
;;; | <once-clause>
|
||||
;;; | <common-file-clause>
|
||||
;;; | <common-all-clause>
|
||||
;;; | <common-md5-clause>
|
||||
;;; | <common-always-clause>
|
||||
;;; | <common-once-clause>
|
||||
;;;
|
||||
;;;
|
||||
(define-syntax makefile
|
||||
(syntax-rules ()
|
||||
((makefile) (list))
|
||||
((makefile ?rule0 ?rule1 ...) (?rule0 (makefile ?rule1 ...)))))
|
||||
((makefile ?rule0 ...)
|
||||
(sort-rules () () ?rule0 ...))))
|
||||
|
||||
;;;
|
||||
;;; <file-clause>
|
||||
;;; Each rule will be transformed into something similar to this:
|
||||
;;;
|
||||
;;; to achieve consistency only rule will use the rule-tmpvars
|
||||
;;; macro directly and all other macros use this clause
|
||||
;;; (cons ()
|
||||
;;; ("target" ("prereq0" ...) is-out-of-date? (lambda () ?action0 ...)))
|
||||
;;;
|
||||
;;; or this
|
||||
;;;
|
||||
;;; (cons ("target" ("prereq0" ...) is-out-of-date? (lambda () ?action0 ...)
|
||||
;;; ()))
|
||||
;;;
|
||||
;;; The car of each result then goes into the file-rules-list while the
|
||||
;;; cdr goes into the common-rules-list. At the end those elements in each
|
||||
;;; of the file-rules-list and the common-rules-list being empty lists are
|
||||
;;; removed. The result are the cons-ed remaining lists.
|
||||
;;;
|
||||
(define-syntax sort-rules
|
||||
(syntax-rules ()
|
||||
((sort-rules (?file0 ...) (?common0 ...))
|
||||
(let ((file-rules (remove null? (list ?file0 ...)))
|
||||
(common-rules (remove null? (list ?common0 ...))))
|
||||
(cons file-rules common-rules)))
|
||||
((sort-rules (?file1 ...) (?common1 ...) ?rule0 ?rule1 ...)
|
||||
(let ((rule-result ?rule0))
|
||||
(let ((common0 (cdr rule-result))
|
||||
(file0 (car rule-result)))
|
||||
(sort-rules (file0 ?file1 ...) (common0 ?common1 ...) ?rule1 ...))))))
|
||||
|
||||
;;;
|
||||
;;; MAKERULE-CLAUSES:
|
||||
;;; =================
|
||||
;;;
|
||||
;;;
|
||||
;;; <file-clause>
|
||||
;;;
|
||||
(define-syntax makefile-rule
|
||||
(syntax-rules ()
|
||||
|
|
@ -41,22 +77,55 @@
|
|||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(lambda (rule-candidates)
|
||||
(cons (list target
|
||||
prereqs
|
||||
(make-is-out-of-date? target tmp1 ...)
|
||||
(make-file-build-func target prereqs thunk))
|
||||
rule-candidates))))
|
||||
((file-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...) ?action0 ...)
|
||||
(list))))
|
||||
((file-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(file-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...) ?action0 ...)))))
|
||||
(file-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <all-clause>
|
||||
;;;
|
||||
(define-syntax all
|
||||
(syntax-rules ()
|
||||
((makefile-rule ?target ?prereqs ?action0 ...)
|
||||
(file-all ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax all-out-of-date?
|
||||
(syntax-rules ()
|
||||
((all-out-of-date? ?target ?prereqs ?action0 ...)
|
||||
(file-all ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax file-all
|
||||
(syntax-rules ()
|
||||
((file-all ?target (?prereq0 ...) ?action0 ...)
|
||||
(file-all-tmpvars () ?target (?prereq0 ...) ?action0 ...))))
|
||||
|
||||
(define-syntax file-all-tmpvars
|
||||
(syntax-rules ()
|
||||
((file-all-tmpvars (tmp1 ...) ?target () ?action0 ...)
|
||||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(cons (list target
|
||||
prereqs
|
||||
(make-all-out-of-date? target tmp1 ...)
|
||||
(make-all-build-func target prereqs thunk))
|
||||
(list))))
|
||||
((file-all-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(file-all-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <md5-clause>
|
||||
;;;
|
||||
;;; to achieve consistency only file-md5 will use the file-md5-tmpvars
|
||||
;;; macro directly and all other macros use this clause
|
||||
;;;
|
||||
(define-syntax md5
|
||||
(syntax-rules ()
|
||||
((md5 ?target ?prereqs ?action0 ...)
|
||||
|
|
@ -73,22 +142,20 @@
|
|||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(lambda (rule-candidates)
|
||||
(cons (list target
|
||||
prereqs
|
||||
(make-md5-sum-changed? target tmp1 ...)
|
||||
(make-md5-build-func target prereqs thunk))
|
||||
rule-candidates))))
|
||||
((file-md5-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...) ?action0 ...)
|
||||
(list))))
|
||||
((file-md5-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(file-md5-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...) ?action0 ...)))))
|
||||
(file-md5-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <always-clause>
|
||||
;;;
|
||||
;;; to achieve consistency only rule-always will use the rule-always-tmpvars
|
||||
;;; macro directly and all other macros use this clause
|
||||
;;;
|
||||
(define-syntax phony
|
||||
(syntax-rules ()
|
||||
((phony ?target ?prereqs ?action0 ...)
|
||||
|
|
@ -115,22 +182,20 @@
|
|||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(lambda (rule-candidates)
|
||||
(cons (list target
|
||||
prereqs
|
||||
(make-is-out-of-date! target tmp1 ...)
|
||||
(make-always-build-func target prereqs thunk))
|
||||
rule-candidates))))
|
||||
((file-always-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...) ?action0 ...)
|
||||
(list))))
|
||||
((file-always-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(file-always-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...) ?action0 ...)))))
|
||||
(file-always-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <once-clause>
|
||||
;;;
|
||||
;;; to achieve consistency only rule-once will use the rule-once-tmpvars
|
||||
;;; macro directly and all other macros use this clause
|
||||
;;;
|
||||
(define-syntax once
|
||||
(syntax-rules ()
|
||||
((once ?target ?prereqs ?action0 ...)
|
||||
|
|
@ -147,12 +212,165 @@
|
|||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(lambda (rule-candidates)
|
||||
(cons (list target
|
||||
prereqs
|
||||
(make-once target tmp1 ...)
|
||||
(make-once-build-func target prereqs thunk))
|
||||
rule-candidates))))
|
||||
((file-once-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...) ?action0 ...)
|
||||
(list))))
|
||||
((file-once-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(file-once-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...) ?action0 ...)))))
|
||||
(file-once-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;; COMMON-MAKERULE-CLAUSES:
|
||||
;;; ========================
|
||||
;;;
|
||||
;;;
|
||||
;;;
|
||||
;;; <common-file-clause>
|
||||
;;;
|
||||
(define-syntax common-file
|
||||
(syntax-rules ()
|
||||
((common-file ?target (?prereq0 ...) ?action0 ...)
|
||||
(common-file-tmpvars () ?target (?prereq0 ...) ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-tmpvars
|
||||
(syntax-rules ()
|
||||
((common-file-tmpvars (tmp1 ...) ?target () ?action0 ...)
|
||||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(cons (list)
|
||||
(list target
|
||||
prereqs
|
||||
(make-common-is-out-of-date? target tmp1 ...)
|
||||
(make-common-file-build-func target prereqs thunk)))))
|
||||
((common-file-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(common-file-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <common-all-clause>
|
||||
;;;
|
||||
;;; to achieve consistency only file will use the file-tmpvars
|
||||
;;; macro directly and all other macros use this clause
|
||||
;;;
|
||||
(define-syntax common-all
|
||||
(syntax-rules ()
|
||||
((common-all ?target ?prereqs ?action0 ...)
|
||||
(common-file-all ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-all
|
||||
(syntax-rules ()
|
||||
((common-file-all ?target (?prereq0 ...) ?action0 ...)
|
||||
(common-file-all-tmpvars () ?target (?prereq0 ...) ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-all-tmpvars
|
||||
(syntax-rules ()
|
||||
((common-file-all-tmpvars (tmp1 ...) ?target () ?action0 ...)
|
||||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(cons (list)
|
||||
(list target
|
||||
prereqs
|
||||
(make-common-all-out-of-date? target tmp1 ...)
|
||||
(make-common-all-build-func target prereqs thunk)))))
|
||||
((common-file-all-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(common-file-all-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <common-md5-clause>
|
||||
;;;
|
||||
(define-syntax common-md5
|
||||
(syntax-rules ()
|
||||
((common-md5 ?target ?prereqs ?action0 ...)
|
||||
(common-file-md5 ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-md5
|
||||
(syntax-rules ()
|
||||
((common-file-md5 ?target (?prereq0 ...) ?action0 ...)
|
||||
(common-file-md5-tmpvars () ?target (?prereq0 ...) ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-md5-tmpvars
|
||||
(syntax-rules ()
|
||||
((common-file-md5-tmpvars (tmp1 ...) ?target () ?action0 ...)
|
||||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(cons (list)
|
||||
(list target
|
||||
prereqs
|
||||
(make-common-md5-sum-changed? target tmp1 ...)
|
||||
(make-common-md5-build-func target prereqs thunk)))))
|
||||
((common-file-md5-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(common-file-md5-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <common-always-clause>
|
||||
;;;
|
||||
(define-syntax common-always
|
||||
(syntax-rules ()
|
||||
((common-always ?target ?prereqs ?action0 ...)
|
||||
(common-file-always ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-always
|
||||
(syntax-rules ()
|
||||
((common-file-always ?target ?prereqs ?action0 ...)
|
||||
(common-file-always-tmpvars () ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-always-tmpvars
|
||||
(syntax-rules ()
|
||||
((common-file-always-tmpvars (tmp1 ...) ?target () ?action0 ...)
|
||||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(cons (list)
|
||||
(list target
|
||||
prereqs
|
||||
(make-common-is-out-of-date! target tmp1 ...)
|
||||
(make-common-always-build-func target prereqs thunk)))))
|
||||
((common-file-always-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(common-file-always-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
||||
;;;
|
||||
;;; <common-once-clause>
|
||||
;;;
|
||||
(define-syntax common-once
|
||||
(syntax-rules ()
|
||||
((common-once ?target ?prereqs ?action0 ...)
|
||||
(common-file-once ?target ?prereqs ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-once
|
||||
(syntax-rules ()
|
||||
((common-file-once ?target (?prereq0 ...) ?action0 ...)
|
||||
(common-file-once-tmpvars () ?target (?prereq0 ...) ?action0 ...))))
|
||||
|
||||
(define-syntax common-file-once-tmpvars
|
||||
(syntax-rules ()
|
||||
((common-file-once-tmpvars (tmp1 ...) ?target () ?action0 ...)
|
||||
(let ((target ?target)
|
||||
(prereqs (list tmp1 ...))
|
||||
(thunk (lambda () ?action0 ...)))
|
||||
(cons (list)
|
||||
(list target
|
||||
prereqs
|
||||
(make-common-once target tmp1 ...)
|
||||
(make-common-once-build-func target prereqs thunk)))))
|
||||
((common-file-once-tmpvars (tmp1 ...) ?target (?prereq0 ?prereq1 ...)
|
||||
?action0 ...)
|
||||
(let ((tmp2 ?prereq0))
|
||||
(common-file-once-tmpvars (tmp1 ... tmp2) ?target (?prereq1 ...)
|
||||
?action0 ...)))))
|
||||
|
|
|
|||
4
make.scm
4
make.scm
|
|
@ -1,6 +1,8 @@
|
|||
(define (make rcs targets . maybe-arg)
|
||||
(let-optionals maybe-arg ((init-state (list)))
|
||||
(let* ((rules (rcs->rules rcs))
|
||||
(let* ((common-rule-candidates (cdr rcs))
|
||||
(rule-candidates (car rcs))
|
||||
(rules (rcs->rules rule-candidates common-rule-candidates))
|
||||
(rule-set (rules->rule-set rules))
|
||||
(target-rules (map (lambda (t) (lookup-rule t rules))
|
||||
targets)))
|
||||
|
|
|
|||
67
packages.scm
67
packages.scm
|
|
@ -184,7 +184,14 @@
|
|||
(always :syntax)
|
||||
(is-out-of-date! :syntax)
|
||||
(once :syntax)
|
||||
(file-once :syntax)))
|
||||
(file-once :syntax)
|
||||
(common-file :syntax)
|
||||
(common-md5 :syntax)
|
||||
(common-file-md5 :syntax)
|
||||
(common-always :syntax)
|
||||
(common-file-always :syntax)
|
||||
(common-once :syntax)
|
||||
(common-file-once :syntax)))
|
||||
|
||||
(define-structure macros macros-interface
|
||||
(open scheme-with-scsh
|
||||
|
|
@ -210,6 +217,7 @@
|
|||
srfi-1
|
||||
templates
|
||||
make-rule
|
||||
common-rules
|
||||
dfs)
|
||||
(files to-rule-set))
|
||||
|
||||
|
|
@ -226,19 +234,10 @@
|
|||
threads
|
||||
srfi-1
|
||||
srfi-9
|
||||
misc
|
||||
let-opt
|
||||
(with-prefix rendezvous-channels cml-sync-ch/))
|
||||
(files dfs))
|
||||
|
||||
(define-interface misc-interface
|
||||
(export sort
|
||||
insert))
|
||||
|
||||
(define-structure misc misc-interface
|
||||
(open scheme-with-scsh)
|
||||
(files misc))
|
||||
|
||||
(define-interface templates-interface
|
||||
(export make-file-build-func
|
||||
make-md5-build-func
|
||||
|
|
@ -247,10 +246,19 @@
|
|||
make-is-out-of-date!
|
||||
make-once
|
||||
make-is-out-of-date?
|
||||
make-md5-sum-changed?))
|
||||
make-md5-sum-changed?
|
||||
make-common-file-build-func
|
||||
make-common-md5-build-func
|
||||
make-common-always-build-func
|
||||
make-common-once-build-func
|
||||
make-common-is-out-of-date!
|
||||
make-common-once
|
||||
make-common-is-out-of-date?
|
||||
make-common-md5-sum-changed?))
|
||||
|
||||
(define-structure templates templates-interface
|
||||
(open scheme-with-scsh
|
||||
common-rules
|
||||
autovars
|
||||
srfi-1
|
||||
big-util
|
||||
|
|
@ -258,17 +266,21 @@
|
|||
(files templates))
|
||||
|
||||
(define-interface autovars-interface
|
||||
(export bind-fluids-gnu
|
||||
(export bind-fluids-common
|
||||
bind-fluids-gnu
|
||||
fluid-$@
|
||||
fluid-$<
|
||||
fluid-$?
|
||||
fluid-$^
|
||||
fluid-$+
|
||||
fluid-$*
|
||||
fluid-$=*
|
||||
fluid-$*=
|
||||
fluid-$=*=
|
||||
fluid-$@/
|
||||
fluid-/$@
|
||||
fluid-$*/
|
||||
fluid-/$*
|
||||
fluid-$=*=/
|
||||
fluid-/$=*=
|
||||
fluid-$</
|
||||
fluid-/$<
|
||||
fluid-$^/
|
||||
|
|
@ -283,10 +295,13 @@
|
|||
$^
|
||||
$+
|
||||
$*
|
||||
$=*
|
||||
$*=
|
||||
$=*=
|
||||
$@/
|
||||
/$@
|
||||
$*/
|
||||
/$*
|
||||
$=*=/
|
||||
/$=*=
|
||||
$</
|
||||
/$<
|
||||
$^/
|
||||
|
|
@ -305,6 +320,24 @@
|
|||
srfi-13)
|
||||
(files autovars))
|
||||
|
||||
(define-interface common-rules-interface
|
||||
(export make-empty-common-rules
|
||||
common-rules-add
|
||||
common-rules-show
|
||||
search-match-in-common-rules
|
||||
common-rcs->common-rules
|
||||
is-matched-by?
|
||||
replace-by-match))
|
||||
|
||||
(define-structure common-rules common-rules-interface
|
||||
(open scheme-with-scsh
|
||||
autovars
|
||||
srfi-1
|
||||
srfi-9
|
||||
big-util
|
||||
srfi-13)
|
||||
(files common-rules))
|
||||
|
||||
(define-structure make (export make)
|
||||
(open scheme-with-scsh
|
||||
srfi-1
|
||||
|
|
@ -314,4 +347,4 @@
|
|||
make-rule)
|
||||
(files make))
|
||||
|
||||
(define make-rule make-rule-cml)
|
||||
(define make-rule make-rule-no-cml)
|
||||
|
|
|
|||
|
|
@ -190,3 +190,38 @@
|
|||
#f))
|
||||
(else (error "no match in same-checksum?"))))))
|
||||
(else (error "no match in same-checksum?")))))))
|
||||
|
||||
(define (make-common-is-out-of-date? target-descr . prereqs)
|
||||
(lambda args (apply make-is-out-of-date? args)))
|
||||
|
||||
(define (make-common-file-build-func target-descr prereqs thunk)
|
||||
(lambda (target-name cooked-prereqs)
|
||||
(make-file-build-func target-name cooked-prereqs thunk)))
|
||||
|
||||
(define (make-common-all-out-of-date? target-descr . prereqs)
|
||||
(lambda args (apply make-all-out-of-date? args)))
|
||||
|
||||
(define (make-common-all-build-func target-descr prereqs thunk)
|
||||
(lambda (target-name cooked-prereqs)
|
||||
(make-all-build-func target-name cooked-prereqs thunk)))
|
||||
|
||||
(define (make-common-md5-sum-changed? target-descr . prereqs)
|
||||
(lambda args (apply make-md5-sum-changed? args)))
|
||||
|
||||
(define (make-common-md5-build-func target-descr prereqs thunk)
|
||||
(lambda (target-name cooked-prereqs)
|
||||
(make-md5-build-func target-name cooked-prereqs thunk)))
|
||||
|
||||
(define (make-common-is-out-of-date! target-descr . prereqs)
|
||||
(lambda args (apply make-is-out-of-date! args)))
|
||||
|
||||
(define (make-common-always-build-func target-descr prereqs thunk)
|
||||
(lambda (target-name cooked-prereqs)
|
||||
(make-always-build-func target-name cooked-prereqs thunk)))
|
||||
|
||||
(define (make-common-once target-descr . prereqs)
|
||||
(lambda args (apply make-common-once args)))
|
||||
|
||||
(define (make-common-once-build-func target-descr prereqs thunk)
|
||||
(lambda (target-name cooked-prereqs)
|
||||
(make-once-build-func target-name cooked-prereqs thunk)))
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
(define (rc->dfs-node rc)
|
||||
(let ((target (list-ref rc 0))
|
||||
(prereqs (list-ref rc 1))
|
||||
(wants-build? (list-ref rc 2))
|
||||
(build-func (list-ref rc 3)))
|
||||
(make-dfs target prereqs (list wants-build? build-func))))
|
||||
|
||||
(define (rcs->dag rcs)
|
||||
(map (lambda (rc)
|
||||
(let ((target (list-ref rc 0))
|
||||
|
|
@ -22,14 +29,7 @@
|
|||
(let ((wants-build? (car ignored))
|
||||
(build-func (cadr ignored)))
|
||||
(list target prereqs wants-build? build-func))
|
||||
(let* ((tfname (expand-file-name target (cwd)))
|
||||
(wants-build? (lambda args
|
||||
(cons (file-not-exists? tfname)
|
||||
(last args))))
|
||||
(build-func (lambda args
|
||||
(error "file (assumed leaf) does not exist:"
|
||||
tfname))))
|
||||
(list target prereqs wants-build? build-func)))))
|
||||
(error "node without wants-build? and build-func"))))
|
||||
dag))
|
||||
|
||||
(define (lookup-rc rc rcs)
|
||||
|
|
@ -50,11 +50,16 @@
|
|||
(cdr maybe-rule)
|
||||
(error "lookup-rule: fname not found in rules."))))
|
||||
|
||||
(define (rcs->rules rule-candidates)
|
||||
(let* ((sorted-dag (dfs (rcs->dag rule-candidates)))
|
||||
(define (rcs->rules rule-candidates common-rcs)
|
||||
(let* ((common-rules (common-rcs->common-rules common-rcs))
|
||||
(create-leaf (lambda (maybe-target)
|
||||
(rc->dfs-node
|
||||
(search-match-in-common-rules common-rules
|
||||
maybe-target))))
|
||||
(sorted-dag (dfs (rcs->dag rule-candidates) string=? #t create-leaf))
|
||||
(sorted-rcs (dag->rcs sorted-dag)))
|
||||
;;(common-rules-show common-rules) (newline)
|
||||
;;(dfs-dag-show sorted-dag (car sorted-dag))
|
||||
;; (rcs-show sorted-rcs)
|
||||
(if (not (null? sorted-rcs))
|
||||
(let for-all-rcs ((rc (car sorted-rcs))
|
||||
(todo (cdr sorted-rcs))
|
||||
|
|
|
|||
Loading…
Reference in New Issue