(zilch lang ninja build): support per-project patches

lang/ninja/src/build.sld

@@ -6,7 +6,7 @@
   (zilch nixpkgs) (zilch zexpr) (zilch vfs)
   (chicken format)
   (srfi 128) (srfi 146) (srfi 152)
-  (zilch lang ninja))
+  (zilch lang ninja) (zilch lang ninja config))
 
  (export process-ninja-file)
 
@@ -42,7 +42,7 @@
       (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-store-path relative-to-root edges current-edge)
+  (define (derivation-for-edge conf 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 "")
@@ -96,17 +96,42 @@
     (for-each append-copy-command (build-edge-outputs current-edge))
     (for-each append-copy-command (build-edge-implicit-outputs current-edge))
 
+    (define patch-commands (list))
+    (for-each
+     (lambda (patch)
+      (define result (patch current-edge))
+      (when result
+        (set! patch-commands (cons result patch-commands))))
+     (ninja-build-config-patches conf))
+    (set! patch-commands (reverse patch-commands))
+    (define processed-patch-commands
+      #~,(string-join
+          (map
+           (lambda (item)
+            (if (string? item) item
+              (string-join item "\n")))
+           #$patch-commands)
+          "\n"))
+
     ; Run the build rule inside the build environment's vfs. This requires copying the entire VFS over, sadly.
     (define command
       #~,(string-append
+          ; Copy over the VFS, as we have to make changes to it.
           #$coreutils "/bin/cp -rf --no-preserve=ownership " #$vfs-store-path " bdir\n"
           #$coreutils "/bin/chmod ugo+rw -R bdir\n"
+
+          ; Copy over the other input files.
           "(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"
-          #$copy-output-files))
+          #$coreutils "/bin/chmod ugo+rw -R bdir\n"
+
+          ; Run any patches we have received.
+          "(cd bdir; _ZILCH_ROOT=" #$vfs-store-path "; PATH=\"" #$coreutils "/bin:$PATH\"; " #$processed-patch-commands ")\n"
+
+          ; Enter the build dir and then run the command for this build.
+          "(cd bdir/" relative-to-root "; " command-to-run ") || exit 1\n"
+
+          ; Create the output directory, and copyy over the output files.
+          "(COREUTILS=" #$coreutils"/bin; cd bdir/" relative-to-root "; $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
@@ -115,7 +140,7 @@
        (make-valid-store-path-string (build-rule-description resolved))
        "x86_64-linux"
        (list "/bin/sh" "-c" command)
-       environment
+       (ninja-build-config-environment conf)
        '("out"))))
     outpath)
 
@@ -125,8 +150,7 @@
   ;;
   ;; If the `environment` is a <derivation> or a <store-path>, it is considered
   ;; 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)))
+  (define (process-ninja-file file conf relative-to)
     (unless (or (string=? relative-to "") (string-suffix? "/" relative-to)) (set! relative-to (string-append relative-to "/")))
 
     (define edges (mapping (make-default-comparator)))
@@ -140,11 +164,11 @@
         ((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))
+     (vfs-contents (ninja-build-config-root-dir conf)))
+    (define vfs-store-path (vfs-to-store (ninja-build-config-root-dir conf)))
     (for-each
      (lambda (edge)
-      (define processed (delay (derivation-for-edge environment vfs-store-path relative-to edges edge)))
+      (define processed (delay (derivation-for-edge conf vfs-store-path relative-to edges 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)))