~ruther/guix-local

d80855999a81f344ca0c994f0532f5bd45162089 — Ludovic Courtès 13 years ago 993fb66
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.
1 files changed, 74 insertions(+), 32 deletions(-)

M guix/derivations.scm
M guix/derivations.scm => guix/derivations.scm +74 -32
@@ 235,6 235,32 @@ DRV and not already available in STORE, recursively."
              (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 @@ that form."
  ;; 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 @@ that form."
          '()
          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 @@ that form."
    (($ <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
                            (lambda (o1 o2)
                              (string<? (car o1) (car o2))))))
     (write-list (sort outputs
                       (lambda (o1 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)
                            (lambda (i1 i2)
                              (string<? (derivation-input-path i1)
                                        (derivation-input-path i2))))))
     (write-list (sort (coalesce-duplicate-inputs inputs)
                       (lambda (i1 i2)
                         (string<? (derivation-input-path i1)
                                   (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
                            (lambda (e1 e2)
                              (string<? (car e1) (car e2))))))
     (write-list (sort env-vars
                       (lambda (e1 e2)
                         (string<? (car e1) (car e2))))
                 write-env-var
                 port)
     (display ")" port))))

(define derivation-path->output-path