From dfb1d6b0fb2f8cd3aba382dbd38105488be8d001 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 28 Dec 1990 16:49:09 +0000 Subject: [PATCH] Changed MAYBE-NEGATE-CHECK to allow weakened checks to be simple when debug-info is not important, so that we can use CHECK-STRUCTURE, etc. Changed TYPE-TEST-COST to penalize predicates as opposed to check templates so that we will use a check template in favor of a "same cost" predicate. --- compiler/checkgen.lisp | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/compiler/checkgen.lisp b/compiler/checkgen.lisp index fca90aec8..b006629fa 100644 --- a/compiler/checkgen.lisp +++ b/compiler/checkgen.lisp @@ -59,7 +59,7 @@ (template-cost check) (let ((found (cdr (assoc type *type-predicates* :test #'type=)))) (if found - (function-cost found) + (+ (function-cost found) (function-cost 'eq)) nil)))) (typecase type (union-type @@ -145,8 +145,11 @@ ;;; impossible, we do a hairy test with non-negated types. If true, ;;; Force-Hairy forces a hairy type check. ;;; -;;; When doing a non-negated hairy check, we call MAYBE-WEAKEN-CHECK to -;;; weaken the test to a convenient supertype (conditional on policy.) +;;; When doing a non-negated check, we call MAYBE-WEAKEN-CHECK to weaken the +;;; test to a convenient supertype (conditional on policy.) If debug-info is +;;; not particularly important (debug <= 1) or speed is 3, then we allow +;;; weakened checks to be simple, resulting in less informative error messages, +;;; but saving space and possibly time. ;;; (defun maybe-negate-check (cont types force-hairy) (declare (type continuation cont) (list types)) @@ -169,11 +172,18 @@ (list t diff c) (list nil weak c)))) ptypes types))) - (if (and (not (find-if #'first res)) - (every #'type-check-template types) - (not force-hairy)) - (values :simple types) - (values :hairy res)))))) + (cond ((or force-hairy (find-if #'first res)) + (values :hairy res)) + ((every #'type-check-template types) + (values :simple types)) + ((policy (continuation-dest cont) + (or (<= debug 1) (and (= speed 3) (/= debug 3)))) + (let ((weakened (mapcar #'second res))) + (if (every #'type-check-template weakened) + (values :simple weakened) + (values :hairy res)))) + (t + (values :hairy res))))))) ;;; CONTINUATION-CHECK-TYPES -- Interface -- GitLab