(zilch lang ninja): process depfile, elide .h files where posssible

Incremental builds now take depfiles in account! Using a file that
contains a mapping of depfile to its cached contents, Zilch now
rebuilds less targets unnecessarily! If a build fails because an
include is added, it transparently rebuilds it with all possible header
dependencies, using the custom build scheduler built into Zilch. If an
include is removed, the target will be rebuilt with the new set of
headers the next time the CLI is invoked.

Change-Id: I6a6a6964c2fb191af4a474c45fd0f29623c588b0

cli/zilch-ninja.scm

@@ -73,37 +73,42 @@ Arguments:
 
 (import
   (scheme base) (scheme file) (scheme read)
-  (chicken format) (chicken process)
+  (chicken format) (chicken process) (chicken file)
   (zilch lang ninja) (zilch lang ninja build)
   (zilch lang ninja nixpkgs)
   (zilch lang ninja config)
   (zilch magic) (zilch nixpkgs) (zilch vfs)
   (zilch nix drv)
   (zilch zexpr)
-  (srfi 152))
+  (srfi 128) (srfi 146) (srfi 152))
 
 (define source (and (assoc 'source options) (cdr (assoc 'source options))))
 
 (define config-path (if (assoc 'config-file options) (cdr (assoc 'config-file options)) "zilch.scm"))
 (define config (parse-ninja-config `(override-source: ,source ,@(call-with-input-file config-path read))))
 
+(when (and (ninja-build-config-depfile-path config) (file-exists? (ninja-build-config-depfile-path config)))
+  (set-ninja-build-config-depfile! config (alist->mapping (make-default-comparator) (call-with-input-file (ninja-build-config-depfile-path config) read))))
+
 (cond
  ((string=? (car args) "source")
   (let*-values
-   (((_ configured-drv _ _ _) (setup-ninja-environment config))
+   (((_ configured-drv _ _ _ _) (setup-ninja-environment config))
     ((realised) (store-path-realised configured-drv))
     ((path) (if (null? (cdr args)) "src" (cadr args))))
    (system* (string-append "cp -rf --no-preserve=ownership " realised "/src " (qs path)))
    (system* (string-append "chmod -R u+rw " (qs path)))))
  ((string=? (car args) "build")
   (if (null? (cdr args))
-   (let ((built (build-nixpkgs-drv-reproducibly config)))
+   (let-values (((built export-depfile) (build-nixpkgs-drv-reproducibly config)))
     (for-each
      (lambda (output-and-path)
       (store-path-realised (cdr output-and-path))
       (printf "~A\t-> ~S\n" (car output-and-path) (cdr output-and-path)))
-     built))
+     built)
-   (let-values (((_ _ _ edge-ref defaults) (setup-ninja-environment config)))
+    (when (ninja-build-config-depfile-path config)
+     (call-with-output-file (ninja-build-config-depfile-path config) (lambda (p) (write (mapping->alist (export-depfile)) p)))))
+   (let-values (((_ _ _ edge-ref defaults _) (setup-ninja-environment config)))
     (for-each
      (lambda (target)
       (define built-target (edge-ref target))
@@ -111,7 +116,7 @@ Arguments:
      (cdr args)))))
  ((string=? (car args) "diff")
   (let*-values
-   (((_ configured-drv _ _ _) (setup-ninja-environment config))
+   (((_ configured-drv _ _ _ _) (setup-ninja-environment config))
     ((realised) (store-path-realised configured-drv))
     ((path) (or source "src")))
    (process-execute "git" (list "diff" "--no-index" "--" (string-append realised "/src") path))))

lang/ninja/src/build.sld

@@ -1,12 +1,12 @@
 (define-library (zilch lang ninja build)
  (import
-  (scheme base) (scheme lazy)
+  (scheme base) (scheme lazy) (scheme file)
   (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) (zilch lang ninja config))
+  (zilch lang ninja) (zilch lang ninja config) (zilch lang ninja depfile))
 
  (export process-ninja-file
    built-edge-edge built-edge-out-drv
@@ -26,12 +26,15 @@
     (phony-inputs built-edge-phony-inputs))
 
   (define-record-type <build-env>
-    (make-build-env config vfs build-dir base-paths)
+    (make-build-env config vfs header-files build-dir base-paths parsed-depfiles collected-deps)
     build-env?
     (config build-env-config)
     (vfs build-env-vfs set-build-env-vfs!)
+    (header-files build-env-header-files set-build-env-header-files!)
     (build-dir build-env-build-dir)
-    (base-paths build-env-base-paths set-build-env-base-paths!))
+    (base-paths build-env-base-paths set-build-env-base-paths!)
+    (parsed-depfiles build-env-parsed-depfiles)
+    (collected-deps build-env-collected-deps set-build-env-collected-deps!))
 
   ;; normalize a POSIX-y path. Ninja doesn't have an internal concept of path normalisation,
   ;; so this is necessary for proper file-finding behavior.
@@ -61,10 +64,7 @@
       "zilch-ninja"
       (string-map (lambda (c) (if (is-valid-store-path-char c) c #\-)) (if (> (string-length str) 128) (string-copy str 0 128) str))))
 
-  ;; Returns a derivation that runs the command for this edge,
+  (define (inner-derivation-for-edge env edges current-edge resolved depfile-data)
-  ;; inside a Nix derivation with the correct inputs.
-  (define (derivation-for-edge env 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 is-meson-phony #f)
@@ -144,6 +144,7 @@
       (when (string=? path "PHONY")
        (set! is-meson-phony #t)))
 
+    (for-each append-file depfile-data)
     ; 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))
@@ -178,6 +179,10 @@
     (for-each append-copy-command (build-edge-outputs current-edge))
     (for-each append-copy-command (build-edge-implicit-outputs current-edge))
 
+    (define depfile (build-rule-depfile resolved))
+    (when depfile
+      (append-copy-command depfile))
+
     (define patch-commands (list))
     (for-each
      (lambda (patch)
@@ -214,7 +219,6 @@
 
           ; Create the output directory, and copyy over the output files.
           "(COREUTILS=" #$coreutils"/bin; cd bdir/" (build-env-build-dir env) "; $COREUTILS/mkdir " out-placeholder "\n" #$copy-output-files ")"))
-
     ; Create the derivation. The rest of the code, that builds up the full list of edges, will extract each output from it.
     (define outpath
      (cdar
@@ -224,7 +228,29 @@
        '("/bin/sh" "-c" "exec /bin/sh $ZILCH_CMDPath")
        `(("ZILCH_CMD" . ,command) ("passAsFile" . "ZILCH_CMD") . ,(ninja-build-config-environment (build-env-config env)))
        '("out"))))
+    (when depfile
+     (store-path-register-post-build outpath
+      (lambda (pairs)
+       (define depfile-bytes (call-with-input-file (string-append (cdar pairs) "/" depfile) (lambda (f) (read-bytevector (* 1 1024 1024) f))))
+       (define parsed-depfile (parse-depfile depfile-bytes))
+       (define data (cdar (mapping->alist parsed-depfile)))
+       (define filtered '())
+       (for-each (lambda (item) (unless (string-prefix? "/nix/store/" item) (set! filtered (cons item filtered)))) data)
+       (set-build-env-collected-deps! env (mapping-set! (build-env-collected-deps env) depfile filtered)))))
     outpath)
+
+  ;; Returns a derivation that runs the command for this edge,
+  ;; inside a Nix derivation with the correct inputs.
+  (define (derivation-for-edge env edges current-edge)
+    (define resolved (build-edge-resolved current-edge))
+    (define result #f)
+    (when (build-rule-depfile resolved)
+      (let*
+       ((path-deps (mapping-ref/default (build-env-parsed-depfiles env) (build-rule-depfile resolved) #f))
+        (new-result (and path-deps (inner-derivation-for-edge env edges current-edge resolved path-deps))))
+       (set! result (and new-result (store-path-register-fallback new-result (lambda () (inner-derivation-for-edge env edges current-edge resolved (build-env-header-files env))))))))
+    (or result (inner-derivation-for-edge env edges current-edge resolved (build-env-header-files env))))
+
   (define (ifs-for-shsym env edges current-edge)
     (define implib (mapping-ref (build-edge-variables current-edge) "IMPLIB" (lambda () (error "SHSYM rule does not have IMPLIB variable"))))
     (define input-path (car (build-edge-inputs current-edge)))
@@ -283,6 +309,11 @@
     (string-suffix? ".cc" path)
     (string-suffix? ".c" path)))
 
+  (define (can-safely-elide-header path)
+   (or
+    (string-suffix? ".hh" path)
+    (string-suffix? ".h" path)))
+
   ;; 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.
@@ -314,9 +345,26 @@
        (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 env (make-build-env conf #f '() relative-to base-paths (or (ninja-build-config-depfile conf) (mapping (make-default-comparator))) (mapping (make-default-comparator))))
 
     (set! edges (mapping-set! edges "meson-private" (cons 'base-path #f)))
+
+    ; First record all paths we are planning on eliding (for being headers)..
+    (mapping-for-each
+     (lambda (path kv)
+      (when (and (can-safely-elide-header path)
+             (not (and (ninja-build-config-disallow-elide conf) ((ninja-build-config-disallow-elide conf) path))))
+       (set-build-env-header-files! env (cons path (build-env-header-files env)))))
+     edges)
+    ; Then mark them (to avoid having an ongoing for-each whilst modifying the mapping)
+    (for-each
+     (lambda (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))))
+     (build-env-header-files env))
+
     (set! filtered-vfs (mapping-delete! filtered-vfs (cons "build" "meson-private")))
     (for-each
      (lambda (edge)
@@ -371,4 +419,4 @@
        (define edge (mapping-ref edges path (lambda () (error "Target doesn't exist" path))))
        (cons (if (promise? (car edge)) (force (car edge)) (car edge)) (force (cdr edge)))))
     (define defaults (build-file-default-targets file))
-    (values edge-ref defaults))))
+    (values edge-ref defaults (lambda () (build-env-collected-deps env))))))

lang/ninja/src/config.sld

@@ -9,22 +9,26 @@
   ninja-build-config?
   ninja-build-config-environment ninja-build-config-environment-drv
   ninja-build-config-root-dir ninja-build-config-patches ninja-build-config-targets
-  ninja-build-config-override-source
+  ninja-build-config-override-source ninja-build-config-depfile ninja-build-config-depfile-path
+  ninja-build-config-disallow-elide
 
-  set-ninja-build-config-root-dir! set-ninja-build-config-environment!
+  set-ninja-build-config-root-dir! set-ninja-build-config-environment! set-ninja-build-config-depfile!
 
   parse-ninja-config)
 
  (begin
    (define-record-type <ninja-build-config>
-    (make-ninja-build-config environment environment-drv root-dir patches targets override-source)
+    (make-ninja-build-config environment environment-drv root-dir patches targets override-source depfile depfile-path disallow-elide)
     ninja-build-config?
     (environment ninja-build-config-environment set-ninja-build-config-environment!)
     (environment-drv ninja-build-config-environment-drv set-ninja-build-config-environment-drv!)
     (root-dir ninja-build-config-root-dir set-ninja-build-config-root-dir!)
     (patches ninja-build-config-patches set-ninja-build-config-patches!)
     (targets ninja-build-config-targets set-ninja-build-config-targets!)
-    (override-source ninja-build-config-override-source set-ninja-build-config-override-source!))
+    (override-source ninja-build-config-override-source set-ninja-build-config-override-source!)
+    (depfile ninja-build-config-depfile set-ninja-build-config-depfile!)
+    (depfile-path ninja-build-config-depfile-path set-ninja-build-config-depfile-path!)
+    (disallow-elide ninja-build-config-disallow-elide set-ninja-build-config-disallow-elide!))
 
    (define (parse-config-inner conf data)
     (cond
@@ -45,6 +49,12 @@
        ((#:override-source)
         (set-ninja-build-config-override-source! conf (if (string? (list-ref data 1)) (vfs-from-directory (list-ref data 1)) (list-ref data 1)))
         (parse-config-inner conf (cddr data)))
+       ((#:depfile-path)
+        (set-ninja-build-config-depfile-path! conf (list-ref data 1))
+        (parse-config-inner conf (cddr data)))
+       ((#:depfile)
+        (set-ninja-build-config-depfile! conf (list-ref data 1))
+        (parse-config-inner conf (cddr data)))
        ((#:patch)
         (let*
          ((patch-base (list-ref data 1))
@@ -57,6 +67,16 @@
             (else patch-base))))
          (set-ninja-build-config-patches! conf (cons processed-patch (ninja-build-config-patches conf))))
         (parse-config-inner conf (cddr data)))
+       ((#:disallow-elide)
+        (let*
+         ((thunk (list-ref data 1))
+          (processed-thunk
+           (cond
+            ((list? thunk)
+             (scheme-eval thunk))
+            (else thunk))))
+         (set-ninja-build-config-disallow-elide! conf processed-thunk)) 
+        (parse-config-inner conf (cddr data)))
        ((#:target #:targets)
         (when (eq? (ninja-build-config-targets conf) #f)
           (set-ninja-build-config-targets! conf '()))
@@ -70,4 +90,4 @@
    (define (parse-ninja-config config)
     (unless (list? config)
      (error "expected Zilch Ninja config to be a list"))
-    (parse-config-inner (make-ninja-build-config #f #f #f '() #f #f) config))))
+    (parse-config-inner (make-ninja-build-config #f #f #f '() #f #f #f #f #f) config))))

lang/ninja/src/nixpkgs.sld

@@ -122,12 +122,12 @@
      (read-ninja-file (read-file-at-path "build.ninja") read-file-at-path))
 
     ; Process the build.ninja file.
-    (define-values (edge-ref defaults) (process-ninja-file ninja-file conf "build"))
+    (define-values (edge-ref defaults export-depfile) (process-ninja-file ninja-file conf "build"))
 
-    (values initial-drv configured-drv placeholders edge-ref defaults))
+    (values initial-drv configured-drv placeholders edge-ref defaults export-depfile))
 
   (define (build-nixpkgs-drv-reproducibly conf)
-    (define-values (initial-drv configured-drv placeholders edge-ref defaults) (setup-ninja-environment conf))
+    (define-values (initial-drv configured-drv placeholders edge-ref defaults export-depfile) (setup-ninja-environment conf))
 
     ; Build all store paths necessary for installing. This assumes Meson.
     (define preinstall-state (force (built-edge-out-drv (cdr (edge-ref "all")))))
@@ -200,8 +200,10 @@
           "for curPhase in ${phases[*]}; do runPhase \"$curPhase\"; done\n"))
 
     ; Patch the original .drv to run the postbuild-builder command.
+    (values
      (patch-drv initial-drv
       (append
        `(("buildCommand" . ,postbuild-builder))
        placeholders)
-     (map car placeholders)))))
+      (map car placeholders))
+     export-depfile))))

lang/ninja/zilch-lang-ninja.egg

@@ -11,7 +11,7 @@
     (source "src/depfile.sld"))
   (extension zilch.lang.ninja.build
     (source "src/build.sld")
-    (component-dependencies zilch.lang.ninja zilch.lang.ninja.config))
+    (component-dependencies zilch.lang.ninja zilch.lang.ninja.config zilch.lang.ninja.depfile))
   (extension zilch.lang.ninja.config
     (source "src/config.sld"))
   (extension zilch.lang.ninja.nixpkgs