From 5cf4b26d52bcea382d98fb4becce89be9ee37b55 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 23 Jun 2019 11:28:29 +0200 Subject: derivations: now aggregates a . Consequently, the whole graph of object is readily available without having to go through 'read-derivation-from-file', which could have cache misses if the requested object had been GC'd in the meantime. This is an important property for the performance of things like 'derivation-build-plan' that traverse the derivation graph. * guix/derivations.scm (): Replace 'path' field by 'derivation'. (derivation-input-path): Adjust accordingly. (derivation-input-key): New procedure. (derivation-input-output-paths): Adjust accordingly. (coalesce-duplicate-inputs): Likewise. (derivation-prerequisites): Use 'derivation-input-key' to compute keys for INPUT-SET. (derivation-build-plan): Likewise. (read-derivation): Add optional 'read-derivation-from-file' parameter. [make-input-drvs]: Call it. (write-derivation)[write-input]: Adjust to new . (derivation/masked-inputs): Likewise, and remove redundant 'coalesce-duplicate-inputs' call. (derivation)[input->derivation-input]: Change to consider only the derivation case. Update call to 'make-derivation-input'. [input->source]: New procedure. Separate sources from inputs. (map-derivation): Adjust to new . * tests/derivations.scm ("parse & export"): Pass a second argument to 'read-derivation'. ("build-expression->derivation and derivation-prerequisites") ("derivation-prerequisites and valid-derivation-input?"): Adjust to new . --- guix/derivations.scm | 156 ++++++++++++++++++++++++++++---------------------- tests/derivations.scm | 10 ++-- 2 files changed, 95 insertions(+), 71 deletions(-) diff --git a/guix/derivations.scm b/guix/derivations.scm index f6e94694fd..5c568f223b 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -152,22 +152,28 @@ (define-immutable-record-type (recursive? derivation-output-recursive?)) ; Boolean (define-immutable-record-type - (make-derivation-input path sub-derivations) + (make-derivation-input drv sub-derivations) derivation-input? - (path derivation-input-path) ; store path + (drv derivation-input-derivation) ; (sub-derivations derivation-input-sub-derivations)) ; list of strings -(define (derivation-input-derivation input) - "Return the object INPUT refers to." - (read-derivation-from-file (derivation-input-path input))) + +(define (derivation-input-path input) + "Return the file name of the derivation INPUT refers to." + (derivation-file-name (derivation-input-derivation input))) (define* (derivation-input drv #:optional (outputs (derivation-output-names drv))) "Return a for the OUTPUTS of DRV." ;; This is a public interface meant to be more convenient than ;; 'make-derivation-input' and giving us more control. - (make-derivation-input (derivation-file-name drv) - outputs)) + (make-derivation-input drv outputs)) + +(define (derivation-input-key input) + "Return an object for which 'equal?' and 'hash' are constant-time, and which +can thus be used as a key for INPUT in lookup tables." + (cons (derivation-input-path input) + (derivation-input-sub-derivations input))) (set-record-type-printer! (lambda (drv port) @@ -209,8 +215,8 @@ (define (derivation-input-output-paths input) "Return the list of output paths corresponding to INPUT, a ." (match input - (($ path sub-drvs) - (map (cut derivation-path->output-path path <>) + (($ drv sub-drvs) + (map (cut derivation->output-path drv <>) sub-drvs)))) (define (valid-derivation-input? store input) @@ -225,20 +231,20 @@ (define (coalesce-duplicate-inputs inputs) Nix itself keeps only one of them." (fold (lambda (input result) (match input - (($ path sub-drvs) + (($ (= derivation-file-name path) sub-drvs) ;; XXX: quadratic (match (find (match-lambda - (($ p s) + (($ (= derivation-file-name p) + s) (string=? p path))) result) (#f (cons input result)) - ((and dup ($ _ sub-drvs2)) + ((and dup ($ drv sub-drvs2)) ;; Merge DUP with INPUT. (let ((sub-drvs (delete-duplicates (append sub-drvs sub-drvs2)))) - (cons (make-derivation-input path - (sort sub-drvs string - (lambda (substitutables) - (loop rest build - (append substitutables substitute) - (set-insert input visited)))) - (else - (let ((deps (derivation-inputs - (derivation-input-derivation input)))) - (loop (append deps rest) - (cons (derivation-input-derivation input) build) - substitute - (set-insert input visited))))))))) + (let ((key (derivation-input-key input))) + (cond ((set-contains? visited key) + (loop rest build substitute visited)) + ((input-built? input) + (loop rest build substitute + (set-insert key visited))) + ((input-substitutable-info input) + => + (lambda (substitutables) + (loop rest build + (append substitutables substitute) + (set-insert key visited)))) + (else + (let ((deps (derivation-inputs + (derivation-input-derivation input)))) + (loop (append deps rest) + (cons (derivation-input-derivation input) build) + substitute + (set-insert key visited)))))))))) (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest) derivation-build-plan @@ -410,10 +419,15 @@ (define-deprecated (derivation-prerequisites-to-build store drv #:rest rest) (list (derivation-input drv)) rest))) (values (map derivation-input build) download))) -(define (read-derivation drv-port) +(define* (read-derivation drv-port + #:optional (read-derivation-from-file + read-derivation-from-file)) "Read the derivation from DRV-PORT and return the corresponding -object. Most of the time you'll want to use 'read-derivation-from-file', -which caches things as appropriate and is thus more efficient." +object. Call READ-DERIVATION-FROM-FILE to read derivations declared as inputs +of the derivation being parsed. + +Most of the time you'll want to use 'read-derivation-from-file', which caches +things as appropriate and is thus more efficient." (define comma (string->symbol ",")) @@ -449,8 +463,9 @@ (define (make-input-drvs x) (fold-right (lambda (input result) (match input ((path (sub-drvs ...)) - (cons (make-derivation-input path sub-drvs) - result)))) + (let ((drv (read-derivation-from-file path))) + (cons (make-derivation-input drv sub-drvs) + result))))) '() x)) @@ -552,9 +567,15 @@ (define (write-output output port) (define (write-input input port) (match input - (($ path sub-drvs) + (($ obj sub-drvs) (display "(\"" port) - (display path port) + + ;; 'derivation/masked-inputs' produces objects that contain a string + ;; instead of a , so we need to account for that. + (display (if (derivation? obj) + (derivation-file-name obj) + obj) + port) (display "\"," port) (write-string-list sub-drvs) (display ")" port)))) @@ -645,13 +666,16 @@ (define (derivation/masked-inputs drv) (($ outputs inputs sources system builder args env-vars) (let ((inputs (map (match-lambda - (($ path sub-drvs) + (($ (= derivation-file-name path) + sub-drvs) (let ((hash (derivation-path->base16-hash path))) (make-derivation-input hash sub-drvs)))) inputs))) (make-derivation outputs - (sort (coalesce-duplicate-inputs inputs) - derivation-inputderivation-input (match-lambda (((? derivation? drv)) - (make-derivation-input (derivation-file-name drv) '("out"))) + (make-derivation-input drv '("out"))) (((? derivation? drv) sub-drvs ...) - (make-derivation-input (derivation-file-name drv) sub-drvs)) - (((? direct-store-path? input)) - (make-derivation-input input '("out"))) - (((? direct-store-path? input) sub-drvs ...) - (make-derivation-input input sub-drvs)) - ((input . _) - (let ((path (add-to-store store (basename input) - #t "sha256" input))) - (make-derivation-input path '()))))) + (make-derivation-input drv sub-drvs)) + (_ #f))) + + (define input->source + (match-lambda + (((? string? input) . _) + (if (direct-store-path? input) + input + (add-to-store store (basename input) + #t "sha256" input))) + (_ #f))) ;; Note: lists are sorted alphabetically, to conform with the behavior of ;; C++ `std::map' in Nix itself. @@ -828,29 +854,24 @@ (define input->derivation-input (make-derivation-output "" hash-algo hash recursive?))) (sort outputs stringsource inputs)) + stringderivation-input - (delete-duplicates inputs))) + (filter-map input->derivation-input inputs)) derivation-inputbytevector drv) - (map derivation-input-path inputs))) + (append (map derivation-input-path inputs) + sources))) (drv* (set-field drv (derivation-file-name) file))) (hash-set! %derivation-cache file drv*) drv*))) @@ -920,7 +941,8 @@ (define rewritten-input ;; in the format used in 'derivation' calls. (mlambda (input loop) (match input - (($ path (sub-drvs ...)) + (($ (= derivation-file-name path) + (sub-drvs ...)) (match (vhash-assoc path mapping) ((_ . (? derivation? replacement)) (cons replacement sub-drvs)) diff --git a/tests/derivations.scm b/tests/derivations.scm index 35fb20bab0..54fa588969 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -87,9 +87,11 @@ (define prefix-len (string-length dir)) (test-assert "parse & export" (let* ((f (search-path %load-path "tests/test.drv")) (b1 (call-with-input-file f get-bytevector-all)) - (d1 (read-derivation (open-bytevector-input-port b1))) + (d1 (read-derivation (open-bytevector-input-port b1) + identity)) (b2 (call-with-bytevector-output-port (cut write-derivation d1 <>))) - (d2 (read-derivation (open-bytevector-input-port b2)))) + (d2 (read-derivation (open-bytevector-input-port b2) + identity))) (and (equal? b1 b2) (equal? d1 d2)))) @@ -724,7 +726,7 @@ (define %coreutils (test-assert "build-expression->derivation and derivation-prerequisites" (let ((drv (build-expression->derivation %store "fail" #f))) (any (match-lambda - (($ path) + (($ (= derivation-file-name path)) (string=? path (derivation-file-name (%guile-for-build))))) (derivation-prerequisites drv)))) @@ -741,7 +743,7 @@ (define %coreutils (match (derivation-prerequisites c (cut valid-derivation-input? %store <>)) - ((($ file ("out"))) + ((($ (= derivation-file-name file) ("out"))) (string=? file (derivation-file-name b))) (x (pk 'fail x #f))))) -- cgit v1.2.3