From 11b8fcf55c80cb2686fb49663fa4d96f9b152ce4 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Thu, 18 Jul 2002 03:31:01 +0000 Subject: [PATCH] 0.7.5.15: fixed handling of INTERSECTION-TYPE corner case in DEFTRANSFORM %DATA-VECTOR-AND-INDEX (used to fail with TYPE-ERROR at compile time) by making DEFTRANSFORMs call UPGRADED-ELEMENT-TYPE-SPECIFIER-OR-GIVE-UP instead of assuming ARRAY-TYPE and calling ARRAY-TYPE-SPECIALIZED-ELEMENT-TYPE directly --- src/code/alien-type.lisp | 5 ----- src/compiler/array-tran.lisp | 10 ++++++++-- src/compiler/generic/vm-tran.lisp | 17 +++++++++-------- src/compiler/srctran.lisp | 2 +- tests/compiler.impure.lisp | 10 ++++++++++ version.lisp-expr | 2 +- 6 files changed, 29 insertions(+), 17 deletions(-) diff --git a/src/code/alien-type.lisp b/src/code/alien-type.lisp index 41a6e84..b76b3e9 100644 --- a/src/code/alien-type.lisp +++ b/src/code/alien-type.lisp @@ -38,11 +38,6 @@ ;;; others (toplevel form time instead of cold load init time) because ;;; ALIEN-VALUE itself is a structure which isn't defined until fairly ;;; late. -;;; -;;; FIXME: I'm somewhat tempted to just punt ALIEN from the type system. -;;; It's sufficiently unlike the others that it's a bit of a pain, and -;;; it doesn't seem to be put to any good use either in type inference or -;;; in type declarations. (!define-superclasses alien ((alien-value)) progn) (!define-type-method (alien :simple-=) (type1 type2) diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp index ddb8f20..d2eafd1 100644 --- a/src/compiler/array-tran.lisp +++ b/src/compiler/array-tran.lisp @@ -28,6 +28,11 @@ ;;; type is going to be the array upgraded element type. (defun extract-upgraded-element-type (array) (let ((type (continuation-type array))) + ;; Note that this IF mightn't be satisfied even if the runtime + ;; value is known to be a subtype of some specialized ARRAY, because + ;; we can have values declared e.g. (AND SIMPLE-VECTOR UNKNOWN-TYPE), + ;; which are represented in the compiler as INTERSECTION-TYPE, not + ;; array type. (if (array-type-p type) (array-type-specialized-element-type type) *universal-type*))) @@ -38,10 +43,11 @@ (defun assert-new-value-type (new-value array) (let ((type (continuation-type array))) (when (array-type-p type) - (assert-continuation-type new-value (array-type-specialized-element-type type)))) + (assert-continuation-type new-value + (array-type-specialized-element-type type)))) (continuation-type new-value)) -;;; Return true if Arg is NIL, or is a constant-continuation whose +;;; Return true if ARG is NIL, or is a constant-continuation whose ;;; value is NIL, false otherwise. (defun unsupplied-or-nil (arg) (declare (type (or continuation null) arg)) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 2cbd25c..7031de3 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -125,14 +125,15 @@ (simple-array t) * :important t) - (let* ((atype (continuation-type array)) - (eltype (array-type-specialized-element-type atype))) - (when (eq eltype *wild-type*) - (give-up-ir1-transform - "specialized array element type not known at compile-time")) - `(if (array-header-p array) - (values (%array-data-vector array) index) - (values array index)))) + + ;; We do this solely for the -OR-GIVE-UP side effect, since we want + ;; to know that the type can be figured out in the end before we + ;; proceed, but we don't care yet what the type will turn out to be. + (upgraded-element-type-specifier-or-give-up array) + + '(if (array-header-p array) + (values (%array-data-vector array) index) + (values array index))) ;;; transforms for getting at simple arrays of (UNSIGNED-BYTE N) when (< N 8) ;;; diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index f9b0161..54da0ee 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -3301,7 +3301,7 @@ *universal-type*))))) (defoptimizer (array-element-type derive-type) ((array)) - (let* ((array-type (continuation-type array))) + (let ((array-type (continuation-type array))) (labels ((consify (list) (if (endp list) '(eql nil) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index de68a8a..55f003a 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -103,6 +103,16 @@ (defun floating-point-pain (x) (declare (single-float x)) (log x)) + +;;; bug found and fixed ca. sbcl-0.7.5.12: The INTERSECTION-TYPE +;;; here satisfies "is a subtype of ARRAY-TYPE", but can't be +;;; accessed with ARRAY-TYPE accessors like +;;; ARRAY-TYPE-SPECIALIZED-ELEMENT-TYPE, so ARRAY-related +;;; DEFTRANSFORMs died with TYPE-ERROR at compile time when +;;; compiling the DEFUN here. +(defun stupid-input-to-smart-array-deftransforms-0-7-5-12 (v) + (declare (type (and simple-vector fwd-type-ref) v)) + (aref v 0)) ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 9169f4f..aae9b1e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.5.14" +"0.7.5.15" -- 1.7.10.4