[Sbcl-commits] master: add :TYPE for some STRING-OUTPUT-STREAM slots

[Nathan F. <nf...@us...>]

The branch "master" has been updated in SBCL:
       via  9759f6299340944a0f2a74bfa996d7deb2f559ec (commit)
      from  1e6d784fb74b1343e74087acd454918999fbe2c1 (commit)

- Log -----------------------------------------------------------------
commit 9759f6299340944a0f2a74bfa996d7deb2f559ec
Author: Nathan Froyd <fr...@gm...>
Date:   Sun Apr 6 20:09:38 2014 -0400

    add :TYPE for some STRING-OUTPUT-STREAM slots
    
    The transition through FILL shows up in some profiles when
    GET-OUTPUT-STREAM-STRING is used heavily.  Add :TYPE information to the
    appropriate slots so the compiler knows LIST-FILL* can be used.
    
    Moving the NREVERSE call is required so the compiler understands that
    PREV is actually of list type.  NREVERSE's :DERIVE-TYPE is set up
    correctly; I think the compiler's failure to understand that
    
      (setf prev (nreverse prev))
    
    is not also a list is just fallout from the compiler not dealing
    well with SETF and/or some fault in the type derivation itself.
---
 src/code/stream.lisp |    7 +++----
 1 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index 2bc1aa7..7b33002 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -1288,8 +1288,8 @@
   ;; The string we throw stuff in.
   (buffer (missing-arg) :type (simple-array character (*)))
   ;; Chains of buffers to use
-  (prev nil)
-  (next nil)
+  (prev nil :type list)
+  (next nil :type list)
   ;; Index of the next location to use in the current string.
   (pointer 0 :type index)
   ;; Global location in the stream
@@ -1499,7 +1499,7 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
   (let* ((length (max (string-output-stream-index stream)
                       (string-output-stream-index-cache stream)))
          (element-type (string-output-stream-element-type stream))
-         (prev (string-output-stream-prev stream))
+         (prev (nreverse (string-output-stream-prev stream)))
          (this (string-output-stream-buffer stream))
          (next (string-output-stream-next stream))
          (result
@@ -1531,7 +1531,6 @@ benefit of the function GET-OUTPUT-STREAM-STRING.")
     (flet ((replace-all (fun)
              (let ((start 0))
                (declare (index start))
-               (setf prev (nreverse prev))
                (dolist (buffer prev)
                  (funcall fun buffer start)
                  (incf start (length buffer)))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL