markDangerousOccs,
lookupRhsInfo, lookupOutIdEnv, isEvaluated,
extendEnvGivenBinding, extendEnvGivenNewRhs,
- extendEnvForRecBinding, extendEnvGivenRhsInfo,
+ extendEnvGivenRhsInfo,
lookForConstructor,
- getSwitchChecker, switchIsSet, getSimplIntSwitch, switchOffInlining,
+ getSwitchChecker, switchIsSet, getSimplIntSwitch,
+ switchOffInlining, setCaseScrutinee,
setEnclosingCC, getEnclosingCC,
import BinderInfo ( orBinderInfo, andBinderInfo, noBinderInfo,
BinderInfo(..){-instances, too-}, FunOrArg, DuplicationDanger, InsideSCC
)
-import CgCompInfo ( uNFOLDING_CREATION_THRESHOLD )
-import CmdLineOpts ( switchIsOn, intSwitchSet, SimplifierSwitch(..), SwitchResult(..) )
+import CmdLineOpts ( switchIsOn, intSwitchSet, opt_UnfoldingCreationThreshold,
+ SimplifierSwitch(..), SwitchResult(..)
+ )
import CoreSyn
import CoreUnfold ( mkFormSummary, exprSmallEnoughToDup,
- Unfolding(..), SimpleUnfolding(..), FormSummary(..),
- mkSimpleUnfolding,
+ Unfolding(..), UfExpr, RdrName,
+ SimpleUnfolding(..), FormSummary(..),
calcUnfoldingGuidance, UnfoldingGuidance(..)
)
import CoreUtils ( coreExprCc, unTagBinders )
import CostCentre ( CostCentre, noCostCentre, noCostCentreAttached )
import FiniteMap -- lots of things
import Id ( idType, getIdUnfolding, getIdStrictness, idWantsToBeINLINEd,
- applyTypeEnvToId,
+ applyTypeEnvToId, getInlinePragma,
nullIdEnv, growIdEnvList, rngIdEnv, lookupIdEnv,
addOneToIdEnv, modifyIdEnv, mkIdSet, modifyIdEnv_Directly,
- SYN_IE(IdEnv), SYN_IE(IdSet), GenId )
-import IdInfo ( bottomIsGuaranteed, StrictnessInfo )
+ SYN_IE(IdEnv), SYN_IE(IdSet), GenId, SYN_IE(Id) )
import Literal ( isNoRepLit, Literal{-instances-} )
import Maybes ( maybeToBool, expectJust )
import Name ( isLocallyDefined )
import OccurAnal ( occurAnalyseExpr )
-import Outputable ( Outputable(..){-instances-} )
+import Outputable ( PprStyle(..), Outputable(..){-instances-} )
import PprCore -- various instances
-import PprStyle ( PprStyle(..) )
import PprType ( GenType, GenTyVar )
import Pretty
-import Type ( eqTy, applyTypeEnvToTy )
+import Type ( eqTy, applyTypeEnvToTy, SYN_IE(Type) )
import TyVar ( nullTyVarEnv, addOneToTyVarEnv, growTyVarEnvList,
- SYN_IE(TyVarEnv), GenTyVar{-instance Eq-}
+ SYN_IE(TyVarEnv), GenTyVar{-instance Eq-} ,
+ SYN_IE(TyVar)
)
import Unique ( Unique{-instance Outputable-} )
-import UniqFM ( addToUFM_C, ufmToList, eltsUFM
+import UniqFM ( addToUFM_C, ufmToList, Uniquable(..)
)
---import UniqSet -- lots of things
import Usage ( SYN_IE(UVar), GenUsage{-instances-} )
-import Util ( zipEqual, thenCmp, cmpList, panic, panic#, assertPanic )
+import Util ( SYN_IE(Eager), appEager, returnEager, runEager,
+ zipEqual, thenCmp, cmpList, panic, panic#, assertPanic, Ord3(..) )
-type TypeEnv = TyVarEnv Type
-cmpType = panic "cmpType (SimplEnv)"
\end{code}
%************************************************************************
= expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
-- Crude, but simple
-switchOffInlining :: SimplEnv -> SimplEnv
-switchOffInlining (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
+setCaseScrutinee :: SimplEnv -> SimplEnv
+setCaseScrutinee (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
= SimplEnv chkr' encl_cc ty_env in_id_env out_id_env con_apps
where
- chkr' EssentialUnfoldingsOnly = SwBool True
- chkr' other = chkr other
+ chkr' SimplCaseScrutinee = SwBool True
+ chkr' other = chkr other
+\end{code}
+
+@switchOffInlining@ is used to prepare the environment for simplifying
+the RHS of an Id that's marked with an INLINE pragma. It is going to
+be inlined wherever they are used, and then all the inlining will take
+effect. Meanwhile, there isn't much point in doing anything to the
+as-yet-un-INLINEd rhs. Furthremore, it's very important to switch off
+inlining! because
+ (a) not doing so will inline a worker straight back into its wrapper!
+
+and (b) Consider the following example
+ let f = \pq -> BIG
+ in
+ let g = \y -> f y y
+ {-# INLINE g #-}
+ in ...g...g...g...g...g...
+
+ Now, if that's the ONLY occurrence of f, it will be inlined inside g,
+ and thence copied multiple times when g is inlined.
+
+ Andy disagrees! Example:
+ all xs = foldr (&&) True xs
+ any p = all . map p {-# INLINE any #-}
+
+ Problem: any won't get deforested, and so if it's exported and
+ the importer doesn't use the inlining, (eg passes it as an arg)
+ then we won't get deforestation at all.
+ We havn't solved this problem yet!
+
+We prepare the envt by simply discarding the out_id_env, which has
+all the unfolding info. At one point we did it by modifying the chkr so
+that it said "EssentialUnfoldingsOnly", but that prevented legitmate, and important,
+simplifications happening in the body of the RHS.
+
+\begin{code}
+switchOffInlining :: SimplEnv -> SimplEnv
+switchOffInlining (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
+ = SimplEnv chkr encl_cc ty_env in_id_env nullIdEnv nullConApps
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
+type TypeEnv = TyVarEnv Type
type InTypeEnv = TypeEnv -- Maps InTyVars to OutTypes
extendTyEnv :: SimplEnv -> TyVar -> Type -> SimplEnv
where
new_ty_env = growTyVarEnvList ty_env pairs
-simplTy (SimplEnv _ _ ty_env _ _ _) ty = applyTypeEnvToTy ty_env ty
-simplTyInId (SimplEnv _ _ ty_env _ _ _) id = applyTypeEnvToId ty_env id
+simplTy (SimplEnv _ _ ty_env _ _ _) ty = returnEager (applyTypeEnvToTy ty_env ty)
+simplTyInId (SimplEnv _ _ ty_env _ _ _) id = returnEager (applyTypeEnvToId ty_env id)
\end{code}
%************************************************************************
\end{code}
\begin{code}
-lookupId :: SimplEnv -> Id -> OutArg
+lookupId :: SimplEnv -> Id -> Eager ans OutArg
lookupId (SimplEnv _ _ _ in_id_env _ _) id
= case (lookupIdEnv in_id_env id) of
- Just atom -> atom
- Nothing -> VarArg id
+ Just atom -> returnEager atom
+ Nothing -> returnEager (VarArg id)
\end{code}
\begin{code}
extendIdEnvWithAtom (SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
(in_id,occ_info) atom
- = SimplEnv chkr encl_cc ty_env new_in_id_env new_out_id_env con_apps
+ = case atom of
+ LitArg _ -> SimplEnv chkr encl_cc ty_env new_in_id_env out_id_env con_apps
+ VarArg out_id -> SimplEnv chkr encl_cc ty_env new_in_id_env
+ (modifyOccInfo out_id_env (uniqueOf out_id, occ_info)) con_apps
+--SimplEnv chkr encl_cc ty_env new_in_id_env new_out_id_env con_apps
where
new_in_id_env = addOneToIdEnv in_id_env in_id atom
+{-
new_out_id_env = case atom of
LitArg _ -> out_id_env
VarArg out_id -> modifyOccInfo out_id_env (uniqueOf out_id, occ_info)
+-}
extendIdEnvWithAtoms :: SimplEnv -> [(InBinder, OutArg)] -> SimplEnv
extendIdEnvWithAtoms = foldr (\ (bndr,val) env -> extendIdEnvWithAtom env bndr val)
-> (OutId, BinderInfo, RhsInfo)
-> (OutId, BinderInfo, RhsInfo)
modifyOutEnvItem (id, occ, info1) (_, _, info2)
- = (id, occ, new_info)
- where
- new_info = case (info1, info2) of
- (OtherLit ls1, OtherLit ls2) -> OtherLit (ls1++ls2)
- (OtherCon cs1, OtherCon cs2) -> OtherCon (cs1++cs2)
- (_, NoRhsInfo) -> info1
- other -> info2
+ = case (info1, info2) of
+ (OtherLit ls1, OtherLit ls2) -> (id,occ, OtherLit (ls1++ls2))
+ (OtherCon cs1, OtherCon cs2) -> (id,occ, OtherCon (cs1++cs2))
+ (_, NoRhsInfo) -> (id,occ, info1)
+ other -> (id,occ, info2)
\end{code}
isEvaluated other = False
\end{code}
-@extendUnfoldEnvGivenRhs@ records in the UnfoldEnv info about the RHS
-of a new binding. There is a horrid case we have to take care about,
-due to Andr\'e Santos:
-@
- type Array_type b = Array Int b;
- type Descr_type = (Int,Int);
- tabulate :: (Int -> x) -> Descr_type -> Array_type x;
- tabulate f (l,u) = listArray (l,u) [f i | i <- [l..u]];
-
- f_iaamain a_xs=
- let {
- f_aareorder::(Array_type Int) -> (Array_type t1) -> Array_type t1;
- f_aareorder a_index a_ar=
- let {
- f_aareorder' a_i= a_ar ! (a_index ! a_i)
- } in tabulate f_aareorder' (bounds a_ar);
- r_index=tabulate ((+) 1) (1,1);
- arr = listArray (1,1) a_xs;
- arg = f_aareorder r_index arr
- } in elems arg
-@
-Now, when the RHS of arg gets simplified, we inline f_aareorder to get
-@
- arg = let f_aareorder' a_i = arr ! (r_index ! a_i)
- in tabulate f_aareorder' (bounds arr)
-@
-Note that r_index is not inlined, because it was bound to a_index which
-occurs inside a lambda.
-
-Alas, if elems is inlined, so that (elems arg) becomes (case arg of ...),
-then arg is inlined. IF WE USE THE NEW VERSION OF arg, and re-occurrence
-analyse it, we won't spot the inside-lambda property of r_index, so r_index
-will get inlined inside the lambda. AARGH.
-
-Solution: when we occurrence-analyse the new RHS we have to go back
-and modify the info recorded in the UnfoldEnv for the free vars
-of the RHS. In the example we'd go back and record that r_index is now used
-inside a lambda.
\begin{code}
-extendEnvGivenNewRhs :: SimplEnv -> OutId -> OutExpr -> SimplEnv
-extendEnvGivenNewRhs env out_id rhs
- = extendEnvGivenBinding env noBinderInfo out_id rhs
-
-extendEnvGivenBinding :: SimplEnv -> BinderInfo -> OutId -> OutExpr -> SimplEnv
-extendEnvGivenBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
- occ_info out_id rhs
- = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env new_con_apps
- where
- new_con_apps = extendConApps con_apps out_id rhs
- new_out_id_env = case guidance of
- UnfoldNever -> out_id_env -- No new stuff to put in
- other -> out_id_env_with_unfolding
-
- -- If there is an unfolding, we add rhs-info for out_id,
- -- *and* modify the occ info for rhs's interesting free variables.
- --
- -- If the out_id is already in the OutIdEnv, then just replace the
- -- unfolding, leaving occurrence info alone (this must then
- -- be a call via extendEnvGivenNewRhs).
- out_id_env_with_unfolding = foldl modifyOccInfo env1 full_fv_occ_info
- -- full_fv_occ_info combines the occurrence of the current binder
- -- with the occurrences of its RHS's free variables.
- full_fv_occ_info = [ (uniq, fv_occ `andBinderInfo` occ_info)
- | (uniq,fv_occ) <- ufmToList fv_occ_info
- ]
- env1 = addToUFM_C modifyOutEnvItem out_id_env out_id
- (out_id, occ_info, rhs_info)
-
- -- Occurrence-analyse the RHS
- -- The "interesting" free variables we want occurrence info for are those
- -- in the OutIdEnv that have only a single occurrence right now.
- (fv_occ_info, template) = occurAnalyseExpr interesting_fvs rhs
- interesting_fvs = mkIdSet [id | (id,OneOcc _ _ _ _ _,_) <- eltsUFM out_id_env]
-
- -- Compute unfolding details
- rhs_info = OutUnfolding unf_cc (SimpleUnfolding form_summary guidance template)
- form_summary = mkFormSummary rhs
-
- guidance = mkSimplUnfoldingGuidance chkr out_id rhs
-
- -- Compute cost centre for thing
- unf_cc | noCostCentreAttached expr_cc = encl_cc
- | otherwise = expr_cc
- where
- expr_cc = coreExprCc rhs
-
-{- We need to be pretty careful when extending
- the environment with RHS info in recursive groups.
-
-Here's a nasty example:
-
- letrec r = f x
- t = r
- x = ...t...
- in
- ...t...
-
-Here, r occurs exactly once, so we may reasonably inline r in t's RHS.
-But the pre-simplified t's rhs is an atom, r, so we may also decide to
-inline t everywhere. But if we do *both* these reasonable things we get
-
- letrec r = f x
- t = f x
- x = ...r...
- in
- ...t...
-
-(The t in the body doesn't get inlined because by the time the recursive
-group is done we see that t's RHS isn't an atom.)
-
-Bad news! (f x) is duplicated! Our solution is to only be prepared to
-inline RHSs in their own RHSs if they are *values* (lambda or constructor).
-
-This means that silly x=y bindings in recursive group will never go away. Sigh. ToDo!
--}
-
-extendEnvForRecBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
- (out_id, ((_,occ_info), old_rhs))
- = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env con_apps
- where
- new_out_id_env = case (form_summary, guidance) of
- (ValueForm, UnfoldNever) -> out_id_env -- No new stuff to put in
- (ValueForm, _) -> out_id_env_with_unfolding
- other -> out_id_env -- Not a value
-
- -- If there is an unfolding, we add rhs-info for out_id,
- -- No need to modify occ info because RHS is pre-simplification
- out_id_env_with_unfolding = addOneToIdEnv out_id_env out_id
- (out_id, occ_info, rhs_info)
-
- -- Compute unfolding details
- rhs_info = InUnfolding env (SimpleUnfolding form_summary guidance old_rhs)
- form_summary = mkFormSummary old_rhs
- guidance = mkSimplUnfoldingGuidance chkr out_id (unTagBinders old_rhs)
-
-
mkSimplUnfoldingGuidance chkr out_id rhs
- | not (switchIsOn chkr IgnoreINLINEPragma) && idWantsToBeINLINEd out_id
- = UnfoldAlways
-
- | otherwise
- = calcUnfoldingGuidance True{-sccs OK-} bOMB_OUT_SIZE rhs
- where
- bOMB_OUT_SIZE = getSimplIntSwitch chkr SimplUnfoldingCreationThreshold
+ = calcUnfoldingGuidance (getInlinePragma out_id) opt_UnfoldingCreationThreshold rhs
extendEnvGivenRhsInfo :: SimplEnv -> OutId -> BinderInfo -> RhsInfo -> SimplEnv
extendEnvGivenRhsInfo env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
+
+
+============================ OLD ================================
+ This version was used when we use the *simplified* RHS of a
+ let as the thing's unfolding. The has the nasty property described
+ in the following comments. Much worse, it can fail to terminate
+ on recursive things. Consider
+
+ letrec f = \x -> let z = f x' in ...
+
+ in
+ let n = f y
+ in
+ case n of { ... }
+
+ If 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!
+
+
+@extendUnfoldEnvGivenRhs@ records in the UnfoldEnv info about the RHS
+of a new binding. There is a horrid case we have to take care about,
+due to Andr\'e Santos:
+@
+ type Array_type b = Array Int b;
+ type Descr_type = (Int,Int);
+
+ tabulate :: (Int -> x) -> Descr_type -> Array_type x;
+ tabulate f (l,u) = listArray (l,u) [f i | i <- [l..u]];
+
+ f_iaamain a_xs=
+ let {
+ f_aareorder::(Array_type Int) -> (Array_type t1) -> Array_type t1;
+ f_aareorder a_index a_ar=
+ let {
+ f_aareorder' a_i= a_ar ! (a_index ! a_i)
+ } in tabulate f_aareorder' (bounds a_ar);
+ r_index=tabulate ((+) 1) (1,1);
+ arr = listArray (1,1) a_xs;
+ arg = f_aareorder r_index arr
+ } in elems arg
+@
+Now, when the RHS of arg gets simplified, we inline f_aareorder to get
+@
+ arg = let f_aareorder' a_i = arr ! (r_index ! a_i)
+ in tabulate f_aareorder' (bounds arr)
+@
+Note that r_index is not inlined, because it was bound to a_index which
+occurs inside a lambda.
+
+Alas, if elems is inlined, so that (elems arg) becomes (case arg of ...),
+then arg is inlined. IF WE USE THE NEW VERSION OF arg, and re-occurrence
+analyse it, we won't spot the inside-lambda property of r_index, so r_index
+will get inlined inside the lambda. AARGH.
+
+Solution: when we occurrence-analyse the new RHS we have to go back
+and modify the info recorded in the UnfoldEnv for the free vars
+of the RHS. In the example we'd go back and record that r_index is now used
+inside a lambda.
+
+\begin{code}
+extendEnvGivenNewRhs :: SimplEnv -> OutId -> OutExpr -> SimplEnv
+extendEnvGivenNewRhs env out_id rhs
+ = extendEnvGivenBinding env noBinderInfo out_id rhs
+
+extendEnvGivenBinding :: SimplEnv -> BinderInfo -> OutId -> OutExpr -> SimplEnv
+extendEnvGivenBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
+ occ_info out_id rhs
+ = SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env new_con_apps
+ where
+ new_out_id_env = case guidance of
+ UnfoldNever -> out_id_env -- No new stuff to put in
+ other -> out_id_env_with_unfolding
+
+ new_con_apps = _scc_ "eegnr.conapps"
+ extendConApps con_apps out_id rhs
+
+ -- Modify the occ info for rhs's interesting free variables.
+ out_id_env_with_unfolding = _scc_ "eegnr.modify_occ"
+ foldl modifyOccInfo env1 full_fv_occ_info
+ -- NB: full_fv_occ_info *combines* the occurrence of the current binder
+ -- with the occurrences of its RHS's free variables. That's to take
+ -- account of:
+ -- let a = \x -> BIG in
+ -- let b = \f -> f a
+ -- in ...b...b...b...
+ -- Here "a" occurs exactly once. "b" simplifies to a small value.
+ -- So "b" will be inlined at each call site, and there's a good chance
+ -- that "a" will too. So we'd better modify "a"s occurrence info to
+ -- record the fact that it can now occur many times by virtue that "b" can.
+
+ full_fv_occ_info = _scc_ "eegnr.full_fv"
+ [ (uniq, fv_occ `andBinderInfo` occ_info)
+ | (uniq, fv_occ) <- ufmToList fv_occ_info
+ ]
+
+ -- Add an unfolding and rhs_info for the new Id.
+ -- If the out_id is already in the OutIdEnv (which can happen if
+ -- the call to extendEnvGivenBinding is from extendEnvGivenNewRhs)
+ -- then just replace the unfolding, leaving occurrence info alone.
+ env1 = _scc_ "eegnr.modify_out"
+ addToUFM_C modifyOutEnvItem out_id_env out_id
+ (out_id, occ_info, rhs_info)
+
+ -- Occurrence-analyse the RHS
+ -- The "interesting" free variables we want occurrence info for are those
+ -- in the OutIdEnv that have only a single occurrence right now.
+ (fv_occ_info, template) = _scc_ "eegnr.occ-anal"
+ occurAnalyseExpr is_interesting rhs
+
+ is_interesting v = _scc_ "eegnr.mkidset"
+ case lookupIdEnv out_id_env v of
+ Just (_, OneOcc _ _ _ _ _, _) -> True
+ other -> False
+
+ -- Compute unfolding details
+ rhs_info = OutUnfolding unf_cc (SimpleUnfolding form_summary guidance template)
+ form_summary = _scc_ "eegnr.form_sum"
+ mkFormSummary rhs
+ guidance = _scc_ "eegnr.guidance"
+ mkSimplUnfoldingGuidance chkr out_id rhs
+
+ -- Compute cost centre for thing
+ unf_cc | noCostCentreAttached expr_cc = encl_cc
+ | otherwise = expr_cc
+ where
+ expr_cc = coreExprCc rhs
+\end{code}
+
+
+
+
+========================== OLD [removed SLPJ March 97] ====================
+
+I removed the attempt to inline recursive bindings when I discovered
+a program that made the simplifier loop (nofib/spectral/hartel/typecheck/Main.hs)
+
+The nasty case is this:
+
+ letrec f = \x -> let z = f x' in ...
+
+ in
+ let n = f y
+ in
+ case n of { ... }
+
+If 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!
+
+Recursive bindings
+~~~~~~~~~~~~~~~~~~
+We need to be pretty careful when extending
+the environment with RHS info in recursive groups.
+
+Here's a nasty example:
+
+ letrec r = f x
+ t = r
+ x = ...t...
+ in
+ ...t...
+
+Here, r occurs exactly once, so we may reasonably inline r in t's RHS.
+But the pre-simplified t's rhs is an atom, r, so we may also decide to
+inline t everywhere. But if we do *both* these reasonable things we get
+
+ letrec r = f x
+ t = f x
+ x = ...r...
+ in
+ ...t...
+
+Bad news! (f x) is duplicated! (The t in the body doesn't get
+inlined because by the time the recursive group is done we see that
+t's RHS isn't an atom.)
+
+Our solution is this:
+ (a) we inline un-simplified RHSs, and then simplify
+ them in a clone-only environment.
+ (b) we inline only variables and values
+This means that
+
+
+ r = f x ==> r = f x
+ t = r ==> t = r
+ x = ...t... ==> x = ...r...
+ in in
+ t r
+
+Now t is dead, and we're home.
+
+Most silly x=y bindings in recursive group will go away. But not all:
+
+ let y = 1:x
+ x = y
+
+Here, we can't inline x because it's in an argument position. so we'll just replace
+with a clone of y. Instead we'll probably inline y (a small value) to give
+
+ let y = 1:x
+ x = 1:y
+
+which is OK if not clever.
+
+
+
+\begin{code}
+{-
+extendEnvForRecBinding env@(SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps)
+ (out_id, ((_,occ_info), old_rhs))
+ = case (form_summary, guidance) of
+ (_, UnfoldNever) -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps -- No new stuff to put in
+ (ValueForm, _) -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env_with_unfolding con_apps
+ (VarForm, _) -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env_with_unfolding con_apps
+ other -> SimplEnv chkr encl_cc ty_env in_id_env out_id_env con_apps -- Not a value or variable
+
+-- SimplEnv chkr encl_cc ty_env in_id_env new_out_id_env con_apps
+ where
+{-
+ new_out_id_env = case (form_summary, guidance) of
+ (_, UnfoldNever) -> out_id_env -- No new stuff to put in
+ (ValueForm, _) -> out_id_env_with_unfolding
+ (VarForm, _) -> out_id_env_with_unfolding
+ other -> out_id_env -- Not a value or variable
+-}
+ -- If there is an unfolding, we add rhs-info for out_id,
+ -- No need to modify occ info because RHS is pre-simplification
+ out_id_env_with_unfolding = addOneToIdEnv out_id_env out_id
+ (out_id, occ_info, rhs_info)
+
+ -- Compute unfolding details
+ -- Note that we use the "old" environment, that just has clones of the rec-bound vars,
+ -- in the InUnfolding. So if we ever use the InUnfolding we'll just inline once.
+ -- Only if the thing is still small enough next time round will we inline again.
+ rhs_info = InUnfolding env (SimpleUnfolding form_summary guidance old_rhs)
+ form_summary = mkFormSummary old_rhs
+ guidance = mkSimplUnfoldingGuidance chkr out_id (unTagBinders old_rhs)
+-}
+\end{code}
projects / ghc-hetmet.git / blobdiff