161 lines
5.8 KiB
Scheme
161 lines
5.8 KiB
Scheme
|
(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-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-$+ $+
|
||
|
|
|
||
|
|
;; $* : 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 $@
|
||
|
|
;;
|
||
|
|
;; $(@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-$*/ (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 (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))))))
|