X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=06e95a791c2d75ea4da0b5791f62f5de57540ad7;hb=c10e4afc31e25003cc2500803ceb7589232e7f6b;hp=ac44a9053cd6df6b538f738d83ce6b5294d791d5;hpb=24407d11d34abdaaef6d839fd0b2665c73b0e6d5;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index ac44a90..06e95a7 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -59,16 +59,16 @@
 
 ;;; stream manipulation functions
 
-(defun input-stream-p (stream)
-  (declare (type stream stream))
+(declaim (inline ansi-stream-input-stream-p))
+(defun ansi-stream-input-stream-p (stream)
+  (declare (type ansi-stream stream))
 
   #!+high-security
   (when (synonym-stream-p stream)
     (setf stream
 	  (symbol-value (synonym-stream-symbol stream))))
 
-  (and (ansi-stream-p stream)
-       (not (eq (ansi-stream-in stream) #'closed-flame))
+  (and (not (eq (ansi-stream-in stream) #'closed-flame))
        ;;; KLUDGE: It's probably not good to have EQ tests on function
        ;;; values like this. What if someone's redefined the function?
        ;;; Is there a better way? (Perhaps just VALID-FOR-INPUT and
@@ -76,37 +76,60 @@
        (or (not (eq (ansi-stream-in stream) #'ill-in))
 	   (not (eq (ansi-stream-bin stream) #'ill-bin)))))
 
-(defun output-stream-p (stream)
+(defun input-stream-p (stream)
   (declare (type stream stream))
+  (and (ansi-stream-p stream)
+       (ansi-stream-input-stream-p stream)))
+
+(declaim (inline ansi-stream-output-stream-p))
+(defun ansi-stream-output-stream-p (stream)
+  (declare (type ansi-stream stream))
 
   #!+high-security
   (when (synonym-stream-p stream)
     (setf stream (symbol-value
 		  (synonym-stream-symbol stream))))
 
-  (and (ansi-stream-p stream)
-       (not (eq (ansi-stream-in stream) #'closed-flame))
+  (and (not (eq (ansi-stream-in stream) #'closed-flame))
        (or (not (eq (ansi-stream-out stream) #'ill-out))
 	   (not (eq (ansi-stream-bout stream) #'ill-bout)))))
 
-(defun open-stream-p (stream)
+(defun output-stream-p (stream)
   (declare (type stream stream))
+
+  (and (ansi-stream-p stream)
+       (ansi-stream-output-stream-p stream)))
+
+(declaim (inline ansi-stream-open-stream-p))
+(defun ansi-stream-open-stream-p (stream)
+  (declare (type ansi-stream stream))
   (not (eq (ansi-stream-in stream) #'closed-flame)))
 
-(defun stream-element-type (stream)
-  (declare (type stream stream))
+(defun open-stream-p (stream)
+  (ansi-stream-open-stream-p stream))
+
+(declaim (inline ansi-stream-element-type))
+(defun ansi-stream-element-type (stream)
+  (declare (type ansi-stream stream))
   (funcall (ansi-stream-misc stream) stream :element-type))
 
+(defun stream-element-type (stream)
+  (ansi-stream-element-type stream))
+
 (defun interactive-stream-p (stream)
   (declare (type stream stream))
   (funcall (ansi-stream-misc stream) stream :interactive-p))
 
-(defun close (stream &key abort)
-  (declare (type stream stream))
+(declaim (inline ansi-stream-close))
+(defun ansi-stream-close (stream abort)
+  (declare (type ansi-stream stream))
   (when (open-stream-p stream)
     (funcall (ansi-stream-misc stream) stream :close abort))
   t)
 
+(defun close (stream &key abort)
+  (ansi-stream-close stream abort))
+
 (defun set-closed-flame (stream)
   (setf (ansi-stream-in stream) #'closed-flame)
   (setf (ansi-stream-bin stream) #'closed-flame)
@@ -515,29 +538,23 @@
 	(stream-fresh-line stream))))
 
 (defun write-string (string &optional (stream *standard-output*)
-			    &key (start 0) (end nil))
-  (%write-string string stream start (or end (length string)))
-  string)
-
-(defun %write-string (string stream start end)
+			    &key (start 0) end)
   (declare (type string string))
-  (declare (type streamlike stream))
-  (declare (type index start end))
-
   ;; Note that even though you might expect, based on the behavior of
   ;; things like AREF, that the correct upper bound here is
   ;; (ARRAY-DIMENSION STRING 0), the ANSI glossary definitions for
   ;; "bounding index" and "length" indicate that in this case (i.e.
-  ;; for the ANSI-specified functions WRITE-STRING and WRITE-LINE
-  ;; which are implemented in terms of this function), (LENGTH STRING)
-  ;; is the required upper bound. A foolish consistency is the
-  ;; hobgoblin of lesser languages..
-  (unless (<= 0 start end (length string))
-    (error "~@<bad bounding indices START=~W END=~W for ~2I~_~S~:>"
-	   start
-	   end
-	   string))
+  ;; for the ANSI-specified functions WRITE-STRING [and WRITE-LINE]),
+  ;; (LENGTH STRING) is the required upper bound. A foolish
+  ;; consistency is the hobgoblin of lesser languages..
+  (%write-string string stream start (%check-vector-sequence-bounds
+				      string start end))
+  string)
 
+(defun %write-string (string stream start end)
+  (declare (type string string))
+  (declare (type streamlike stream))
+  (declare (type index start end))
   (let ((stream (out-synonym-of stream)))
     (cond ((ansi-stream-p stream)
 	   (if (array-header-p string)
@@ -551,10 +568,13 @@
 	   (stream-write-string stream string start end)))))
 
 (defun write-line (string &optional (stream *standard-output*)
-			  &key (start 0) (end nil))
-  (let ((defaulted-stream (out-synonym-of stream))
-	(defaulted-end (or end (length string))))
-    (%write-string string defaulted-stream start defaulted-end)
+			  &key (start 0) end)
+  (declare (type string string))
+  ;; FIXME: Why is there this difference between the treatments of the
+  ;; STREAM argument in WRITE-STRING and WRITE-LINE?
+  (let ((defaulted-stream (out-synonym-of stream)))
+    (%write-string string defaulted-stream start (%check-vector-sequence-bounds
+						  string start end))
     (write-char #\newline defaulted-stream))
   string)
 
@@ -884,7 +904,7 @@
 		  (let* ((stream (car current))
 			 (result (,fun stream nil nil)))
 		    (when result (return result)))
-		  (setf (concatenated-stream-current stream) current)))))
+		  (pop (concatenated-stream-current stream))))))
   (in-fun concatenated-in read-char)
   (in-fun concatenated-bin read-byte))
 
@@ -1137,22 +1157,18 @@
     (:element-type 'base-char)))
 
 (defun make-string-input-stream (string &optional
-					(start 0) (end (length string)))
+					(start 0) end)
   #!+sb-doc
   "Return an input stream which will supply the characters of STRING between
   START and END in order."
   (declare (type string string)
 	   (type index start)
 	   (type (or index null) end))
-
-  #!+high-security
-  (when (> end (length string))
-    (cerror "Continue with end changed from ~S to ~S"
-	    "Write-string: end (~S) is larger then the length of the string (~S)"
-	    end (1- (length string))))
-
-  (internal-make-string-input-stream (coerce string 'simple-string)
-				     start end))
+  
+  (internal-make-string-input-stream
+   (coerce string 'simple-string)
+   start
+   (%check-vector-sequence-bounds string start end)))
 
 ;;;; STRING-OUTPUT-STREAM stuff
 
@@ -1689,7 +1705,7 @@
 
 ;;;; READ-SEQUENCE
 
-(defun read-sequence (seq stream &key (start 0) (end nil))
+(defun read-sequence (seq stream &key (start 0) end)
   #!+sb-doc
   "Destructively modify SEQ by reading elements from STREAM.
   That part of SEQ bounded by START and END is destructively modified by