BinderInfo(..),
FunOrArg, DuplicationDanger, InsideSCC, -- NB: all abstract (yay!)
- inlineUnconditionally, oneTextualOcc, oneSafeOcc,
+ inlineUnconditionally, okToInline,
- combineBinderInfo, combineAltsBinderInfo,
+ addBinderInfo, orBinderInfo, andBinderInfo,
- argOccurrence, funOccurrence,
+ argOccurrence, funOccurrence, dangerousArgOcc, noBinderInfo,
markMany, markDangerousToDup, markInsideSCC,
getBinderInfoArity,
setBinderInfoArityToZero,
isFun, isDupDanger -- for Simon Marlow deforestation
) where
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
+import CoreUnfold ( FormSummary(..) )
import Pretty
import Util ( panic )
\end{code}
| ManyOcc -- Everything else besides DeadCode and OneOccs
- Int -- number of arguments on stack when called
+ Int -- number of arguments on stack when called; this is a minimum guarantee
| OneOcc -- Just one occurrence (or one each in
-- time we *use* the info; we could be more clever for
-- other cases if we really had to. (WDP/PS)
- Int -- number of arguments on stack when called
+ Int -- number of arguments on stack when called; minimum guarantee
-- In general, we are feel free to substitute unless
-- (a) is in an argument position (ArgOcc)
data InsideSCC
= InsideSCC -- Inside an SCC; so be careful when substituting.
| NotInsideSCC -- It's ok.
+
+noBinderInfo = ManyOcc 0 -- A non-committal value
\end{code}
Predicates
~~~~~~~~~~
-@oneTextualOcc@ checks for one occurrence, in any position.
-The occurrence may be inside a lambda, that's all right.
-
\begin{code}
-oneTextualOcc :: Bool -> BinderInfo -> Bool
-
-oneTextualOcc ok_to_dup (OneOcc _ _ _ n_alts _) = n_alts <= 1 || ok_to_dup
-oneTextualOcc _ other = False
-\end{code}
-
-@safeSingleOcc@ detects single occurences of values that are safe to
-inline, {\em including} ones in an argument position.
-
-\begin{code}
-oneSafeOcc :: Bool -> BinderInfo -> Bool
-oneSafeOcc ok_to_dup (OneOcc _ NoDupDanger NotInsideSCC n_alts _)
- = n_alts <= 1 || ok_to_dup
-oneSafeOcc _ other = False
+okToInline
+ :: FormSummary -- What the thing to be inlined is like
+ -> BinderInfo -- How the thing to be inlined occurs
+ -> Bool -- True => it's small enough to inline
+ -> Bool -- True => yes, inline it
+
+-- Always inline bottoms
+okToInline BottomForm occ_info small_enough
+ = True -- Unless one of the type args is unboxed??
+ -- This used to be checked for, but I can't
+ -- see why so I've left it out.
+
+-- A WHNF can be inlined if it occurs once, or is small
+okToInline form occ_info small_enough
+ | is_whnf_form form
+ = small_enough || one_occ
+ where
+ one_occ = case occ_info of
+ OneOcc _ _ _ n_alts _ -> n_alts <= 1
+ other -> False
+
+ is_whnf_form VarForm = True
+ is_whnf_form ValueForm = True
+ is_whnf_form other = False
+
+-- A non-WHNF can be inlined if it doesn't occur inside a lambda,
+-- and occurs exactly once or
+-- occurs once in each branch of a case and is small
+okToInline OtherForm (OneOcc _ NoDupDanger _ n_alts _) small_enough
+ = n_alts <= 1 || small_enough
+
+okToInline form any_occ small_enough = False
\end{code}
@inlineUnconditionally@ decides whether a let-bound thing can
= OneOcc posn DupDanger in_scc n_alts ar
markDangerousToDup other = other
+dangerousArgOcc = OneOcc ArgOcc DupDanger NotInsideSCC 1 0
+
markInsideSCC (OneOcc posn dup_danger _ n_alts ar)
= OneOcc posn dup_danger InsideSCC n_alts ar
markInsideSCC other = other
-combineBinderInfo, combineAltsBinderInfo
+addBinderInfo, orBinderInfo
:: BinderInfo -> BinderInfo -> BinderInfo
-combineBinderInfo DeadCode info2 = info2
-combineBinderInfo info1 DeadCode = info1
-combineBinderInfo info1 info2
+addBinderInfo DeadCode info2 = info2
+addBinderInfo info1 DeadCode = info1
+addBinderInfo info1 info2
= ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
-combineAltsBinderInfo DeadCode info2 = info2
-combineAltsBinderInfo info1 DeadCode = info1
-combineAltsBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
- (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
+-- (orBinderInfo orig new) is used when combining occurrence
+-- info from branches of a case
+
+orBinderInfo DeadCode info2 = info2
+orBinderInfo info1 DeadCode = info1
+orBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
+ (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
= OneOcc (combine_posns posn1 posn2)
(combine_dups dup1 dup2)
(combine_sccs scc1 scc2)
(n_alts1 + n_alts2)
(min ar_1 ar_2)
- where
- combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
- combine_posns _ _ = ArgOcc
+orBinderInfo info1 info2
+ = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
+
+-- (andBinderInfo orig new) is used in two situations:
+-- First, when a variable whose occurrence info
+-- is currently "orig" is bound to a variable whose occurrence info is "new"
+-- eg (\new -> e) orig
+-- What we want to do is to *worsen* orig's info to take account of new's
+--
+-- second, when completing a let-binding
+-- let new = ...orig...
+-- we compute the way orig occurs in (...orig...), and then use orBinderInfo
+-- to worsen this info by the way new occurs in the let body; then we use
+-- that to worsen orig's currently recorded occurrence info.
+
+andBinderInfo DeadCode info2 = DeadCode
+andBinderInfo info1 DeadCode = DeadCode
+andBinderInfo (OneOcc posn1 dup1 scc1 n_alts1 ar_1)
+ (OneOcc posn2 dup2 scc2 n_alts2 ar_2)
+ = OneOcc (combine_posns posn1 posn2)
+ (combine_dups dup1 dup2)
+ (combine_sccs scc1 scc2)
+ (n_alts1 + n_alts2)
+ ar_1 -- Min arity just from orig
+andBinderInfo info1 info2 = ManyOcc (getBinderInfoArity info1)
- combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
- combine_dups _ DupDanger = DupDanger
- combine_dups _ _ = NoDupDanger
- combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
- combine_sccs _ InsideSCC = InsideSCC
- combine_sccs _ _ = NotInsideSCC
+combine_posns FunOcc FunOcc = FunOcc -- see comment at FunOrArg defn
+combine_posns _ _ = ArgOcc
-combineAltsBinderInfo info1 info2
- = ManyOcc (min (getBinderInfoArity info1) (getBinderInfoArity info2))
+combine_dups DupDanger _ = DupDanger -- Too paranoid?? ToDo
+combine_dups _ DupDanger = DupDanger
+combine_dups _ _ = NoDupDanger
+
+combine_sccs InsideSCC _ = InsideSCC -- Too paranoid?? ToDo
+combine_sccs _ InsideSCC = InsideSCC
+combine_sccs _ _ = NotInsideSCC
setBinderInfoArityToZero :: BinderInfo -> BinderInfo
setBinderInfoArityToZero DeadCode = DeadCode
projects / ghc-hetmet.git / blobdiff