projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Tweak alternative layout rule
[ghc-hetmet.git]
/
compiler
/
coreSyn
/
CoreUnfold.lhs
diff --git
a/compiler/coreSyn/CoreUnfold.lhs
b/compiler/coreSyn/CoreUnfold.lhs
index
f83521c
..
fd76f23
100644
(file)
--- a/
compiler/coreSyn/CoreUnfold.lhs
+++ b/
compiler/coreSyn/CoreUnfold.lhs
@@
-319,9
+319,13
@@
sizeExpr bOMB_OUT_SIZE top_args expr
_ -> funSize top_args fun (length val_args)
------------
_ -> funSize top_args fun (length val_args)
------------
- size_up_alt (_con, _bndrs, rhs) = size_up rhs
+ size_up_alt (_con, _bndrs, rhs) = size_up rhs `addSizeN` 1
-- Don't charge for args, so that wrappers look cheap
-- (See comments about wrappers with Case)
-- Don't charge for args, so that wrappers look cheap
-- (See comments about wrappers with Case)
+ --
+ -- IMPORATANT: *do* charge 1 for the alternative, else we
+ -- find that giant case nests are treated as practically free
+ -- A good example is Foreign.C.Error.errrnoToIOError
------------
-- These addSize things have to be here because
------------
-- These addSize things have to be here because
@@
-629,10
+633,7
@@
instance Outputable CallCtxt where
ppr ValAppCtxt = ptext (sLit "ValAppCtxt")
callSiteInline dflags active_inline id lone_variable arg_infos cont_info
ppr ValAppCtxt = ptext (sLit "ValAppCtxt")
callSiteInline dflags active_inline id lone_variable arg_infos cont_info
- = let
- n_val_args = length arg_infos
- in
- case idUnfolding id of {
+ = case idUnfolding id of {
NoUnfolding -> Nothing ;
OtherCon _ -> Nothing ;
DFunUnfolding {} -> Nothing ; -- Never unfold a DFun
NoUnfolding -> Nothing ;
OtherCon _ -> Nothing ;
DFunUnfolding {} -> Nothing ; -- Never unfold a DFun
@@
-641,6
+642,8
@@
callSiteInline dflags active_inline id lone_variable arg_infos cont_info
-- uf_arity will typically be equal to (idArity id),
-- but may be less for InlineRules
let
-- uf_arity will typically be equal to (idArity id),
-- but may be less for InlineRules
let
+ n_val_args = length arg_infos
+
result | yes_or_no = Just unf_template
| otherwise = Nothing
result | yes_or_no = Just unf_template
| otherwise = Nothing
@@
-1128,7
+1131,9
@@
exprIsConApp_maybe expr
analyse rhs args
where
is_saturated = count isValArg args == idArity fun
analyse rhs args
where
is_saturated = count isValArg args == idArity fun
- unfolding = idUnfolding fun
+ unfolding = idUnfolding fun -- Does not look through loop breakers
+ -- ToDo: we *may* look through variables that are NOINLINE
+ -- in this phase, and that is really not right
analyse _ _ = Nothing
analyse _ _ = Nothing