From 458086dab03c5f364674033eb24ab25c68082372 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 10 Jan 2017 21:13:20 -0800 Subject: [PATCH] Refactor port operations to be generic where that makes sense. More work remains to clean this up. --- src/edwin/edwin.pkg | 6 + src/runtime/emacs.scm | 6 +- src/runtime/output.scm | 9 +- src/runtime/port.scm | 298 ++++++++++++++--------------- src/runtime/predicate-metadata.scm | 3 - src/runtime/runtime.pkg | 78 +++----- src/runtime/tscript.scm | 8 +- 7 files changed, 195 insertions(+), 213 deletions(-) diff --git a/src/edwin/edwin.pkg b/src/edwin/edwin.pkg index ff3d46c8f..edf3e0191 100644 --- a/src/edwin/edwin.pkg +++ b/src/edwin/edwin.pkg @@ -119,6 +119,12 @@ USA. define-primitives ucode-primitive ucode-type) + (import (runtime port) + generic-port-operation:write-substring + make-port-type + make-port + port/input-channel + port/output-channel) (export (edwin class-macros) class-instance-transforms) (export () diff --git a/src/runtime/emacs.scm b/src/runtime/emacs.scm index 80338ac5d..b085e504e 100644 --- a/src/runtime/emacs.scm +++ b/src/runtime/emacs.scm @@ -227,7 +227,7 @@ USA. (define emacs-console-port-type) (define (initialize-package!) - (set! vanilla-console-port-type (port/type the-console-port)) + (set! vanilla-console-port-type (textual-port-type the-console-port)) (set! emacs-console-port-type (make-port-type `((PROMPT-FOR-EXPRESSION ,emacs/prompt-for-expression) @@ -247,10 +247,10 @@ USA. (add-event-receiver! event:after-restore (lambda () (let ((type (select-console-port-type))) - (if (let ((type (port/type the-console-port))) + (if (let ((type (textual-port-type the-console-port))) (or (eq? type vanilla-console-port-type) (eq? type emacs-console-port-type))) - (set-port/type! the-console-port type)))))) + (set-textual-port-type! the-console-port type)))))) (define (select-console-port-type) (if ((ucode-primitive under-emacs? 0)) diff --git a/src/runtime/output.scm b/src/runtime/output.scm index f650c43a1..f9fba41d4 100644 --- a/src/runtime/output.scm +++ b/src/runtime/output.scm @@ -142,13 +142,16 @@ USA. (output-port/%write-char port #\newline) (output-port/%discretionary-flush port))) -(define (flush-output #!optional port) - (output-port/flush-output (optional-output-port port 'FLUSH-OUTPUT))) +(define (flush-output-port #!optional port) + (let ((port (optional-output-port port 'flush-output-port))) + (cond ((binary-port? port) (flush-binary-output-port port)) + ((textual-port? port) (output-port/flush-output port)) + (else (error:not-a port? port 'flush-output-port))))) (define (wrap-custom-operation-0 operation-name) (lambda (#!optional port) (let ((port (optional-output-port port operation-name))) - (let ((operation (port/%operation port operation-name))) + (let ((operation (port/operation port operation-name))) (if operation (begin (operation port) diff --git a/src/runtime/port.scm b/src/runtime/port.scm index 657c51fbe..049df54ea 100644 --- a/src/runtime/port.scm +++ b/src/runtime/port.scm @@ -29,9 +29,71 @@ USA. (declare (usual-integrations)) +(define (port? object) + (or (textual-port? object) + (binary-port? object))) + +(define (input-port? object) + (or (textual-input-port? object) + (binary-input-port? object))) + +(define (output-port? object) + (or (textual-output-port? object) + (binary-output-port? object))) + +(define (i/o-port? object) + (or (textual-i/o-port? object) + (binary-i/o-port? object))) + +#; +(add-boot-init! + (lambda () + (register-predicate! port? 'port) + (set-predicate<=! binary-port? port?) + (set-predicate<=! textual-port? port?) + (register-predicate! input-port? 'port) + (set-predicate<=! binary-input-port? input-port?) + (set-predicate<=! textual-input-port? input-port?) + (register-predicate! output-port? 'port) + (set-predicate<=! binary-output-port? output-port?) + (set-predicate<=! textual-output-port? output-port?) + (register-predicate! i/o-port? 'port) + (set-predicate<=! binary-i/o-port? i/o-port?) + (set-predicate<=! textual-i/o-port? i/o-port?))) + +(define-guarantee port "port") +(define-guarantee input-port "input port") +(define-guarantee output-port "output port") +(define-guarantee i/o-port "I/O port") + +(define (input-port-open? port) + (cond ((binary-port? port) (binary-input-port-open? port)) + ((textual-port? port) (textual-input-port-open? port)) + (else (error:not-a port? port 'input-port-open?)))) + +(define (output-port-open? port) + (cond ((binary-port? port) (binary-output-port-open? port)) + ((textual-port? port) (textual-output-port-open? port)) + (else (error:not-a port? port 'output-port-open?)))) + +(define (close-port port) + (cond ((binary-port? port) (close-binary-port port)) + ((textual-port? port) (close-textual-port port)) + (else (error:not-a port? port 'close-port)))) + +(define (close-input-port port) + (cond ((binary-port? port) (close-binary-input-port port)) + ((textual-port? port) (close-textual-input-port port)) + (else (error:not-a port? port 'close-input-port)))) + +(define (close-output-port port) + (cond ((binary-port? port) (close-binary-output-port port)) + ((textual-port? port) (close-textual-output-port port)) + (else (error:not-a port? port 'close-output-port)))) + ;;;; Port type -(define-structure (port-type (type-descriptor ) +(define-structure (port-type (type-descriptor ) (conc-name port-type/) (constructor %make-port-type)) (parent #f read-only #t) @@ -51,16 +113,16 @@ USA. (flush-output #f read-only #t) (discretionary-flush-output #f read-only #t)) -(set-record-type-unparser-method! +(set-record-type-unparser-method! (standard-unparser-method (lambda (type) (if (port-type/supports-input? type) (if (port-type/supports-output? type) - 'I/O-PORT-TYPE - 'INPUT-PORT-TYPE) + 'TEXTUAL-I/O-PORT-TYPE + 'TEXTUAL-INPUT-PORT-TYPE) (if (port-type/supports-output? type) - 'OUTPUT-PORT-TYPE - 'PORT-TYPE))) + 'TEXTUAL-OUTPUT-PORT-TYPE + 'TEXTUAL-PORT-TYPE))) #f)) (define (guarantee-port-type object #!optional caller) @@ -290,28 +352,28 @@ USA. (lambda (port) (let ((char (defer port))) (transcribe-input-char char port) - (set-port/unread?! port #f) + (set-textual-port-unread?! port #f) char)))) (unread-char (let ((defer (op 'UNREAD-CHAR))) (and defer (lambda (port char) (defer port char) - (set-port/unread?! port #t))))) + (set-textual-port-unread?! port #t))))) (peek-char (let ((defer (op 'PEEK-CHAR))) (and defer (lambda (port) (let ((char (defer port))) (transcribe-input-char char port) - (set-port/unread?! port #t) + (set-textual-port-unread?! port #t) char))))) (read-substring (let ((defer (op 'READ-SUBSTRING))) (lambda (port string start end) (let ((n (defer port string start end))) (transcribe-input-substring string start n port) - (set-port/unread?! port #f) + (set-textual-port-unread?! port #f) n))))) (lambda (name) (case name @@ -323,13 +385,13 @@ USA. (define (transcribe-input-char char port) (if (and (char? char) - (not (port/unread? port))) + (not (textual-port-unread? port))) (transcribe-char char port))) (define (transcribe-input-substring string start n port) (if (and n (> n 0)) (transcribe-substring string - (if (port/unread? port) (+ start 1) start) + (if (textual-port-unread? port) (+ start 1) start) (+ start n) port))) @@ -342,7 +404,7 @@ USA. (let ((n (defer port char))) (if (and n (fix:> n 0)) (begin - (set-port/previous! port char) + (set-textual-port-previous! port char) (transcribe-char char port))) n)))) (write-substring @@ -351,7 +413,7 @@ USA. (let ((n (defer port string start end))) (if (and n (> n 0)) (let ((end (+ start n))) - (set-port/previous! port (xstring-ref string (- end 1))) + (set-textual-port-previous! port (xstring-ref string (- end 1))) (transcribe-substring string start end port))) n)))) (flush-output @@ -366,13 +428,13 @@ USA. (discretionary-flush-transcript port)))) (line-start? (lambda (port) - (if (port/previous port) - (char=? (port/previous port) #\newline) + (if (textual-port-previous port) + (char=? (textual-port-previous port) #\newline) 'UNKNOWN)))) (let ((fresh-line (lambda (port) - (if (and (port/previous port) - (not (char=? (port/previous port) #\newline))) + (if (and (textual-port-previous port) + (not (char=? (textual-port-previous port) #\newline))) (write-char port #\newline) 0)))) (lambda (name) @@ -385,46 +447,23 @@ USA. ((DISCRETIONARY-FLUSH-OUTPUT) discretionary-flush-output) (else (op name))))))) -;;;; Port object - -(define-structure (port (type-descriptor ) - (conc-name port/) - (constructor %make-port (%type %state))) - %type - %state - (%thread-mutex (make-thread-mutex)) - (unread? #f) - (previous #f) - (properties '()) - (transcript #f)) +;;;; Textual ports + +(define-record-type + (%make-textual-port type state thread-mutex unread? previous properties + transcript) + textual-port? + (type textual-port-type set-textual-port-type!) + (state textual-port-state set-textual-port-state!) + (thread-mutex textual-port-thread-mutex set-textual-port-thread-mutex!) + (unread? textual-port-unread? set-textual-port-unread?!) + (previous textual-port-previous set-textual-port-previous!) + (properties textual-port-properties set-textual-port-properties!) + (transcript textual-port-transcript set-textual-port-transcript!)) (define (make-port type state) (guarantee-port-type type 'MAKE-PORT) - (%make-port type state)) - -(define (port/type port) - (guarantee-port port 'PORT/TYPE) - (port/%type port)) - -(define (set-port/type! port type) - (guarantee-port port 'SET-PORT/TYPE!) - (guarantee-port-type type 'SET-PORT/TYPE!) - (set-port/%type! port type)) - -(define (port/state port) - (guarantee-port port 'PORT/STATE) - (port/%state port)) - -(define (set-port/state! port state) - (guarantee-port port 'SET-PORT/STATE!) - (set-port/%state! port state)) - -(define (port/thread-mutex port) - (guarantee-port port 'PORT/THREAD-MUTEX) - (port/%thread-mutex port)) - -(define (set-port/thread-mutex! port mutex) - (set-port/%thread-mutex! port mutex)) + (%make-textual-port type state (make-thread-mutex) #f #f '() #f)) (define (port=? p1 p2) (guarantee-port p1 'PORT=?) @@ -434,12 +473,9 @@ USA. (define (port/operation-names port) (port-type/operation-names (port/type port))) -(define-integrable (port/%operation port name) - (port-type/%operation (port/%type port) name)) - (define (port/operation port name) (guarantee-port port 'port/operation) - (port/%operation port name)) + (port-type/%operation (port/type port) name)) (define-syntax define-port-operation (sc-macro-transformer @@ -461,20 +497,6 @@ USA. (define-port-operation flush-output) (define-port-operation discretionary-flush-output) -;;; These operations assume that the port is in fact a port. -(define-syntax define-unsafe-port-operation - (sc-macro-transformer - (lambda (form environment) - (let ((name (cadr form))) - `(DEFINE-INTEGRABLE (,(symbol-append 'PORT/%OPERATION/ name) PORT) - (,(close-syntax (symbol-append 'PORT-TYPE/ name) environment) - (PORT/%TYPE PORT))))))) - -(define-unsafe-port-operation discretionary-flush-output) -(define-unsafe-port-operation read-char) -(define-unsafe-port-operation peek-char) -(define-unsafe-port-operation write-char) - (define (port-position port) ((or (port/operation port 'POSITION) (error:bad-range-argument port 'PORT-POSITION)) @@ -485,13 +507,13 @@ USA. (error:bad-range-argument port 'SET-PORT-POSITION!)) port position)) -(set-record-type-unparser-method! +(set-record-type-unparser-method! (lambda (state port) ((let ((name - (cond ((i/o-port? port) 'I/O-PORT) - ((input-port? port) 'INPUT-PORT) - ((output-port? port) 'OUTPUT-PORT) - (else 'PORT)))) + (cond ((textual-i/o-port? port) 'TEXTUAL-I/O-PORT) + ((textual-input-port? port) 'TEXTUAL-INPUT-PORT) + ((textual-output-port? port) 'TEXTUAL-OUTPUT-PORT) + (else 'TEXTUAL-PORT)))) (cond ((port/operation port 'WRITE-SELF) => (lambda (operation) (standard-unparser-method name operation))) @@ -502,11 +524,11 @@ USA. (define (port/copy port state) (let ((port (copy-record port))) - (set-port/state! port state) - (set-port/thread-mutex! port (make-thread-mutex)) + (set-textual-port-state! port state) + (set-textual-port-thread-mutex! port (make-thread-mutex)) port)) -(define (close-port port) +(define (close-textual-port port) (let ((close (port/operation port 'CLOSE))) (if close (close port) @@ -514,12 +536,12 @@ USA. (close-output-port port) (close-input-port port))))) -(define (close-input-port port) +(define (close-textual-input-port port) (let ((close-input (port/operation port 'CLOSE-INPUT))) (if close-input (close-input port)))) -(define (close-output-port port) +(define (close-textual-output-port port) (let ((close-output (port/operation port 'CLOSE-OUTPUT))) (if close-output (close-output port)))) @@ -528,25 +550,29 @@ USA. (let ((open? (port/operation port 'OPEN?))) (if open? (open? port) - (and (if (input-port? port) (%input-open? port) #t) - (if (output-port? port) (%output-open? port) #t))))) + (and (if (textual-input-port? port) + (textual-input-port-open? port) + #t) + (if (textual-output-port? port) + (textual-output-port-open? port) + #t))))) (define (port/input-open? port) - (and (input-port? port) - (%input-open? port))) + (and (textual-input-port? port) + (textual-input-port-open? port))) -(define (%input-open? port) - (let ((open? (port/%operation port 'INPUT-OPEN?))) +(define (textual-input-port-open? port) + (let ((open? (port/operation port 'INPUT-OPEN?))) (if open? (open? port) #t))) (define (port/output-open? port) - (and (output-port? port) - (%output-open? port))) + (and (textual-output-port? port) + (textual-output-port-open? port))) -(define (%output-open? port) - (let ((open? (port/%operation port 'OUTPUT-OPEN?))) +(define (textual-output-port-open? port) + (let ((open? (port/operation port 'OUTPUT-OPEN?))) (if open? (open? port) #t))) @@ -563,101 +589,69 @@ USA. (define (port/get-property port name default) (guarantee-symbol name 'PORT/GET-PROPERTY) - (let ((p (assq name (port/properties port)))) + (let ((p (assq name (textual-port-properties port)))) (if p (cdr p) default))) (define (port/set-property! port name value) (guarantee-symbol name 'PORT/SET-PROPERTY!) - (let ((alist (port/properties port))) + (let ((alist (textual-port-properties port))) (let ((p (assq name alist))) (if p (set-cdr! p value) - (set-port/properties! port (cons (cons name value) alist)))))) + (set-textual-port-properties! port (cons (cons name value) alist)))))) (define (port/intern-property! port name get-value) (guarantee-symbol name 'PORT/INTERN-PROPERTY!) - (let ((alist (port/properties port))) + (let ((alist (textual-port-properties port))) (let ((p (assq name alist))) (if p (cdr p) (let ((value (get-value))) - (set-port/properties! port (cons (cons name value) alist)) + (set-textual-port-properties! port (cons (cons name value) alist)) value))))) (define (port/remove-property! port name) (guarantee-symbol name 'PORT/REMOVE-PROPERTY!) - (set-port/properties! port (del-assq! name (port/properties port)))) + (set-textual-port-properties! port (del-assq! name (textual-port-properties port)))) (define (transcribe-char char port) - (let ((tport (port/transcript port))) + (let ((tport (textual-port-transcript port))) (if tport (%write-char char tport)))) (define (transcribe-substring string start end port) - (let ((tport (port/transcript port))) + (let ((tport (textual-port-transcript port))) (if tport (write-substring string start end tport)))) (define (flush-transcript port) - (let ((tport (port/transcript port))) + (let ((tport (textual-port-transcript port))) (if tport (flush-output tport)))) (define (discretionary-flush-transcript port) - (let ((tport (port/transcript port))) + (let ((tport (textual-port-transcript port))) (if tport (output-port/discretionary-flush tport)))) -(define (input-port? object) - (and (port? object) - (port-type/supports-input? (port/%type object)) +(define (textual-input-port? object) + (and (textual-port? object) + (port-type/supports-input? (port/type object)) #t)) -(define (output-port? object) - (and (port? object) - (port-type/supports-output? (port/%type object)) +(define (textual-output-port? object) + (and (textual-port? object) + (port-type/supports-output? (port/type object)) #t)) -(define (i/o-port? object) - (and (port? object) - (let ((type (port/%type object))) +(define (textual-i/o-port? object) + (and (textual-port? object) + (let ((type (port/type object))) (and (port-type/supports-input? type) (port-type/supports-output? type) #t)))) - -(define (guarantee-port port #!optional caller) - (if (not (port? port)) - (error:not-port port caller)) - port) - -(define (error:not-port port #!optional caller) - (error:wrong-type-argument port "port" caller)) - -(define (guarantee-input-port port #!optional caller) - (if (not (input-port? port)) - (error:not-input-port port caller)) - port) - -(define (error:not-input-port port #!optional caller) - (error:wrong-type-argument port "input port" caller)) - -(define (guarantee-output-port port #!optional caller) - (if (not (output-port? port)) - (error:not-output-port port caller)) - port) - -(define (error:not-output-port port #!optional caller) - (error:wrong-type-argument port "output port" caller)) - -(define (guarantee-i/o-port port #!optional caller) - (if (not (i/o-port? port)) - (error:not-i/o-port port caller)) - port) - -(define (error:not-i/o-port port #!optional caller) - (error:wrong-type-argument port "I/O port" caller)) (define (port/supports-coding? port) (let ((operation (port/operation port 'SUPPORTS-CODING?))) @@ -788,14 +782,14 @@ USA. (define notification-output-port) (define trace-output-port) (define interaction-i/o-port) - -(define (initialize-package!) - (set! current-input-port (make-port-parameter guarantee-input-port)) - (set! current-output-port (make-port-parameter guarantee-output-port)) - (set! notification-output-port (make-port-parameter guarantee-output-port)) - (set! trace-output-port (make-port-parameter guarantee-output-port)) - (set! interaction-i/o-port (make-port-parameter guarantee-i/o-port)) - unspecific) +(add-boot-init! + (lambda () + (set! current-input-port (make-port-parameter guarantee-input-port)) + (set! current-output-port (make-port-parameter guarantee-output-port)) + (set! notification-output-port (make-port-parameter guarantee-output-port)) + (set! trace-output-port (make-port-parameter guarantee-output-port)) + (set! interaction-i/o-port (make-port-parameter guarantee-i/o-port)) + unspecific)) (define (make-port-parameter guarantee) (make-general-parameter #f diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm index d26dcf342..03103aa06 100644 --- a/src/runtime/predicate-metadata.scm +++ b/src/runtime/predicate-metadata.scm @@ -219,10 +219,8 @@ USA. (register-predicate! char? 'char) (register-predicate! default-object? 'default-object) (register-predicate! eof-object? 'eof-object) - (register-predicate! input-port? 'input-port '<= port?) (register-predicate! list? 'list) (register-predicate! number? 'number) - (register-predicate! output-port? 'output-port '<= port?) (register-predicate! pair? 'pair) (register-predicate! procedure? 'procedure) (register-predicate! string? 'string) @@ -304,7 +302,6 @@ USA. (register-predicate! environment? 'environment) (register-predicate! equality-predicate? 'equality-predicate '<= binary-procedure?) - (register-predicate! i/o-port? 'i/o-port '<= (list input-port? output-port?)) (register-predicate! interned-symbol? 'interned-symbol '<= symbol?) (register-predicate! keyword? 'keyword '<= symbol?) (register-predicate! lambda-tag? 'lambda-tag) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 5c01f3dc3..83ee3fc74 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -2461,63 +2461,41 @@ USA. binary-output-port? close-binary-input-port close-binary-output-port - close-binary-port)) + close-binary-port) + (export (runtime output-port) + flush-binary-output-port)) (define-package (runtime port) (files "port") (parent (runtime)) (export () + (port/input-open? input-port-open?) + (port/output-open? output-port-open?) + (port/state textual-port-state) + (port/thread-mutex textual-port-thread-mutex) + (port/type textual-port-type) + (set-port/state! set-textual-port-state!) close-input-port close-output-port close-port current-input-port current-output-port - error:not-input-port - error:not-output-port - generic-port-operation:read-substring - generic-port-operation:write-substring guarantee-i/o-port guarantee-input-port guarantee-output-port guarantee-port - guarantee-port-type - i/o-port-type? i/o-port? - input-port-type? + input-port-open? input-port? interaction-i/o-port - make-port - make-port-type notification-output-port - output-port-type? + output-port-open? output-port? port-position - port-type/%operation - port-type/char-ready? - port-type/discretionary-flush-output - port-type/flush-output - port-type/fresh-line - port-type/line-start? - port-type/operation - port-type/operation-names - port-type/operations - port-type/parent - port-type/peek-char - port-type/read-char - port-type/read-substring - port-type/unread-char - port-type/write-char - port-type/write-substring - port-type? - port/%operation - port/%state - port/%type port/coding port/copy port/get-property port/input-blocking-mode - port/input-channel - port/input-open? port/input-terminal-mode port/intern-property! port/known-coding? @@ -2529,8 +2507,6 @@ USA. port/operation port/operation-names port/output-blocking-mode - port/output-channel - port/output-open? port/output-terminal-mode port/remove-property! port/set-coding @@ -2540,10 +2516,7 @@ USA. port/set-output-blocking-mode port/set-output-terminal-mode port/set-property! - port/state port/supports-coding? - port/thread-mutex - port/type port/with-input-blocking-mode port/with-input-terminal-mode port/with-output-blocking-mode @@ -2555,25 +2528,31 @@ USA. set-interaction-i/o-port! set-notification-output-port! set-port-position! - set-port/state! set-trace-output-port! + textual-port? trace-output-port with-input-from-port with-interaction-i/o-port with-notification-output-port with-output-to-port with-trace-output-port) + (export (runtime) + generic-port-operation:write-substring + make-port + make-port-type + port/input-channel + port/output-channel + set-textual-port-state! + textual-port-state) (export (runtime input-port) - port/%operation/read-char - port/%operation/peek-char + port/operation port/operation/char-ready? port/operation/peek-char port/operation/read-char port/operation/read-substring port/operation/unread-char) (export (runtime output-port) - port/%operation/discretionary-flush-output - port/%operation/write-char + port/operation port/operation/discretionary-flush-output port/operation/flush-output port/operation/fresh-line @@ -2581,11 +2560,13 @@ USA. port/operation/write-char port/operation/write-substring) (export (runtime transcript) - port/transcript - set-port/transcript!) + set-textual-port-transcript! + textual-port-transcript) (export (runtime emacs-interface) - set-port/thread-mutex! - set-port/type!) + port-type/operation + set-textual-port-thread-mutex! + set-textual-port-type! + textual-port-type) (initialization (initialize-package!))) (define-package (runtime input-port) @@ -2630,12 +2611,13 @@ USA. (files "output") (parent (runtime)) (export () + (flush-output flush-output-port) %write-char beep call-with-truncated-output-port clear display - flush-output + flush-output-port fresh-line newline output-port/%write-char diff --git a/src/runtime/tscript.scm b/src/runtime/tscript.scm index 739aec9f8..86a4f4948 100644 --- a/src/runtime/tscript.scm +++ b/src/runtime/tscript.scm @@ -31,14 +31,14 @@ USA. (define (transcript-on filename #!optional port) (let ((port (if (default-object? port) (nearest-cmdl/port) port))) - (if (port/transcript port) + (if (textual-port-transcript port) (error "Transcript already turned on.")) - (set-port/transcript! port (open-output-file filename)))) + (set-textual-port-transcript! port (open-output-file filename)))) (define (transcript-off #!optional port) (let ((port (if (default-object? port) (nearest-cmdl/port) port))) - (let ((transcript-port (port/transcript port))) + (let ((transcript-port (textual-port-transcript port))) (if transcript-port (begin - (set-port/transcript! port #f) + (set-textual-port-transcript! port #f) (close-port transcript-port)))))) \ No newline at end of file -- 2.25.1