derivations: Avoid uses of 'display' in 'write-derivation'.

This yields a 4% improvement on the wall-clock time of:

  guix build -e '(@@ (gnu packages libreoffice) libreoffice)' --no-grafts -d

* guix/derivations.scm (write-sequence, write-list, write-tuple): Use
'put-char' instead of 'display'.
(write-derivation): Use 'put-string' and 'put-char', and remove unused
'format' binding.
This commit is contained in:
Ludovic Courtès 2020-08-28 18:31:40 +02:00
parent cd0c4e4ef8
commit 3e339c4410
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 21 additions and 22 deletions

View File

@ -26,6 +26,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 binary-ports)
#:use-module ((ice-9 textual-ports) #:select (put-char put-string))
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
@ -561,30 +562,29 @@ things as appropriate and is thus more efficient."
((prefix (... ...) last)
(for-each (lambda (item)
(write-item item port)
(display "," port))
(put-char 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)
(put-char port #\[)
(write-sequence lst write-item port)
(display "]" port))
(put-char port #\]))
(define-inlinable (write-tuple lst write-item port)
;; Same, but write LST as a tuple.
(display "(" port)
(put-char port #\()
(write-sequence lst write-item port)
(display ")" port))
(put-char 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
that form."
;; Make sure we're using the faster implementation.
(define format simple-format)
;; Use 'put-string', which does less work and is faster than 'display'.
(define (write-string-list lst)
(write-list lst write port))
@ -605,42 +605,41 @@ that form."
(define (write-input input port)
(match input
(($ <derivation-input> obj sub-drvs)
(display "(\"" port)
(put-string port "(\"")
;; 'derivation/masked-inputs' produces objects that contain a string
;; instead of a <derivation>, so we need to account for that.
(display (if (derivation? obj)
(derivation-file-name obj)
obj)
port)
(display "\"," port)
(put-string port (if (derivation? obj)
(derivation-file-name obj)
obj))
(put-string port "\",")
(write-string-list sub-drvs)
(display ")" port))))
(put-char port #\)))))
(define (write-env-var env-var port)
(match env-var
((name . value)
(display "(" port)
(put-string port "(")
(write name port)
(display "," port)
(put-string port ",")
(write value port)
(display ")" port))))
(put-string port ")"))))
;; Assume all the lists we are writing are already sorted.
(match drv
(($ <derivation> outputs inputs sources
system builder args env-vars)
(display "Derive(" port)
(put-string port "Derive(")
(write-list outputs write-output port)
(display "," port)
(put-char port #\,)
(write-list inputs write-input port)
(display "," port)
(put-char port #\,)
(write-string-list sources)
(simple-format port ",\"~a\",\"~a\"," system builder)
(write-string-list args)
(display "," port)
(put-char port #\,)
(write-list env-vars write-env-var port)
(display ")" port))))
(put-char port #\)))))
(define derivation->bytevector
(lambda (drv)