From 4c0c4db0702048488a9712dbba7cad862c667d54 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 15 Mar 2017 21:54:34 +0100
Subject: utils: Move base16 procedures to (guix base16).

* guix/utils.scm (bytevector->base16-string, base16-string->bytevector):
Move to...
* guix/base16.scm: ... here.  New file.
* tests/utils.scm ("bytevector->base16-string->bytevector"): Move to...
* tests/base16.scm: ... here.  New file.
* Makefile.am (MODULES): Add guix/base16.scm.
(SCM_TESTS): Add tests/base16.scm.
* build-aux/download.scm, guix/derivations.scm,
guix/docker.scm, guix/import/snix.scm, guix/pk-crypto.scm,
guix/scripts/authenticate.scm, guix/scripts/download.scm,
guix/scripts/hash.scm, guix/store.scm, tests/hash.scm,
tests/pk-crypto.scm: Adjust imports accordingly.
---
 guix/utils.scm | 65 +---------------------------------------------------------
 1 file changed, 1 insertion(+), 64 deletions(-)

(limited to 'guix/utils.scm')

diff --git a/guix/utils.scm b/guix/utils.scm
index b72e3f233f..bc90686de0 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -28,15 +28,12 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
-  #:use-module (srfi srfi-60)
-  #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:autoload   (rnrs io ports) (make-custom-binary-input-port)
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module (guix memoization)
   #:use-module ((guix build utils) #:select (dump-port))
   #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
-  #:use-module (ice-9 vlist)
   #:use-module (ice-9 format)
   #:autoload   (ice-9 popen)  (open-pipe*)
   #:autoload   (ice-9 rdelim) (read-line)
@@ -46,10 +43,7 @@
   #:use-module ((ice-9 iconv) #:prefix iconv:)
   #:use-module (system foreign)
   #:re-export (memoize)         ; for backwards compatibility
-  #:export (bytevector->base16-string
-            base16-string->bytevector
-
-            strip-keyword-arguments
+  #:export (strip-keyword-arguments
             default-keyword-arguments
             substitute-keyword-arguments
             ensure-keyword-arguments
@@ -98,63 +92,6 @@
             call-with-compressed-output-port
             canonical-newline-port))
 
-
-;;;
-;;; Base 16.
-;;;
-
-(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 base16-string->bytevector
-  (let ((chars->value (fold (lambda (i r)
-                              (vhash-consv (string-ref (number->string i 16)
-                                                       0)
-                                           i r))
-                            vlist-null
-                            (iota 16))))
-    (lambda (s)
-      "Return the bytevector whose hexadecimal representation is string S."
-      (define bv
-        (make-bytevector (quotient (string-length s) 2) 0))
-
-      (string-fold (lambda (chr i)
-                     (let ((j (quotient i 2))
-                           (v (and=> (vhash-assv chr chars->value) cdr)))
-                       (if v
-                           (if (zero? (logand i 1))
-                               (bytevector-u8-set! bv j
-                                                   (arithmetic-shift v 4))
-                               (let ((w (bytevector-u8-ref bv j)))
-                                 (bytevector-u8-set! bv j (logior v w))))
-                           (error "invalid hexadecimal character" chr)))
-                     (+ i 1))
-                   0
-                   s)
-      bv)))
-
-
 
 ;;;
 ;;; Filtering & pipes.
-- 
cgit v1.2.3