diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index 70959037e..b6ea593f7 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 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)) 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 1b2b2dc9c..2dc7203c3 100644 --- a/module/ice-9/soft-ports.scm +++ b/module/ice-9/soft-ports.scm @@ -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))