Implement {input,output}-port-channel.

diff --git a/src/runtime/port.scm b/src/runtime/port.scm
index 049df54eae026253d98372e2f10d6a02aca41ad1..6d0939a2577e657f45c62309bbbae5a04dbaa0ed 100644 (file)
--- a/src/runtime/port.scm
+++ b/src/runtime/port.scm
@@ -67,14 +67,14 @@ USA.
 (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?))))
+  (cond ((binary-input-port? port) (binary-input-port-open? port))
+       ((textual-input-port? port) (textual-input-port-open? port))
+       (else (error:not-a input-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?))))
+  (cond ((binary-output-port? port) (binary-output-port-open? port))
+       ((textual-output-port? port) (textual-output-port-open? port))
+       (else (error:not-a output-port? port 'output-port-open?))))
 
 (define (close-port port)
   (cond ((binary-port? port) (close-binary-port port))
@@ -82,14 +82,24 @@ USA.
        (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))))
+  (cond ((binary-input-port? port) (close-binary-input-port port))
+       ((textual-input-port? port) (close-textual-input-port port))
+       (else (error:not-a input-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))))
+  (cond ((binary-output-port? port) (close-binary-output-port port))
+       ((textual-output-port? port) (close-textual-output-port port))
+       (else (error:not-a output-port? port 'close-output-port))))
+
+(define (input-port-channel port)
+  (cond ((binary-input-port? port) (binary-input-port-channel port))
+       ((textual-input-port? port) (textual-input-port-channel port))
+       (else (error:not-a input-port? port 'input-port-channel))))
+
+(define (output-port-channel port)
+  (cond ((binary-output-port? port) (binary-output-port-channel port))
+       ((textual-output-port? port) (textual-output-port-channel port))
+       (else (error:not-a output-port? port 'output-port-channel))))
 \f
 ;;;; Port type
 
@@ -557,33 +567,25 @@ USA.
                 (textual-output-port-open? port)
                 #t)))))
 
-(define (port/input-open? port)
-  (and (textual-input-port? port)
-       (textual-input-port-open? port)))
-
 (define (textual-input-port-open? port)
   (let ((open? (port/operation port 'INPUT-OPEN?)))
     (if open?
        (open? port)
        #t)))
 
-(define (port/output-open? port)
-  (and (textual-output-port? port)
-       (textual-output-port-open? port)))
-
 (define (textual-output-port-open? port)
   (let ((open? (port/operation port 'OUTPUT-OPEN?)))
     (if open?
        (open? port)
        #t)))
 
-(define (port/input-channel port)
-  (let ((operation (port/operation port 'INPUT-CHANNEL)))
+(define (textual-port-input-channel port)
+  (let ((operation (port/operation port 'input-port-channel)))
     (and operation
         (operation port))))
 
-(define (port/output-channel port)
-  (let ((operation (port/operation port 'OUTPUT-CHANNEL)))
+(define (textual-port-output-channel port)
+  (let ((operation (port/operation port 'output-port-channel)))
     (and operation
         (operation port))))
 \f

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 57b1f6f084834e49c18be2d1ea96dc230cc5d7f6..c06e68b6c1f0bd615f0d4ca5c2f6e5706c9a9b1d 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2471,12 +2471,14 @@ USA.
   (files "port")
   (parent (runtime))
   (export ()
-         (port/input-open? input-port-open?)
-         (port/output-open? output-port-open?)
+         ;; BEGIN legacy bindings
+         (port/input-channel input-port-channel)
+         (port/output-channel output-port-channel)
          (port/state textual-port-state)
          (port/thread-mutex textual-port-thread-mutex)
          (port/type textual-port-type)
          (set-port/state! set-textual-port-state!)
+         ;; END legacy bindings
          close-input-port
          close-output-port
          close-port
@@ -2487,10 +2489,12 @@ USA.
          guarantee-output-port
          guarantee-port
          i/o-port?
+         input-port-channel
          input-port-open?
          input-port?
          interaction-i/o-port
          notification-output-port
+         output-port-channel
          output-port-open?
          output-port?
          port-position