From 59b281ce92ea64b3701c15dd5af35f0c4bd429c2 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Sat, 10 Jan 1998 05:02:26 +0000 Subject: [PATCH] The aref derive type optimiser should have been returning the upgraded element type rather than a possibly more specific declared element type. When there is only a single use of the continuation the type is also asserted to be the declared element type. This can pickup errors such as reading an uninitialised element type is not of the declared type. --- compiler/array-tran.lisp | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp index d237b2852..34e0dd03e 100644 --- a/compiler/array-tran.lisp +++ b/compiler/array-tran.lisp @@ -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/array-tran.lisp,v 1.22 1998/01/09 10:07:48 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.23 1998/01/10 05:02:26 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -30,8 +30,8 @@ ;;; EXTRACT-ELEMENT-TYPE -- internal ;;; -;;; Array access functions return an object from the array, hence it's type -;;; is going to be the array element type. +;;; Array access functions return an object from the array, hence it's +;;; type will be asserted to be array element type. ;;; (defun extract-element-type (array) (let ((type (continuation-type array))) @@ -39,6 +39,17 @@ (array-type-element-type type) *universal-type*))) +;;; EXTRACT-UPGRADED-ELEMENT-TYPE -- internal +;;; +;;; Array access functions return an object from the array, hence it's +;;; type is going to be the array upgraded element type. +;;; +(defun extract-upgraded-element-type (array) + (let ((type (continuation-type array))) + (if (array-type-p type) + (array-type-specialized-element-type type) + *universal-type*))) + ;;; ASSERT-NEW-VALUE-TYPE -- internal ;;; ;;; The ``new-value'' for array setters must fit in the array, and the @@ -70,9 +81,13 @@ ;;; AREF -- derive-type optimizer. ;;; -(defoptimizer (aref derive-type) ((array &rest indices)) +(defoptimizer (aref derive-type) ((array &rest indices) node) (assert-array-rank array (length indices)) - (extract-element-type array)) + ;; If the node continuation has a single use then assert its type. + (let ((cont (node-cont node))) + (unless (rest (find-uses cont)) + (assert-continuation-type cont (extract-element-type array)))) + (extract-upgraded-element-type array)) ;;; %ASET -- derive-type optimizer. ;;; @@ -83,7 +98,7 @@ ;;; DATA-VECTOR-REF -- derive-type optimizer. ;;; (defoptimizer (data-vector-ref derive-type) ((array index)) - (extract-element-type array)) + (extract-upgraded-element-type array)) ;;; DATA-VECTOR-SET -- derive-type optimizer. ;;; @@ -114,7 +129,7 @@ ;;; ROW-MAJOR-AREF -- derive-type optimizer. ;;; (defoptimizer (row-major-aref derive-type) ((array index)) - (extract-element-type array)) + (extract-upgraded-element-type array)) ;;; %SET-ROW-MAJOR-AREF -- derive-type optimizer. ;;; -- GitLab