X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=5950822c575461a6cbe2bba7648520fc02b01eac;hb=bed279acc9bd04eb1bbf56acb0dcaa3b1acf04f0;hp=523f792f17766979a86312486fbc8a7b09956362;hpb=6c765578c8dc4bcc7798e37c9918715f198b30da;p=sbcl.git diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 523f792..5950822 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -31,9 +31,9 @@ ;;; ;;; 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 @@ -41,7 +41,6 @@ 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 @@ -132,10 +131,10 @@ ;;; the description of a &KEY argument (defstruct (key-info #-sb-xc-host (:pure t) (:copier nil)) - ;; the key (not necessarily a keyword in ANSI) - (name (required-argument) :type symbol) + ;; the key (not necessarily a keyword in ANSI Common Lisp) + (name (missing-arg) :type symbol) ;; the type of the argument value - (type (required-argument) :type ctype)) + (type (missing-arg) :type ctype)) (!define-type-method (values :simple-subtypep :complex-subtypep-arg1) (type1 type2) @@ -193,18 +192,18 @@ ;;; a flag that we can bind to cause complex function types to be ;;; unparsed as FUNCTION. This is useful when we want a type that we ;;; can pass to TYPEP. -(defvar *unparse-function-type-simplify*) -(!cold-init-forms (setq *unparse-function-type-simplify* nil)) +(defvar *unparse-fun-type-simplify*) +(!cold-init-forms (setq *unparse-fun-type-simplify* nil)) (!define-type-method (function :unparse) (type) - (if *unparse-function-type-simplify* + (if *unparse-fun-type-simplify* 'function (list 'function - (if (function-type-wild-args type) + (if (fun-type-wild-args type) '* (unparse-args-types type)) (type-specifier - (function-type-returns type))))) + (fun-type-returns type))))) ;;; Since all function types are equivalent to FUNCTION, they are all ;;; subtypes of each other. @@ -295,10 +294,9 @@ (result))) (!def-type-translator function (&optional (args '*) (result '*)) - (let ((res (make-function-type - :returns (values-specifier-type result)))) + (let ((res (make-fun-type :returns (values-specifier-type result)))) (if (eq args '*) - (setf (function-type-wild-args res) t) + (setf (fun-type-wild-args res) t) (parse-args-types args res)) res)) @@ -333,9 +331,9 @@ ;;; Return the minimum number of arguments that a function can be ;;; called with, and the maximum number or NIL. If not a function ;;; type, return NIL, NIL. -(defun function-type-nargs (type) +(defun fun-type-nargs (type) (declare (type ctype type)) - (if (function-type-p type) + (if (fun-type-p type) (let ((fixed (length (args-type-required type)))) (if (or (args-type-rest type) (args-type-keyp type) @@ -876,7 +874,7 @@ (defvar *wild-type*) (defvar *empty-type*) (defvar *universal-type*) - +(defvar *universal-fun-type*) (!cold-init-forms (macrolet ((frob (name var) `(progn @@ -891,7 +889,10 @@ ;; Ts and *UNIVERSAL-TYPE*s. (frob * *wild-type*) (frob nil *empty-type*) - (frob t *universal-type*))) + (frob t *universal-type*)) + (setf *universal-fun-type* + (make-fun-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 @@ -1912,16 +1913,18 @@ (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))) @@ -2152,7 +2155,7 @@ ;; 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. + (;; Otherwise both of them must be FUN-TYPE objects. t ;; FIXME: For now we only check compatibility of the return ;; type, not argument types, and we don't even check the @@ -2161,11 +2164,11 @@ ;; 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.) + ;; the ARGS-TYPE slices of the FUN-TYPEs. (ARGS-TYPE + ;; is a base class both of VALUES-TYPE and of FUN-TYPE.) (values-types-equal-or-intersect - (function-type-returns defined-ftype) - (function-type-returns declared-ftype)))))) + (fun-type-returns defined-ftype) + (fun-type-returns declared-ftype)))))) ;;; This messy case of CTYPE for NUMBER is shared between the ;;; cross-compiler and the target system. @@ -2185,6 +2188,15 @@ :low low :high high)))) -(!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")