Archived
1
0
Fork 0

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

View file

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