Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/344562443cc0165c171c1bb28fb810f0513cd824 >--------------------------------------------------------------- commit 344562443cc0165c171c1bb28fb810f0513cd824 Author: [email protected] <unknown> Date: Mon Feb 14 11:15:12 2011 +0000 Fix exprIsDupable It turns out that exprIsDupable would return True for an expression of *arbitrary* size, provide it was a nested bunch of applications in which no function had more than three arguments. That was never the intention, and could give rise to massive code duplication. This patch makes it much less aggressive. >--------------------------------------------------------------- compiler/coreSyn/CoreUtils.lhs | 28 +++++++++++++++------------- 1 files changed, 15 insertions(+), 13 deletions(-) diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 2eedd33..c50251d 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -465,22 +465,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} %************************************************************************ _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
