scsh-make/autovars.scm

173 lines
6.3 KiB
Scheme
Raw Normal View History

(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)))
(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 (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
((and (list? prereqs) (not (null? prereqs))) (car prereqs))
((and (list? prereqs) (null? prereqs)) "")
(else prereqs)))
($? (cond
((not (list? prereqs))
(let ((newer-prereq (list)))
(if (car (rule-result-wants-build?
(car prereqs-results)))
(cons newer-prereq newer-prereq)
newer-prereq)))
((and (list? prereqs) (null? prereqs)) prereqs)
((list? prereqs)
(let for-prereqs ((newer-prereqs (list))
(current-prereq (car prereqs))
(todo-prereqs (cdr prereqs))
(current-result (car prereqs-results))
(todo-results (cdr prereqs-results)))
(let ((build? (if (is-rule-result? current-result)
(car (rule-result-wants-build?
current-result))
#f)))
(if build?
(if (not (null? todo-prereqs))
(for-prereqs (cons current-prereq
newer-prereqs)
(car todo-prereqs)
(cdr todo-prereqs)
(car todo-results)
(cdr todo-results))
newer-prereqs)
(if (not (null? todo-prereqs))
(for-prereqs newer-prereqs
(car todo-prereqs)
(cdr todo-prereqs)
(car todo-results)
(cdr todo-results))
newer-prereqs)))))
(else (error "no match in bind-fluids-gnu fluid-$?"))))
($^ (delete-duplicates! prereqs))
($+ prereqs))
(let-thread-fluids fluid-$@ $@ ;; $@ : file name of the target
;; $% : target member name, when target is an archive member.
;; fluid-$% target
;; $< : name of the first prerequisite
fluid-$< $<
;; $? : names of all prerequisites that are newer than target
fluid-$? $?
;; $^ : names of all the prerequisites without duplicates
;; $+ : names of all the prerequisites
fluid-$^ $^
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 $@
;;
;; $(@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-$%)
;; $(<D), $(<F) : directory part and file-within-directory
fluid-$</ (file-name-directory $<)
fluid-/$< (file-name-nondirectory $<)
;; $(^D), $(^F) : directory part and file-within-directory
fluid-$^/ (map (lambda (d)
(file-name-directory d))
$^)
fluid-/$^ (map (lambda (f)
(file-name-nondirectory f))
$^)
;; $(+D), $(+F) : directory part and file-within-directory
fluid-$+/ (map (lambda (d)
(file-name-directory d))
$+)
fluid-/$+ (map (lambda (f)
(file-name-nondirectory f))
$+)
;; $(?D), $(?F) : directory part and the
;; file-within-directory part of $?.
fluid-$?/ (map (lambda (d)
(file-name-directory d))
$?)
fluid-/$? (map (lambda (f)
(file-name-nondirectory f))
$?)
thunk)))
(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-/$<))
(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 (bind-fluids-human target prereqs prereqs-results thunk)
(display "not yet implemented."))
;;; (define (bind-fluids-human target prereqs prereqs-results thunk)
;;; (lambda ()
;;; (bind-fluids-gnu target prereqs prereqs-results
;;; (lambda ()
;;; (let ((target-fname (make-preserved-thread-fluid $@))
;;; (prereqs-first (make-preserved-thread-fluid $<))
;;; (prereqs-to-build (make-preserved-thread-fluid $?))
;;; (prereqs-unique (make-preserved-thread-fluid $^))
;;; (prereqs (make-preserved-thread-fluid $+)))
;;; (thunk))))))