From b480340342e71e6e17c7b6efdfefab664d7cad4e Mon Sep 17 00:00:00 2001 From: Mark Cox Date: Mon, 24 Nov 2014 16:40:01 +1000 Subject: [PATCH 1/2] Fix optimizer for %ARRAY-DATA-VECTOR and ARRAY-STORAGE-VECTOR in SB-C. Closes bug #1382383. --- src/compiler/generic/vm-tran.lisp | 33 +++++++++++++++++++++++++-------- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 70d514d..47aaf24 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -266,7 +266,11 @@ sb!vm:vector-data-offset index offset t)))) -(defun maybe-array-data-vector-type-specifier (array-lvar) +;; Return the type of the underlying simple array that ARRAY-LVAR uses +;; for storage. This function differs from +;; MAYBE-ARRAY-DATA-VECTOR-TYPE-SPECIFIER as it follows all array +;; displacements. +(defun maybe-array-storage-vector-type-specifier (array-lvar) (let ((atype (lvar-type array-lvar))) (when (array-type-p atype) (let ((dims (array-type-dimensions atype))) @@ -280,13 +284,26 @@ (array-type-specialized-element-type atype)) (,(apply #'* dims)))))))) -(macrolet ((def (name) - `(defoptimizer (,name derive-type) ((array-lvar)) - (let ((spec (maybe-array-data-vector-type-specifier array-lvar))) - (when spec - (specifier-type spec)))))) - (def %array-data-vector) - (def array-storage-vector)) +;; Compute the type of the underlying array that ARRAY-LVAR is a view +;; of. +(defun maybe-array-data-vector-type-specifier (array-lvar) + (let ((atype (lvar-type array-lvar))) + (when (array-type-p atype) + (if (array-type-complexp atype) + `(array ,(type-specifier + (array-type-specialized-element-type atype)) + *) + (maybe-array-storage-vector-type-specifier array-lvar))))) + +(defoptimizer (%array-data-vector derive-type) ((array-lvar)) + (let ((spec (maybe-array-data-vector-type-specifier array-lvar))) + (when spec + (specifier-type spec)))) + +(defoptimizer (array-storage-vector derive-type) ((array-lvar)) + (let ((spec (maybe-array-storage-vector-type-specifier array-lvar))) + (when spec + (specifier-type spec)))) (defoptimizer (%data-vector-and-index derive-type) ((array index)) (declare (ignore index)) -- 2.1.2 From b444864b11ed4d491399f730e7f5e971e4e6e2a3 Mon Sep 17 00:00:00 2001 From: Mark Cox Date: Mon, 24 Nov 2014 16:54:22 +1000 Subject: [PATCH 2/2] Test for Bug #1382383. --- tests/type.pure.lisp | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp index 38dc75c..478bc99 100644 --- a/tests/type.pure.lisp +++ b/tests/type.pure.lisp @@ -560,3 +560,17 @@ '(not (or (and simple-array (not vector)) (and array (not simple-array)))))) (specifier-type 'simple-string)))) + +(in-package "CL-USER") +(with-test (:name :bug-1382383) + ;; Dimensions of ARRAY-LVAR are unknown. + (let* ((storage (make-array (list 2 5 5))) + (array (make-array (list 5 5) :displaced-to storage))) + (assert (typep array '(array t (* *)))) + (assert (typep array '(array t *)))) + + ;; Dimensions of ARRAY-LVAR are known. + (let* ((storage (make-array '(2 5 5))) + (array (make-array '(5 5) :displaced-to storage))) + (assert (typep storage '(array t (* * *)))) + (assert (typep array '(array t (* *)))))) -- 2.1.2