From d0d5fab361c86ad151c12b2b2d30a9966849d12f Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 10 Jan 2017 22:47:17 -0800
Subject: [PATCH] Change textual-port-type to be defined with
define-record-type.
---
src/runtime/port.scm | 58 ++++++++++++++++++++++++++------------------
1 file changed, 34 insertions(+), 24 deletions(-)
diff --git a/src/runtime/port.scm b/src/runtime/port.scm
index 0986af69c..6a8ed7b37 100644
--- a/src/runtime/port.scm
+++ b/src/runtime/port.scm
@@ -31,25 +31,40 @@ USA.
;;;; Port type
-(define-structure (port-type (type-descriptor <textual-port-type>)
- (conc-name port-type/)
- (constructor %make-port-type))
- (parent #f read-only #t)
- standard-operations
- custom-operations
+(define-record-type <textual-port-type>
+ (%make-port-type parent
+ standard-operations
+ custom-operations
+ char-ready?
+ read-char
+ unread-char
+ peek-char
+ read-substring
+ write-char
+ write-substring
+ fresh-line
+ line-start?
+ flush-output
+ discretionary-flush-output)
+ port-type?
+ (parent port-type/parent)
+ (standard-operations port-type/standard-operations
+ set-port-type/standard-operations!)
+ (custom-operations port-type/custom-operations
+ set-port-type/custom-operations!)
;; input operations:
- (char-ready? #f read-only #t)
- (read-char #f read-only #t)
- (unread-char #f read-only #t)
- (peek-char #f read-only #t)
- (read-substring #f read-only #t)
+ (char-ready? port-type/char-ready?)
+ (read-char port-type/read-char)
+ (unread-char port-type/unread-char)
+ (peek-char port-type/peek-char)
+ (read-substring port-type/read-substring)
;; output operations:
- (write-char #f read-only #t)
- (write-substring #f read-only #t)
- (fresh-line #f read-only #t)
- (line-start? #f read-only #t)
- (flush-output #f read-only #t)
- (discretionary-flush-output #f read-only #t))
+ (write-char port-type/write-char)
+ (write-substring port-type/write-substring)
+ (fresh-line port-type/fresh-line)
+ (line-start? port-type/line-start?)
+ (flush-output port-type/flush-output)
+ (discretionary-flush-output port-type/discretionary-flush-output))
(set-record-type-unparser-method! <textual-port-type>
(standard-unparser-method
@@ -107,17 +122,12 @@ USA.
(list (car entry) (cdr entry)))
(port-type/custom-operations type))))
-;; Assumes type is a PORT-TYPE
-(define (port-type/%operation type name)
+(define (port-type/operation type name)
(let ((entry
(or (assq name (port-type/custom-operations type))
(assq name (port-type/standard-operations type)))))
(and entry
(cdr entry))))
-
-(define (port-type/operation type name)
- (guarantee-port-type type 'PORT-TYPE/OPERATION)
- (port-type/%operation type name))
;;;; Constructors
@@ -440,7 +450,7 @@ USA.
(define (textual-port-operation port name)
(guarantee textual-port? port 'textual-port-operation)
- (port-type/%operation (port/type port) name))
+ (port-type/operation (port/type port) name))
(define-syntax define-port-operation
(sc-macro-transformer
--
2.25.1