lloda pushed a commit to branch main
in repository guile.
commit 4739eae499f35b0e87ed4dba8ebaf4548d2e8faa
Author: Rob Browning <r...@defaultvalue.org>
AuthorDate: Wed Sep 10 14:31:27 2025 -0500
bytevector->hex-string: avoid constructing intermediate strings
Compute bytevector->hex-string result directly from a list of characters
via to avoid having to construct intermediate strings for each byte.
* module/srfi/srfi-207.scm (bytevector->hex-string): Build one string
via list->string.
* module/srfi/srfi-207/upstream/bytestrings-impl.scm
(bytevector->hex-string): Move to srfi-207.scm.
---
module/srfi/srfi-207.scm | 23 +++++++++++++++++++++-
module/srfi/srfi-207/upstream/bytestrings-impl.scm | 15 --------------
2 files changed, 22 insertions(+), 16 deletions(-)
diff --git a/module/srfi/srfi-207.scm b/module/srfi/srfi-207.scm
index a4c8ae104..56085d6be 100644
--- a/module/srfi/srfi-207.scm
+++ b/module/srfi/srfi-207.scm
@@ -25,7 +25,10 @@
(define-module (srfi srfi-207)
#:use-module ((rnrs arithmetic bitwise) #:select (bitwise-and bitwise-ior))
#:use-module ((rnrs bytevectors)
- #:select (bytevector->u8-list string->utf8
u8-list->bytevector))
+ #:select (bytevector->u8-list
+ bytevector-u8-ref
+ string->utf8
+ u8-list->bytevector))
#:use-module ((scheme base)
#:select (binary-port?
bytevector
@@ -142,6 +145,24 @@
(make-bytestring! result 0 parts)
result))
+(define (bytevector->hex-string bv)
+ (assume (bytevector? bv))
+ (define (integer->hex-char n)
+ (case n
+ ((0) #\0) ((1) #\1) ((2) #\2) ((3) #\3) ((4) #\4)
+ ((5) #\5) ((6) #\6) ((7) #\7) ((8) #\8) ((9) #\9)
+ ((10) #\a) ((11) #\b) ((12) #\c) ((13) #\d) ((14) #\e) ((15) #\f)
+ (else (error "Should not be possible, half-byte out of hex range:" n))))
+ (list->string
+ (let loop ((i (1- (bytevector-length bv))) (result '()))
+ (if (= i -1)
+ result
+ (let ((b (bytevector-u8-ref bv i)))
+ (loop (1- i)
+ (cons* (integer->hex-char (ash b -4))
+ (integer->hex-char (logand b #x0f))
+ result)))))))
+
(define read-textual-bytestring
(case-lambda
((prefix) (read-textual-bytestring prefix (current-input-port)))
diff --git a/module/srfi/srfi-207/upstream/bytestrings-impl.scm
b/module/srfi/srfi-207/upstream/bytestrings-impl.scm
index 23379813b..e5a8e443c 100644
--- a/module/srfi/srfi-207/upstream/bytestrings-impl.scm
+++ b/module/srfi/srfi-207/upstream/bytestrings-impl.scm
@@ -61,21 +61,6 @@
;;; Hex string conversion
-(define (integer->hex-string n)
- (cond ((number->string n 16) =>
- (lambda (res)
- (if (even? (string-length res))
- res
- (string-append "0" res))))
- (else (bytestring-error "not an integer" n))))
-
-(define (bytevector->hex-string bv)
- (assume (bytevector? bv))
- (string-concatenate
- (list-tabulate (bytevector-length bv)
- (lambda (i)
- (integer->hex-string (bytevector-u8-ref bv i))))))
-
(define (hex-string->bytevector hex-str)
(unless (string? hex-str)
(bytestring-error "invalid hex-str argument" hex-str))
