X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreUtils.lhs;h=c901fc2ef044f01241898a3e87e2efcdc763c07e;hp=2eedd331314a2de3dcefedeebc2348006ea10e7e;hb=c406b5bde899dd2b28e5239937c909d675bca356;hpb=46ff3d8caded776ab471d3682258147e42be8f14 diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 2eedd33..c901fc2 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -69,7 +69,6 @@ import CostCentre import Unique import Outputable import TysPrim -import PrelNames( absentErrorIdKey ) import FastString import Maybes import Util @@ -465,22 +464,24 @@ Note [exprIsDupable] \begin{code} exprIsDupable :: CoreExpr -> Bool -exprIsDupable (Type _) = True -exprIsDupable (Var _) = True -exprIsDupable (Lit lit) = litIsDupable lit -exprIsDupable (Note _ e) = exprIsDupable e -exprIsDupable (Cast e _) = exprIsDupable e -exprIsDupable expr - = go expr 0 +exprIsDupable e + = isJust (go dupAppSize e) where - go (Var _) _ = True - go (App f a) n_args = n_args < dupAppSize - && exprIsDupable a - && go f (n_args+1) - go _ _ = False + go :: Int -> CoreExpr -> Maybe Int + go n (Type {}) = Just n + go n (Var {}) = decrement n + go n (Note _ e) = go n e + go n (Cast e _) = go n e + go n (App f a) | Just n' <- go n a = go n' f + go n (Lit lit) | litIsDupable lit = decrement n + go _ _ = Nothing + + decrement :: Int -> Maybe Int + decrement 0 = Nothing + decrement n = Just (n-1) dupAppSize :: Int -dupAppSize = 4 -- Size of application we are prepared to duplicate +dupAppSize = 6 -- Size of term we are prepared to duplicate \end{code} %************************************************************************ @@ -562,6 +563,7 @@ exprIsCheap' good_app other_expr -- Applications and variables = go other_expr [] where -- Accumulate value arguments, then decide + go (Cast e _) val_args = go e val_args go (App f a) val_args | isRuntimeArg a = go f (a:val_args) | otherwise = go f val_args @@ -697,10 +699,7 @@ exprOkForSpeculation (Case e _ _ alts) exprOkForSpeculation other_expr = case collectArgs other_expr of - (Var f, args) | f `hasKey` absentErrorIdKey -- Note [Absent error Id] - -> all exprOkForSpeculation args -- in WwLib - | otherwise - -> spec_ok (idDetails f) args + (Var f, args) -> spec_ok (idDetails f) args _ -> False where