Merge different port-type constructors into MAKE-PORT-TYPE.
authorChris Hanson <org/chris-hanson/cph>
Wed, 24 Feb 1999 21:37:22 +0000 (21:37 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 24 Feb 1999 21:37:22 +0000 (21:37 +0000)
16 files changed:
v7/src/edwin/artdebug.scm
v7/src/edwin/bufinp.scm
v7/src/edwin/bufout.scm
v7/src/edwin/debug.scm
v7/src/edwin/intmod.scm
v7/src/edwin/winout.scm
v7/src/runtime/emacs.scm
v7/src/runtime/fileio.scm
v7/src/runtime/genio.scm
v7/src/runtime/port.scm
v7/src/runtime/runtime.pkg
v7/src/runtime/strnin.scm
v7/src/runtime/strott.scm
v7/src/runtime/strout.scm
v7/src/runtime/ttyio.scm
v8/src/runtime/runtime.pkg

index 055cf4a55ccbb67a7e19f47641294f9a2bcc64d7..6588b889120a9b1c9a0966b963addf8cda3a32e9 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: artdebug.scm,v 1.27 1999/02/16 20:12:15 cph Exp $
+;;; $Id: artdebug.scm,v 1.28 1999/02/24 21:35:54 cph Exp $
 ;;;
 ;;; Copyright (c) 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -1346,7 +1346,7 @@ Prefix argument means do not kill the debugger buffer."
   (prompt-for-confirmation? prompt))
 
 (define interface-port-type
-  (make-output-port-type
+  (make-port-type
    `((WRITE-CHAR ,operation/write-char)
      (WRITE-SUBSTRING ,operation/write-substring)
      (FRESH-LINE ,operation/fresh-line)
index ba9ff49ffb4842abe124535020a92934fbeee6a0..3bceda854bc7a5a31b67463cec615e5c2ec79d70 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: bufinp.scm,v 1.7 1999/02/18 04:14:41 cph Exp $
+;;;$Id: bufinp.scm,v 1.8 1999/02/24 21:35:46 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
                (buffer-input-port-state/current-index state)))))
 
 (define buffer-input-port-type
-  (make-input-port-type `((CHAR-READY? ,operation/char-ready?)
-                         (DISCARD-CHAR ,operation/discard-char)
-                         (DISCARD-CHARS ,operation/discard-chars)
-                         (PEEK-CHAR ,operation/peek-char)
-                         (PRINT-SELF ,operation/print-self)
-                         (READ-CHAR ,operation/read-char)
-                         (READ-STRING ,operation/read-string))
-                       #f))
\ No newline at end of file
+  (make-port-type `((CHAR-READY? ,operation/char-ready?)
+                   (DISCARD-CHAR ,operation/discard-char)
+                   (DISCARD-CHARS ,operation/discard-chars)
+                   (PEEK-CHAR ,operation/peek-char)
+                   (PRINT-SELF ,operation/print-self)
+                   (READ-CHAR ,operation/read-char)
+                   (READ-STRING ,operation/read-string))
+                 #f))
\ No newline at end of file
index f4736e14f5227c208e8f4feb00cdcf3ac27ec0e5..3fe2deddef0a4fe501b3e13aaa6ff123f931a16f 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: bufout.scm,v 1.12 1999/02/16 20:12:28 cph Exp $
+;;; $Id: bufout.scm,v 1.13 1999/02/24 21:35:39 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
   (mark-x-size (port/mark port)))
 
 (define mark-output-port-type
-  (make-output-port-type `((CLOSE ,operation/close)
-                          (FLUSH-OUTPUT ,operation/flush-output)
-                          (FRESH-LINE ,operation/fresh-line)
-                          (PRINT-SELF ,operation/print-self)
-                          (WRITE-CHAR ,operation/write-char)
-                          (WRITE-SUBSTRING ,operation/write-substring)
-                          (X-SIZE ,operation/x-size))
-                        #f))
\ No newline at end of file
+  (make-port-type `((CLOSE ,operation/close)
+                   (FLUSH-OUTPUT ,operation/flush-output)
+                   (FRESH-LINE ,operation/fresh-line)
+                   (PRINT-SELF ,operation/print-self)
+                   (WRITE-CHAR ,operation/write-char)
+                   (WRITE-SUBSTRING ,operation/write-substring)
+                   (X-SIZE ,operation/x-size))
+                 #f))
\ No newline at end of file
index 0e6511e4c788fdbda6b37a34dc48836a50c426e9..c7f8a144f2690e31b94e58cd8ea0516338ca115e 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: debug.scm,v 1.47 1999/02/16 20:12:04 cph Exp $
+;;; $Id: debug.scm,v 1.48 1999/02/24 21:36:02 cph Exp $
 ;;;
 ;;; Copyright (c) 1992-1999 Massachusetts Institute of Technology
 ;;;
@@ -1895,7 +1895,7 @@ once it has been renamed, it will not be deleted automatically.")
   (prompt-for-expression prompt))
 
 (define interface-port-type
-  (make-output-port-type
+  (make-port-type
    `((WRITE-CHAR ,operation/write-char)
      (PROMPT-FOR-CONFIRMATION ,operation/prompt-for-confirmation)
      (PROMPT-FOR-EXPRESSION ,operation/prompt-for-expression))
index 35b61099b957864afa7f4305c0b12b5b11502351..83c8f9b5bb261d05b317d9469b32c7804660673d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: intmod.scm,v 1.97 1999/02/18 04:05:22 cph Exp $
+;;; $Id: intmod.scm,v 1.98 1999/02/24 21:35:50 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -1052,7 +1052,7 @@ If this is an error, the debugger examines the error condition."
       #t)))
 
 (define interface-port-type
-  (make-i/o-port-type
+  (make-port-type
    `((WRITE-CHAR ,operation/write-char)
      (WRITE-SUBSTRING ,operation/write-substring)
      (FRESH-LINE ,operation/fresh-line)
index ae561be000074e286e0b896743fbab5b17ec0fad..d2a77b121c987fc5c8adf6a8d68cb03389ab7d5d 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;$Id: winout.scm,v 1.12 1999/02/16 20:12:09 cph Exp $
+;;;$Id: winout.scm,v 1.13 1999/02/24 21:35:58 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-1999 Massachusetts Institute of Technology
 ;;;
   (unparse-object state (port/state port)))
 
 (define window-output-port-type
-  (make-output-port-type `((FLUSH-OUTPUT ,operation/flush-output)
-                          (FRESH-LINE ,operation/fresh-line)
-                          (PRINT-SELF ,operation/print-self)
-                          (WRITE-CHAR ,operation/write-char)
-                          (WRITE-SUBSTRING ,operation/write-substring)
-                          (X-SIZE ,operation/x-size))
-                        #f))
\ No newline at end of file
+  (make-port-type `((FLUSH-OUTPUT ,operation/flush-output)
+                   (FRESH-LINE ,operation/fresh-line)
+                   (PRINT-SELF ,operation/print-self)
+                   (WRITE-CHAR ,operation/write-char)
+                   (WRITE-SUBSTRING ,operation/write-substring)
+                   (X-SIZE ,operation/x-size))
+                 #f))
\ No newline at end of file
index f3fe7018802e7a7edc28753791f087d1db218887..556d865411ec696c514377deb7ce91f74cde29b5 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: emacs.scm,v 14.25 1999/02/16 20:30:54 cph Exp $
+$Id: emacs.scm,v 14.26 1999/02/24 21:36:13 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -209,7 +209,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
 (define (initialize-package!)
   (set! emacs-console-port
-       (make-port (make-i/o-port-type
+       (make-port (make-port-type
                    `((PROMPT-FOR-EXPRESSION ,emacs/prompt-for-expression)
                      (PROMPT-FOR-COMMAND-CHAR ,emacs/prompt-for-command-char)
                      (PROMPT-FOR-COMMAND-EXPRESSION
index 61738febd8384b75d15af9bbb257545747f7829e..4286cde9b5c27bf0dd14ebb89add9ab7e0f4e05d 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fileio.scm,v 1.16 1999/02/16 20:11:34 cph Exp $
+$Id: fileio.scm,v 1.17 1999/02/24 21:36:17 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -33,16 +33,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
           (PATHNAME ,operation/pathname)
           (TRUENAME ,operation/truename))))
     (set! input-file-type
-         (make-input-port-type (append input-operations
-                                       other-operations)
-                               generic-input-type))
+         (make-port-type (append input-operations other-operations)
+                         generic-input-type))
     (set! output-file-type
-         (make-output-port-type other-operations
-                                generic-output-type))
+         (make-port-type other-operations
+                         generic-output-type))
     (set! i/o-file-type
-         (make-i/o-port-type (append input-operations
-                                     other-operations)
-                             generic-i/o-type)))
+         (make-port-type (append input-operations other-operations)
+                         generic-i/o-type)))
   unspecific)
 
 (define input-file-type)
index 276d12c3052880535679688f70f4e1046d95ae6b..9991dee3a9a06f446f8d4fc878959b3f3067e373 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.14 1999/02/16 20:11:38 cph Exp $
+$Id: genio.scm,v 1.15 1999/02/24 21:36:33 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -64,18 +64,18 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         `((CLOSE ,operation/close)
           (WRITE-SELF ,operation/write-self))))
     (set! generic-input-type
-         (make-input-port-type (append input-operations
-                                       other-operations)
-                               #f))
+         (make-port-type (append input-operations
+                                 other-operations)
+                         #f))
     (set! generic-output-type
-         (make-output-port-type (append output-operations
-                                        other-operations)
-                                #f))
+         (make-port-type (append output-operations
+                                 other-operations)
+                         #f))
     (set! generic-i/o-type
-         (make-i/o-port-type (append input-operations
-                                     output-operations
-                                     other-operations)
-                             #f)))
+         (make-port-type (append input-operations
+                                 output-operations
+                                 other-operations)
+                         #f)))
   unspecific)
 
 (define generic-input-type)
index 4565eb61d6ba2093a53d7c6378b1a2b6638e6acc..ff8cb9fbef86688f5aeb155c5092074189999469 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.16 1999/02/18 03:54:03 cph Exp $
+$Id: port.scm,v 1.17 1999/02/24 21:36:37 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -345,11 +345,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define (make-encapsulated-port port state rewrite-operation)
   (guarantee-port port)
   (%make-port (let ((type (port/type port)))
-               ((if (port-type/supports-input? type)
-                    (if (port-type/supports-output? type)
-                        make-i/o-port-type
-                        make-input-port-type)
-                    make-output-port-type)
+               (make-port-type
                 (append-map
                  (lambda (entry)
                    (let ((operation
@@ -364,61 +360,48 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 \f
 ;;;; Constructors
 
-(define (make-input-port type state)
-  (make-port (if (port-type? type) type (make-input-port-type type #f)) state))
-
-(define (make-output-port type state)
-  (make-port (if (port-type? type) type (make-output-port-type type #f))
-            state))
-
-(define (make-i/o-port type state)
-  (make-port (if (port-type? type) type (make-i/o-port-type type #f)) state))
-
 (define (make-port type state)
   (guarantee-port-type type 'MAKE-PORT)
   (%make-port type state (make-thread-mutex)))
 
-(define (make-input-port-type operations type)
-  (operations->port-type operations type 'MAKE-INPUT-PORT-TYPE #t #f))
-
-(define (make-output-port-type operations type)
-  (operations->port-type operations type 'MAKE-OUTPUT-PORT-TYPE #f #t))
-
-(define (make-i/o-port-type operations type)
-  (operations->port-type operations type 'MAKE-I/O-PORT-TYPE #t #t))
-
-(define (operations->port-type operations type procedure-name input? output?)
+(define (make-port-type operations type)
   (let ((type
         (parse-operations-list
          (append operations
                  (if type
                      (list-transform-negative (port-type/operations type)
                        (let ((ignored
-                              (append (if (assq 'READ-CHAR operations)
-                                          '(DISCARD-CHAR
-                                            DISCARD-CHARS
-                                            PEEK-CHAR
-                                            READ-CHAR
-                                            READ-STRING
-                                            READ-SUBSTRING)
-                                          '())
-                                      (if (assq 'WRITE-CHAR operations)
-                                          '(WRITE-CHAR
-                                            WRITE-SUBSTRING)
-                                          '()))))
+                              (append
+                               (if (assq 'READ-CHAR operations)
+                                   '(DISCARD-CHAR
+                                     DISCARD-CHARS
+                                     PEEK-CHAR
+                                     READ-CHAR
+                                     READ-STRING
+                                     READ-SUBSTRING)
+                                   '())
+                               (if (or (assq 'WRITE-CHAR operations)
+                                       (assq 'WRITE-SUBSTRING operations))
+                                   '(WRITE-CHAR
+                                     WRITE-SUBSTRING)
+                                   '()))))
                          (lambda (entry)
                            (or (assq (car entry) operations)
                                (memq (car entry) ignored)))))
                      '()))
-         procedure-name)))
-    (install-operations! type input?
-                        input-operation-names
-                        input-operation-modifiers
-                        input-operation-defaults)
-    (install-operations! type output?
-                        output-operation-names
-                        output-operation-modifiers
-                        output-operation-defaults)
+         'MAKE-PORT-TYPE)))
+    (let ((operations (port-type/operations type)))
+      (install-operations! type
+                          (assq 'READ-CHAR operations)
+                          input-operation-names
+                          input-operation-modifiers
+                          input-operation-defaults)
+      (install-operations! type
+                          (or (assq 'WRITE-CHAR operations)
+                              (assq 'WRITE-SUBSTRING operations))
+                          output-operation-names
+                          output-operation-modifiers
+                          output-operation-defaults))
     type))
 
 (define (parse-operations-list operations procedure)
@@ -717,4 +700,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (define output-port/operation-names port/operation-names)
 (define output-port/state port/state)
 (define set-input-port/state! set-port/state!)
-(define set-output-port/state! set-port/state!)
\ No newline at end of file
+(define set-output-port/state! set-port/state!)
+
+(define (make-input-port type state)
+  (make-port (if (port-type? type) type (make-port-type type #f)) state))
+
+(define make-output-port make-input-port)
+(define make-i/o-port make-input-port)
\ No newline at end of file
index 13a6a53b84e6e760fb0609e30a77c87e84618e11..2e72c06c35afd6c0e1dcbb7b6ffaf0f63d0efe37 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.319 1999/02/24 21:23:58 cph Exp $
+$Id: runtime.pkg,v 14.320 1999/02/24 21:37:18 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -1070,12 +1070,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          interaction-i/o-port
          make-encapsulated-port
          make-i/o-port
-         make-i/o-port-type
          make-input-port
-         make-input-port-type
          make-output-port
-         make-output-port-type
          make-port
+         make-port-type
          notification-output-port
          output-port-type?
          output-port/channel
index 536bf328a8f389dbb106d8ab14e6ac1bc5475baf..5c84cef1cc3a614eab9f04811fe8f0fa4a3dbca3 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strnin.scm,v 14.7 1999/02/18 04:14:22 cph Exp $
+$Id: strnin.scm,v 14.8 1999/02/24 21:36:21 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -26,14 +26,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 \f
 (define (initialize-package!)
   (set! input-string-port-type
-       (make-input-port-type `((CHAR-READY? ,operation/char-ready?)
-                               (DISCARD-CHAR ,operation/discard-char)
-                               (DISCARD-CHARS ,operation/discard-chars)
-                               (PEEK-CHAR ,operation/peek-char)
-                               (WRITE-SELF ,operation/write-self)
-                               (READ-CHAR ,operation/read-char)
-                               (READ-STRING ,operation/read-string))
-                             #f))
+       (make-port-type `((CHAR-READY? ,operation/char-ready?)
+                         (DISCARD-CHAR ,operation/discard-char)
+                         (DISCARD-CHARS ,operation/discard-chars)
+                         (PEEK-CHAR ,operation/peek-char)
+                         (WRITE-SELF ,operation/write-self)
+                         (READ-CHAR ,operation/read-char)
+                         (READ-STRING ,operation/read-string))
+                       #f))
   unspecific)
 
 (define (with-input-from-string string thunk)
index c84c6a1a347cef4fbbb7015399144fd80b425f40..642b04e089230dc6a115d120a95a40f195743c36 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strott.scm,v 14.8 1999/02/18 04:14:19 cph Exp $
+$Id: strott.scm,v 14.9 1999/02/24 21:36:25 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -26,10 +26,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 \f
 (define (initialize-package!)
   (set! output-string-port-type
-       (make-output-port-type `((WRITE-SELF ,operation/write-self)
-                                (WRITE-CHAR ,operation/write-char)
-                                (WRITE-SUBSTRING ,operation/write-substring))
-                              #f)))
+       (make-port-type `((WRITE-SELF ,operation/write-self)
+                         (WRITE-CHAR ,operation/write-char)
+                         (WRITE-SUBSTRING ,operation/write-substring))
+                       #f)))
 
 (define (with-output-to-truncated-string max thunk)
   (call-with-current-continuation
index 3bebb239a3f691f77646e84e93e8edd7ef88fabb..0ead6a0ac3549858e4810996384c49d8a406d4be 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: strout.scm,v 14.11 1999/02/18 04:14:15 cph Exp $
+$Id: strout.scm,v 14.12 1999/02/24 21:36:29 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -26,10 +26,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 \f
 (define (initialize-package!)
   (set! output-string-port-type
-       (make-output-port-type `((WRITE-SELF ,operation/write-self)
-                                (WRITE-CHAR ,operation/write-char)
-                                (WRITE-SUBSTRING ,operation/write-substring))
-                              #f))
+       (make-port-type `((WRITE-SELF ,operation/write-self)
+                         (WRITE-CHAR ,operation/write-char)
+                         (WRITE-SUBSTRING ,operation/write-substring))
+                       #f))
   unspecific)
 
 (define (with-output-to-string thunk)
index 750844c80f1f4fd425e1f0839f6d3c146fd8a76c..dbeec07d8e644db42a18a4d23a704a4adbfdeef4 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ttyio.scm,v 1.11 1999/02/18 03:54:37 cph Exp $
+$Id: ttyio.scm,v 1.12 1999/02/24 21:36:08 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -33,7 +33,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (set! hook/read-char operation/read-char)
     (set! hook/peek-char operation/peek-char)
     (set! the-console-port-type
-         (make-i/o-port-type
+         (make-port-type
           `((BEEP ,operation/beep)
             (CLEAR ,operation/clear)
             (DISCRETIONARY-FLUSH-OUTPUT ,operation/flush-output)
index 57751f19da4dc6cbf4ec8afb815df794bc0f3dbc..cc5c06bbf369f5260d6b75c5439c9b9f2af0a792 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.324 1999/02/24 21:23:53 cph Exp $
+$Id: runtime.pkg,v 14.325 1999/02/24 21:37:22 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -1074,12 +1074,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          interaction-i/o-port
          make-encapsulated-port
          make-i/o-port
-         make-i/o-port-type
          make-input-port
-         make-input-port-type
          make-output-port
-         make-output-port-type
          make-port
+         make-port-type
          notification-output-port
          output-port-type?
          output-port/channel