2 % (c) The AQUA Project, Glasgow University, 1993-1996
4 \section[SimplEnv]{Environment stuff for the simplifier}
7 #include "HsVersions.h"
10 nullSimplEnv, combineSimplEnv,
11 pprSimplEnv, -- debugging only
13 extendTyEnv, extendTyEnvList,
16 extendIdEnvWithAtom, extendIdEnvWithAtoms,
17 extendIdEnvWithClone, extendIdEnvWithClones,
22 lookupRhsInfo, lookupOutIdEnv, isEvaluated,
23 extendEnvGivenBinding, extendEnvGivenNewRhs,
24 extendEnvGivenRhsInfo,
28 getSwitchChecker, switchIsSet, getSimplIntSwitch,
29 switchOffInlining, setCaseScrutinee,
31 setEnclosingCC, getEnclosingCC,
34 SYN_IE(SwitchChecker),
36 SYN_IE(InIdEnv), SYN_IE(InTypeEnv),
40 SYN_IE(InId), SYN_IE(InBinder), SYN_IE(InBinding), SYN_IE(InType),
41 SYN_IE(OutId), SYN_IE(OutBinder), SYN_IE(OutBinding), SYN_IE(OutType),
43 SYN_IE(InExpr), SYN_IE(InAlts), SYN_IE(InDefault), SYN_IE(InArg),
44 SYN_IE(OutExpr), SYN_IE(OutAlts), SYN_IE(OutDefault), SYN_IE(OutArg)
49 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
50 IMPORT_DELOOPER(SmplLoop) -- breaks the MagicUFs / SimplEnv loop
53 import BinderInfo ( orBinderInfo, andBinderInfo, noBinderInfo,
54 BinderInfo(..){-instances, too-}, FunOrArg, DuplicationDanger, InsideSCC
56 import CmdLineOpts ( switchIsOn, intSwitchSet, opt_UnfoldingCreationThreshold,
57 SimplifierSwitch(..), SwitchResult(..)
60 import CoreUnfold ( mkFormSummary, okToInline, couldBeSmallEnoughToInline,
61 Unfolding(..), UfExpr, RdrName,
62 SimpleUnfolding(..), FormSummary(..),
63 calcUnfoldingGuidance, UnfoldingGuidance(..)
65 import CoreUtils ( coreExprCc, unTagBinders )
66 import CostCentre ( CostCentre, subsumedCosts, noCostCentreAttached )
67 import FiniteMap -- lots of things
68 import Id ( idType, getIdUnfolding, getIdStrictness, idWantsToBeINLINEd,
69 applyTypeEnvToId, getInlinePragma,
70 nullIdEnv, growIdEnvList, rngIdEnv, lookupIdEnv,
71 addOneToIdEnv, modifyIdEnv, mkIdSet, modifyIdEnv_Directly,
72 SYN_IE(IdEnv), SYN_IE(IdSet), GenId, SYN_IE(Id) )
73 import Literal ( isNoRepLit, Literal{-instances-} )
74 import Maybes ( maybeToBool, expectJust )
75 import Name ( isLocallyDefined )
76 import OccurAnal ( occurAnalyseExpr )
77 import Outputable ( PprStyle(..), Outputable(..){-instances-} )
78 import PprCore -- various instances
79 import PprType ( GenType, GenTyVar )
81 import Type ( eqTy, applyTypeEnvToTy, SYN_IE(Type) )
82 import TyVar ( nullTyVarEnv, addOneToTyVarEnv, growTyVarEnvList,
83 SYN_IE(TyVarEnv), GenTyVar{-instance Eq-} ,
86 import Unique ( Unique{-instance Outputable-}, Uniquable(..) )
87 import UniqFM ( addToUFM_C, ufmToList )
88 import Usage ( SYN_IE(UVar), GenUsage{-instances-} )
89 import Util ( SYN_IE(Eager), appEager, returnEager, runEager,
90 zipEqual, thenCmp, cmpList, panic, panic#, assertPanic, Ord3(..) )
94 %************************************************************************
96 \subsection[Simplify-types]{Type declarations}
98 %************************************************************************
101 type InId = Id -- Not yet cloned
102 type InBinder = (InId, BinderInfo)
103 type InType = Type -- Ditto
104 type InBinding = SimplifiableCoreBinding
105 type InExpr = SimplifiableCoreExpr
106 type InAlts = SimplifiableCoreCaseAlts
107 type InDefault = SimplifiableCoreCaseDefault
108 type InArg = SimplifiableCoreArg
110 type OutId = Id -- Cloned
112 type OutType = Type -- Cloned
113 type OutBinding = CoreBinding
114 type OutExpr = CoreExpr
115 type OutAlts = CoreCaseAlts
116 type OutDefault = CoreCaseDefault
117 type OutArg = CoreArg
119 type SwitchChecker = SimplifierSwitch -> SwitchResult
122 %************************************************************************
124 \subsubsection{The @SimplEnv@ type}
126 %************************************************************************
129 INVARIANT: we assume {\em no shadowing}. (ToDo: How can we ASSERT
130 this? WDP 94/06) This allows us to neglect keeping everything paired
131 with its static environment.
133 The environment contains bindings for all
135 {\em locally-defined}
138 For such things, any unfolding is found in the environment, not in the
139 Id. Unfoldings in the Id itself are used only for imported things
140 (otherwise we get trouble because we have to simplify the unfoldings
141 inside the Ids, etc.).
147 CostCentre -- The enclosing cost-centre (when profiling)
148 InTypeEnv -- Maps old type variables to new clones
149 InIdEnv -- Maps locally-bound Ids to new clones
150 OutIdEnv -- Info about the values of OutIds
151 ConAppMap -- Maps constructor applications back to OutIds
154 nullSimplEnv :: SwitchChecker -> SimplEnv
157 = SimplEnv sw_chkr subsumedCosts nullTyVarEnv nullIdEnv nullIdEnv nullConApps
159 combineSimplEnv :: SimplEnv -> SimplEnv -> SimplEnv
160 combineSimplEnv env@(SimplEnv chkr _ _ _ out_id_env con_apps)
161 new_env@(SimplEnv _ encl_cc ty_env in_id_env _ _ )
162 = SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps
164 pprSimplEnv (SimplEnv _ _ ty_env in_id_env out_id_env con_apps) = panic "pprSimplEnv"
168 %************************************************************************
170 \subsubsection{Command-line switches}
172 %************************************************************************
175 getSwitchChecker :: SimplEnv -> SwitchChecker
176 getSwitchChecker (SimplEnv chkr _ _ _ _ _) = chkr
178 switchIsSet :: SimplEnv -> SimplifierSwitch -> Bool
179 switchIsSet (SimplEnv chkr _ _ _ _ _) switch
180 = switchIsOn chkr switch
182 getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
183 getSimplIntSwitch chkr switch
184 = expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
187 setCaseScrutinee :: SimplEnv -> SimplEnv
188 setCaseScrutinee (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
189 = SimplEnv chkr' encl_cc ty_env in_id_env out_id_env con_apps
191 chkr' SimplCaseScrutinee = SwBool True
192 chkr' other = chkr other
195 @switchOffInlining@ is used to prepare the environment for simplifying
196 the RHS of an Id that's marked with an INLINE pragma. It is going to
197 be inlined wherever they are used, and then all the inlining will take
198 effect. Meanwhile, there isn't much point in doing anything to the
199 as-yet-un-INLINEd rhs. Furthremore, it's very important to switch off
201 (a) not doing so will inline a worker straight back into its wrapper!
203 and (b) Consider the following example
208 in ...g...g...g...g...g...
210 Now, if that's the ONLY occurrence of f, it will be inlined inside g,
211 and thence copied multiple times when g is inlined.
213 Andy disagrees! Example:
214 all xs = foldr (&&) True xs
215 any p = all . map p {-# INLINE any #-}
217 Problem: any won't get deforested, and so if it's exported and
218 the importer doesn't use the inlining, (eg passes it as an arg)
219 then we won't get deforestation at all.
220 We havn't solved this problem yet!
222 We prepare the envt by simply discarding the out_id_env, which has
223 all the unfolding info. At one point we did it by modifying the chkr so
224 that it said "EssentialUnfoldingsOnly", but that prevented legitmate, and important,
225 simplifications happening in the body of the RHS.
228 switchOffInlining :: SimplEnv -> SimplEnv
229 switchOffInlining (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
230 = SimplEnv chkr encl_cc ty_env in_id_env nullIdEnv nullConApps
233 %************************************************************************
235 \subsubsection{The ``enclosing cost-centre''}
237 %************************************************************************
240 setEnclosingCC :: SimplEnv -> CostCentre -> SimplEnv
242 setEnclosingCC (SimplEnv chkr _ ty_env in_id_env out_id_env con_apps) encl_cc
243 = SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps
245 getEnclosingCC :: SimplEnv -> CostCentre
246 getEnclosingCC (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps) = encl_cc
249 %************************************************************************
251 \subsubsection{The @TypeEnv@ part}
253 %************************************************************************
256 type TypeEnv = TyVarEnv Type
257 type InTypeEnv = TypeEnv -- Maps InTyVars to OutTypes
259 extendTyEnv :: SimplEnv -> TyVar -> Type -> SimplEnv
260 extendTyEnv (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps) tyvar ty
261 = SimplEnv chkr encl_cc new_ty_env in_id_env out_id_env con_apps
263 new_ty_env = addOneToTyVarEnv ty_env tyvar ty
265 extendTyEnvList :: SimplEnv -> [(TyVar,Type)] -> SimplEnv
266 extendTyEnvList (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps) pairs
267 = SimplEnv chkr encl_cc new_ty_env in_id_env out_id_env con_apps
269 new_ty_env = growTyVarEnvList ty_env pairs
271 simplTy (SimplEnv _ _ ty_env _ _ _) ty = returnEager (applyTypeEnvToTy ty_env ty)
272 simplTyInId (SimplEnv _ _ ty_env _ _ _) id = returnEager (applyTypeEnvToId ty_env id)
275 %************************************************************************
277 \subsubsection{The ``Id env'' part}
279 %************************************************************************
282 type InIdEnv = IdEnv OutArg -- Maps InIds to their value
283 -- Usually this is just the cloned Id, but if
284 -- if the orig defn is a let-binding, and
285 -- the RHS of the let simplifies to an atom,
286 -- we just bind the variable to that atom, and
291 lookupId :: SimplEnv -> Id -> Eager ans OutArg
293 lookupId (SimplEnv _ _ _ in_id_env _ _) id
294 = case (lookupIdEnv in_id_env id) of
295 Just atom -> returnEager atom
296 Nothing -> returnEager (VarArg id)
303 -> OutArg{-Val args only, please-}
306 extendIdEnvWithAtom (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
307 (in_id,occ_info) atom
309 LitArg _ -> SimplEnv chkr encl_cc ty_env new_in_id_env out_id_env con_apps
310 VarArg out_id -> SimplEnv chkr encl_cc ty_env new_in_id_env
311 (modifyOccInfo out_id_env (uniqueOf out_id, occ_info)) con_apps
312 --SimplEnv chkr encl_cc ty_env new_in_id_env new_out_id_env con_apps
314 new_in_id_env = addOneToIdEnv in_id_env in_id atom
316 new_out_id_env = case atom of
317 LitArg _ -> out_id_env
318 VarArg out_id -> modifyOccInfo out_id_env (uniqueOf out_id, occ_info)
321 extendIdEnvWithAtoms :: SimplEnv -> [(InBinder, OutArg)] -> SimplEnv
322 extendIdEnvWithAtoms = foldr (\ (bndr,val) env -> extendIdEnvWithAtom env bndr val)
325 extendIdEnvWithClone :: SimplEnv -> InBinder -> OutId -> SimplEnv
327 extendIdEnvWithClone (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
329 = SimplEnv chkr encl_cc ty_env new_in_id_env out_id_env con_apps
331 new_in_id_env = addOneToIdEnv in_id_env in_id (VarArg out_id)
333 extendIdEnvWithClones :: SimplEnv -> [InBinder] -> [OutId] -> SimplEnv
334 extendIdEnvWithClones (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
336 = SimplEnv chkr encl_cc ty_env new_in_id_env out_id_env con_apps
338 new_in_id_env = growIdEnvList in_id_env bindings
339 bindings = zipEqual "extendIdEnvWithClones"
340 [id | (id,_) <- in_binders]
344 %************************************************************************
346 \subsubsection{The @OutIdEnv@}
348 %************************************************************************
351 The domain of @OutIdInfo@ is some, but not necessarily all, in-scope @OutId@s;
352 both locally-bound ones, and perhaps some imported ones too.
355 type OutIdEnv = IdEnv (OutId, BinderInfo, RhsInfo)
359 The "Id" part is just so that we can recover the domain of the mapping, which
360 IdEnvs don't allow directly.
362 The @BinderInfo@ tells about the occurrences of the @OutId@.
363 Anything that isn't in here should be assumed to occur many times.
364 We keep this info so we can modify it when something changes.
366 The @RhsInfo@ part tells about the value to which the @OutId@ is bound.
369 data RhsInfo = NoRhsInfo
370 | OtherLit [Literal] -- It ain't one of these
371 | OtherCon [Id] -- It ain't one of these
373 | InUnfolding SimplEnv -- Un-simplified unfolding
374 SimpleUnfolding -- (need to snag envts therefore)
376 | OutUnfolding CostCentre
377 SimpleUnfolding -- Already-simplified unfolding
379 lookupOutIdEnv :: SimplEnv -> OutId -> Maybe (OutId,BinderInfo,RhsInfo)
380 lookupOutIdEnv (SimplEnv _ _ _ _ out_id_env _) id = lookupIdEnv out_id_env id
382 lookupRhsInfo :: SimplEnv -> OutId -> RhsInfo
384 = case lookupOutIdEnv env id of
385 Just (_,_,info) -> info
388 modifyOutEnvItem :: (OutId, BinderInfo, RhsInfo)
389 -> (OutId, BinderInfo, RhsInfo)
390 -> (OutId, BinderInfo, RhsInfo)
391 modifyOutEnvItem (id, occ, info1) (_, _, info2)
392 = case (info1, info2) of
393 (OtherLit ls1, OtherLit ls2) -> (id,occ, OtherLit (ls1++ls2))
394 (OtherCon cs1, OtherCon cs2) -> (id,occ, OtherCon (cs1++cs2))
395 (_, NoRhsInfo) -> (id,occ, info1)
396 other -> (id,occ, info2)
401 isEvaluated :: RhsInfo -> Bool
402 isEvaluated (OtherLit _) = True
403 isEvaluated (OtherCon _) = True
404 isEvaluated (InUnfolding _ (SimpleUnfolding ValueForm _ expr)) = True
405 isEvaluated (OutUnfolding _ (SimpleUnfolding ValueForm _ expr)) = True
406 isEvaluated other = False
412 mkSimplUnfoldingGuidance chkr out_id rhs
413 = calcUnfoldingGuidance (getInlinePragma out_id) opt_UnfoldingCreationThreshold rhs
415 extendEnvGivenRhsInfo :: SimplEnv -> OutId -> BinderInfo -> RhsInfo -> SimplEnv
416 extendEnvGivenRhsInfo env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
417 out_id occ_info rhs_info
418 = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env con_apps
420 new_out_id_env = addToUFM_C modifyOutEnvItem out_id_env out_id
421 (out_id, occ_info, rhs_info)
426 modifyOccInfo out_id_env (uniq, new_occ)
427 = modifyIdEnv_Directly modify_fn out_id_env uniq
429 modify_fn (id,occ,rhs) = (id, orBinderInfo occ new_occ, rhs)
431 markDangerousOccs (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps) atoms
432 = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env con_apps
434 new_out_id_env = foldl (modifyIdEnv modify_fn) out_id_env [v | VarArg v <- atoms]
435 modify_fn (id,occ,rhs) = (id, noBinderInfo, rhs)
440 %************************************************************************
442 \subsubsection{The @ConAppMap@ type}
444 %************************************************************************
446 The @ConAppMap@ maps applications of constructors (to value atoms)
447 back to an association list that says "if the constructor was applied
448 to one of these lists-of-Types, then this OutId is your man (in a
449 non-gender-specific sense)". I.e., this is a reversed mapping for
450 (part of) the main OutIdEnv
453 type ConAppMap = FiniteMap UnfoldConApp [([Type], OutId)]
456 = UCA OutId -- data constructor
457 [OutArg] -- *value* arguments; see use below
461 nullConApps = emptyFM
463 extendConApps con_apps id (Con con args)
464 = addToFM_C (\old new -> new++old) con_apps (UCA con val_args) [(ty_args,id)]
466 val_args = filter isValArg args -- Literals and Ids
467 ty_args = [ty | TyArg ty <- args] -- Just types
469 extendConApps con_apps id other_rhs = con_apps
473 lookForConstructor (SimplEnv _ _ _ _ _ con_apps) con args
474 = case lookupFM con_apps (UCA con val_args) of
477 Just assocs -> case [id | (tys, id) <- assocs,
478 and (zipWith eqTy tys ty_args)]
483 val_args = filter isValArg args -- Literals and Ids
484 ty_args = [ty | TyArg ty <- args] -- Just types
488 NB: In @lookForConstructor@ we used (before Apr 94) to have a special case
489 for nullary constructors, but now we only do constructor re-use in
490 let-bindings the special case isn't necessary any more.
493 = -- Don't re-use nullary constructors; it's a waste. Consider
501 -- Here the False in the second case will get replace by "a", hardly
507 The main thing about @UnfoldConApp@ is that it has @Ord@ defined on
508 it, so we can use it for a @FiniteMap@ key.
511 instance Eq UnfoldConApp where
512 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
513 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
515 instance Ord UnfoldConApp where
516 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
517 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
518 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
519 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
520 _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
522 instance Ord3 UnfoldConApp where
525 cmp_app (UCA c1 as1) (UCA c2 as2)
526 = cmp c1 c2 `thenCmp` cmpList cmp_arg as1 as2
528 -- ToDo: make an "instance Ord3 CoreArg"???
530 cmp_arg (VarArg x) (VarArg y) = x `cmp` y
531 cmp_arg (LitArg x) (LitArg y) = x `cmp` y
532 cmp_arg (TyArg x) (TyArg y) = panic# "SimplEnv.cmp_app:TyArgs"
533 cmp_arg (UsageArg x) (UsageArg y) = panic# "SimplEnv.cmp_app:UsageArgs"
535 | tag x _LT_ tag y = LT_
538 tag (VarArg _) = ILIT(1)
539 tag (LitArg _) = ILIT(2)
540 tag (TyArg _) = panic# "SimplEnv.cmp_app:TyArg"
541 tag (UsageArg _) = panic# "SimplEnv.cmp_app:UsageArg"
548 ============================ OLD ================================
549 This version was used when we use the *simplified* RHS of a
550 let as the thing's unfolding. The has the nasty property described
551 in the following comments. Much worse, it can fail to terminate
552 on recursive things. Consider
554 letrec f = \x -> let z = f x' in ...
561 If we bind n to its *simplified* RHS, we then *re-simplify* it when
562 we inline n. Then we may well inline f; and then the same thing
566 @extendUnfoldEnvGivenRhs@ records in the UnfoldEnv info about the RHS
567 of a new binding. There is a horrid case we have to take care about,
568 due to Andr\'e Santos:
570 type Array_type b = Array Int b;
571 type Descr_type = (Int,Int);
573 tabulate :: (Int -> x) -> Descr_type -> Array_type x;
574 tabulate f (l,u) = listArray (l,u) [f i | i <- [l..u]];
578 f_aareorder::(Array_type Int) -> (Array_type t1) -> Array_type t1;
579 f_aareorder a_index a_ar=
581 f_aareorder' a_i= a_ar ! (a_index ! a_i)
582 } in tabulate f_aareorder' (bounds a_ar);
583 r_index=tabulate ((+) 1) (1,1);
584 arr = listArray (1,1) a_xs;
585 arg = f_aareorder r_index arr
588 Now, when the RHS of arg gets simplified, we inline f_aareorder to get
590 arg = let f_aareorder' a_i = arr ! (r_index ! a_i)
591 in tabulate f_aareorder' (bounds arr)
593 Note that r_index is not inlined, because it was bound to a_index which
594 occurs inside a lambda.
596 Alas, if elems is inlined, so that (elems arg) becomes (case arg of ...),
597 then arg is inlined. IF WE USE THE NEW VERSION OF arg, and re-occurrence
598 analyse it, we won't spot the inside-lambda property of r_index, so r_index
599 will get inlined inside the lambda. AARGH.
601 Solution: when we occurrence-analyse the new RHS we have to go back
602 and modify the info recorded in the UnfoldEnv for the free vars
603 of the RHS. In the example we'd go back and record that r_index is now used
607 extendEnvGivenNewRhs :: SimplEnv -> OutId -> OutExpr -> SimplEnv
608 extendEnvGivenNewRhs env out_id rhs
609 = extendEnvGivenBinding env noBinderInfo out_id rhs
611 extendEnvGivenBinding :: SimplEnv -> BinderInfo -> OutId -> OutExpr -> SimplEnv
612 extendEnvGivenBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
614 = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env new_con_apps
616 new_out_id_env | okToInline form occ_info (couldBeSmallEnoughToInline guidance)
617 = out_id_env_with_unfolding
620 -- Don't bother to extend the OutIdEnv unless there is some possibility
621 -- that the thing might be inlined. We check this by calling okToInline suitably.
623 new_con_apps = _scc_ "eegnr.conapps"
624 extendConApps con_apps out_id rhs
626 -- Modify the occ info for rhs's interesting free variables.
627 out_id_env_with_unfolding = _scc_ "eegnr.modify_occ"
628 foldl modifyOccInfo env1 full_fv_occ_info
629 -- NB: full_fv_occ_info *combines* the occurrence of the current binder
630 -- with the occurrences of its RHS's free variables. That's to take
632 -- let a = \x -> BIG in
634 -- in ...b...b...b...
635 -- Here "a" occurs exactly once. "b" simplifies to a small value.
636 -- So "b" will be inlined at each call site, and there's a good chance
637 -- that "a" will too. So we'd better modify "a"s occurrence info to
638 -- record the fact that it can now occur many times by virtue that "b" can.
640 full_fv_occ_info = _scc_ "eegnr.full_fv"
641 [ (uniq, fv_occ `andBinderInfo` occ_info)
642 | (uniq, fv_occ) <- ufmToList fv_occ_info
645 -- Add an unfolding and rhs_info for the new Id.
646 -- If the out_id is already in the OutIdEnv (which can happen if
647 -- the call to extendEnvGivenBinding is from extendEnvGivenNewRhs)
648 -- then just replace the unfolding, leaving occurrence info alone.
649 env1 = _scc_ "eegnr.modify_out"
650 addToUFM_C modifyOutEnvItem out_id_env out_id
651 (out_id, occ_info, rhs_info)
653 -- Occurrence-analyse the RHS
654 -- The "interesting" free variables we want occurrence info for are those
655 -- in the OutIdEnv that have only a single occurrence right now.
656 (fv_occ_info, template) = _scc_ "eegnr.occ-anal"
657 occurAnalyseExpr is_interesting rhs
659 is_interesting v = _scc_ "eegnr.mkidset"
660 case lookupIdEnv out_id_env v of
661 Just (_, OneOcc _ _ _ _ _, _) -> True
664 -- Compute unfolding details
665 rhs_info = OutUnfolding unf_cc (SimpleUnfolding form guidance template)
666 form = _scc_ "eegnr.form_sum"
668 guidance = _scc_ "eegnr.guidance"
669 mkSimplUnfoldingGuidance chkr out_id rhs
671 -- Compute cost centre for thing
672 unf_cc | noCostCentreAttached expr_cc = encl_cc
673 | otherwise = expr_cc
675 expr_cc = coreExprCc rhs