X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fstream.lisp;h=e3dbd91b327f1d8471cb837cfe4bd804e34a3818;hb=c7de1989d006e0b3a4f26143b7a81c9bdb754101;hp=5e5b8926f54a69f53cc35a06572a07c290136e32;hpb=a63a3a68cdf694ea8076731ed7dfbfd88d127108;p=sbcl.git

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 5e5b892..e3dbd91 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -145,7 +145,7 @@
 ;;; Call the MISC method with the :FILE-POSITION operation.
 (defun file-position (stream &optional position)
   (declare (type stream stream))
-  (declare (type (or index (member nil :start :end)) position))
+  (declare (type (or index (alien sb!unix:off-t) (member nil :start :end)) position))
   (cond
    (position
     (setf (ansi-stream-in-index stream) +ansi-stream-in-buffer-length+)
@@ -185,7 +185,7 @@
 	   ;; private predicate function..) is ugly and confusing, but
 	   ;; I can't see any other way. -- WHN 2001-04-14
 	   :expected-type '(satisfies stream-associated-with-file-p)
-	   :format-string
+	   :format-control
 	   "~@<The stream ~2I~_~S ~I~_isn't associated with a file.~:>"
 	   :format-arguments (list stream))))
 
@@ -332,20 +332,9 @@
 			    eof-value
 			    recursive-p)
   (declare (ignore recursive-p))
-  ;; FIXME: The type of PEEK-TYPE is also declared in a DEFKNOWN, but
-  ;; the compiler doesn't seem to be smart enough to go from there to
-  ;; imposing a type check. Figure out why (because PEEK-TYPE is an
-  ;; &OPTIONAL argument?) and fix it, and then this explicit type
-  ;; check can go away.
-  (unless (typep peek-type '(or character boolean))
-    (error 'simple-type-error
-	   :datum peek-type
-	   :expected-type '(or character boolean)
-	   :format-control "~@<bad PEEK-TYPE=~S, ~_expected ~S~:>"
-	   :format-arguments (list peek-type '(or character boolean))))
   (let ((stream (in-synonym-of stream)))
     (cond ((typep stream 'echo-stream)
-	   (echo-misc stream 
+	   (echo-misc stream
 		      :peek-char
 		      peek-type
 		      (list eof-error-p eof-value)))
@@ -1158,7 +1147,11 @@
   (case operation
     (:file-position
      (if arg1
-	 (setf (string-input-stream-current stream) arg1)
+	 (setf (string-input-stream-current stream)
+	       (case arg1
+		 (:start 0)
+		 (:end (string-input-stream-end stream))
+		 (t arg1)))
 	 (string-input-stream-current stream)))
     (:file-length (length (string-input-stream-string stream)))
     (:unread (decf (string-input-stream-current stream)))
@@ -1189,12 +1182,16 @@
 		      (sout #'string-sout)
 		      (misc #'string-out-misc)
                       ;; The string we throw stuff in.
-                      (string (make-string 40)
+                      (string (missing-arg)
 			      :type (simple-array character (*))))
-	    (:constructor make-string-output-stream ())
+	    (:constructor make-string-output-stream 
+			  (&key (element-type 'character)
+			   &aux (string (make-string 40))))
 	    (:copier nil))
   ;; Index of the next location to use.
-  (index 0 :type fixnum))
+  (index 0 :type fixnum)
+  ;; Requested element type
+  (element-type 'character))
 
 #!+sb-doc
 (setf (fdocumentation 'make-string-output-stream 'function)
@@ -1261,8 +1258,19 @@
 (defun get-output-stream-string (stream)
   (declare (type string-output-stream stream))
   (let* ((length (string-output-stream-index stream))
-	 (result (make-string length)))
-    (replace result (string-output-stream-string stream))
+	 (element-type (string-output-stream-element-type stream))
+	 (result 
+	  (case element-type
+	    ;; Overwhelmingly common case; can be inlined.
+	    ((character) (make-string length))
+	    (t (make-string length :element-type element-type)))))
+    ;; For the benefit of the REPLACE transform, let's do this, so
+    ;; that the common case isn't ludicrously expensive.
+    (etypecase result 
+      ((simple-array character (*)) 
+       (replace result (string-output-stream-string stream)))
+      ((simple-array nil (*))
+       (replace result (string-output-stream-string stream))))
     (setf (string-output-stream-index stream) 0)
     result))