[Guile-commits] 02/05: Add call-with-input-bytevector, call-with-output-bytevector

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 0f42fef11981f38578bbd629a294b2053d258db0
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Tue Jan 12 11:47:58 2021 +0100

    Add call-with-input-bytevector, call-with-output-bytevector
    
    * module/ice-9/binary-ports.scm (call-with-input-bytevector):
      (call-with-output-bytevector): New functions.
    * module/ice-9/iconv.scm: Remove superfluous copies of
      call-with-output-string* and call-with-output-bytevector*, now that
      the former closes the port and the latter exists.
      (call-with-encoded-output-string): Adapt.
    * module/web/uri.scm: Use (ice-9 iconv) instead of local
      bytevector/string conversion procedures.
---
 module/ice-9/binary-ports.scm | 56 +++++++++++++++++++++++++++++--------------
 module/ice-9/iconv.scm        | 22 +++--------------
 module/web/uri.scm            | 54 +++++------------------------------------
 3 files changed, 47 insertions(+), 85 deletions(-)

diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index 62fd978..bffd74e 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -1,20 +1,19 @@
-;;;; binary-ports.scm --- Binary IO on ports
-
-;;;;   Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Lesser General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 3 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Lesser General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Lesser General Public
-;;;; License along with this library; if not, write to the Free Software
-;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA
+;;; binary-ports.scm --- Binary IO on ports
+;;; Copyright (C) 2009-2011,2013,2016,2019,2021 Free Software Foundation, Inc.
+;;;
+;;; This library is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
 
 ;;; Author: Ludovic Courtès <ludo@gnu.org>
 
@@ -44,10 +43,31 @@
             unget-bytevector
             open-bytevector-output-port
             make-custom-binary-output-port
-            make-custom-binary-input/output-port))
+            make-custom-binary-input/output-port
+            call-with-input-bytevector
+            call-with-output-bytevector))
 
 ;; Note that this extension also defines %make-transcoded-port, which is
 ;; not exported but is used by (rnrs io ports).
 
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_r6rs_ports")
+
+(define (call-with-input-bytevector bv proc)
+  "Call the one-argument procedure @var{proc} with a newly created
+binary input port from which the bytevector @var{bv}'s contents may be
+read.  All values yielded by @var{proc} are returned."
+  (proc (open-bytevector-input-port bv)))
+
+(define (call-with-output-bytevector proc)
+  "Call the one-argument procedure @var{proc} with a newly created
+binary output port.  When the function returns, port is closed and the
+bytevector composed of the bytes written into the port is returned."
+  (call-with-values
+      (lambda ()
+        (open-bytevector-output-port))
+    (lambda (port get-bytevector)
+      (proc port)
+      (let ((bv (get-bytevector)))
+        (close-port port)
+        bv))))
diff --git a/module/ice-9/iconv.scm b/module/ice-9/iconv.scm
index 125dad8..cfe5fe3 100644
--- a/module/ice-9/iconv.scm
+++ b/module/ice-9/iconv.scm
@@ -1,6 +1,6 @@
 ;;; Encoding and decoding byte representations of strings
 
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2021 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -26,22 +26,6 @@
             bytevector->string
             call-with-encoded-output-string))
 
-;; Like call-with-output-string, but actually closes the port.
-(define (call-with-output-string* proc)
-  (let ((port (open-output-string)))
-    (proc port)
-    (let ((str (get-output-string port)))
-      (close-port port)
-      str)))
-
-(define (call-with-output-bytevector* proc)
-  (call-with-values (lambda () (open-bytevector-output-port))
-    (lambda (port get-bytevector)
-      (proc port)
-      (let ((bv (get-bytevector)))
-        (close-port port)
-        bv))))
-
 (define* (call-with-encoded-output-string encoding proc
                                           #:optional
                                           (conversion-strategy 'error))
@@ -52,8 +36,8 @@ bytevector according to ENCODING, and return the bytevector."
       ;; I don't know why, but this appears to be faster; at least for
       ;; serving examples/debug-sxml.scm (1464 reqs/s versus 850
       ;; reqs/s).
-      (string->utf8 (call-with-output-string* proc))
-      (call-with-output-bytevector*
+      (string->utf8 (call-with-output-string proc))
+      (call-with-output-bytevector
        (lambda (port)
          (set-port-encoding! port encoding)
          (if conversion-strategy
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 728444a..8e0b9be 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -1,6 +1,6 @@
 ;;;; (web uri) --- URI manipulation tools
 ;;;;
-;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013,2014,2019,2020 Free 
Software Foundation, Inc.
+;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013,2014,2019-2021 Free 
Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -26,6 +26,7 @@
 
 (define-module (web uri)
   #:use-module (srfi srfi-9)
+  #:use-module (ice-9 iconv)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 control)
@@ -364,49 +365,6 @@ serialization."
          ""))))
 
 
-;; like call-with-output-string, but actually closes the port (doh)
-(define (call-with-output-string* proc)
-  (let ((port (open-output-string)))
-    (proc port)
-    (let ((str (get-output-string port)))
-      (close-port port)
-      str)))
-
-(define (call-with-output-bytevector* proc)
-  (call-with-values
-      (lambda ()
-        (open-bytevector-output-port))
-    (lambda (port get-bytevector)
-      (proc port)
-      (let ((bv (get-bytevector)))
-        (close-port port)
-        bv))))
-
-(define (call-with-encoded-output-string encoding proc)
-  (if (string-ci=? encoding "utf-8")
-      (string->utf8 (call-with-output-string* proc))
-      (call-with-output-bytevector*
-       (lambda (port)
-         (set-port-encoding! port encoding)
-         (proc port)))))
-
-(define (encode-string str encoding)
-  (if (string-ci=? encoding "utf-8")
-      (string->utf8 str)
-      (call-with-encoded-output-string encoding
-                                       (lambda (port)
-                                         (display str port)))))
-
-(define (decode-string bv encoding)
-  (if (string-ci=? encoding "utf-8")
-      (utf8->string bv)
-      (let ((p (open-bytevector-input-port bv)))
-        (set-port-encoding! p encoding)
-        (let ((res (read-string p)))
-          (close-port p)
-          res))))
-
-
 ;; A note on characters and bytes: URIs are defined to be sequences of
 ;; characters in a subset of ASCII. Those characters may encode a
 ;; sequence of bytes (octets), which in turn may encode sequences of
@@ -444,7 +402,7 @@ Returns a string of the decoded characters, or a bytevector 
if
 ENCODING was ‘#f’."
   (let* ((len (string-length str))
          (bv
-          (call-with-output-bytevector*
+          (call-with-output-bytevector
            (lambda (port)
              (let lp ((i 0))
                (if (< i len)
@@ -469,7 +427,7 @@ ENCODING was ‘#f’."
                        (uri-error "Invalid character in encoded URI ~a: ~s"
                                   str ch))))))))))
     (if encoding
-        (decode-string bv encoding)
+        (bytevector->string bv encoding)
         ;; Otherwise return raw bytevector
         bv)))
 
@@ -506,13 +464,13 @@ uppercase hexadecimal representation of the byte."
   (define (needs-escaped? ch)
     (not (char-set-contains? unescaped-chars ch)))
   (if (string-index str needs-escaped?)
-      (call-with-output-string*
+      (call-with-output-string
        (lambda (port)
          (string-for-each
           (lambda (ch)
             (if (char-set-contains? unescaped-chars ch)
                 (display ch port)
-                (let* ((bv (encode-string (string ch) encoding))
+                (let* ((bv (string->bytevector (string ch) encoding))
                        (len (bytevector-length bv)))
                   (let lp ((i 0))
                     (if (< i len)