02/09: base16: Reduce GC pressure in bytevector->base16-string.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit a87d8c912d64382d8d7489c156249bc2b2638df0
Author: Maxime Devos <maximedevos@telenet.be>
AuthorDate: Mon Sep 6 00:46:17 2021 +0200

    base16: Reduce GC pressure in bytevector->base16-string.
    
    This makes bytevector->base16-string two times faster.
    
    * guix/base16.scm (bytevector->base16-string): Use utf8->string
      and iteration instead of string-concatenate and named let.
    
    Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 guix/base16.scm | 44 +++++++++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 21 deletions(-)

diff --git a/guix/base16.scm b/guix/base16.scm
index 6c15a9f..9ac964d 100644
--- a/guix/base16.scm
+++ b/guix/base16.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,27 +33,28 @@
 
 (define (bytevector->base16-string bv)
   "Return the hexadecimal representation of BV's contents."
-  (define len
-    (bytevector-length bv))
-
-  (let-syntax ((base16-chars (lambda (s)
-                               (syntax-case s ()
-                                 (_
-                                  (let ((v (list->vector
-                                            (unfold (cut > <> 255)
-                                                    (lambda (n)
-                                                      (format #f "~2,'0x" n))
-                                                    1+
-                                                    0))))
-                                    v))))))
-    (define chars base16-chars)
-    (let loop ((i len)
-               (r '()))
-      (if (zero? i)
-          (string-concatenate r)
-          (let ((i (- i 1)))
-            (loop i
-                  (cons (vector-ref chars (bytevector-u8-ref bv i)) r)))))))
+  (define len (bytevector-length bv))
+  (define utf8 (make-bytevector (* len 2)))
+  (let-syntax ((base16-octet-pairs
+                (lambda (s)
+                  (syntax-case s ()
+                    (_
+                     (string->utf8
+                      (string-concatenate
+                       (unfold (cut > <> 255)
+                               (lambda (n)
+                                 (format #f "~2,'0x" n))
+                               1+
+                               0))))))))
+    (define octet-pairs base16-octet-pairs)
+    (let loop ((i 0))
+      (when (< i len)
+        (bytevector-u16-native-set!
+         utf8 (* 2 i)
+         (bytevector-u16-native-ref octet-pairs
+                                    (* 2 (bytevector-u8-ref bv i))))
+        (loop (+ i 1))))
+    (utf8->string utf8)))
 
 (define base16-string->bytevector
   (let ((chars->value (fold (lambda (i r)