puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch lang ninja build): expose phony build edges better

Browse source
This commit is contained in:
puck 2025-05-11 22:21:07 +00:00
parent f3618358aa
commit c94279fcb2
1 changed files with 33 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

39
lang/ninja/src/build.sld
View file

@ -22,7 +22,7 @@
(lambda (part)
(cond
((string=? part "") (when (null? part-stack) (set! part-stack '(""))))
((string=? part "..") (unless (or (null? part-stack) (string=? (car part-stack) "")) (set! part-stack (cdr part-stack))))
((string=? part "..") (if (or (null? part-stack) (string=? (car part-stack) "") (string=? (car part-stack) "..")) (set! part-stack (cons ".." part-stack)) (set! part-stack (cdr part-stack))))
((string=? part "."))
(else (set! part-stack (cons part part-stack)))))
parts)
@ -54,7 +54,7 @@
((eq? input-file 'base) #f)
; Phony rule; pass through the inputs literally.
((and (pair? input-file) (eq? (car input-file) 'phony)) (for-each append-file (cdr input-file)))
((and (pair? input-file) (eq? (car input-file) 'phony)) (for-each append-file (cddr input-file)))
; This file is produced by another build edge. Add it to our input vfs.
(input-file
@ -144,6 +144,27 @@
'("out"))))
outpath)
(define (phony-edge edges current-edge)
(define copies (list))
(define (process-input path)
(define input-file (mapping-ref edges path (lambda () (mapping-ref/default edges (normalize-path path) #f))))
(if (and (pair? input-file) (eq? (car input-file) 'phony))
(for-each process-input (cddr input-file))
(set! copies (cons #~,(string-append "mkdir -p \"$out/$(dirname " path ")\"; cp -rf " #$(force input-file) " $out/" path) copies))))
(for-each process-input (build-edge-inputs current-edge))
(define command
#~,(string-join #$copies "\n"))
(cdar
(store-path-for-ca-drv*
"zilch-ninja-phony-edge"
"x86_64-linux"
(list "/bin/sh" "-c" command)
#~(("PATH" . ,(string-append #$coreutils "/bin")))
'("out"))))
;; process a ninja file and corresponding vfs, and return two values:
;; - `edge-ref`, a lambda that lets one fetch any build edge;
;; - `defaults`, a list containing the default build edges.
@ -169,15 +190,21 @@
(for-each
(lambda (edge)
(define processed (delay (derivation-for-edge conf vfs-store-path relative-to edges edge)))
(define all-outputs (append (build-edge-outputs edge) (build-edge-implicit-outputs edge)))
(if (build-edge-resolved edge)
(for-each (lambda (v) (set! edges (mapping-set! edges v (delay #~,(string-append #$(force processed) "/" v)))))
(append (build-edge-outputs edge) (build-edge-implicit-outputs edge)))
all-outputs)
; This edge is phony; mark the edge as having its outputs.
(for-each (lambda (v) (set! edges (mapping-set! edges v (cons 'phony (build-edge-inputs edge)))))
(append (build-edge-outputs edge) (build-edge-implicit-outputs edge)))))
(for-each (lambda (v) (set! edges (mapping-set! edges v (cons 'phony (cons edge (build-edge-inputs edge))))))
all-outputs)))
(build-file-build-edges file))
(define edge-ref (lambda (path) (force (mapping-ref/default edges path #f))))
(define edge-ref
(lambda (path)
(define edge (force (mapping-ref/default edges path #f)))
(if (and (pair? edge) (eq? (car edge) 'phony))
(phony-edge edges (cadr edge))
edge)))
(define defaults (build-file-default-targets file))
(values edge-ref defaults))))