mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-01 15:20:34 +02:00
Code Activity

Move transcoded ports implementation to Scheme

Browse source 
* libguile/r6rs-ports.c: Remove private transcoded ports implementation.
* module/ice-9/binary-ports.scm: Remove stale comment.
* module/rnrs/io/ports.scm (%make-transcoded-port): New implementation
based on custom ports.
This commit is contained in:
Andy Wingo 2025-06-18 11:06:12 +02:00
parent 66ec19d790
commit 3f4048f6c8
3 changed files with 22 additions and 83 deletions
Download patch file Download diff file Expand all files Collapse all files

77
libguile/r6rs-ports.c
View file

@ -485,81 +485,6 @@ SCM scm_make_custom_binary_input_output_port (SCM id, SCM read_proc,
}
/* Transcoded ports. */
static scm_t_port_type *transcoded_port_type = 0;
#define SCM_TRANSCODED_PORT_BINARY_PORT(_port) SCM_PACK (SCM_STREAM (_port))
static inline SCM
make_transcoded_port (SCM binary_port, unsigned long mode)
{
return scm_c_make_port (transcoded_port_type, mode,
SCM_UNPACK (binary_port));
}
static size_t
transcoded_port_write (SCM port, SCM src, size_t start, size_t count)
{
SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
scm_c_write_bytes (bport, src, start, count);
return count;
}
static size_t
transcoded_port_read (SCM port, SCM dst, size_t start, size_t count)
{
SCM bport = SCM_TRANSCODED_PORT_BINARY_PORT (port);
return scm_c_read_bytes (bport, dst, start, count);
}
static void
transcoded_port_close (SCM port)
{
scm_close_port (SCM_TRANSCODED_PORT_BINARY_PORT (port));
}
static inline void
initialize_transcoded_ports (void)
{
transcoded_port_type =
scm_make_port_type ("r6rs-transcoded-port", transcoded_port_read,
transcoded_port_write);
scm_set_port_close (transcoded_port_type, transcoded_port_close);
scm_set_port_needs_close_on_gc (transcoded_port_type, 1);
}
SCM_INTERNAL SCM scm_i_make_transcoded_port (SCM);
SCM_DEFINE (scm_i_make_transcoded_port,
"%make-transcoded-port", 1, 0, 0,
(SCM port),
"Return a new port which reads and writes to @var{port}")
#define FUNC_NAME s_scm_i_make_transcoded_port
{
SCM result;
unsigned long mode = 0;
SCM_VALIDATE_PORT (SCM_ARG1, port);
if (scm_is_true (scm_output_port_p (port)))
mode |= SCM_WRTNG;
if (scm_is_true (scm_input_port_p (port)))
mode |= SCM_RDNG;
result = make_transcoded_port (port, mode);
/* FIXME: We should actually close `port' "in a special way" here,
according to R6RS. As there is no way to do that in Guile without
rendering the underlying port unusable for our purposes as well, we
just leave it open. */
return result;
}
#undef FUNC_NAME
/* Textual I/O */
@ -610,8 +535,6 @@ scm_register_r6rs_ports (void)
"scm_init_r6rs_ports",
(scm_t_extension_init_func) scm_init_r6rs_ports,
NULL);
initialize_transcoded_ports ();
}
void

3
module/ice-9/binary-ports.scm
View file

@ -50,9 +50,6 @@
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")

25
module/rnrs/io/ports.scm
View file

@ -1,6 +1,6 @@
;;;; ports.scm --- R6RS port API -*- coding: utf-8 -*-
;;;; Copyright (C) 2009-2011, 2013, 2019, 2023 Free Software Foundation, Inc.
;;;; Copyright (C) 2009-2011, 2013, 2019, 2023, 2025 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
@ -112,6 +112,7 @@
&i/o-encoding i/o-encoding-error?
make-i/o-encoding-error i/o-encoding-error-char)
(import (ice-9 binary-ports)
(only (ice-9 custom-ports) make-custom-port)
(only (ice-9 textual-ports)
make-custom-textual-input-port
make-custom-textual-output-port
@ -297,12 +298,30 @@ I/O in Guile."
(lookahead-u8 port)
(lookahead-char port))))
(define (%make-transcoded-port other)
"Return a new port which reads and writes to @var{other}."
(define (read port bv start count)
(let ((n (get-bytevector-n! other bv start count)))
(if (eof-object? n)
0
n)))
(define (write port bv start count)
(put-bytevector other bv start count)
count)
;; FIXME: We should actually close `other' "in a special way" here,
;; according to R6RS. As there is no way to do that in Guile without
;; rendering the underlying port unusable for our purposes as well, we
;; just leave it open.
(make-custom-port #:id "r6rs-transcoded-port"
#:read (and (input-port? other) read)
#:write (and (output-port? other) write)
#:close (lambda (p) (close-port other))))
(define (transcoded-port port transcoder)
"Return a new textual port based on @var{port}, using
@var{transcoder} to encode and decode data written to or
read from its underlying binary port @var{port}."
;; Hackily get at %make-transcoded-port.
(let ((result ((@@ (ice-9 binary-ports) %make-transcoded-port) port)))
(let ((result (%make-transcoded-port port)))
(set-port-encoding! result (transcoder-codec transcoder))
(case (transcoder-error-handling-mode transcoder)
((raise)