Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/81594da51d0204ee99e8dd9fbb95e48ab5d6d212 >--------------------------------------------------------------- commit 81594da51d0204ee99e8dd9fbb95e48ab5d6d212 Author: Simon Peyton Jones <[email protected]> Date: Mon Oct 15 11:06:24 2012 +0100 Use isCheapApp in exprIsWorkFree exprIsWorkFree was returning False for constructor applications like (Just x). Horror! Now we delegate to isCheapApp, which does the right thing. I found this (by accident) when seeing why the simplifier was taking more iterations than I expected. So not only should we generate better code as a result, but perhaps with fewer simplifier iterations. General happiness. >--------------------------------------------------------------- compiler/coreSyn/CoreUtils.lhs | 40 +++++++++++++++++++++++++++++----------- 1 files changed, 29 insertions(+), 11 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index cad8012..33c7a9d 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -675,7 +675,7 @@ exprIsWorkFree e = go 0 e [ go n rhs | (_,_,rhs) <- alts ] -- See Note [Case expressions are work-free] go _ (Let {}) = False - go n (Var v) = n==0 || n < idArity v + go n (Var v) = isCheapApp v n go n (Tick t e) | tickishCounts t = False | otherwise = go n e go n (Lam x e) | isRuntimeVar x = n==0 || go (n-1) e @@ -740,7 +740,6 @@ exprIsCheap = exprIsCheap' isCheapApp exprIsExpandable :: CoreExpr -> Bool exprIsExpandable = exprIsCheap' isExpandableApp -- See Note [CONLIKE pragma] in BasicTypes -type CheapAppFun = Id -> Int -> Bool exprIsCheap' :: CheapAppFun -> CoreExpr -> Bool exprIsCheap' _ (Lit _) = True exprIsCheap' _ (Type _) = True @@ -779,16 +778,26 @@ exprIsCheap' good_app other_expr -- Applications and variables go (App f a) val_args | isRuntimeArg a = go f (a:val_args) | otherwise = go f val_args - go (Var _) [] = True -- Just a type application of a variable - -- (f t1 t2 t3) counts as WHNF + go (Var _) [] = True + -- Just a type application of a variable + -- (f t1 t2 t3) counts as WHNF + -- This case is probably handeld by the good_app case + -- below, which should have a case for n=0, but putting + -- it here too is belt and braces; and it's such a common + -- case that checking for null directly seems like a + -- good plan + go (Var f) args + | good_app f (length args) + = go_pap args + + | otherwise = case idDetails f of - RecSelId {} -> go_sel args - ClassOpId {} -> go_sel args - PrimOpId op -> go_primop op args - _ | good_app f (length args) -> go_pap args - | isBottomingId f -> True - | otherwise -> False + RecSelId {} -> go_sel args + ClassOpId {} -> go_sel args + PrimOpId op -> go_primop op args + _ | isBottomingId f -> True + | otherwise -> False -- Application of a function which -- always gives bottom; we treat this as cheap -- because it certainly doesn't need to be shared! @@ -820,9 +829,17 @@ exprIsCheap' good_app other_expr -- Applications and variables -- BUT: Take care with (sel d x)! The (sel d) might be cheap, but -- there's no guarantee that (sel d x) will be too. Hence (n_val_args == 1) +------------------------------------- +type CheapAppFun = Id -> Int -> Bool + -- Is an application of this function to n *value* args + -- always cheap, assuming the arguments are cheap? + -- Mainly true of partial applications, data constructors, + -- and of course true if the number of args is zero + isCheapApp :: CheapAppFun isCheapApp fn n_val_args - = isDataConWorkId fn + = isDataConWorkId fn + || n_val_args == 0 || n_val_args < idArity fn isExpandableApp :: CheapAppFun @@ -833,6 +850,7 @@ isExpandableApp fn n_val_args where -- See if all the arguments are PredTys (implicit params or classes) -- If so we'll regard it as expandable; see Note [Expandable overloadings] + -- This incidentally picks up the (n_val_args = 0) case go 0 _ = True go n_val_args ty | Just (_, ty) <- splitForAllTy_maybe ty = go n_val_args ty _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
