mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 15:40:38 +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

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)