From dd78ace069633407de8be3655b29b7a38f478916 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Sat, 19 Mar 2016 15:39:51 -0400 Subject: [PATCH] Look into array-types in CONTAINS-UNKNOWN-TYPE-P. Also avoid handler-bind of PARSE-UNKNOWN-TYPE in some places. VALUE-SPECIFIER-TYPE never caches types that contain any unknown, and always returns an indicator of whether its argument was cached. Therefore, if it wasn't cached, it probably contains an unknown. --- package-data-list.lisp-expr | 1 + src/code/array.lisp | 11 +++++------ src/code/early-type.lisp | 12 ++++++++++++ src/code/late-type.lisp | 10 +++++++++- src/code/target-type.lisp | 7 ++++--- src/compiler/generic/vm-type.lisp | 22 +++++++++------------- 6 files changed, 40 insertions(+), 23 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index e3fe29fa6..5339e3f90 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1908,6 +1908,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "TYPE-SINGLETON-P" "TYPE-SINGLE-VALUE-P" "TYPE-SPECIFIER" "TYPE-UNION" "TYPE/=" "TYPE=" "TYPES-EQUAL-OR-INTERSECT" + "TYPE-OR-NIL-IF-UNKNOWN" "UNBOUND-SYMBOL-ERROR" "UNBOXED-ARRAY" "UNDEFINED-FUN-ERROR" "UNDEFINED-ALIEN-FUN-ERROR" "UNION-TYPE" "UNION-TYPE-P" diff --git a/src/code/array.lisp b/src/code/array.lisp index 3ac39642f..819bb301c 100644 --- a/src/code/array.lisp +++ b/src/code/array.lisp @@ -274,12 +274,11 @@ (result sb!vm:simple-array-nil-widetag)) (t (block nil - (let ((ctype - (handler-case (specifier-type type) - (parse-unknown-type () - (return (result sb!vm:simple-vector-widetag)))))) + (let ((ctype (type-or-nil-if-unknown type))) + (unless ctype + (return (result sb!vm:simple-vector-widetag))) (typecase ctype - (union-type ; FIXME: forward ref + (union-type (let ((types (union-type-types ctype))) (cond ((not (every #'numeric-type-p types)) (result sb!vm:simple-vector-widetag)) @@ -296,7 +295,7 @@ (result sb!vm:simple-array-long-float-widetag)) (t (result sb!vm:simple-vector-widetag))))) - (character-set-type ; FIXME: forward ref + (character-set-type #!-sb-unicode (result sb!vm:simple-base-string-widetag) #!+sb-unicode (if (loop for (start . end) diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 1ad5e94f7..dfd1806b7 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -875,6 +875,18 @@ (dx-let ((context (cons type-specifier t))) (specifier-type-r context type-specifier))) +;;; Parse TYPE-SPECIFIER, returning NIL if any sub-part of it is unknown +(defun type-or-nil-if-unknown (type-specifier &optional allow-values) + (dx-let ((context (cons type-specifier t))) + (let ((result (values-specifier-type-r context type-specifier))) + (when (and (not allow-values) (values-type-p result)) + (error "VALUES type illegal in this context:~% ~S" type-specifier)) + ;; If it was non-cacheable, either it contained a deprecated type + ;; or unknown type, or was a pending defstruct definition. + (if (and (not (cdr context)) (contains-unknown-type-p result)) + nil + result)))) + (defun single-value-specifier-type-r (context x) (if (eq x '*) *universal-type* (specifier-type-r context x))) (defun single-value-specifier-type (x) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 0006b3a83..80b415e2f 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -64,7 +64,15 @@ (negation-type (contains-unknown-type-p (negation-type-type ctype))) (cons-type (or (contains-unknown-type-p (cons-type-car-type ctype)) (contains-unknown-type-p (cons-type-cdr-type ctype)))) - (array-type (contains-unknown-type-p (array-type-element-type ctype))))) + (array-type (contains-unknown-type-p (array-type-element-type ctype))) + (args-type + (or (some #'contains-unknown-type-p (args-type-required ctype)) + (some #'contains-unknown-type-p (args-type-optional ctype)) + (acond ((args-type-rest ctype) (contains-unknown-type-p it))) + (some (lambda (x) (contains-unknown-type-p (key-info-type x))) + (args-type-keywords ctype)) + (and (fun-type-p ctype) + (contains-unknown-type-p (fun-type-returns ctype))))))) ;; Similar to (NOT CONTAINS-UNKNOWN-TYPE-P), but report that (SATISFIES F) ;; is not a testable type unless F is currently bound. diff --git a/src/code/target-type.lisp b/src/code/target-type.lisp index a0d3e91a5..664c221c8 100644 --- a/src/code/target-type.lisp +++ b/src/code/target-type.lisp @@ -252,6 +252,7 @@ Examples: Experimental." (declare (ignore env)) - (handler-case (prog1 t (values-specifier-type type-specifier)) - (parse-unknown-type () nil) - (error () nil))) + ;; We don't even care if the spec is parseable - + ;; just deem it invalid. + (not (null (ignore-errors + (type-or-nil-if-unknown type-specifier t))))) diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp index 78e701582..46b96afaa 100644 --- a/src/compiler/generic/vm-type.lisp +++ b/src/compiler/generic/vm-type.lisp @@ -131,17 +131,13 @@ with the specifier :ELEMENT-TYPE Spec." (declare (type lexenv-designator environment) (ignore environment)) (declare (explicit-check)) - (handler-case - ;; Can't rely on SPECIFIER-TYPE to signal PARSE-UNKNOWN-TYPE in - ;; the case of (AND KNOWN UNKNOWN), since the result of the - ;; outter call to SPECIFIER-TYPE can be cached by the code that - ;; doesn't catch PARSE-UNKNOWN-TYPE signal. - (let ((type (specifier-type spec))) - (if (contains-unknown-type-p type) - (error "Undefined type: ~S" spec) - (type-specifier (%upgraded-array-element-type type)))) - (parse-unknown-type (c) - (error "Undefined type: ~S" (parse-unknown-type-specifier c))))) + (let ((type (type-or-nil-if-unknown spec))) + (cond ((not type) + ;; What about a FUNCTION-TYPE - would (FUNCTION (UNKNOWN) UNKNOWN) + ;; upgrade to T? Well, it's still ok to say it's an error. + (error "Undefined type: ~S" spec)) + (t + (type-specifier (%upgraded-array-element-type type)))))) (defun sb!xc:upgraded-complex-part-type (spec &optional environment) #!+sb-doc @@ -149,10 +145,10 @@ can hold parts of type SPEC." (declare (type lexenv-designator environment) (ignore environment)) (declare (explicit-check)) - (let ((type (specifier-type spec))) + (let ((type (type-or-nil-if-unknown spec))) (cond ((eq type *empty-type*) nil) - ((unknown-type-p type) (error "undefined type: ~S" spec)) + ((not type) (error "Undefined type: ~S" spec)) (t (let ((ctype (specifier-type `(complex ,spec)))) (cond -- 2.11.4.GIT