From 7fbf559019c59487018417f434d8d9610246ac70 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Tue, 15 Oct 2002 21:23:14 +0000 Subject: [PATCH] Port over SBCL's fix for the Entomotomy bug array-element-type-treated-as-declaration wherein the compiler believes type declarations on array elements without checking them, e.g. (DECLAIM (OPTIMIZE (SAFETY 3) (SPEED 1) (SPACE 1))) (DEFSTRUCT FOO A B) (DEFUN BAR (X) (DECLARE (TYPE (SIMPLE-ARRAY CONS 1) X)) (WHEN (CONSP (AREF X 0)) (PRINT (AREF X 0)))) (BAR (VECTOR (MAKE-FOO :A 11 :B 12))) prints a structure out. This patch makes the compiler use the specialized (upgraded) element type instead of the declared element type for aref. --- compiler/array-tran.lisp | 6 +++--- compiler/generic/vm-tran.lisp | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp index d37325ab3..2f3b45f29 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.28 2000/07/06 18:37:00 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.29 2002/10/15 21:23:13 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -59,7 +59,7 @@ (let ((type (continuation-type array))) (when (array-type-p type) (assert-continuation-optional-type new-value - (array-type-element-type type)))) + (array-type-specialized-element-type type)))) (continuation-type new-value)) ;;; Unsupplied-Or-NIL -- Internal @@ -87,7 +87,7 @@ ;; If the node continuation has a single use then assert its type. (let ((cont (node-cont node))) (when (= (length (find-uses cont)) 1) - (assert-continuation-type cont (extract-element-type array)))) + (assert-continuation-type cont (extract-upgraded-element-type array)))) (extract-upgraded-element-type array)) ;;; %ASET -- derive-type optimizer. diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index edadb6b2c..9eb24c879 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-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/generic/vm-tran.lisp,v 1.45 2002/08/08 15:37:38 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.46 2002/10/15 21:23:14 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -59,7 +59,7 @@ (let ((dims (array-type-dimensions array-type))) (when (and (consp dims) (= (length dims) 1)) (give-up)) - (let* ((el-type (array-type-element-type array-type)) + (let* ((el-type (array-type-specialized-element-type array-type)) (total-size (if (or (atom dims) (member '* dims)) '* (reduce #'* dims))) @@ -84,7 +84,7 @@ (give-up)) (delay-transform node :optimize) (let* ((dims (array-type-dimensions array-type)) - (el-type (array-type-element-type array-type)) + (el-type (array-type-specialized-element-type array-type)) (total-size (if (or (atom dims) (member '* dims)) '* (reduce #'* dims))) -- GitLab