projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Improve the handling of default methods
[ghc-hetmet.git]
/
compiler
/
coreSyn
/
CoreUnfold.lhs
diff --git
a/compiler/coreSyn/CoreUnfold.lhs
b/compiler/coreSyn/CoreUnfold.lhs
index
fc31d5a
..
7d04154
100644
(file)
--- a/
compiler/coreSyn/CoreUnfold.lhs
+++ b/
compiler/coreSyn/CoreUnfold.lhs
@@
-43,6
+43,7
@@
import PprCore () -- Instances
import OccurAnal
import CoreSubst hiding( substTy )
import CoreFVs ( exprFreeVars )
import OccurAnal
import CoreSubst hiding( substTy )
import CoreFVs ( exprFreeVars )
+import CoreArity ( manifestArity )
import CoreUtils
import Id
import DataCon
import CoreUtils
import Id
import DataCon
@@
-140,13
+141,17
@@
mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolde
expr 0 -- Arity of unfolding doesn't matter
(UnfWhen unSaturatedOk boringCxtOk)
expr 0 -- Arity of unfolding doesn't matter
(UnfWhen unSaturatedOk boringCxtOk)
-mkInlineRule :: Bool -> CoreExpr -> Arity -> Unfolding
-mkInlineRule unsat_ok expr arity
+mkInlineRule :: CoreExpr -> Maybe Arity -> Unfolding
+mkInlineRule expr mb_arity
= mkCoreUnfolding True InlineRule -- Note [Top-level flag on inline rules]
expr' arity
(UnfWhen unsat_ok boring_ok)
where
expr' = simpleOptExpr expr
= mkCoreUnfolding True InlineRule -- Note [Top-level flag on inline rules]
expr' arity
(UnfWhen unsat_ok boring_ok)
where
expr' = simpleOptExpr expr
+ (unsat_ok, arity) = case mb_arity of
+ Nothing -> (unSaturatedOk, manifestArity expr')
+ Just ar -> (needSaturated, ar)
+
boring_ok = case calcUnfoldingGuidance True -- Treat as cheap
False -- But not bottoming
(arity+1) expr' of
boring_ok = case calcUnfoldingGuidance True -- Treat as cheap
False -- But not bottoming
(arity+1) expr' of
@@
-184,7
+189,6
@@
calcUnfoldingGuidance expr_is_cheap top_bot bOMB_OUT_SIZE expr
| uncondInline n_val_bndrs (iBox size)
, expr_is_cheap
-> UnfWhen unSaturatedOk boringCxtOk -- Note [INLINE for small functions]
| uncondInline n_val_bndrs (iBox size)
, expr_is_cheap
-> UnfWhen unSaturatedOk boringCxtOk -- Note [INLINE for small functions]
-
| top_bot -- See Note [Do not inline top-level bottoming functions]
-> UnfNever
| top_bot -- See Note [Do not inline top-level bottoming functions]
-> UnfNever
@@
-626,9
+630,11
@@
actual arguments.
\begin{code}
couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
couldBeSmallEnoughToInline threshold rhs
\begin{code}
couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
couldBeSmallEnoughToInline threshold rhs
- = case calcUnfoldingGuidance False False threshold rhs of
- (_, UnfNever) -> False
- _ -> True
+ = case sizeExpr (iUnbox threshold) [] body of
+ TooBig -> False
+ _ -> True
+ where
+ (_, body) = collectBinders rhs
----------------
smallEnoughToInline :: Unfolding -> Bool
----------------
smallEnoughToInline :: Unfolding -> Bool