ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -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 ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2014, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -32,27 +33,28 @@ (define-module (guix base16)
(define (bytevector->base16-string bv) (define (bytevector->base16-string bv)
"Return the hexadecimal representation of BV's contents." "Return the hexadecimal representation of BV's contents."
(define len (define len (bytevector-length bv))
(bytevector-length bv)) (define utf8 (make-bytevector (* len 2)))
(let-syntax ((base16-octet-pairs
(let-syntax ((base16-chars (lambda (s) (lambda (s)
(syntax-case s () (syntax-case s ()
(_ (_
(let ((v (list->vector (string->utf8
(unfold (cut > <> 255) (string-concatenate
(lambda (n) (unfold (cut > <> 255)
(format #f "~2,'0x" n)) (lambda (n)
1+ (format #f "~2,'0x" n))
0)))) 1+
v)))))) 0))))))))
(define chars base16-chars) (define octet-pairs base16-octet-pairs)
(let loop ((i len) (let loop ((i 0))
(r '())) (when (< i len)
(if (zero? i) (bytevector-u16-native-set!
(string-concatenate r) utf8 (* 2 i)
(let ((i (- i 1))) (bytevector-u16-native-ref octet-pairs
(loop i (* 2 (bytevector-u8-ref bv i))))
(cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))) (loop (+ i 1))))
(utf8->string utf8)))
(define base16-string->bytevector (define base16-string->bytevector
(let ((chars->value (fold (lambda (i r) (let ((chars->value (fold (lambda (i r)