[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/02: Modernize soft ports
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/02: Modernize soft ports |
Date: |
Fri, 2 Jun 2023 07:45:49 -0400 (EDT) |
wingo pushed a commit to branch wip-custom-ports
in repository guile.
commit 4dbd2d224e4e963253cf4a0ee593e76fe053529b
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed May 31 10:28:50 2023 +0200
Modernize soft ports
* doc/ref/api-io.texi (Soft Ports): Update docs.
* module/ice-9/boot-9.scm (make-soft-port): Don't eagerly load soft
ports.
* module/ice-9/soft-ports.scm (deprecated-make-soft-port): Rename from
make-soft-port.
(make-soft-port): New interface.
---
doc/ref/api-io.texi | 75 +++++++++++++++++++++++---
module/ice-9/boot-9.scm | 10 ++--
module/ice-9/soft-ports.scm | 127 ++++++++++++++++++++++++++++++++++++--------
3 files changed, 178 insertions(+), 34 deletions(-)
diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 6faa8b5a1..0609b264a 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1060,7 +1060,7 @@ initialized with the @var{port} argument.
* Bytevector Ports:: Ports on a bytevector.
* String Ports:: Ports on a Scheme string.
* Custom Ports:: Ports whose implementation you control.
-* Soft Ports:: An older version of custom ports.
+* Soft Ports:: A Guile-specific version of custom ports.
* Void Ports:: Ports on nothing at all.
* Low-Level Custom Ports:: Implementing new kinds of port.
* Low-Level Custom Ports in C:: A C counterpart to make-custom-port.
@@ -1522,14 +1522,75 @@ With custom textual ports:
@cindex Port, soft
Soft ports are what Guile had before it had custom binary and textual
-ports. Probably you want to use one of those instead. @xref{Custom
+ports, and allow for customizable textual input and output.
+
+We recommend soft ports over R6RS custom textual ports because they are
+easier to use while also being more expressive. R6RS custom textual
+ports operate under the principle that a port has a mutable string
+buffer, and this is reflected in the @code{read} and @code{write}
+procedures which take a buffer, offset, and length. However in Guile as
+all ports have a byte buffer rather than some having a string buffer,
+the R6RS interface imposes overhead and complexity.
+
+Additionally, and unlike the R6RS interfaces, @code{make-soft-port} from
+the @code{(ice-9 soft-ports)} module accepts keyword arguments, allowing
+for its functionality to be extended over time.
+
+If you find yourself needing more power, notably the ability to seek,
+probably you want to use low-level custom ports. @xref{Low-Level Custom
Ports}.
-But since you are still here, a @dfn{soft port} is a port based on a
-vector of procedures capable of accepting or delivering characters. It
-allows emulation of I/O ports.
+@example
+(use-modules (ice-9 soft-ports))
+@end example
+
+@deffn {Scheme Procedure} make-soft-port @
+ [#:id] [#:read-string] [#:write-string] [#:input-waiting?] @
+ [#:close] [#:close-on-gc?]
+Return a new port. If the @var{read-string} keyword argument is
+present, the port will be an input port. If @var{write-string} is
+present, the port will be an output port. If both are supplied, the
+port will be open for input and output.
+
+When the port's internal buffers are empty, @var{read-string} will be
+called with no arguments, and should return a string, or @code{#f} to
+indicate end-of-stream. Similarly when a port flushes its write buffer,
+the characters in that buffer will be passed to the @var{write-string}
+procedure as its single argument. @var{write-string} returns
+unspecified values.
+
+If supplied, @var{input-waiting?} should return @code{#t} if the soft
+port has input which would be returned directly by @var{read-string}.
+
+If supplied, @var{close} will be called when the port is closed, with no
+arguments. If @var{close-on-gc?} is @code{#t}, @var{close} will
+additionally be called when the port becomes unreachable, after flushing
+any pending write buffers.
+@end deffn
+
+With soft ports, the @code{open-string-input-port} example from the
+previous section is more simple:
+
+@example
+(define (open-string-input-port source)
+ (define already-read? #f)
+
+ (define (read-string)
+ (cond
+ (already-read? "")
+ (else
+ (set! already-read? #t)
+ source)))
+
+ (make-soft-port #:id "strport" #:read-string read-string))
+@end example
+
+Note that there was an earlier form of @code{make-soft-port} which was
+exposed in Guile's default environment, and which is still there. Its
+interface is more clumsy and its users historically expect unbuffered
+input. This interface will be deprecated, but we document it here.
-@deffn {Scheme Procedure} make-soft-port pv modes
+@deffn {Scheme Procedure} deprecated-make-soft-port pv modes
Return a port capable of receiving or delivering characters as
specified by the @var{modes} string (@pxref{File Ports,
open-file}). @var{pv} must be a vector of length 5 or 6. Its
@@ -1563,7 +1624,7 @@ For example:
@lisp
(define stdout (current-output-port))
-(define p (make-soft-port
+(define p (deprecated-make-soft-port
(vector
(lambda (c) (write c stdout))
(lambda (s) (display s stdout))
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 381960406..686a9c87d 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -4700,12 +4700,14 @@ R7RS."
-;;; make-soft-port in the default environment. FIXME: we should
-;;; figure out how to deprecate this.
+;;; make-soft-port in the default environment. FIXME: Deprecate, make
+;;; callers import (ice-9 soft-port).
;;;
-;; FIXME:
-(module-use! the-scm-module (resolve-interface '(ice-9 soft-ports)))
+(define (make-soft-port pv modes)
+ ((module-ref (resolve-interface '(ice-9 soft-ports))
+ 'deprecated-make-soft-port)
+ pv modes))
diff --git a/module/ice-9/soft-ports.scm b/module/ice-9/soft-ports.scm
index 2d2cada1a..a9d4e47c4 100644
--- a/module/ice-9/soft-ports.scm
+++ b/module/ice-9/soft-ports.scm
@@ -28,15 +28,16 @@
#:use-module (ice-9 textual-ports)
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
- #:export (make-soft-port))
+ #:export (deprecated-make-soft-port)
+ #:replace (make-soft-port))
(define (type-error proc expecting val)
(scm-error 'wrong-type-arg proc "Wrong type (expecting `~S'): ~S"
(list expecting val) (list val)))
-(define (soft-port-read %get-char)
+(define (deprecated-soft-port-read %get-char)
(unless (procedure? %get-char)
- (type-error "soft-port-read" "procedure" %get-char))
+ (type-error "deprecated-soft-port-read" "procedure" %get-char))
(define encode-buf-size 10)
(define buffer (make-bytevector encode-buf-size))
(define buffer-pos 0)
@@ -77,12 +78,12 @@
(bytevector-copy! bv start sub 0 count)
sub)))
-(define (soft-port-write %put-string %flush)
+(define (deprecated-soft-port-write %put-string %flush)
(unless (procedure? %put-string)
- (type-error "soft-port-write" "procedure" %put-string))
+ (type-error "deprecated-soft-port-write" "procedure" %put-string))
(when %flush
(unless (procedure? %flush)
- (type-error "soft-port-write" "procedure" %flush)))
+ (type-error "deprecated-soft-port-write" "procedure" %flush)))
(lambda (port bv start count)
(let* ((bytes (subbytevector bv start count))
(str (call-with-input-bytevector
@@ -97,18 +98,19 @@
(if %flush (%flush))
count)))
-(define (soft-port-close %close)
+(define (deprecated-soft-port-close %close)
(unless (procedure? %close)
(type-error "soft-port-close" "procedure" %close))
(lambda (port) (%close)))
-(define (soft-port-input-waiting? %input-ready)
+(define (deprecated-soft-port-input-waiting? %input-ready)
(unless (procedure? %input-ready)
- (type-error "soft-port-close" "procedure" %input-ready))
+ (type-error "deprecated-soft-port-close" "procedure" %input-ready))
(lambda (port) (< 0 (%input-ready))))
-(define (%make-soft-port %put-char %put-string %flush %get-char %close
- %input-ready reading? writing? buffering)
+(define (%deprecated-make-soft-port %put-char %put-string %flush %get-char
+ %close %input-ready
+ reading? writing? buffering)
(cond
((not (or reading? writing?))
(%make-void-port ""))
@@ -116,13 +118,12 @@
(let ((port
(make-custom-port
#:id "soft-port"
- #:read (and reading? (soft-port-read %get-char))
- #:write (and writing? (soft-port-write %put-string %flush))
+ #:read (and reading? (deprecated-soft-port-read %get-char))
+ #:write (and writing? (deprecated-soft-port-write %put-string
%flush))
#:seek (lambda (port offset whence)
(error "soft ports are not seekable"))
- #:close (if %close
- (soft-port-close %close)
- (lambda (port) (values)))
+ #:close (and %close
+ (deprecated-soft-port-close %close))
#:get-natural-buffer-sizes (lambda (port read-size write-size)
;; The in-practice expectation
;; is that soft ports have
@@ -130,14 +131,14 @@
(values read-size 1))
#:random-access? (lambda (port) #f)
#:input-waiting? (if %input-ready
- (soft-port-input-waiting? %input-ready)
+ (deprecated-soft-port-input-waiting?
%input-ready)
(lambda (port) #t))
#:close-on-gc? #t)))
(when buffering
(setvbuf port buffering))
port))))
-(define (make-soft-port vtable modes)
+(define (deprecated-make-soft-port vtable modes)
"Return a port capable of receiving or delivering characters as
specified by the @var{modes} string (@pxref{File Ports, open-file}).
@var{pv} must be a vector of length 5 or 6. Its components are as
@@ -197,9 +198,89 @@ For example:
(else #f))))
(match vtable
(#(%put-char %put-string %flush %get-char %close)
- (%make-soft-port %put-char %put-string %flush %get-char %close #f
- reading? writing? buffering))
+ (%deprecated-make-soft-port %put-char %put-string %flush %get-char %close
+ #f reading? writing? buffering))
(#(%put-char %put-string %flush %get-char %close %chars-waiting)
- (%make-soft-port %put-char %put-string %flush %get-char %close
- %chars-waiting
- reading? writing? buffering))))
+ (%deprecated-make-soft-port %put-char %put-string %flush %get-char %close
+ %chars-waiting reading? writing? buffering))))
+
+(define (soft-port-read read-string)
+ (unless (procedure? read-string)
+ (type-error "soft-port-read" "procedure" read-string))
+ (define-values (transcoder get-bytes) (open-bytevector-output-port))
+ (define buffer #f)
+ (define buffer-pos 0)
+ (lambda (port bv start count)
+ (unless (and buffer (< buffer-pos (bytevector-length buffer)))
+ (let* ((str (read-string)))
+ (unless (eq? (port-encoding port) (port-encoding transcoder))
+ (set-port-encoding! transcoder (port-encoding port)))
+ (unless (eq? (port-conversion-strategy port)
+ (port-conversion-strategy transcoder))
+ (set-port-conversion-strategy! transcoder
+ (port-conversion-strategy port)))
+ (put-string transcoder str)
+ (set! buffer (get-bytes))
+ (set! buffer-pos 0)))
+
+ (let ((to-copy (min count (- (bytevector-length buffer) buffer-pos))))
+ (bytevector-copy! buffer buffer-pos bv start to-copy)
+ (if (= (bytevector-length buffer) (+ buffer-pos to-copy))
+ (set! buffer #f)
+ (set! buffer-pos (+ buffer-pos to-copy)))
+ to-copy)))
+
+(define (soft-port-write write-string)
+ (unless (procedure? write-string)
+ (type-error "soft-port-write" "procedure" write-string))
+ (lambda (port bv start count)
+ (write-string
+ (call-with-input-bytevector
+ (subbytevector bv start count)
+ (lambda (bport)
+ (set-port-encoding! bport (port-encoding port))
+ (set-port-conversion-strategy!
+ bport
+ (port-conversion-strategy port))
+ (get-string-all bport))))
+ count))
+
+(define* (make-soft-port #:key
+ (id "soft-port")
+ (read-string #f)
+ (write-string #f)
+ (input-waiting? #f)
+ (close #f)
+ (close-on-gc? #f))
+ "Return a new port. If the @var{read-string} keyword argument is
+present, the port will be an input port. If @var{write-string} is
+present, the port will be an output port. If both are supplied, the
+port will be open for input and output.
+
+When the port's internal buffers are empty, @var{read-string} will be
+called with no arguments, and should return a string. Returning \"\"
+indicates end-of-stream. Similarly when a port flushes its write
+buffer, the characters in that buffer will be passed to the
+@var{write-string} procedure as its single argument. @var{write-string}
+returns unspecified values.
+
+If supplied, @var{input-waiting?} should return @code{#t} if the soft
+port has input which would be returned directly by @var{read-string}.
+
+If supplied, @var{close} will be called when the port is closed, with no
+arguments. If @var{close-on-gc?} is @code{#t}, @var{close} will
+additionally be called when the port becomes unreachable, after flushing
+any pending write buffers."
+ (unless (or read-string write-string)
+ (error "Expected at least one of #:read-string, #:write-string"))
+ (when (and input-waiting? (not read-string))
+ (error "Supplying #:input-waiting? requires a #:read-string"))
+ (make-custom-port
+ #:id id
+ #:read (and read-string (soft-port-read read-string))
+ #:write (and write-string (soft-port-write write-string))
+ #:close (and close (lambda (port) (close)))
+ #:input-waiting? (and input-waiting?
+ (lambda (port) (input-waiting?)))
+ #:close-on-gc? close-on-gc?
+ #:encoding 'UTF-8))