Commit a35f75aa authored by simonpj@microsoft.com's avatar simonpj@microsoft.com
Browse files

Second bite at the rules-only idea

This is part 2 of the patch that improved the interaction of RULES and
recursion.  It's vital that all Ids that may be referred to from later in
the module are marked 'IAmALoopBreaker' because otherwise we may do
postInlineUnconditionally, and lose the binding altogether. 

So I've added a boolean rules-only flag to IAmALoopBreaker.  Now we can
do inlining for rules-only loop-breakers. 
parent 0477b389
......@@ -38,7 +38,7 @@ module BasicTypes(
TupCon(..), tupleParens,
OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc,
isDeadOcc, isLoopBreaker, isNoOcc,
isDeadOcc, isLoopBreaker, isNonRuleLoopBreaker, isNoOcc,
InsideLam, insideLam, notInsideLam,
OneBranch, oneBranch, notOneBranch,
......@@ -372,13 +372,40 @@ data OccInfo
| IAmDead -- Marks unused variables. Sometimes useful for
-- lambda and case-bound variables.
| OneOcc !InsideLam -- Occurs exactly once, not inside a rule
!OneBranch
!InterestingCxt
| OneOcc -- Occurs exactly once, not inside a rule
!InsideLam
!OneBranch
!InterestingCxt
| IAmALoopBreaker -- Used by the occurrence analyser to mark loop-breakers
-- in a group of recursive definitions
!Bool -- True <=> This loop breaker occurs only the RHS of a RULE
\end{code}
Note [RulesOnly]
~~~~~~~~~~~~~~~~
The RulesOnly constructor records if an Id occurs only in the RHS of a Rule.
Similarly, the boolean in IAmLoopbreaker True if the only reason the Id is a
loop-breaker only because of recursion through a RULE. In that case,
we can ignore the loop-breaker-ness for inlining purposes. Example
(from GHC.Enum):
eftInt :: Int# -> Int# -> [Int]
eftInt x y = ...(non-recursive)...
{-# INLINE [0] eftIntFB #-}
eftIntFB :: (Int -> r -> r) -> r -> Int# -> Int# -> r
eftIntFB c n x y = ...(non-recursive)...
{-# RULES
"eftInt" [~1] forall x y. eftInt x y = build (\ c n -> eftIntFB c n x y)
"eftIntList" [1] eftIntFB (:) [] = eftInt
#-}
The two look mutually recursive only because of their RULES;
we don't want that to inhibit inlining!
\begin{code}
isNoOcc :: OccInfo -> Bool
isNoOcc NoOccInfo = True
isNoOcc other = False
......@@ -405,8 +432,12 @@ oneBranch = True
notOneBranch = False
isLoopBreaker :: OccInfo -> Bool
isLoopBreaker IAmALoopBreaker = True
isLoopBreaker other = False
isLoopBreaker (IAmALoopBreaker _) = True
isLoopBreaker other = False
isNonRuleLoopBreaker :: OccInfo -> Bool
isNonRuleLoopBreaker (IAmALoopBreaker False) = True -- Loop-breaker that breaks a non-rule cycle
isNonRuleLoopBreaker other = False
isDeadOcc :: OccInfo -> Bool
isDeadOcc IAmDead = True
......@@ -423,10 +454,10 @@ isFragileOcc other = False
\begin{code}
instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07
ppr NoOccInfo = empty
ppr RulesOnly = ptext SLIT("RulesOnly")
ppr IAmALoopBreaker = ptext SLIT("LoopBreaker")
ppr IAmDead = ptext SLIT("Dead")
ppr NoOccInfo = empty
ppr RulesOnly = ptext SLIT("RulesOnly")
ppr (IAmALoopBreaker ro) = ptext SLIT("LoopBreaker") <> if ro then char '!' else empty
ppr IAmDead = ptext SLIT("Dead")
ppr (OneOcc inside_lam one_branch int_cxt)
= ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
where
......
......@@ -532,11 +532,11 @@ callSiteInline dflags active_inline occ id arg_infos interesting_cont
yes_or_no
| not active_inline = False
| otherwise = case occ of
IAmDead -> pprTrace "callSiteInline: dead" (ppr id) False
IAmALoopBreaker -> False
--OneOcc in_lam _ _ -> (not in_lam || is_cheap) && consider_safe True
other -> is_cheap && consider_safe False
-- we consider even the once-in-one-branch
IAmDead -> pprTrace "callSiteInline: dead" (ppr id) False
IAmALoopBreaker False -> False -- Note [RulesOnly] in BasicTypes
--OneOcc in_lam _ _ -> (not in_lam || is_cheap) && consider_safe True
other -> is_cheap && consider_safe False
-- We consider even the once-in-one-branch
-- occurrences, because they won't all have been
-- caught by preInlineUnconditionally. In particular,
-- if the occurrence is once inside a lambda, and the
......
......@@ -26,7 +26,7 @@ import Id ( idType, idInfo, idName, idCoreRules, isGlobalId,
import IdInfo {- loads of stuff -}
import InstEnv ( Instance, DFunId, instanceDFunId, setInstanceDFunId )
import NewDemand ( isBottomingSig, topSig )
import BasicTypes ( Arity, isNeverActive )
import BasicTypes ( Arity, isNeverActive, isNonRuleLoopBreaker )
import Name ( Name, getOccName, nameOccName, mkInternalName,
localiseName, isExternalName, nameSrcLoc, nameParent_maybe,
isWiredInName, getName
......@@ -462,7 +462,7 @@ addExternal (id,rhs) needed
idinfo = idInfo id
dont_inline = isNeverActive (inlinePragInfo idinfo)
loop_breaker = isLoopBreaker (occInfo idinfo)
loop_breaker = isNonRuleLoopBreaker (occInfo idinfo)
bottoming_fn = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
spec_ids = specInfoFreeVars (specInfo idinfo)
worker_info = workerInfo idinfo
......
......@@ -35,7 +35,7 @@ import Maybes ( orElse )
import Digraph ( stronglyConnCompR, SCC(..) )
import PrelNames ( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
import Unique ( Unique )
import UniqFM ( keysUFM, lookupUFM_Directly )
import UniqFM ( keysUFM )
import Util ( zipWithEqual, mapAndUnzip )
import Outputable
\end{code}
......@@ -79,14 +79,6 @@ Bindings
~~~~~~~~
\begin{code}
type IdWithOccInfo = Id -- An Id with fresh PragmaInfo attached
type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique,
-- which is gotten from the Id.
type Details1 = (Id, UsageDetails, CoreExpr)
type Details2 = (IdWithOccInfo, CoreExpr)
occAnalBind :: OccEnv
-> CoreBind
-> UsageDetails -- Usage details of scope
......@@ -198,17 +190,22 @@ occAnalBind env (Rec pairs) body_usage
details = [details | (details, _, _) <- cycle]
bndrs = [bndr | (bndr, _, _) <- details]
rhs_usages = [rhs_usage | (_, rhs_usage, _) <- details]
total_usage = foldr combineUsageDetails body_usage rhs_usages
rhs_usage = foldr1 combineUsageDetails rhs_usages
total_usage = rhs_usage `combineUsageDetails` body_usage
(combined_usage, tagged_bndrs) = tagBinders total_usage bndrs
final_bind = Rec (doReorder edges)
new_cycle :: [Node Details2]
new_cycle = zipWithEqual "reorder" mk_node tagged_bndrs cycle
final_bind = Rec (reOrderCycle rhs_usage new_cycle)
mk_node tagged_bndr ((_, _, rhs'), key, keys) = ((tagged_bndr, rhs'), key, keys)
{- An alternative; rebuild the edges. No semantic difference, but perf might change
-- Hopefully 'bndrs' is a relatively small group now
-- Now get ready for the loop-breaking phase, this time ignoring RulesOnly references
-- We've done dead-code elimination already, so no worries about un-referenced binders
edges :: [Node Details2]
edges = zipWithEqual "reorder" mk_edge tagged_bndrs details
keys = map idUnique bndrs
mk_edge tagged_bndr (_, rhs_usage, rhs')
mk_node tagged_bndr (_, rhs_usage, rhs')
= ((tagged_bndr, rhs'), idUnique tagged_bndr, used)
where
used = [key | key <- keys, used_outside_rule rhs_usage key ]
......@@ -217,15 +214,16 @@ occAnalBind env (Rec pairs) body_usage
Nothing -> False
Just RulesOnly -> False -- Ignore rules
other -> True
-}
\end{code}
@reOrderRec@ is applied to the list of (binder,rhs) pairs for a cyclic
strongly connected component (there's guaranteed to be a cycle). It returns the
same pairs, but
a) in a better order,
b) with some of the Ids having a IMustNotBeINLINEd pragma
b) with some of the Ids having a IAmALoopBreaker pragma
The "no-inline" Ids are sufficient to break all cycles in the SCC. This means
The "loop-breaker" Ids are sufficient to break all cycles in the SCC. This means
that the simplifier can guarantee not to loop provided it never records an inlining
for these no-inline guys.
......@@ -252,53 +250,34 @@ My solution was to make a=b bindings record b as Many, rather like INLINE bindin
Perhaps something cleverer would suffice.
===============
You might think that you can prevent non-termination simply by making
sure that we simplify a recursive binding's RHS in an environment that
simply clones the recursive Id. But no. Consider
letrec f = \x -> let z = f x' in ...
in
let n = f y
in
case n of { ... }
We bind n to its *simplified* RHS, we then *re-simplify* it when
we inline n. Then we may well inline f; and then the same thing
happens with z!
I don't think it's possible to prevent non-termination by environment
manipulation in this way. Apart from anything else, successive
iterations of the simplifier may unroll recursive loops in cases like
that above. The idea of beaking every recursive loop with an
IMustNotBeINLINEd pragma is much much better.
\begin{code}
doReorder :: [Node Details2] -> [Details2]
-- Sorted into a plausible order. Enough of the Ids have
-- dontINLINE pragmas that there are no loops left.
doReorder nodes = concatMap reOrderRec (stronglyConnCompR nodes)
reOrderRec :: SCC (Node Details2) -> [Details2]
-- Non-recursive case
reOrderRec (AcyclicSCC (bind, _, _)) = [bind]
type IdWithOccInfo = Id -- An Id with fresh PragmaInfo attached
-- Common case of simple self-recursion
reOrderRec (CyclicSCC [])
= panic "reOrderRec"
type Node details = (details, Unique, [Unique]) -- The Ints are gotten from the Unique,
-- which is gotten from the Id.
type Details1 = (Id, UsageDetails, CoreExpr)
type Details2 = (IdWithOccInfo, CoreExpr)
reOrderRec (CyclicSCC [bind])
= [(setIdOccInfo tagged_bndr IAmALoopBreaker, rhs)]
reOrderRec :: UsageDetails -> SCC (Node Details2) -> [Details2]
-- Sorted into a plausible order. Enough of the Ids have
-- IAmALoopBreaker pragmas that there are no loops left.
reOrderRec rhs_usg (AcyclicSCC (bind, _, _)) = [bind]
reOrderRec rhs_usg (CyclicSCC cycle) = reOrderCycle rhs_usg cycle
reOrderCycle :: UsageDetails -> [Node Details2] -> [Details2]
reOrderCycle rhs_usg []
= panic "reOrderCycle"
reOrderCycle rhs_usg [bind] -- Common case of simple self-recursion
= [(makeLoopBreaker rhs_usg tagged_bndr, rhs)]
where
((tagged_bndr, rhs), _, _) = bind
reOrderRec (CyclicSCC (bind : binds))
reOrderCycle rhs_usg (bind : binds)
= -- Choose a loop breaker, mark it no-inline,
-- do SCC analysis on the rest, and recursively sort them out
doReorder unchosen ++
[(setIdOccInfo tagged_bndr IAmALoopBreaker, rhs)]
concatMap (reOrderRec rhs_usg) (stronglyConnCompR unchosen) ++
[(makeLoopBreaker rhs_usg tagged_bndr, rhs)]
where
(chosen_pair, unchosen) = choose_loop_breaker bind (score bind) [] binds
......@@ -355,6 +334,16 @@ reOrderRec (CyclicSCC (bind : binds))
-- But we won't because constructor args are marked "Many".
not_fun_ty ty = not (isFunTy (dropForAlls ty))
makeLoopBreaker :: UsageDetails -> Id -> Id
-- Set the loop-breaker flag, recording whether the thing occurs only in
-- the RHS of a RULE (in this recursive group)
makeLoopBreaker rhs_usg bndr
= setIdOccInfo bndr (IAmALoopBreaker rules_only)
where
rules_only = case lookupVarEnv rhs_usg bndr of
Just RulesOnly -> True
other -> False
\end{code}
@occAnalRhs@ deals with the question of bindings where the Id is marked
......
......@@ -721,7 +721,8 @@ postInlineUnconditionally
-> Bool
postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding
| not active = False
| isLoopBreaker occ_info = False
| isLoopBreaker occ_info = False -- If it's a loop-breaker of any kind, dont' inline
-- because it might be referred to "earlier"
| isExportedId bndr = False
| exprIsTrivial rhs = True
| otherwise
......
......@@ -26,10 +26,8 @@ import Id ( Id, idType, idInfo, idArity, isDataConWorkId,
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 )
......@@ -58,7 +56,7 @@ import VarEnv ( elemVarEnv, emptyVarEnv )
import TysPrim ( realWorldStatePrimTy )
import PrelInfo ( realWorldPrimId )
import BasicTypes ( TopLevelFlag(..), isTopLevel,
RecFlag(..), isNonRec
RecFlag(..), isNonRec, isNonRuleLoopBreaker
)
import OrdList
import List ( nub )
......@@ -600,14 +598,17 @@ completeLazyBind env top_lvl old_bndr new_bndr new_rhs
| 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
......@@ -635,7 +636,7 @@ completeLazyBind env top_lvl old_bndr new_bndr new_rhs
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}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment