diff --git a/lang/ninja/src/build.sld b/lang/ninja/src/build.sld index 30c17b7..e3de8af 100644 --- a/lang/ninja/src/build.sld +++ b/lang/ninja/src/build.sld @@ -26,11 +26,12 @@ (phony-inputs built-edge-phony-inputs)) (define-record-type - (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) - (build-dir build-env-build-dir)) + (vfs build-env-vfs set-build-env-vfs!) + (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) - (define path (if (string=? (car kv) "") (cdr kv) (string-append (car kv) "/" (cdr kv)))) + (lambda (kv loc) + (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))) - (define env (make-build-env conf vfs-store-path relative-to)) + (set! edges (mapping-set! edges "meson-private" (cons 'base-path #f))) + (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) diff --git a/lang/ninja/src/config.sld b/lang/ninja/src/config.sld index f71f70b..b0d8451 100644 --- a/lang/ninja/src/config.sld +++ b/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