Unfolding, UnfoldingGuidance, -- Abstract types
noUnfolding, mkImplicitUnfolding,
- mkTopUnfolding, mkUnfolding, mkCoreUnfolding,
- mkInlineRule, mkWwInlineRule,
+ mkUnfolding, mkCoreUnfolding,
+ mkTopUnfolding, mkSimpleUnfolding,
+ mkInlineUnfolding, mkInlinableUnfolding, mkWwInlineRule,
mkCompulsoryUnfolding, mkDFunUnfolding,
interestingArg, ArgSummary(..),
import DynFlags
import CoreSyn
import PprCore () -- Instances
+import TcType ( tcSplitSigmaTy, tcSplitDFunHead )
import OccurAnal
import CoreSubst hiding( substTy )
import CoreFVs ( exprFreeVars )
-import CoreArity ( manifestArity )
+import CoreArity ( manifestArity, exprBotStrictness_maybe )
import CoreUtils
import Id
import DataCon
import FastTypes
import FastString
import Outputable
-
+import Data.Maybe
\end{code}
\begin{code}
mkTopUnfolding :: Bool -> CoreExpr -> Unfolding
-mkTopUnfolding is_bottoming expr
- = mkUnfolding True {- Top level -} is_bottoming expr
+mkTopUnfolding = mkUnfolding InlineRhs True {- Top level -}
mkImplicitUnfolding :: CoreExpr -> Unfolding
-- For implicit Ids, do a tiny bit of optimising first
-- top-level flag to True. It gets set more accurately by the simplifier
-- Simplify.simplUnfolding.
-mkUnfolding :: Bool -> Bool -> CoreExpr -> Unfolding
-mkUnfolding top_lvl is_bottoming expr
- = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
- uf_src = InlineRhs,
- uf_arity = arity,
- uf_is_top = top_lvl,
- uf_is_value = exprIsHNF expr,
- uf_is_conlike = exprIsConLike expr,
- uf_expandable = exprIsExpandable expr,
- uf_is_cheap = is_cheap,
- uf_guidance = guidance }
- where
- is_cheap = exprIsCheap expr
- (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming)
- opt_UF_CreationThreshold expr
- -- Sometimes during simplification, there's a large let-bound thing
- -- which has been substituted, and so is now dead; so 'expr' contains
- -- two copies of the thing while the occurrence-analysed expression doesn't
- -- Nevertheless, we *don't* occ-analyse before computing the size because the
- -- size computation bales out after a while, whereas occurrence analysis does not.
- --
- -- This can occasionally mean that the guidance is very pessimistic;
- -- it gets fixed up next round. And it should be rare, because large
- -- let-bound things that are dead are usually caught by preInlineUnconditionally
+mkSimpleUnfolding :: CoreExpr -> Unfolding
+mkSimpleUnfolding = mkUnfolding InlineRhs False False
-mkCoreUnfolding :: Bool -> UnfoldingSource -> CoreExpr
- -> Arity -> UnfoldingGuidance -> Unfolding
--- Occurrence-analyses the expression before capturing it
-mkCoreUnfolding top_lvl src expr arity guidance
- = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
- uf_src = src,
- uf_arity = arity,
- uf_is_top = top_lvl,
- uf_is_value = exprIsHNF expr,
- uf_is_conlike = exprIsConLike expr,
- uf_is_cheap = exprIsCheap expr,
- uf_expandable = exprIsExpandable expr,
- uf_guidance = guidance }
-
-mkDFunUnfolding :: DataCon -> [Id] -> Unfolding
-mkDFunUnfolding con ops = DFunUnfolding con (map Var ops)
+mkDFunUnfolding :: Type -> [CoreExpr] -> Unfolding
+mkDFunUnfolding dfun_ty ops
+ = DFunUnfolding dfun_nargs data_con ops
+ where
+ (tvs, theta, head_ty) = tcSplitSigmaTy dfun_ty
+ -- NB: tcSplitSigmaTy: do not look through a newtype
+ -- when the dictionary type is a newtype
+ (cls, _) = tcSplitDFunHead head_ty
+ dfun_nargs = length tvs + length theta
+ data_con = classDataCon cls
mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding
mkWwInlineRule id expr arity
- = mkCoreUnfolding True (InlineWrapper id)
+ = mkCoreUnfolding (InlineWrapper id) True
(simpleOptExpr expr) arity
(UnfWhen unSaturatedOk boringCxtNotOk)
mkCompulsoryUnfolding :: CoreExpr -> Unfolding
mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
- = mkCoreUnfolding True InlineCompulsory
+ = mkCoreUnfolding InlineCompulsory True
expr 0 -- Arity of unfolding doesn't matter
(UnfWhen unSaturatedOk boringCxtOk)
-mkInlineRule :: CoreExpr -> Maybe Arity -> Unfolding
-mkInlineRule expr mb_arity
- = mkCoreUnfolding True InlineRule -- Note [Top-level flag on inline rules]
- expr' arity
+mkInlineUnfolding :: Maybe Arity -> CoreExpr -> Unfolding
+mkInlineUnfolding mb_arity expr
+ = mkCoreUnfolding InlineStable
+ True -- Note [Top-level flag on inline rules]
+ expr' arity
(UnfWhen unsat_ok boring_ok)
where
expr' = simpleOptExpr expr
(_, UnfWhen _ boring_ok) -> boring_ok
_other -> boringCxtNotOk
-- See Note [INLINE for small functions]
+
+mkInlinableUnfolding :: CoreExpr -> Unfolding
+mkInlinableUnfolding expr
+ = mkUnfolding InlineStable True is_bot expr'
+ where
+ expr' = simpleOptExpr expr
+ is_bot = isJust (exprBotStrictness_maybe expr')
\end{code}
+Internal functions
+
+\begin{code}
+mkCoreUnfolding :: UnfoldingSource -> Bool -> CoreExpr
+ -> Arity -> UnfoldingGuidance -> Unfolding
+-- Occurrence-analyses the expression before capturing it
+mkCoreUnfolding src top_lvl expr arity guidance
+ = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
+ uf_src = src,
+ uf_arity = arity,
+ uf_is_top = top_lvl,
+ uf_is_value = exprIsHNF expr,
+ uf_is_conlike = exprIsConLike expr,
+ uf_is_cheap = exprIsCheap expr,
+ uf_expandable = exprIsExpandable expr,
+ uf_guidance = guidance }
+
+mkUnfolding :: UnfoldingSource -> Bool -> Bool -> CoreExpr -> Unfolding
+-- Calculates unfolding guidance
+-- Occurrence-analyses the expression before capturing it
+mkUnfolding src top_lvl is_bottoming expr
+ = CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
+ uf_src = src,
+ uf_arity = arity,
+ uf_is_top = top_lvl,
+ uf_is_value = exprIsHNF expr,
+ uf_is_conlike = exprIsConLike expr,
+ uf_expandable = exprIsExpandable expr,
+ uf_is_cheap = is_cheap,
+ uf_guidance = guidance }
+ where
+ is_cheap = exprIsCheap expr
+ (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming)
+ opt_UF_CreationThreshold expr
+ -- Sometimes during simplification, there's a large let-bound thing
+ -- which has been substituted, and so is now dead; so 'expr' contains
+ -- two copies of the thing while the occurrence-analysed expression doesn't
+ -- Nevertheless, we *don't* occ-analyse before computing the size because the
+ -- size computation bales out after a while, whereas occurrence analysis does not.
+ --
+ -- This can occasionally mean that the guidance is very pessimistic;
+ -- it gets fixed up next round. And it should be rare, because large
+ -- let-bound things that are dead are usually caught by preInlineUnconditionally
+\end{code}
%************************************************************************
%* *
{- Arity: 3, HasNoCafRefs, Strictness: SLL,
Unfolding: (\ @ a $dOrd :: GHC.Classes.Ord a x :: a y :: a ->
case @ a GHC.Classes.<= @ a $dOrd x y of wild {
- GHC.Bool.False -> y GHC.Bool.True -> x }) -}
+ GHC.Types.False -> y GHC.Types.True -> x }) -}
We *really* want to inline $dmmin, even though it has arity 3, in
order to unravel the recursion.
go (Note _ a) n = go a n
go (Cast e _) n = go e n
go (Lam v e) n
- | isTyVar v = go e n
+ | isTyCoVar v = go e n
| n>0 = go e (n-1)
| otherwise = ValueArg
go (Let _ e) n = case go e n of { ValueArg -> ValueArg; _ -> NonTrivArg }
-- where t1..tk are the *universally-qantified* type args of 'dc'
exprIsConApp_maybe :: IdUnfoldingFun -> CoreExpr -> Maybe (DataCon, [Type], [CoreExpr])
-exprIsConApp_maybe id_unf (Note _ expr)
+exprIsConApp_maybe id_unf (Note note expr)
+ | notSccNote note
= exprIsConApp_maybe id_unf expr
- -- We ignore all notes. For example,
+ -- We ignore all notes except SCCs. For example,
-- case _scc_ "foo" (C a b) of
-- C a b -> e
- -- should be optimised away, but it will be only if we look
- -- through the SCC note.
+ -- should not be optimised away, because we'll lose the
+ -- entry count on 'foo'; see Trac #4414
exprIsConApp_maybe id_unf (Cast expr co)
= -- Here we do the KPush reduction rule as described in the FC paper
analyse (Var fun) args
| Just con <- isDataConWorkId_maybe fun
- , is_saturated
+ , count isValArg args == idArity fun
, let (univ_ty_args, rest_args) = splitAtList (dataConUnivTyVars con) args
= Just (con, stripTypeArgs univ_ty_args, rest_args)
-- Look through dictionary functions; see Note [Unfolding DFuns]
- | DFunUnfolding con ops <- unfolding
- , is_saturated
+ | DFunUnfolding dfun_nargs con ops <- unfolding
+ , let sat = length args == dfun_nargs -- See Note [DFun arity check]
+ in if sat then True else
+ pprTrace "Unsaturated dfun" (ppr fun <+> int dfun_nargs $$ ppr args) False
, let (dfun_tvs, _cls, dfun_res_tys) = tcSplitDFunTy (idType fun)
subst = zipOpenTvSubst dfun_tvs (stripTypeArgs (takeList dfun_tvs args))
= Just (con, substTys subst dfun_res_tys,
= -- pprTrace "expanding" (ppr fun $$ ppr rhs) $
analyse rhs args
where
- is_saturated = count isValArg args == idArity fun
unfolding = id_unf fun
analyse _ _ = Nothing
= Nothing
beta fun pairs args
- = case analyse (substExpr (text "subst-expr-is-con-app") subst fun) args of
- Nothing -> -- pprTrace "Bale out! exprIsConApp_maybe" doc $
- Nothing
- Just ans -> -- pprTrace "Woo-hoo! exprIsConApp_maybe" doc $
- Just ans
+ = analyse (substExpr (text "subst-expr-is-con-app") subst fun) args
where
subst = mkOpenSubst (mkInScopeSet (exprFreeVars fun)) pairs
-- doc = vcat [ppr fun, ppr expr, ppr pairs, ppr args]
to the very same args as the dfun. It takes a little more work
to compute the type arguments to the dictionary constructor.
+Note [DFun arity check]
+~~~~~~~~~~~~~~~~~~~~~~~
+Here we check that the total number of supplied arguments (inclding
+type args) matches what the dfun is expecting. This may be *less*
+than the ordinary arity of the dfun: see Note [DFun unfoldings] in CoreSyn
projects / ghc-hetmet.git / blobdiff