X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcheckgen.lisp;h=8d04f9405a4bacb9cf0b2f2788e1e2f28e172774;hb=287475f107626c6c8993b955daa9b19b292e69fd;hp=2f9f9072a53a5f619f37b2a403b3485bd0dd9aeb;hpb=61c18727668ff0c3263a3d363e609d4522d545cc;p=sbcl.git diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 2f9f907..8d04f94 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -332,26 +332,30 @@ nil) ((basic-combination-p dest) (let ((kind (basic-combination-kind dest))) - (cond ((eq cont (basic-combination-fun dest)) t) - ((eq kind :local) t) - ((eq kind :full) - (and (combination-p dest) - (not (values-subtypep ; explicit THE - (continuation-externally-checkable-type cont) - (continuation-type-to-check cont))))) - - ((eq kind :error) nil) - ;; :ERROR means that we have an invalid syntax of - ;; the call and the callee will detect it before - ;; thinking about types. - - ((fun-info-ir2-convert kind) t) - (t - (dolist (template (fun-info-templates kind) nil) - (when (eq (template-ltn-policy template) :fast-safe) - (multiple-value-bind (val win) - (valid-fun-use dest (template-type template)) - (when (or val (not win)) (return t))))))))) + (cond + ((eq cont (basic-combination-fun dest)) t) + (t + (ecase kind + (:local t) + (:full + (and (combination-p dest) + (not (values-subtypep ; explicit THE + (continuation-externally-checkable-type cont) + (continuation-type-to-check cont))))) + ;; :ERROR means that we have an invalid syntax of + ;; the call and the callee will detect it before + ;; thinking about types. + (:error nil) + (:known + (let ((info (basic-combination-fun-info dest))) + (if (fun-info-ir2-convert info) + t + (dolist (template (fun-info-templates info) nil) + (when (eq (template-ltn-policy template) + :fast-safe) + (multiple-value-bind (val win) + (valid-fun-use dest (template-type template)) + (when (or val (not win)) (return t))))))))))))) (t t)))) ;;; Return a lambda form that we can convert to do a hairy type check