fixing bug 40..
UPGRADED-ARRAY-ELEMENT-TYPE now signals an error when the type
is undefined.
TYPEP and SUBTYPEP now catch type arguments which are arrays
with undefined element types.
also cleaned up UPGRADED-COMPLEX-PART-TYPE a little..
UPGRADED-COMPLEX-PART-TYPE signals an error for undefined type.
UPGRADED-COMPLEX-PART-TYPE always returns a value which is a
subtype of REAL.
accepting &REST even when it's not followed by an argument name:
(DEFMETHOD FOO ((X T) &REST) NIL)
-40:
- TYPEP treats the result of UPGRADED-ARRAY-ELEMENT-TYPE as gospel,
- so that (TYPEP (MAKE-ARRAY 3) '(VECTOR SOMETHING-NOT-DEFINED-YET))
- returns (VALUES T T). Probably it should be an error instead,
- complaining that the type SOMETHING-NOT-DEFINED-YET is not defined.
- Or perhaps UPGRADED-ARRAY-ELEMENT-TYPE should just fail when a type
- isn't defined yet. (What if the definition of
- SOMETHING-NOT-DEFINED-YET turns out to be SINGLE-FLOAT?)
-
41:
TYPEP of VALUES types is sometimes implemented very inefficiently, e.g. in
(DEFTYPE INDEXOID () '(INTEGER 0 1000))
but like most other programs, it defaults to copying the Unix
environment from the original process instead of starting the
new process in an empty environment.
+* fixed bug 40: TYPEP, SUBTYPEP, UPGRADED-ARRAY-ELEMENT-TYPE,
+ and UPGRADED-COMPLEX-PART-TYPE now work better with of compound
+ types built from undefined types, e.g. '(VECTOR SOME-UNDEF-TYPE).
* Extensions which manipulate the Unix environment now support
an :ENVIRONMENT keyword option which doesn't smash case or
do other bad things. The CMU-CL-style :ENV option is retained
(let ((dims1 (array-type-dimensions type1))
(dims2 (array-type-dimensions type2))
(complexp2 (array-type-complexp type2)))
- ;; See whether dimensions are compatible.
- (cond ((not (or (eq dims2 '*)
+ (cond (;; not subtypep unless dimensions are compatible
+ (not (or (eq dims2 '*)
(and (not (eq dims1 '*))
;; (sbcl-0.6.4 has trouble figuring out that
;; DIMS1 and DIMS2 must be lists at this
(the list dims1)
(the list dims2)))))
(values nil t))
- ;; See whether complexpness is compatible.
+ ;; not subtypep unless complexness is compatible
((not (or (eq complexp2 :maybe)
(eq (array-type-complexp type1) complexp2)))
(values nil t))
- ;; If the TYPE2 eltype is wild, we win. Otherwise, the types
- ;; must be identical.
- ((or (eq (array-type-element-type type2) *wild-type*)
- (type= (specialized-element-type-maybe type1)
- (specialized-element-type-maybe type2)))
+ ;; Since we didn't fail any of the tests above, we win
+ ;; if the TYPE2 element type is wild.
+ ((eq (array-type-element-type type2) *wild-type*)
(values t t))
- (t
- (values nil t)))))
+ (;; Since we didn't match any of the special cases above, we
+ ;; can't give a good answer unless both the element types
+ ;; have been defined.
+ (or (unknown-type-p (array-type-element-type type1))
+ (unknown-type-p (array-type-element-type type2)))
+ (values nil nil))
+ (;; Otherwise, the subtype relationship holds iff the
+ ;; types are equal, and they're equal iff the specialized
+ ;; element types are identical.
+ t
+ (values (type= (specialized-element-type-maybe type1)
+ (specialized-element-type-maybe type2))
+ t)))))
(!define-superclasses array
((string string)
#!+sb-doc
"Return the element type that will actually be used to implement an array
with the specifier :ELEMENT-TYPE Spec."
- (type-specifier
- (array-type-specialized-element-type
- (specifier-type `(array ,spec)))))
+ (if (unknown-type-p (specifier-type spec))
+ (error "undefined type: ~S" spec)
+ (type-specifier (array-type-specialized-element-type
+ (specifier-type `(array ,spec))))))
\f
;;;; equality predicates
(vlen (car (array-type-dimensions type))))
(if (and (numberp vlen) (/= vlen length))
(error 'simple-type-error
- ;; these two are under-specified by ANSI
+ ;; These two are under-specified by ANSI.
:datum (type-specifier type)
:expected-type (type-specifier type)
:format-control
- "The length of ~S does not match the specified length of ~S."
+ "The length of ~S does not match the specified ~
+ length=~S."
:format-arguments
(list (type-specifier type) length)))
(if iep
(defun upgraded-complex-part-type (spec)
#!+sb-doc
"Returns the element type of the most specialized COMPLEX number type that
- can hold parts of type Spec."
- (cond ((subtypep spec 'single-float)
+ can hold parts of type SPEC."
+ (cond ((unknown-type-p (specifier-type spec))
+ (error "undefined type: ~S" spec))
+ ((subtypep spec 'single-float)
'single-float)
((subtypep spec 'double-float)
'double-float)
'long-float)
((subtypep spec 'rational)
'rational)
- (t)))
+ (t
+ 'real)))
(defun complex (realpart &optional (imagpart 0))
#!+sb-doc
(in-package "SB!KERNEL")
-;;; The actual TYPEP engine. The compiler only generates calls to this
+;;; the actual TYPEP engine. The compiler only generates calls to this
;;; function when it can't figure out anything more intelligent to do.
(defun %typep (object specifier)
(%%typep object
(or (eq (car want) '*)
(= (car want) (car got))))
(return nil))))
+ (if (unknown-type-p (array-type-element-type type))
+ ;; better to fail this way than to get bogosities like
+ ;; (TYPEP (MAKE-ARRAY 11) '(ARRAY SOME-UNDEFINED-TYPE)) => T
+ (error "~@<unknown element type in array type: ~2I~_~S~:>"
+ (type-specifier type))
+ t)
(or (eq (array-type-element-type type) *wild-type*)
(values (type= (array-type-specialized-element-type type)
(specifier-type (array-element-type
(error "Function types are not a legal argument to TYPEP:~% ~S"
(type-specifier type)))))
-;;; Do type test from a class cell, allowing forward reference and
+;;; Do a type test from a class cell, allowing forward reference and
;;; redefinition.
(defun class-cell-typep (obj-layout cell object)
(let ((class (class-cell-class cell)))
(error "The class ~S has not yet been defined." (class-cell-name cell)))
(class-typep obj-layout class object)))
-;;; Test whether Obj-Layout is from an instance of Class.
+;;; Test whether OBJ-LAYOUT is from an instance of CLASS.
(defun class-typep (obj-layout class object)
(declare (optimize speed))
(when (layout-invalid obj-layout)
;;; This function is called when the type code wants to find out how
;;; an array will actually be implemented. We set the
-;;; Specialized-Element-Type to correspond to the actual
+;;; SPECIALIZED-ELEMENT-TYPE to correspond to the actual
;;; specialization used in this implementation.
(declaim (ftype (function (array-type) array-type) specialize-array-type))
(defun specialize-array-type (type)
',(find-class-cell name)
object)))))))))
-#|
-;;; Return (VALUES BEST-GUESS EXACT?), where BEST-GUESS is a CTYPE
-;;; which corresponds to the value returned by
-;;; CL:UPGRADED-ARRAY-ELEMENT-TYPE, and EXACT? tells whether that
-;;; result might change when we encounter a DEFTYPE.
-(declaim (maybe-inline upgraded-array-element-ctype-2))
-(defun upgraded-array-element-ctype-2 (spec)
- (let ((ctype (specifier-type `(array ,spec))))
- (values (array-type-specialized-element-type
- (specifier-type `(array ,spec)))
- (not (unknown-type-p (array-type-element-type ctype))))))
-|#
-
;;; If the specifier argument is a quoted constant, then we consider
;;; converting into a simple predicate or other stuff. If the type is
;;; constant, but we can't transform the call, then we convert to
(cl:in-package :cl-user)
+(defmacro grab-condition (&body body)
+ `(nth-value 1
+ (ignore-errors ,@body)))
+
+(defmacro raises-error? (&body body)
+ `(typep (nth-value 1 (ignore-errors ,@body)) 'error))
+
;;; EXPR is an expression to evaluate (both with EVAL and with
;;; COMPILE/FUNCALL). EXTRA-OPTIMIZATIONS is a list of lists of
;;; optimizations to pass to (DECLARE (OPTIMIZE ..)), to cause the
(in-package "CL-USER")
-(defmacro grab-condition (&body body)
- `(nth-value 1
- (ignore-errors ,@body)))
+(load "assertoid.lisp")
(setf (logical-pathname-translations "demo0")
'(("**;*.*.*" "/tmp/")))
(in-package :cl-user)
+(load "assertoid.lisp")
+
(let ((types '(character
integer fixnum (integer 0 10)
single-float (single-float -1.0 1.0) (single-float 0.1)
(assert (type-evidently-= '(integer 0 10) '(or (integer 0 5) (integer 4 10))))
+;;; sbcl-0.6.10 did (UPGRADED-ARRAY-ELEMENT-TYPE 'SOME-UNDEF-TYPE)=>T
+;;; and (UPGRADED-COMPLEX-PART-TYPE 'SOME-UNDEF-TYPE)=>T.
+(assert (raises-error? (upgraded-array-element-type 'some-undef-type)))
+(assert (eql (upgraded-array-element-type t) t))
+(assert (raises-error? (upgraded-complex-part-type 'some-undef-type)))
+(assert (subtypep (upgraded-complex-part-type 'fixnum) 'real))
+
+;;; Do reasonable things with undefined types, and with compound types
+;;; built from undefined types.
+;;;
+;;; part I: TYPEP
+(assert (typep #(11) '(simple-array t 1)))
+(assert (typep #(11) '(simple-array (or integer symbol) 1)))
+(assert (raises-error? (typep #(11) '(simple-array undef-type 1))))
+(assert (not (typep 11 '(simple-array undef-type 1))))
+;;; part II: SUBTYPEP
+(assert (subtypep '(vector some-undef-type) 'vector))
+(assert (not (subtypep '(vector some-undef-type) 'integer)))
+(macrolet ((nilnil (expr)
+ `(assert (equal '(nil nil) (multiple-value-list ,expr)))))
+ (nilnil (subtypep 'utype-1 'utype-2))
+ (nilnil (subtypep '(vector utype-1) '(vector utype-2)))
+ (nilnil (subtypep '(vector utype-1) '(vector t)))
+ (nilnil (subtypep '(vector t) '(vector utype-2))))
+
;;; success
(quit :unix-status 104)
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.10.13"
+"0.6.10.14"
projects / sbcl.git / commitdiff