X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fltn.lisp;h=b38fa17b7ddaee3d65932e08220d4a9ff2df7585;hb=c47519c9e63fd32a635943a84ec13d8a60d95f08;hp=501aaf6ed08bad3442c4b7869976103a46dcdc5a;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp index 501aaf6..b38fa17 100644 --- a/src/compiler/ltn.lisp +++ b/src/compiler/ltn.lisp @@ -58,7 +58,7 @@ ((:safe :fast-safe) t) ((:small :fast) nil))) -;;; an annotated continuation's primitive-type +;;; an annotated lvar's primitive-type #!-sb-fluid (declaim (inline lvar-ptype)) (defun lvar-ptype (lvar) (declare (type lvar lvar)) @@ -401,7 +401,7 @@ ;;; T restriction allows any operand type. This is also called by IR2 ;;; translation when it determines whether a result temporary needs to ;;; be made, and by representation selection when it is deciding which -;;; move VOP to use. CONT and TN are used to test for constant +;;; move VOP to use. LVAR and TN are used to test for constant ;;; arguments. (defun operand-restriction-ok (restr type &key lvar tn (t-ok t)) (declare (type (or (member *) cons) restr) @@ -492,7 +492,7 @@ ;;; destination of the value is an immediately following IF node. ;;; -- If either the template is safe or the policy is unsafe (i.e. we ;;; can believe output assertions), then we test against the -;;; intersection of the node derived type and the continuation +;;; intersection of the node derived type and the lvar ;;; asserted type. Otherwise, we just use the node type. If ;;; TYPE-CHECK is null, there is no point in doing the intersection, ;;; since the node type must be a subtype of the assertion. @@ -676,6 +676,12 @@ (when (and (or (not guard) (funcall guard)) (or (not safe-p) (ltn-policy-safe-p (template-ltn-policy try))) + ;; :SAFE is also considered to be :SMALL-SAFE, + ;; while the template cost describes time cost; + ;; so the fact that (< (t-cost try) (t-cost + ;; template)) does not mean that TRY is better + (not (and (eq ltn-policy :safe) + (eq (template-ltn-policy try) :fast-safe))) (or verbose-p (and (template-note try) (valid-fun-use @@ -838,13 +844,6 @@ (ctran-next ctran)) (ctran (node-next node) (node-next node))) (nil) - (let* ((lvar (when (valued-node-p node) - (node-lvar node))) - (dest (and lvar (lvar-dest lvar)))) - (when (and (cast-p dest) - (not (cast-type-check dest)) - (immediately-used-p lvar node)) - (derive-node-type node (cast-asserted-type dest)))) (etypecase node (ref) (combination