From d80855999a81f344ca0c994f0532f5bd45162089 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 16 Mar 2013 16:46:46 +0100
Subject: 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.
---
 guix/derivations.scm | 106 +++++++++++++++++++++++++++++++++++----------------
 1 file changed, 74 insertions(+), 32 deletions(-)

(limited to 'guix/derivations.scm')

diff --git a/guix/derivations.scm b/guix/derivations.scm
index 18a637ae5a..d70bd9dd85 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -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
-- 
cgit v1.2.3