Commit 6c0ccaa5 authored by rtoy's avatar rtoy
Browse files

Add derive-type optimizer for lisp::shrink-vector so the compiler 

knows the result type of lisp::shrink-vector.  (Without this, the
return type is always VECTOR, instead of the same type as the input
vector.)
parent e64adb39

compiler/fndb.lisp

+2 −1
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.136.4.1 2008/05/31 19:50:26 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.136.4.1.2.1 2009/05/28 20:36:42 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -1241,6 +1241,7 @@ 
  (foldable flushable))

(defknown %set-symbol-package (symbol t) t (unsafe))

(defknown %coerce-to-function (t) function (flushable))

(defknown lisp::shrink-vector (vector fixnum) vector (unsafe))



;;; Structure slot accessors or setters are magically "known" to be these

;;; functions, although the var remains the Slot-Accessor describing the actual

compiler/seqtran.lisp

+14 −1
Original line number Diff line number Diff line
@@ -5,7 +5,7 @@ 
;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(ext:file-comment

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.31.18.1 2009/03/25 21:51:34 rtoy Exp $")

  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/seqtran.lisp,v 1.31.18.2 2009/05/28 20:36:44 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -661,3 +661,16 @@ 
  ;; The result type of MAKE-SEQUENCE is OUTPUT-SPEC, but check to see

  ;; if it makes sense.

  (output-spec-sequence output-spec))



(defoptimizer (lisp::shrink-vector derive-type) ((vector new-size))

  ;; The result of shrink-vector is another vector of the same type as

  ;; the input.  If the size is a known constant, we use it, otherwise

  ;; just make the dimension unknown.

  (let* ((type (continuation-type vector))

	 (dim (if (constant-continuation-p new-size)

		  `(,(continuation-value new-size))

		  '(*)))

	 (new-type (kernel::copy-array-type type)))

    (setf (kernel:array-type-dimensions new-type) dim)

    new-type))