mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
cd0c4e4ef8
commit
3e339c4410
1 changed files with 21 additions and 22 deletions
|
@ -26,6 +26,7 @@ (define-module (guix derivations)
|
|||
#: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 @@ (define-inlinable (write-sequence lst write-item port)
|
|||
((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 @@ (define (write-output output port)
|
|||
(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)
|
||||
|
|
Loading…
Reference in a new issue