diff options
author | Andy Wingo <wingo@pobox.com> | 2021-01-12 11:47:58 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2021-01-12 12:09:19 +0100 |
commit | 0f42fef11981f38578bbd629a294b2053d258db0 (patch) | |
tree | ef383134ad3521c7415b589ebea979fb413f9d5f | |
parent | 9fecf20fcf1bac764b3d812e07ed4a4a56be52a2 (diff) | |
download | guile-0f42fef11981f38578bbd629a294b2053d258db0.tar.gz |
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.
-rw-r--r-- | module/ice-9/binary-ports.scm | 56 | ||||
-rw-r--r-- | module/ice-9/iconv.scm | 22 | ||||
-rw-r--r-- | 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 62fd9786f..bffd74e14 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 125dad8b8..cfe5fe3d7 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 728444afc..8e0b9bee7 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) |