From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Fri, 28 Sep 1990 01:56:48 +0000 (+0000)
Subject: Added (guarantee-input-port port) where necessary to improve type
X-Git-Tag: 20090517-FFI~11175
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=75d1052593179db36d975aa6a5758b23d6cd228f;p=mit-scheme.git

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 e48f26a00..4d1be17b8 100644
--- 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)))))
 
 (define (make-input-port operations state)
   (let ((operations
@@ -146,34 +149,42 @@ MIT in each case. |#
 		 (loop))))))
 
 (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