Added (guarantee-input-port port) where necessary to improve type

safety.

diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index e48f26a000edc623113a21e854ed6ad42d4fc6d4..4d1be17b80ca288f3d5ec32667cb6a94e8f73407 100644 (file)
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 14.6 1990/06/20 20:29:14 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/input.scm,v 14.7 1990/09/28 01:56:48 arthur Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -67,27 +67,30 @@ MIT in each case. |#
   port)
 
 (define (input-port/copy port state)
-  (let ((result (%input-port/copy port)))
-    (set-input-port/state! result state)
-    result))
+  (let ((port (guarantee-input-port port)))
+    (let ((result (%input-port/copy port)))
+      (set-input-port/state! result state)
+      result)))
 
 (define (input-port/custom-operation port name)
-  (let ((entry (assq name (input-port/custom-operations port))))
-    (and entry
-        (cdr entry))))
+  (let ((port (guarantee-input-port port)))
+    (let ((entry (assq name (input-port/custom-operations port))))
+      (and entry
+          (cdr entry)))))
 
 (define (input-port/operation port name)
   ;; Try the custom operations first since the user is less likely to
   ;; use this procedure to access the standard operations.
-  (or (input-port/custom-operation port name)
-      (case name
-       ((CHAR-READY?) (input-port/operation/char-ready? port))
-       ((PEEK-CHAR) (input-port/operation/peek-char port))
-       ((READ-CHAR) (input-port/operation/read-char port))
-       ((DISCARD-CHAR) (input-port/operation/discard-char port))
-       ((READ-STRING) (input-port/operation/read-string port))
-       ((DISCARD-CHARS) (input-port/operation/discard-chars port))
-       (else false))))
+  (let ((port (guarantee-input-port port)))
+    (or (input-port/custom-operation port name)
+       (case name
+         ((CHAR-READY?) (input-port/operation/char-ready? port))
+         ((PEEK-CHAR) (input-port/operation/peek-char port))
+         ((READ-CHAR) (input-port/operation/read-char port))
+         ((DISCARD-CHAR) (input-port/operation/discard-char port))
+         ((READ-STRING) (input-port/operation/read-string port))
+         ((DISCARD-CHARS) (input-port/operation/discard-chars port))
+         (else false)))))
 \f
 (define (make-input-port operations state)
   (let ((operations
@@ -146,34 +149,42 @@ MIT in each case. |#
                 (loop))))))
 \f
 (define (input-port/char-ready? port interval)
-  ((input-port/operation/char-ready? port) port interval))
+  (let ((port (guarantee-input-port port)))
+    ((input-port/operation/char-ready? port) port interval)))
 
 (define (input-port/peek-char port)
-  ((input-port/operation/peek-char port) port))
+  (let ((port (guarantee-input-port port)))
+    ((input-port/operation/peek-char port) port)))
 
 (define (input-port/read-char port)
-  ((input-port/operation/read-char port) port))
+  (let ((port (guarantee-input-port port)))
+    ((input-port/operation/read-char port) port)))
 
 (define (input-port/discard-char port)
-  ((input-port/operation/discard-char port) port))
+  (let ((port (guarantee-input-port port)))
+    ((input-port/operation/discard-char port) port)))
 
 (define (input-port/read-string port delimiters)
-  ((input-port/operation/read-string port) port delimiters))
+  (let ((port (guarantee-input-port port)))
+    ((input-port/operation/read-string port) port delimiters)))
 
 (define (input-port/discard-chars port delimiters)
-  ((input-port/operation/discard-chars port) port delimiters))
+  (let ((port (guarantee-input-port port)))
+    ((input-port/operation/discard-chars port) port delimiters)))
 
 (define (input-port/normal-mode port thunk)
-  (let ((operation (input-port/custom-operation port 'NORMAL-MODE)))
-    (if operation
-       (operation port thunk)
-       (thunk))))
+  (let ((port (guarantee-input-port port)))
+    (let ((operation (input-port/custom-operation port 'NORMAL-MODE)))
+      (if operation
+         (operation port thunk)
+         (thunk)))))
 
 (define (input-port/immediate-mode port thunk)
-  (let ((operation (input-port/custom-operation port 'IMMEDIATE-MODE)))
-    (if operation
-       (operation port thunk)
-       (thunk))))
+  (let ((port (guarantee-input-port port)))
+    (let ((operation (input-port/custom-operation port 'IMMEDIATE-MODE)))
+      (if operation
+         (operation port thunk)
+         (thunk)))))
 
 (define eof-object
   "EOF Object")
@@ -291,6 +302,7 @@ MIT in each case. |#
       object)))
 
 (define (close-input-port port)
-  (let ((operation (input-port/custom-operation port 'CLOSE)))
-    (if operation
-       (operation port))))
\ No newline at end of file
+  (let ((port (guarantee-input-port port)))
+    (let ((operation (input-port/custom-operation port 'CLOSE)))
+      (if operation
+         (operation port)))))
\ No newline at end of file