mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

Modernize soft ports

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2023-05-31 10:28:50 +02:00
parent 075599e5b0
commit f320ce8979
3 changed files with 178 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

75
doc/ref/api-io.texi
View file

@ -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 pv modes
@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} 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))

10
module/ice-9/boot-9.scm
View file

@ -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))

127
module/ice-9/soft-ports.scm
View file

@ -29,15 +29,16 @@
#:use-module (ice-9 match)
#:use-module (rnrs bytevectors)
#:use-module (rnrs bytevectors gnu)
#: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)
@ -71,12 +72,12 @@
(set! buffer-pos (+ buffer-pos to-copy))
to-copy))))
(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 (bytevector-slice bv start count))
(str (call-with-input-bytevector
@ -91,18 +92,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 ""))
@ -110,13 +112,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
@ -124,14 +125,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
@ -191,9 +192,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
(bytevector-slice 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))