;;;
;;; RATIO and BIGNUM are not recognized as numeric types.
-;;; FIXME: It seems to me that this should be set to NIL by default,
-;;; and perhaps not even optionally set to T.
-(defvar *use-implementation-types* t
+;;; FIXME: This really should go away. Alas, it doesn't seem to be so
+;;; simple to make it go away.. (See bug 123 in BUGS file.)
+(defvar *use-implementation-types* t ; actually initialized in cold init
#!+sb-doc
"*USE-IMPLEMENTATION-TYPES* is a semi-public flag which determines how
restrictive we are in determining type membership. If two types are the
this switch is on. When it is off, we try to be as restrictive as the
language allows, allowing us to detect more errors. Currently, this only
affects array types.")
-
(!cold-init-forms (setq *use-implementation-types* t))
;;; These functions are used as method for types which need a complex
(defvar *wild-type*)
(defvar *empty-type*)
(defvar *universal-type*)
-
+(defvar *universal-function-type*)
(!cold-init-forms
(macrolet ((frob (name var)
`(progn
;; Ts and *UNIVERSAL-TYPE*s.
(frob * *wild-type*)
(frob nil *empty-type*)
- (frob t *universal-type*)))
+ (frob t *universal-type*))
+ (setf *universal-function-type*
+ (make-function-type :wild-args t
+ :returns *wild-type*)))
(!define-type-method (named :simple-=) (type1 type2)
;; FIXME: BUG 85: This assertion failed when I added it in
(type=-set (intersection-type-types type1)
(intersection-type-types type2)))
-(flet ((intersection-complex-subtypep-arg1 (type1 type2)
- (any/type (swapped-args-fun #'csubtypep)
- type2
- (intersection-type-types type1))))
- (!define-type-method (intersection :simple-subtypep) (type1 type2)
- (every/type #'intersection-complex-subtypep-arg1
- type1
- (intersection-type-types type2)))
- (!define-type-method (intersection :complex-subtypep-arg1) (type1 type2)
- (intersection-complex-subtypep-arg1 type1 type2)))
+(defun %intersection-complex-subtypep-arg1 (type1 type2)
+ (any/type (swapped-args-fun #'csubtypep)
+ type2
+ (intersection-type-types type1)))
+
+(!define-type-method (intersection :simple-subtypep) (type1 type2)
+ (every/type #'%intersection-complex-subtypep-arg1
+ type1
+ (intersection-type-types type2)))
+
+(!define-type-method (intersection :complex-subtypep-arg1) (type1 type2)
+ (%intersection-complex-subtypep-arg1 type1 type2))
(!define-type-method (intersection :complex-subtypep-arg2) (type1 type2)
(every/type #'csubtypep type1 (intersection-type-types type2)))
\f
;;;; utilities shared between cross-compiler and target system
+;;; Does the type derived from compilation of an actual function
+;;; definition satisfy declarations of a function's type?
+(defun defined-ftype-matches-declared-ftype-p (defined-ftype declared-ftype)
+ (declare (type ctype defined-ftype declared-ftype))
+ (flet ((is-built-in-class-function-p (ctype)
+ (and (built-in-class-p ctype)
+ (eq (built-in-class-%name ctype) 'function))))
+ (cond (;; DECLARED-FTYPE could certainly be #<BUILT-IN-CLASS FUNCTION>;
+ ;; that's what happens when we (DECLAIM (FTYPE FUNCTION FOO)).
+ (is-built-in-class-function-p declared-ftype)
+ ;; In that case, any definition satisfies the declaration.
+ t)
+ (;; It's not clear whether or how DEFINED-FTYPE might be
+ ;; #<BUILT-IN-CLASS FUNCTION>, but it's not obviously
+ ;; invalid, so let's handle that case too, just in case.
+ (is-built-in-class-function-p defined-ftype)
+ ;; No matter what DECLARED-FTYPE might be, we can't prove
+ ;; that an object of type FUNCTION doesn't satisfy it, so
+ ;; we return success no matter what.
+ t)
+ (;; Otherwise both of them must be FUNCTION-TYPE objects.
+ t
+ ;; FIXME: For now we only check compatibility of the return
+ ;; type, not argument types, and we don't even check the
+ ;; return type very precisely (as per bug 94a). It would be
+ ;; good to do a better job. Perhaps to check the
+ ;; compatibility of the arguments, we should (1) redo
+ ;; VALUES-TYPES-EQUAL-OR-INTERSECT as
+ ;; ARGS-TYPES-EQUAL-OR-INTERSECT, and then (2) apply it to
+ ;; the ARGS-TYPE slices of the FUNCTION-TYPEs. (ARGS-TYPE
+ ;; is a base class both of VALUES-TYPE and of FUNCTION-TYPE.)
+ (values-types-equal-or-intersect
+ (function-type-returns defined-ftype)
+ (function-type-returns declared-ftype))))))
+
;;; This messy case of CTYPE for NUMBER is shared between the
;;; cross-compiler and the target system.
(defun ctype-of-number (x)
:low low
:high high))))
\f
-(!defun-from-collected-cold-init-forms !late-type-cold-init)
+(locally
+ ;; Why SAFETY 0? To suppress the is-it-the-right-structure-type
+ ;; checking for declarations in structure accessors. Otherwise we
+ ;; can get caught in a chicken-and-egg bootstrapping problem, whose
+ ;; symptom on x86 OpenBSD sbcl-0.pre7.37.flaky5.22 is an illegal
+ ;; instruction trap. I haven't tracked it down, but I'm guessing it
+ ;; has to do with setting LAYOUTs when the LAYOUT hasn't been set
+ ;; yet. -- WHN
+ (declare (optimize (safety 0)))
+ (!defun-from-collected-cold-init-forms !late-type-cold-init))
(/show0 "late-type.lisp end of file")
projects / sbcl.git / blobdiff