idNewDemandInfo, setIdInfo,
setIdOccInfo, zapLamIdInfo, setOneShotLambda
)
-import IdInfo ( OccInfo(..), isLoopBreaker,
- setArityInfo, zapDemandInfo,
- setUnfoldingInfo,
- occInfo
+import IdInfo ( OccInfo(..), setArityInfo, zapDemandInfo,
+ setUnfoldingInfo, occInfo
)
import NewDemand ( isStrictDmd )
import TcGadt ( dataConCanMatch )
import TysPrim ( realWorldStatePrimTy )
import PrelInfo ( realWorldPrimId )
import BasicTypes ( TopLevelFlag(..), isTopLevel,
- RecFlag(..), isNonRec
+ RecFlag(..), isNonRec, isNonRuleLoopBreaker
)
import OrdList
import List ( nub )
| otherwise
= -- Make the arguments atomic if necessary,
-- adding suitable bindings
- -- pprTrace "completeNonRecX" (ppr new_bndr <+> ppr new_rhs) $
mkAtomicArgsE env is_strict new_rhs $ \ env new_rhs ->
completeLazyBind env NotTopLevel
old_bndr new_bndr new_rhs `thenSmpl` \ (floats, env) ->
| otherwise
= let
- -- Add arity info
+ -- Arity info
new_bndr_info = idInfo new_bndr `setArityInfo` exprArity new_rhs
+ -- Unfolding info
-- Add the unfolding *only* for non-loop-breakers
-- Making loop breakers not have an unfolding at all
-- means that we can avoid tests in exprIsConApp, for example.
-- This is important: if exprIsConApp says 'yes' for a recursive
-- thing, then we can get into an infinite loop
+
+ -- Demand info
-- If the unfolding is a value, the demand info may
-- go pear-shaped, so we nuke it. Example:
-- let x = (a,b) in
returnSmpl (unitFloat env final_id new_rhs, env)
where
unfolding = mkUnfolding (isTopLevel top_lvl) new_rhs
- loop_breaker = isLoopBreaker occ_info
+ loop_breaker = isNonRuleLoopBreaker occ_info
old_info = idInfo old_bndr
occ_info = occInfo old_info
\end{code}
= case substId env var of
DoneEx e -> simplExprF (zapSubstEnv env) e cont
ContEx tvs ids e -> simplExprF (setSubstEnv env tvs ids) e cont
- DoneId var1 occ -> completeCall (zapSubstEnv env) var1 occ cont
+ DoneId var1 -> completeCall (zapSubstEnv env) var1 cont
-- Note [zapSubstEnv]
-- The template is already simplified, so don't re-substitute.
-- This is VITAL. Consider
---------------------------------------------------------
-- Dealing with a call site
-completeCall env var occ_info cont
+completeCall env var cont
= -- Simplify the arguments
getDOptsSmpl `thenSmpl` \ dflags ->
let
interesting_cont = interestingCallContext (notNull args)
(notNull arg_infos)
call_cont
- active_inline = activeInline env var occ_info
- maybe_inline = callSiteInline dflags active_inline occ_info
+ active_inline = activeInline env var
+ maybe_inline = callSiteInline dflags active_inline
var arg_infos interesting_cont
in
case maybe_inline of {