mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-19 14:07:01 +01:00
derivations: Optimize `write-derivation'.
This reduces the execution time of "guix build -e '(@ (gnu packages emacs) emacs)' -d" by 25%, from 1.54 s. to 1.15s. * guix/derivations.scm (write-sequence, write-list, write-tuple): New procedures. (write-derivation)[list->string, write-list]: Remove. [write-string-list, write-output, write-input, write-env-var]: New helpers. Rewrite in terms of these new helpers.
This commit is contained in:
parent
993fb66dd2
commit
d80855999a
1 changed files with 74 additions and 32 deletions
|
@ -235,6 +235,32 @@ (define read-derivation
|
|||
(hash-set! cache file drv)
|
||||
drv))))))
|
||||
|
||||
(define-inlinable (write-sequence lst write-item port)
|
||||
;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
|
||||
;; comma.
|
||||
(match lst
|
||||
(()
|
||||
#t)
|
||||
((prefix (... ...) last)
|
||||
(for-each (lambda (item)
|
||||
(write-item item port)
|
||||
(display "," port))
|
||||
prefix)
|
||||
(write-item last port))))
|
||||
|
||||
(define-inlinable (write-list lst write-item port)
|
||||
;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
|
||||
;; element.
|
||||
(display "[" port)
|
||||
(write-sequence lst write-item port)
|
||||
(display "]" port))
|
||||
|
||||
(define-inlinable (write-tuple lst write-item port)
|
||||
;; Same, but write LST as a tuple.
|
||||
(display "(" port)
|
||||
(write-sequence lst write-item port)
|
||||
(display ")" port))
|
||||
|
||||
(define (write-derivation drv port)
|
||||
"Write the ATerm-like serialization of DRV to PORT. See Section 2.4 of
|
||||
Eelco Dolstra's PhD dissertation for an overview of a previous version of
|
||||
|
@ -243,11 +269,8 @@ (define (write-derivation drv port)
|
|||
;; Make sure we're using the faster implementation.
|
||||
(define format simple-format)
|
||||
|
||||
(define (list->string lst)
|
||||
(string-append "[" (string-join lst ",") "]"))
|
||||
|
||||
(define (write-list lst)
|
||||
(display (list->string lst) port))
|
||||
(define (write-string-list lst)
|
||||
(write-list lst write port))
|
||||
|
||||
(define (coalesce-duplicate-inputs inputs)
|
||||
;; Return a list of inputs, such that when INPUTS contains the same DRV
|
||||
|
@ -272,6 +295,34 @@ (define (coalesce-duplicate-inputs inputs)
|
|||
'()
|
||||
inputs))
|
||||
|
||||
(define (write-output output port)
|
||||
(match output
|
||||
((name . ($ <derivation-output> path hash-algo hash))
|
||||
(write-tuple (list name path
|
||||
(or (and=> hash-algo symbol->string) "")
|
||||
(or (and=> hash bytevector->base16-string)
|
||||
""))
|
||||
write
|
||||
port))))
|
||||
|
||||
(define (write-input input port)
|
||||
(match input
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(display "(" port)
|
||||
(write path port)
|
||||
(display "," port)
|
||||
(write-string-list (sort sub-drvs string<?))
|
||||
(display ")" port))))
|
||||
|
||||
(define (write-env-var env-var port)
|
||||
(match env-var
|
||||
((name . value)
|
||||
(display "(" port)
|
||||
(write name port)
|
||||
(display "," port)
|
||||
(write value port)
|
||||
(display ")" port))))
|
||||
|
||||
;; Note: lists are sorted alphabetically, to conform with the behavior of
|
||||
;; C++ `std::map' in Nix itself.
|
||||
|
||||
|
@ -279,37 +330,28 @@ (define (coalesce-duplicate-inputs inputs)
|
|||
(($ <derivation> outputs inputs sources
|
||||
system builder args env-vars)
|
||||
(display "Derive(" port)
|
||||
(write-list (map (match-lambda
|
||||
((name . ($ <derivation-output> path hash-algo hash))
|
||||
(format #f "(~s,~s,~s,~s)"
|
||||
name path
|
||||
(or (and=> hash-algo symbol->string) "")
|
||||
(or (and=> hash bytevector->base16-string)
|
||||
""))))
|
||||
(sort outputs
|
||||
(write-list (sort outputs
|
||||
(lambda (o1 o2)
|
||||
(string<? (car o1) (car o2))))))
|
||||
(string<? (car o1) (car o2))))
|
||||
write-output
|
||||
port)
|
||||
(display "," port)
|
||||
(write-list (map (match-lambda
|
||||
(($ <derivation-input> path sub-drvs)
|
||||
(format #f "(~s,~a)" path
|
||||
(list->string (map object->string
|
||||
(sort sub-drvs string<?))))))
|
||||
(sort (coalesce-duplicate-inputs inputs)
|
||||
(write-list (sort (coalesce-duplicate-inputs inputs)
|
||||
(lambda (i1 i2)
|
||||
(string<? (derivation-input-path i1)
|
||||
(derivation-input-path i2))))))
|
||||
(derivation-input-path i2))))
|
||||
write-input
|
||||
port)
|
||||
(display "," port)
|
||||
(write-list (map object->string (sort sources string<?)))
|
||||
(write-string-list (sort sources string<?))
|
||||
(format port ",~s,~s," system builder)
|
||||
(write-list (map object->string args))
|
||||
(write-string-list args)
|
||||
(display "," port)
|
||||
(write-list (map (match-lambda
|
||||
((name . value)
|
||||
(format #f "(~s,~s)" name value)))
|
||||
(sort env-vars
|
||||
(write-list (sort env-vars
|
||||
(lambda (e1 e2)
|
||||
(string<? (car e1) (car e2))))))
|
||||
(string<? (car e1) (car e2))))
|
||||
write-env-var
|
||||
port)
|
||||
(display ")" port))))
|
||||
|
||||
(define derivation-path->output-path
|
||||
|
|
Loading…
Reference in a new issue