zilch-cli-ninja: make source' and diff' operate on rewrites

Change-Id: I6a6a69644e8984ec8400e13928c8ac0e14526ad1
This commit is contained in:
puck 2025-10-01 12:11:45 +00:00
parent cdee2291fb
commit 5485b0f4ce
2 changed files with 58 additions and 29 deletions

View file

@ -10,7 +10,8 @@
<ninja-build-config> 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-depfile ninja-build-config-depfile-path
ninja-build-config-override-source ninja-build-config-override-source-path
ninja-build-config-depfile ninja-build-config-depfile-path
ninja-build-config-disallow-elide ninja-build-config-rewrites
set-ninja-build-config-root-dir! set-ninja-build-config-environment! set-ninja-build-config-depfile!
@ -26,7 +27,7 @@
;; Represents a parsed Ninja build configuration.
;; See `parse-ninja-config` for the definition of these fields.
(define-record-type <ninja-build-config>
(make-ninja-build-config environment environment-drv root-dir patches targets override-source depfile depfile-path disallow-elide rewrites)
(make-ninja-build-config environment environment-drv root-dir patches targets override-source override-source-path depfile depfile-path disallow-elide rewrites)
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!)
@ -34,6 +35,7 @@
(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-path ninja-build-config-override-source-path set-ninja-build-config-override-source-path!)
(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!)
@ -46,7 +48,7 @@
(string-append (string-copy path 0 last-slash) "/" path2)
path2))))
(define (parse-config-inner path conf data)
(define (parse-config-inner path accept-override conf data)
(cond
((null? data) conf)
((null? (cdr data)) (error "Expected even list of directives in Zilch Ninja config"))
@ -58,19 +60,22 @@
(set-ninja-build-config-environment! conf (environment-for-derivation drv))
(set-ninja-build-config-environment-drv! conf (store-path-drv drv)))
(set-ninja-build-config-environment! conf (list-ref data 1)))
(parse-config-inner path conf (cddr data)))
(parse-config-inner path accept-override 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 path conf (cddr data)))
(parse-config-inner path accept-override conf (cddr data)))
((#:override-source)
(set-ninja-build-config-override-source! conf (if (string? (list-ref data 1)) (vfs-from-directory (relative-to-file path (list-ref data 1))) (list-ref data 1)))
(parse-config-inner path conf (cddr data)))
(when (string? (list-ref data 1))
(set-ninja-build-config-override-source-path! conf (relative-to-file path (list-ref data 1))))
(when accept-override
(set-ninja-build-config-override-source! conf (if (string? (list-ref data 1)) (vfs-from-directory (relative-to-file path (list-ref data 1))) (list-ref data 1))))
(parse-config-inner path accept-override conf (cddr data)))
((#:depfile-path)
(set-ninja-build-config-depfile-path! conf (relative-to-file path (list-ref data 1)))
(parse-config-inner path conf (cddr data)))
(parse-config-inner path accept-override conf (cddr data)))
((#:depfile)
(set-ninja-build-config-depfile! conf (list-ref data 1))
(parse-config-inner path conf (cddr data)))
(parse-config-inner path accept-override conf (cddr data)))
((#:patch)
(let*
((patch-base (list-ref data 1))
@ -82,7 +87,7 @@
(scheme-eval patch-base))
(else patch-base))))
(set-ninja-build-config-patches! conf (cons processed-patch (ninja-build-config-patches conf))))
(parse-config-inner path conf (cddr data)))
(parse-config-inner path accept-override conf (cddr data)))
((#:disallow-elide)
(let*
((thunk (list-ref data 1))
@ -92,7 +97,7 @@
(scheme-eval thunk))
(else thunk))))
(set-ninja-build-config-disallow-elide! conf processed-thunk))
(parse-config-inner path conf (cddr data)))
(parse-config-inner path accept-override conf (cddr data)))
((#:target #:targets)
(when (eq? (ninja-build-config-targets conf) #f)
(set-ninja-build-config-targets! conf '()))
@ -100,12 +105,12 @@
((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 path conf (cddr data)))
(parse-config-inner path accept-override conf (cddr data)))
((#:rewrite)
(let*
((val (list-ref data 1)))
(set-ninja-build-config-rewrites! conf (cons (cons (car val) (parse-ninja-config path (cdr val))) (ninja-build-config-rewrites conf))))
(parse-config-inner path conf (cddr data)))
(set-ninja-build-config-rewrites! conf (cons (cons (car val) (parse-ninja-config path accept-override (cdr val))) (ninja-build-config-rewrites conf))))
(parse-config-inner path accept-override conf (cddr data)))
(else (error (string-append "Unknown directive " (keyword->string (car data)) " parsing Zilch Ninja config")))))))
;; Parses a Zilch Ninja configuration file.
@ -141,10 +146,11 @@
;; name.
;;
;; `path` is the path this file was located at, used to resolve relative paths for depfiles.
(define (parse-ninja-config path config)
;; `accept-override` specifies whether override-source arguments are processed.
(define (parse-ninja-config path accept-override config)
(unless (list? config)
(error "expected Zilch Ninja config to be a list"))
(parse-config-inner path (make-ninja-build-config #f #f #f '() #f #f #f #f #f '()) config))
(parse-config-inner path accept-override (make-ninja-build-config #f #f #f '() #f #f #f #f #f #f '()) config))
;; `source-paths`: mapping of original store path to virtual path.
;; `finalized-drv`: promise of a <finalized-drv>