projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Follow GHC.Bool/GHC.Types merge
[ghc-hetmet.git]
/
compiler
/
stranal
/
WorkWrap.lhs
diff --git
a/compiler/stranal/WorkWrap.lhs
b/compiler/stranal/WorkWrap.lhs
index
33ca298
..
d329b5a
100644
(file)
--- a/
compiler/stranal/WorkWrap.lhs
+++ b/
compiler/stranal/WorkWrap.lhs
@@
-7,23
+7,16
@@
module WorkWrap ( wwTopBinds, mkWrapper ) where
import CoreSyn
module WorkWrap ( wwTopBinds, mkWrapper ) where
import CoreSyn
-import CoreUnfold ( certainlyWillInline, mkInlineRule, mkWwInlineRule )
+import CoreUnfold ( certainlyWillInline, mkInlineUnfolding, mkWwInlineRule )
import CoreUtils ( exprType, exprIsHNF )
import CoreArity ( exprArity )
import Var
import CoreUtils ( exprType, exprIsHNF )
import CoreArity ( exprArity )
import Var
-import Id ( idType, isOneShotLambda, idUnfolding,
- setIdStrictness, mkWorkerId, setInlinePragma,
- setInlineActivation, setIdUnfolding,
- setIdArity )
+import Id
import Type ( Type )
import IdInfo
import Type ( Type )
import IdInfo
-import Demand ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..),
- Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
- )
+import Demand
import UniqSupply
import UniqSupply
-import BasicTypes ( RecFlag(..), isNonRec, isNeverActive,
- Activation(..), InlinePragma(..),
- inlinePragmaActivation, inlinePragmaRuleMatchInfo )
+import BasicTypes
import VarEnv ( isEmptyVarEnv )
import Maybes ( orElse )
import WwLib
import VarEnv ( isEmptyVarEnv )
import Maybes ( orElse )
import WwLib
@@
-229,6
+222,7
@@
tryWW is_rec fn_id rhs
= return [ (fn_id, rhs) ]
| is_thunk && worthSplittingThunk maybe_fn_dmd res_info
= return [ (fn_id, rhs) ]
| is_thunk && worthSplittingThunk maybe_fn_dmd res_info
+ -- See Note [Thunk splitting]
= ASSERT2( isNonRec is_rec, ppr new_fn_id ) -- The thunk must be non-recursive
checkSize new_fn_id rhs $
splitThunk new_fn_id rhs
= ASSERT2( isNonRec is_rec, ppr new_fn_id ) -- The thunk must be non-recursive
checkSize new_fn_id rhs $
splitThunk new_fn_id rhs
@@
-277,8
+271,8
@@
checkSize fn_id rhs thing_inside
| otherwise = thing_inside
where
| otherwise = thing_inside
where
- unfolding = idUnfolding fn_id
- inline_rule = mkInlineRule unSaturatedOk rhs (unfoldingArity unfolding)
+ unfolding = idUnfolding fn_id
+ inline_rule = mkInlineUnfolding Nothing rhs
---------------------
splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Expr Var
---------------------
splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Expr Var
@@
-292,6
+286,12
@@
splitFun fn_id fn_info wrap_dmds res_info rhs
; let
work_rhs = work_fn rhs
work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
; let
work_rhs = work_fn rhs
work_id = mkWorkerId work_uniq fn_id (exprType work_rhs)
+ `setIdOccInfo` occInfo fn_info
+ -- Copy over occurrence info from parent
+ -- Notably whether it's a loop breaker
+ -- Doesn't matter much, since we will simplify next, but
+ -- seems right-er to do so
+
`setInlineActivation` (inlinePragmaActivation inl_prag)
-- Any inline activation (which sets when inlining is active)
-- on the original function is duplicated on the worker
`setInlineActivation` (inlinePragmaActivation inl_prag)
-- Any inline activation (which sets when inlining is active)
-- on the original function is duplicated on the worker
@@
-310,16
+310,20
@@
splitFun fn_id fn_info wrap_dmds res_info rhs
-- arity is consistent with the demand type goes through
wrap_rhs = wrap_fn work_id
-- arity is consistent with the demand type goes through
wrap_rhs = wrap_fn work_id
- wrap_prag = InlinePragma { inl_inline = True
+ wrap_prag = InlinePragma { inl_inline = Inline
+ , inl_sat = Nothing
, inl_act = ActiveAfter 0
, inl_rule = rule_match_info }
, inl_act = ActiveAfter 0
, inl_rule = rule_match_info }
+ -- See Note [Wrapper activation]
+ -- The RuleMatchInfo is (and must be) unaffected
+ -- The inl_inline is bound to be False, else we would not be
+ -- making a wrapper
wrap_id = fn_id `setIdUnfolding` mkWwInlineRule work_id wrap_rhs arity
`setInlinePragma` wrap_prag
wrap_id = fn_id `setIdUnfolding` mkWwInlineRule work_id wrap_rhs arity
`setInlinePragma` wrap_prag
- -- See Note [Wrapper activation]
- -- The RuleMatchInfo is (and must be) unaffected
- -- The inl_inline is bound to be False, else we would not be
- -- making a wrapper
+ `setIdOccInfo` NoOccInfo
+ -- Zap any loop-breaker-ness, to avoid bleating from Lint
+ -- about a loop breaker with an INLINE rule
; return ([(work_id, work_rhs), (wrap_id, wrap_rhs)]) })
-- Worker first, because wrapper mentions it
; return ([(work_id, work_rhs), (wrap_id, wrap_rhs)]) })
-- Worker first, because wrapper mentions it
@@
-349,8
+353,8
@@
get_one_shots (Note _ e) = get_one_shots e
get_one_shots _ = noOneShotInfo
\end{code}
get_one_shots _ = noOneShotInfo
\end{code}
-Thunk splitting
-~~~~~~~~~~~~~~~
+Note [Thunk splitting]
+~~~~~~~~~~~~~~~~~~~~~~
Suppose x is used strictly (never mind whether it has the CPR
property).
Suppose x is used strictly (never mind whether it has the CPR
property).
@@
-384,6
+388,7
@@
function, so that if x's demand is deeper (say U(U(L,L),L))
then the splitting will go deeper too.
\begin{code}
then the splitting will go deeper too.
\begin{code}
+-- See Note [Thunk splitting]
-- splitThunk converts the *non-recursive* binding
-- x = e
-- into
-- splitThunk converts the *non-recursive* binding
-- x = e
-- into