ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

base16: Reduce GC pressure in bytevector->base16-string.

Browse source 
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>
This commit is contained in:
Maxime Devos 2021-09-06 00:46:17 +02:00 committed by Ludovic Courtès
parent e11830d36e
commit a87d8c912d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 23 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
guix/base16.scm
View file

@ -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-module (guix base16)
(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)