From b6cc5851fa49720b31d989d210c8e43dc27cbfe6 Mon Sep 17 00:00:00 2001 From: "simonpj@microsoft.com" Date: Thu, 5 Oct 2006 13:03:27 +0000 Subject: [PATCH] Remove unused OccInfo (simplification) The substitution used to carry "fragile" OccInfo to call sites via the DoneId constructor of SimplEnv.SimplSR. This was always a tricky thing to do, and for some time I've been removing the need for it. Now at last I think we can nuke it altogether. Hooray. I did a full nonfib run, and got zero perf changes. --- compiler/coreSyn/CoreUnfold.lhs | 12 +++--------- compiler/simplCore/SimplEnv.lhs | 39 ++++++++++++------------------------- compiler/simplCore/SimplUtils.lhs | 6 +++--- compiler/simplCore/Simplify.lhs | 8 ++++---- 4 files changed, 22 insertions(+), 43 deletions(-) diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 2a2751e..ad2a391 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -45,7 +45,7 @@ import Id ( Id, idType, isId, import DataCon ( isUnboxedTupleCon ) import Literal ( litSize ) import PrimOp ( primOpIsDupable, primOpOutOfLine ) -import IdInfo ( OccInfo(..), GlobalIdDetails(..) ) +import IdInfo ( GlobalIdDetails(..) ) import Type ( isUnLiftedType ) import PrelNames ( hasKey, buildIdKey, augmentIdKey ) import Bag @@ -502,14 +502,13 @@ StrictAnal.addStrictnessInfoToTopId \begin{code} callSiteInline :: DynFlags -> Bool -- True <=> the Id can be inlined - -> OccInfo -> Id -- The Id -> [Bool] -- One for each value arg; True if it is interesting -> Bool -- True <=> continuation is interesting -> Maybe CoreExpr -- Unfolding, if any -callSiteInline dflags active_inline occ id arg_infos interesting_cont +callSiteInline dflags active_inline id arg_infos interesting_cont = case idUnfolding id of { NoUnfolding -> Nothing ; OtherCon cs -> Nothing ; @@ -531,11 +530,7 @@ 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 -> False -- Note [RulesOnly] in OccurAnal - --OneOcc in_lam _ _ -> (not in_lam || is_cheap) && consider_safe True - other -> is_cheap && consider_safe False + | otherwise = 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, @@ -596,7 +591,6 @@ callSiteInline dflags active_inline occ id arg_infos interesting_cont if dopt Opt_D_dump_inlinings dflags then pprTrace "Considering inlining" (ppr id <+> vcat [text "active:" <+> ppr active_inline, - text "occ info:" <+> ppr occ, text "arg infos" <+> ppr arg_infos, text "interesting continuation" <+> ppr interesting_cont, text "is value:" <+> ppr is_value, diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index 9bce1e0..fca0d61 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -124,7 +124,7 @@ type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr data SimplSR = DoneEx OutExpr -- Completed term - | DoneId OutId OccInfo -- Completed term variable, with occurrence info + | DoneId OutId -- Completed term variable | ContEx TvSubstEnv -- A suspended substitution SimplIdSubst InExpr @@ -151,11 +151,6 @@ seIdSubst: a77 -> a77 from the substitution, when we decide not to clone a77, but it's quite legitimate to put the mapping in the substitution anyway. - - Indeed, we do so when we want to pass fragile OccInfo to the - occurrences of the variable; we add a substitution - x77 -> DoneId x77 occ - to record x's occurrence information.] Furthermore, consider let x = case k of I# x77 -> ... in @@ -168,12 +163,9 @@ seIdSubst: Of course, the substitution *must* applied! Things in its domain simply aren't necessarily bound in the result. -* substId adds a binding (DoneId new_id occ) to the substitution if - EITHER the Id's unique has changed - OR the Id has interesting occurrence information - So in effect you can only get to interesting occurrence information - by looking up the *old* Id; it's not really attached to the new id - at all. +* substId adds a binding (DoneId new_id) to the substitution if + the Id's unique has changed + Note, though that the substitution isn't necessarily extended if the type changes. Why not? Because of the next point: @@ -292,19 +284,12 @@ getRules = seExtRules substId :: SimplEnv -> Id -> SimplSR substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v | not (isLocalId v) - = DoneId v NoOccInfo + = DoneId v | otherwise -- A local Id = case lookupVarEnv ids v of - Just (DoneId v occ) -> DoneId (refine v) occ - Just res -> res - Nothing -> let v' = refine v - in DoneId v' (idOccInfo v') - -- We don't put LoopBreakers in the substitution (unless then need - -- to be cloned for name-clash rasons), so the idOccInfo is - -- very important! If isFragileOcc returned True for - -- loop breakers we could avoid this call, but at the expense - -- of adding more to the substitution, and building new Ids - -- a bit more often than really necessary + Just (DoneId v) -> DoneId (refine v) + Just res -> res + Nothing -> DoneId (refine v) where -- Get the most up-to-date thing from the in-scope set -- Even though it isn't in the substitution, it may be in @@ -392,7 +377,7 @@ substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst}) -- Extend the substitution if the unique has changed -- See the notes with substTyVarBndr for the delSubstEnv new_subst | new_id /= old_id - = extendVarEnv id_subst old_id (DoneId new_id (idOccInfo old_id)) + = extendVarEnv id_subst old_id (DoneId new_id) | otherwise = delVarEnv id_subst old_id \end{code} @@ -458,8 +443,8 @@ substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old -- or there's some useful occurrence information -- See the notes with substTyVarBndr for the delSubstEnv occ_info = occInfo (idInfo old_id) - new_subst | new_id /= old_id || isFragileOcc occ_info - = extendVarEnv id_subst old_id (DoneId new_id occ_info) + new_subst | new_id /= old_id + = extendVarEnv id_subst old_id (DoneId new_id) | otherwise = delVarEnv id_subst old_id \end{code} @@ -609,7 +594,7 @@ mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env) fiddle (DoneEx e) = e - fiddle (DoneId v occ) = Var v + fiddle (DoneId v) = Var v fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e substExpr :: SimplEnv -> CoreExpr -> CoreExpr diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 2342491..b193771 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -789,10 +789,10 @@ postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding SimplPhase n -> isActive n prag prag = idInlinePragma bndr -activeInline :: SimplEnv -> OutId -> OccInfo -> Bool -activeInline env id occ +activeInline :: SimplEnv -> OutId -> Bool +activeInline env id = case getMode env of - SimplGently -> isOneOcc occ && isAlwaysActive prag + SimplGently -> False -- No inlining at all when doing gentle stuff, -- except for local things that occur once -- The reason is that too little clean-up happens if you diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 80aa89a..4ca68b2 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -927,7 +927,7 @@ simplVar env var cont = 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 @@ -941,7 +941,7 @@ simplVar env var cont --------------------------------------------------------- -- Dealing with a call site -completeCall env var occ_info cont +completeCall env var cont = -- Simplify the arguments getDOptsSmpl `thenSmpl` \ dflags -> let @@ -1006,8 +1006,8 @@ completeCall env var occ_info cont 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 { -- 1.7.10.4