diff --git a/lang/ninja/src/build.sld b/lang/ninja/src/build.sld index b32a80f..44ec977 100644 --- a/lang/ninja/src/build.sld +++ b/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 or a , 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))) diff --git a/lang/ninja/src/config.sld b/lang/ninja/src/config.sld new file mode 100644 index 0000000..f71f70b --- /dev/null +++ b/lang/ninja/src/config.sld @@ -0,0 +1,59 @@ +(define-library (zilch lang ninja config) + (import + (scheme base) (scheme eval) + (zilch nixpkgs) (zilch vfs)) + + (export + ninja-build-config? + ninja-build-config-environment ninja-build-config-root-dir + ninja-build-config-patches ninja-build-config-targets + + parse-ninja-config) + + (begin + (define-record-type + (make-ninja-build-config environment root-dir patches targets) + ninja-build-config? + (environment ninja-build-config-environment set-ninja-build-config-environment!) + (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!)) + + (define (parse-config-inner conf data) + (cond + ((null? data) conf) + ((null? (cdr data)) (error "Expected even list of directives in Zilch Ninja config")) + (else + (case (car data) + ((#:env #:environment) + (set-ninja-build-config-environment! conf (if (string? (list-ref data 1)) (environment-for-derivation (cdar (nixpkgs-eval (list-ref data 1)))) (list-ref data 1))) + (parse-config-inner conf (cddr data))) + ((#:root) + (set-ninja-build-config-root-dir! conf (if (string? (list-ref data 1)) (vfs-from-directory (list-ref data 1)) (list-ref data 1))) + (parse-config-inner conf (cddr data))) + ((#:patch) + (let* + ((patch-base (list-ref data 1)) + (processed-patch + (cond + ((string? patch-base) + (lambda (target) patch-base)) + ((list? patch-base) + (eval patch-base (environment '(scheme base) '(zilch lang ninja)))) + (else patch-base)))) + (set-ninja-build-config-patches! conf (cons processed-patch (ninja-build-config-patches conf)))) + (parse-config-inner conf (cddr data))) + ((#:target #:targets) + (when (eq? (ninja-build-config-targets conf) #f) + (set-ninja-build-config-targets! conf '())) + (let* + ((val (list-ref data 1)) + (list-val (if (list? val) val (list val)))) + (set-ninja-build-config-targets! conf (append list-val (ninja-build-config-targets conf)))) + (parse-config-inner conf (cddr data))) + (else (error (string-append "Unknown directive " (symbol->string (car data)) " parsing Zilch Ninja config"))))))) + + (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) config)))) diff --git a/lang/ninja/zilch-lang-ninja.egg b/lang/ninja/zilch-lang-ninja.egg index 0f56f7c..7065152 100644 --- a/lang/ninja/zilch-lang-ninja.egg +++ b/lang/ninja/zilch-lang-ninja.egg @@ -9,4 +9,6 @@ (source "src/ninja.sld")) (extension zilch.lang.ninja.build (source "src/build.sld") - (component-dependencies zilch.lang.ninja)))) + (component-dependencies zilch.lang.ninja zilch.lang.ninja.config)) + (extension zilch.lang.ninja.config + (source "src/config.sld"))))