(zilch ninja build): elide vfs per-build as much as possible

This should limit the amount of spurious rebuilds.

Change-Id: I6a6a6964b8ba2672c376d848f362f18a599c45d9

lang/ninja/src/build.sld

@@ -26,11 +26,12 @@
     (phony-inputs built-edge-phony-inputs))
 
   (define-record-type <build-env>
-    (make-build-env config vfs build-dir)
+    (make-build-env config vfs build-dir base-paths)
     build-env?
     (config build-env-config)
-    (vfs build-env-vfs)
+    (vfs build-env-vfs set-build-env-vfs!)
-    (build-dir build-env-build-dir))
+    (build-dir build-env-build-dir)
+    (base-paths build-env-base-paths set-build-env-base-paths!))
 
   ;; normalize a POSIX-y path. Ninja doesn't have an internal concept of path normalisation,
   ;; so this is necessary for proper file-finding behavior.
@@ -72,7 +73,7 @@
     (define (append-file path)
       ; Normalize paths pointing into the build environment.
       (cond
-       ((string-prefix? "/build/bdir/src/" path)
+       ((or (string-prefix? "/build/bdir/src/" path) (string-prefix? "/build/bdir/out/" path))
         (set! path (string-append "../" (string-copy path 12))))
        ((string-prefix? "/build/bdir/build/" path)
         (set! path (string-copy path 18))))
@@ -85,6 +86,12 @@
         ; if input-file is 'base, this is part of the base vfs; we don't filter that right now.
         ((eq? input-file 'base) #f)
 
+        ; a base-path path we'll have to copy from the store.
+        ((eq? input-file 'base-path)
+         (let ((base-path-obj (mapping-ref (build-env-base-paths env) path (lambda () (mapping-ref (build-env-base-paths env) (normalize-path path)))))
+               (prev-copy-input-files copy-input-files))
+          (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" (build-env-build-dir env) "/$($COREUTILS/dirname " path "); $COREUTILS/cp -rf " #$(force base-path-obj) " bdir/" (build-env-build-dir env) "/" path))))
+
         ; Phony rule; pass through the inputs literally.
         ((eq? input-file 'phony) (for-each append-file (built-edge-phony-inputs input-edge)))
 
@@ -107,6 +114,19 @@
          (let ((prev-copy-input-files copy-input-files))
           (set! copy-input-files #~,(string-append #$prev-copy-input-files "\n" "$COREUTILS/mkdir -p bdir/" (build-env-build-dir env) "/$($COREUTILS/dirname " so-path "); $COREUTILS/cp -rf " #$so-file " bdir/" (build-env-build-dir env) "/" so-path)))))
 
+      ; When we're depending on a binary, pull in all the libraries it links to, too
+      (when
+       (and input-edge
+        (string=? (build-edge-rule (built-edge-edge input-edge)) "cpp_LINKER")
+        (not (string-suffix? ".so" path)))
+       (for-each
+        (lambda (input)
+          (define edge-data (mapping-ref edges input (lambda () (mapping-ref/default edges (normalize-path input) #f))))
+          (define input-built-edge (and edge-data (force (cdr edge-data))))
+          (when (and input-built-edge (built-edge-lib-placeholder input-built-edge))
+           (append-file (car (force (built-edge-lib-placeholder input-built-edge))))))
+        (build-edge-implicit-dependencies (built-edge-edge input-edge))))
+
       ; Make sure we have all .so stubs transitively.
       (when
        (and input-edge (built-edge-lib-placeholder input-edge))
@@ -128,6 +148,15 @@
     (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))
+    
+    (when
+     (and
+      (or (string=? (build-edge-rule current-edge) "CUSTOM_COMMAND")
+         (string=? (build-edge-rule current-edge) "CUSTOM_COMMAND_DEP"))
+      (string-contains (mapping-ref/default (build-edge-variables current-edge) "COMMAND" "") "/meson-private/"))
+     (let* ((command (mapping-ref (build-edge-variables current-edge) "COMMAND"))
+            (pickle-path (string-copy command (string-contains command "/build/bdir/build/meson-private"))))
+      (append-file pickle-path)))
 
     ; Create parent directories for each output (TODO: implicit outputs?)
     (for-each
@@ -245,6 +274,10 @@
       #~(("ZILCH_CMD" . #$command) ("passAsFile" . "ZILCH_CMD") ("PATH" . ,(string-append #$coreutils "/bin")))
       '("out"))))
 
+  (define (can-safely-elide path)
+   (or
+    (string-suffix? ".cc" path)
+    (string-suffix? ".c" path)))
 
   ;; process a ninja file and corresponding vfs, and return two values:
   ;; - `edge-ref`, a lambda that lets one fetch any build edge;
@@ -258,22 +291,58 @@
     (define edges (mapping (make-default-comparator)))
 
     ; record edges for each path in the base vfs.
+    (define base-paths
+     (mapping (make-default-comparator)))
+    (define path-to-vfs
+     (mapping (make-default-comparator)))
     (mapping-for-each
-     (lambda (kv path)
+     (lambda (kv loc)
-       (define path (if (string=? (car kv) "") (cdr kv) (string-append (car kv) "/" (cdr kv))))
+       (define vfs-path (if (string=? (car kv) "") (cdr kv) (string-append (car kv) "/" (cdr kv))))
+       (define path vfs-path)
        (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 (cons 'base #f))))
+       (if (eq? loc 'directory)
+         (set! base-paths (mapping-set! base-paths path (delay (vfs-to-store (vfs-subdir (ninja-build-config-root-dir conf) vfs-path)))))
+         (set! base-paths (mapping-set! base-paths path loc)))
+       (set! edges (mapping-set! edges path (cons 'base #f)))
+       (set! path-to-vfs (mapping-set! path-to-vfs path kv)))
      (vfs-contents (ninja-build-config-root-dir conf)))
+    (define filtered-vfs (mapping-copy (vfs-contents (ninja-build-config-root-dir conf))))
+    (define env (make-build-env conf #f relative-to base-paths))
 
-    (define vfs-store-path (vfs-to-store (ninja-build-config-root-dir conf)))
+    (set! edges (mapping-set! edges "meson-private" (cons 'base-path #f)))
-    (define env (make-build-env conf vfs-store-path relative-to))
+    (set! filtered-vfs (mapping-delete! filtered-vfs (cons "build" "meson-private")))
     (for-each
      (lambda (edge)
       (define built-edge (delay (build-edge env edges edge)))
       (define all-outputs (append (build-edge-outputs edge) (build-edge-implicit-outputs edge)))
+      (define should-handle-inputs (not (string=? (build-edge-rule edge) "cpp_PCH")))
+
+      ; Mark all inputs coming from the base VFS as filtered.
+      (when should-handle-inputs
+       (for-each
+        (lambda (path)
+         (cond
+          ((or (string-prefix? "/build/bdir/src/" path) (string-prefix? "/build/bdir/out/" path))
+           (set! path (string-append "../" (string-copy path 12))))
+          ((string-prefix? "/build/bdir/build/" path)
+           (set! path (string-copy path 18))))
+
+         (unless (mapping-ref/default edges path #f)
+           (set! path (normalize-path path)))
+         (define data (mapping-ref/default edges path #f))
+
+         ; If this path is in the VFS, and can be elided..
+         (when (and data (eq? (car data) 'base) (can-safely-elide path))
+           ; Mark it as 'base-path (needs copying, and not in main vfs)
+           (set! edges (mapping-set! edges path (cons 'base-path #f)))
+           ; Remove from filtered-vfs.
+           (set! filtered-vfs (mapping-delete! filtered-vfs (mapping-ref path-to-vfs path)))))
+        (append (build-edge-inputs edge) (build-edge-implicit-dependencies edge) (build-edge-order-only-dependencies edge))))
+
+      ; Record output edges of this build edge.
       (if (build-edge-resolved edge)
         (for-each (lambda (v) (set! edges (mapping-set! edges v (cons (delay #~,(string-append #$(force (built-edge-out-drv (force built-edge))) "/" v)) built-edge))))
           all-outputs)
@@ -282,6 +351,16 @@
         (for-each (lambda (v) (set! edges (mapping-set! edges v (cons 'phony built-edge))))
           all-outputs)))
      (build-file-build-edges file))
+    (set! filtered-vfs
+     (mapping-filter!
+      (lambda (kv loc)
+       (not
+        (or
+         (string=? (car kv) "build/meson-private")
+         (string-prefix? "build/meson-private/" (car kv)))))
+      filtered-vfs))
+
+    (set-build-env-vfs! env (vfs-to-store (make-vfs filtered-vfs)))
 
     (define edge-ref
      (lambda (path)

lang/ninja/src/config.sld

@@ -8,6 +8,8 @@
   ninja-build-config-environment ninja-build-config-root-dir
   ninja-build-config-patches ninja-build-config-targets
 
+  set-ninja-build-config-root-dir! set-ninja-build-config-environment!
+
   parse-ninja-config)
 
  (begin