(+ (function-cost found) (function-cost 'eq))
nil))))
(typecase type
- (union-type
- (collect ((res 0 +))
- (dolist (mem (union-type-types type))
- (res (type-test-cost mem)))
- (res)))
+ (compound-type
+ (reduce #'+ (compound-type-types type) :key 'type-test-cost))
(member-type
(* (length (member-type-members type))
(function-cost 'eq)))
(cond ((policy (continuation-dest cont)
(and (<= speed safety)
(<= space safety)
- (<= cspeed safety)))
+ (<= compilation-speed safety)))
type)
(t
(let ((min-cost (type-test-cost type))
(declare (type ctype type))
(multiple-value-bind (res count) (values-types type)
(values (mapcar #'(lambda (type)
- (if (function-type-p type)
+ (if (fun-type-p type)
(specifier-type 'function)
type))
res)
;;; the proven type and the corresponding type in TYPES. If so, we opt
;;; for a :HAIRY check with that test negated. Otherwise, we try to do
;;; a simple test, and if that is impossible, we do a hairy test with
-;;; non-negated types. If true, Force-Hairy forces a hairy type check.
+;;; non-negated types. If true, FORCE-HAIRY forces a hairy type check.
;;;
;;; When doing a non-negated check, we call MAYBE-WEAKEN-CHECK to
;;; weaken the test to a convenient supertype (conditional on policy.)
(declare (type continuation cont))
(let ((type (continuation-asserted-type cont))
(dest (continuation-dest cont)))
- (assert (not (eq type *wild-type*)))
+ (aver (not (eq type *wild-type*)))
(multiple-value-bind (types count) (no-function-values-types type)
(cond ((not (eq count :unknown))
(if (or (exit-p dest)
(maybe-negate-check cont types nil)))
((and (mv-combination-p dest)
(eq (basic-combination-kind dest) :local))
- (assert (values-type-p type))
+ (aver (values-type-p type))
(maybe-negate-check cont (args-type-optional type) nil))
(t
(values :too-hairy nil))))))
;;; We must only return NIL when it is *certain* that a check will not
;;; be done, since if we pass up this chance to do the check, it will
;;; be too late. The penalty for being too conservative is duplicated
-;;; type checks.
+;;; type checks. The penalty for erring by being too speculative is
+;;; much nastier, e.g. falling through without ever being able to find
+;;; an appropriate VOP.
;;;
;;; If there is a compile-time type error, then we always return true
;;; unless the DEST is a full call. With a full call, the theory is
((function-info-ir2-convert kind) t)
(t
(dolist (template (function-info-templates kind) nil)
- (when (eq (template-policy template) :fast-safe)
+ (when (eq (template-ltn-policy template) :fast-safe)
(multiple-value-bind (val win)
(valid-function-use dest (template-type template))
(when (or val (not win)) (return t)))))))))
`(multiple-value-bind ,temps 'dummy
,@(mapcar #'(lambda (temp type)
(let* ((spec
- (let ((*unparse-function-type-simplify* t))
+ (let ((*unparse-fun-type-simplify* t))
(type-specifier (second type))))
(test (if (first type) `(not ,spec) spec)))
`(unless (typep ,temp ',test)
(ir1-convert new-start dummy (make-type-check-form types))
;; TO DO: Why should this be true? -- WHN 19990601
- (assert (eq (continuation-block dummy) new-block))
+ (aver (eq (continuation-block dummy) new-block))
;; KLUDGE: Comments at the head of this function in CMU CL
;; said that somewhere in here we
(let* ((node (continuation-use cont))
(args (basic-combination-args node))
(victim (first args)))
- (assert (and (= (length args) 1)
+ (aver (and (= (length args) 1)
(eq (constant-value
(ref-leaf
(continuation-use victim)))
(setf (basic-combination-kind dest) :error)))
(values))
-;;; Loop over all blocks in Component that have TYPE-CHECK set,
+;;; Loop over all blocks in COMPONENT that have TYPE-CHECK set,
;;; looking for continuations with TYPE-CHECK T. We do two mostly
;;; unrelated things: detect compile-time type errors and determine if
;;; and how to do run-time type checks.
(unless (member type-check '(nil :error :deleted))
(let ((atype (continuation-asserted-type cont)))
(do-uses (use cont)
- (unless (values-types-intersect (node-derived-type use)
- atype)
+ (unless (values-types-equal-or-intersect
+ (node-derived-type use) atype)
(mark-error-continuation cont)
- (unless (policy node (= brevity 3))
+ (unless (policy node (= inhibit-warnings 3))
(do-type-warning use))))))
- (when (and (eq type-check t)
- (not *byte-compiling*))
+ (when (eq type-check t)
(cond ((probable-type-check-p cont)
(conts cont))
(t
(:too-hairy
(let* ((context (continuation-dest cont))
(*compiler-error-context* context))
- (when (policy context (>= safety brevity))
+ (when (policy context (>= safety inhibit-warnings))
(compiler-note
"type assertion too complex to check:~% ~S."
(type-specifier (continuation-asserted-type cont)))))
projects / sbcl.git / blobdiff