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

(zilch lang ninja build): improve build environment + setup times

Browse source 
Turns out generating one full VFS for every single build step is really
expensive.
This commit is contained in:
puck 2025-05-01 13:20:05 +00:00
parent 95e7ca1277
commit be1b4c3792
1 changed files with 26 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -4,6 +4,7 @@
(zilch file) (zilch magic) (scheme char)
(zilch nix drv) (zilch nix path)
(zilch nixpkgs) (zilch zexpr) (zilch vfs)
(chicken format)
(srfi 128) (srfi 146) (srfi 152)
(zilch lang ninja))
@ -41,9 +42,10 @@
(string-map (lambda (c) (if (is-valid-store-path-char c) c #\-)) (if (> (string-length str) 211) (string-copy str 0 211) str))))
(define (derivation-for-edge environment vfs relative-to-root edges current-edge)
(define (derivation-for-edge environment vfs-store-path relative-to-root edges current-edge)
(define resolved (build-edge-resolved current-edge))
(when (build-rule-rspfile resolved) (error "rspfile not yet supported" current-edge))
(define copy-input-files "")
(define (append-file path)
(define input-file (mapping-ref edges path (lambda () (mapping-ref/default edges (normalize-path path) #f))))
@ -51,16 +53,25 @@
(unless (eq? input-file 'base)
(if input-file
; This file is produced by another build edge. Add it to our input vfs.
(set! vfs (vfs-append-file vfs (normalize-path path) (force input-file)))
(error "Path doesn't exist as build edge" path))))
(let ((prev-copy-input-files copy-input-files))
(set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" relative-to-root "/$($COREUTILS/dirname " path "); $COREUTILS/cp -rf " #$(force input-file) " bdir/" relative-to-root "/" path))); (set! vfs (vfs-append-file vfs (normalize-path path) (force input-file)))
(if (string-prefix? "/nix/store" path)
(fprintf (current-error-port) "Path doesn't exist as build edge: ~S\n" path)
(error "Path doesn't exist as build edge" path))))
; Add the inputs, implicit dependencies, _and_ order-only dependencies to our vfs.
(for-each append-file (build-edge-inputs current-edge))
(for-each append-file (build-edge-implicit-dependencies current-edge))
(for-each append-file (build-edge-order-only-dependencies current-edge))
; Create parent directories for each output (TODO: implicit outputs?)
(for-each
(lambda (path)
(define prev-copy-input-files copy-input-files)
(set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" relative-to-root "/$($COREUTILS/dirname " path ")")))
(build-edge-outputs current-edge))
; Create the VFS.
(define input-store-path (vfs-to-store vfs))
(define command-to-run (build-rule-command resolved))
; For each output and implicit output, copy them to the derivation's output.
@ -74,8 +85,10 @@
; Run the build rule inside the build environment's vfs. This requires copying the entire VFS over, sadly.
(define command
#~,(string-append
#$coreutils "/bin/cp -rf --no-preserve=ownership " #$input-store-path " bdir\n"
#$coreutils "/bin/chmod ugo+rw -R bdir\ncd bdir/" relative-to-root "\n"
#$coreutils "/bin/cp -rf --no-preserve=ownership " #$vfs-store-path " bdir\n"
#$coreutils "/bin/chmod ugo+rw -R bdir\n"
"(COREUTILS=" #$coreutils "/bin; " #$copy-input-files ")\n"
"cd bdir/" relative-to-root "\n"
"(" command-to-run ") || exit 1\n"
"COREUTILS=" #$coreutils"/bin\n"
"$COREUTILS/mkdir " out-placeholder "\n"
@ -100,6 +113,7 @@
;; to be a nixpkgs-style derivation, the same way `nix-shell` works.
(define (process-ninja-file file vfs environment relative-to)
(when (or (derivation? environment) (store-path? environment)) (set! environment (environment-for-derivation environment)))
(unless (string-suffix? "/" relative-to) (set! relative-to (string-append relative-to "/")))
(define edges (mapping (make-default-comparator)))
@ -107,11 +121,16 @@
(mapping-for-each
(lambda (kv path)
(define path (if (string=? (car kv) "") (cdr kv) (string-append (car kv) "/" (cdr kv))))
(cond
((string=? relative-to "") #f)
((string-prefix? relative-to path) (set! path (string-copy path (string-length relative-to))))
(else (set! path (string-append "../" path))))
(set! edges (mapping-set! edges path 'base)))
(vfs-contents vfs))
(define vfs-store-path (vfs-to-store vfs))
(for-each
(lambda (edge)
(define processed (delay (derivation-for-edge environment vfs relative-to edges edge)))
(define processed (delay (derivation-for-edge environment vfs-store-path relative-to edges 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))))
(build-file-build-edges file))