X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=beb1ed0e7cfb74c8b75d28cd5b28611c9c2a611f;hp=98ef348be7adfbb67481cf6a0ceca198a796c0a7;hb=2662dbc5b2c30fc11ccb99e7f9b2dba794d680ba;hpb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569 diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 98ef348..beb1ed0 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -19,6 +19,7 @@ import DynFlags ( CoreToDo(..), SimplifierSwitch(..), SimplifierMode(..), DynFlags, DynFlag(..), dopt, getCoreToDo, shouldDumpSimplPhase ) import CoreSyn +import CoreSubst import HscTypes import CSE ( cseProgram ) import Rules ( RuleBase, emptyRuleBase, mkRuleBase, unionRuleBase, @@ -27,25 +28,24 @@ import Rules ( RuleBase, emptyRuleBase, mkRuleBase, unionRuleBase, addSpecInfo, addIdSpecialisations ) import PprCore ( pprCoreBindings, pprCoreExpr, pprRules ) import OccurAnal ( occurAnalysePgm, occurAnalyseExpr ) -import IdInfo ( setNewStrictnessInfo, newStrictnessInfo, - setWorkerInfo, workerInfo, setSpecInfoHead, - setInlinePragInfo, inlinePragInfo, - setSpecInfo, specInfo, specInfoRules ) +import IdInfo import CoreUtils ( coreBindsSize ) import Simplify ( simplTopBinds, simplExpr ) -import SimplEnv ( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet ) +import SimplUtils ( simplEnvForGHCi, simplEnvForRules ) +import SimplEnv import SimplMonad import CoreMonad -import qualified ErrUtils as Err ( dumpIfSet_dyn, dumpIfSet, showPass ) -import CoreLint ( showPass, endPass, endPassIf, endIteration ) +import qualified ErrUtils as Err +import CoreLint +import CoreMonad ( endPass ) import FloatIn ( floatInwards ) import FloatOut ( floatOutwards ) import FamInstEnv import Id import DataCon -import TyCon ( tyConSelIds, tyConDataCons ) +import TyCon ( tyConDataCons ) import Class ( classSelIds ) -import BasicTypes ( CompilerPhase, isActive ) +import BasicTypes ( CompilerPhase, isActive, isDefaultInlinePragma ) import VarSet import VarEnv import NameEnv ( lookupNameEnv ) @@ -55,19 +55,15 @@ import Specialise ( specProgram) import SpecConstr ( specConstrProgram) import DmdAnal ( dmdAnalPgm ) import WorkWrap ( wwTopBinds ) -#ifdef OLD_STRICTNESS -import StrictAnal ( saBinds ) -import CprAnalyse ( cprAnalyse ) -#endif import Vectorise ( vectorise ) import FastString import Util import UniqSupply ( UniqSupply, mkSplitUniqSupply, splitUniqSupply ) -import IO ( hPutStr, stderr ) import Outputable import Control.Monad -import List ( partition, intersperse ) +import Data.List +import System.IO import Maybes \end{code} @@ -92,7 +88,7 @@ core2core hsc_env guts = do ann_env <- prepareAnnotations hsc_env (Just guts) -- COMPUTE THE RULE BASE TO USE - (imp_rule_base, guts1) <- prepareRules hsc_env guts ru_us + (hpt_rule_base, guts1) <- prepareRules hsc_env guts ru_us -- Get the module out of the current HscEnv so we can retrieve it from the monad. -- This is very convienent for the users of the monad (e.g. plugins do not have to @@ -100,7 +96,7 @@ core2core hsc_env guts = do -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which -- would mean our cached value would go out of date. let mod = mg_module guts - (guts2, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do + (guts2, stats) <- runCoreM hsc_env ann_env hpt_rule_base cp_us mod $ do -- FIND BUILT-IN PASSES let builtin_core_todos = getCoreToDo dflags @@ -121,6 +117,8 @@ simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do -> IO CoreExpr -- simplifyExpr is called by the driver to simplify an -- expression typed in at the interactive prompt +-- +-- Also used by Template Haskell simplifyExpr dflags expr = do { ; Err.showPass dflags "Simplify" @@ -128,7 +126,7 @@ simplifyExpr dflags expr ; us <- mkSplitUniqSupply 's' ; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $ - simplExprGently gentleSimplEnv expr + simplExprGently simplEnvForGHCi expr ; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression" (pprCoreExpr expr') @@ -136,9 +134,6 @@ simplifyExpr dflags expr ; return expr' } -gentleSimplEnv :: SimplEnv -gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl []) - doCorePasses :: [CorePass] -> ModGuts -> CoreM ModGuts doCorePasses passes guts = foldM (flip doCorePass) guts passes @@ -181,7 +176,7 @@ doCorePass CoreDoSpecialising = {-# SCC "Specialise" #-} doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-} describePassR "SpecConstr" Opt_D_dump_spec $ - doPassDU specConstrProgram + specConstrProgram doCorePass (CoreDoVectorisation be) = {-# SCC "Vectorise" #-} describePass "Vectorisation" Opt_D_dump_vect $ @@ -191,24 +186,8 @@ doCorePass CoreDoGlomBinds = dontDescribePass $ doPassDM glomBinds doCorePass CoreDoPrintCore = dontDescribePass $ observe printCore doCorePass (CoreDoRuleCheck phase pat) = dontDescribePass $ ruleCheck phase pat -#ifdef OLD_STRICTNESS -doCorePass CoreDoOldStrictness = {-# SCC "OldStrictness" #-} doOldStrictness -#endif - doCorePass CoreDoNothing = return doCorePass (CoreDoPasses passes) = doCorePasses passes - -#ifdef OLD_STRICTNESS -doOldStrictness :: ModGuts -> CoreM ModGuts -doOldStrictness guts - = do dfs <- getDynFlags - guts' <- describePass "Strictness analysis" Opt_D_dump_stranal $ - doPassM (saBinds dfs) guts - guts'' <- describePass "Constructed Product analysis" Opt_D_dump_cpranal $ - doPass cprAnalyse guts' - return guts'' -#endif - \end{code} %************************************************************************ @@ -226,10 +205,10 @@ describePass :: String -> DynFlag -> (ModGuts -> CoreM ModGuts) -> ModGuts -> Co describePass name dflag pass guts = do dflags <- getDynFlags - liftIO $ showPass dflags name + liftIO $ Err.showPass dflags name guts' <- pass guts - liftIO $ endPass dflags name dflag (mg_binds guts') - + liftIO $ endPass dflags name dflag (mg_binds guts') (mg_rules guts') + return guts' describePassD :: SDoc -> DynFlag -> (ModGuts -> CoreM ModGuts) -> ModGuts -> CoreM ModGuts @@ -322,64 +301,74 @@ prepareRules :: HscEnv ModGuts) -- Modified fields are -- (a) Bindings have rules attached, + -- and INLINE rules simplified -- (b) Rules are now just orphan rules prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt }) guts@(ModGuts { mg_binds = binds, mg_deps = deps , mg_rules = local_rules, mg_rdr_env = rdr_env }) us - = do { let -- Simplify the local rules; boringly, we need to make an in-scope set + = do { us <- mkSplitUniqSupply 'w' + + ; let -- Simplify the local rules; boringly, we need to make an in-scope set -- from the local binders, to avoid warnings from Simplify.simplVar local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds)) - env = setInScopeSet gentleSimplEnv local_ids - (better_rules,_) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $ - (mapM (simplRule env) local_rules) - home_pkg_rules = hptRules hsc_env (dep_mods deps) - - -- Find the rules for locally-defined Ids; then we can attach them - -- to the binders in the top-level bindings - -- - -- Reason - -- - It makes the rules easier to look up - -- - It means that transformation rules and specialisations for - -- locally defined Ids are handled uniformly - -- - It keeps alive things that are referred to only from a rule - -- (the occurrence analyser knows about rules attached to Ids) - -- - It makes sure that, when we apply a rule, the free vars - -- of the RHS are more likely to be in scope - -- - The imported rules are carried in the in-scope set - -- which is extended on each iteration by the new wave of - -- local binders; any rules which aren't on the binding will - -- thereby get dropped - (rules_for_locals, rules_for_imps) = partition isLocalRule better_rules - local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals - binds_w_rules = updateBinders local_rule_base binds - - hpt_rule_base = mkRuleBase home_pkg_rules - imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps + env = setInScopeSet simplEnvForRules local_ids + (simpl_rules, _) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $ + mapM (simplRule env) local_rules + + ; let (rules_for_locals, rules_for_imps) = partition isLocalRule simpl_rules + + home_pkg_rules = hptRules hsc_env (dep_mods deps) + hpt_rule_base = mkRuleBase home_pkg_rules + binds_w_rules = updateBinders rules_for_locals binds + ; Err.dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules" (withPprStyle (mkUserStyle (mkPrintUnqualified dflags rdr_env) AllTheWay) $ - vcat [text "Local rules", pprRules better_rules, - text "", - text "Imported rules", pprRuleBase imp_rule_base]) + vcat [text "Local rules", pprRules simpl_rules, + blankLine, + text "Imported rules", pprRuleBase hpt_rule_base]) - ; return (imp_rule_base, guts { mg_binds = binds_w_rules, + ; return (hpt_rule_base, guts { mg_binds = binds_w_rules, mg_rules = rules_for_imps }) } -updateBinders :: RuleBase -> [CoreBind] -> [CoreBind] -updateBinders local_rules binds - = map update_bndrs binds +-- Note [Attach rules to local ids] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- Find the rules for locally-defined Ids; then we can attach them +-- to the binders in the top-level bindings +-- +-- Reason +-- - It makes the rules easier to look up +-- - It means that transformation rules and specialisations for +-- locally defined Ids are handled uniformly +-- - It keeps alive things that are referred to only from a rule +-- (the occurrence analyser knows about rules attached to Ids) +-- - It makes sure that, when we apply a rule, the free vars +-- of the RHS are more likely to be in scope +-- - The imported rules are carried in the in-scope set +-- which is extended on each iteration by the new wave of +-- local binders; any rules which aren't on the binding will +-- thereby get dropped + +updateBinders :: [CoreRule] -> [CoreBind] -> [CoreBind] +updateBinders rules_for_locals binds + = map update_bind binds where - update_bndrs (NonRec b r) = NonRec (update_bndr b) r - update_bndrs (Rec prs) = Rec [(update_bndr b, r) | (b,r) <- prs] - - update_bndr bndr = case lookupNameEnv local_rules (idName bndr) of - Nothing -> bndr - Just rules -> bndr `addIdSpecialisations` rules - -- The binder might have some existing rules, - -- arising from specialisation pragmas + local_rules = extendRuleBaseList emptyRuleBase rules_for_locals + + update_bind (NonRec b r) = NonRec (add_rules b) r + update_bind (Rec prs) = Rec (mapFst add_rules prs) + + -- See Note [Attach rules to local ids] + -- NB: the binder might have some existing rules, + -- arising from specialisation pragmas + add_rules bndr + | Just rules <- lookupNameEnv local_rules (idName bndr) + = bndr `addIdSpecialisations` rules + | otherwise + = bndr \end{code} Note [Simplifying the left-hand side of a RULE] @@ -396,25 +385,19 @@ we do not want to get otherwise we don't match when given an argument like augment (\a. h a a) (build h) +The simplifier does indeed do eta reduction (it's in +Simplify.completeLam) but only if -O is on. + \begin{code} +simplRule :: SimplEnv -> CoreRule -> SimplM CoreRule simplRule env rule@(BuiltinRule {}) = return rule simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) = do (env, bndrs') <- simplBinders env bndrs args' <- mapM (simplExprGently env) args rhs' <- simplExprGently env rhs - return (rule { ru_bndrs = bndrs', ru_args = args', ru_rhs = rhs' }) - --- It's important that simplExprGently does eta reduction. --- For example, in a rule like: --- augment g (build h) --- we do not want to get --- augment (\a. g a) (build h) --- otherwise we don't match when given an argument like --- (\a. h a a) --- --- The simplifier does indeed do eta reduction (it's in --- Simplify.completeLam) but only if -O is on. + return (rule { ru_bndrs = bndrs', ru_args = args' + , ru_rhs = occurAnalyseExpr rhs' }) \end{code} \begin{code} @@ -497,45 +480,49 @@ simplifyPgm mode switches do { hsc_env <- getHscEnv ; us <- getUniqueSupplyM ; rb <- getRuleBase - ; let fam_inst_env = mg_fam_inst_env guts - dump_phase = shouldDumpSimplPhase (hsc_dflags hsc_env) mode - simplify_pgm = simplifyPgmIO dump_phase mode switches - hsc_env us rb fam_inst_env - - ; doPassM (liftIOWithCount . simplify_pgm) guts } + ; liftIOWithCount $ + simplifyPgmIO mode switches hsc_env us rb guts } where doc = ptext (sLit "Simplifier Phase") <+> text (showPpr mode) -simplifyPgmIO :: Bool - -> SimplifierMode - -> [SimplifierSwitch] - -> HscEnv - -> UniqSupply - -> RuleBase - -> FamInstEnv - -> [CoreBind] - -> IO (SimplCount, [CoreBind]) -- New bindings - -simplifyPgmIO dump_phase mode switches hsc_env us imp_rule_base fam_inst_env binds +simplifyPgmIO :: SimplifierMode + -> [SimplifierSwitch] + -> HscEnv + -> UniqSupply + -> RuleBase + -> ModGuts + -> IO (SimplCount, ModGuts) -- New bindings + +simplifyPgmIO mode switches hsc_env us hpt_rule_base + guts@(ModGuts { mg_binds = binds, mg_rules = rules + , mg_fam_inst_env = fam_inst_env }) = do { - (termination_msg, it_count, counts_out, binds') - <- do_iteration us 1 (zeroSimplCount dflags) binds ; + (termination_msg, it_count, counts_out, guts') + <- do_iteration us 1 (zeroSimplCount dflags) binds rules ; Err.dumpIfSet (dump_phase && dopt Opt_D_dump_simpl_stats dflags) "Simplifier statistics for following pass" (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations", - text "", + blankLine, pprSimplCount counts_out]); - return (counts_out, binds') + return (counts_out, guts') } where - dflags = hsc_dflags hsc_env + dflags = hsc_dflags hsc_env + dump_phase = shouldDumpSimplPhase dflags mode sw_chkr = isAmongSimpl switches max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2 - do_iteration us iteration_no counts binds + do_iteration :: UniqSupply + -> Int -- Counts iterations + -> SimplCount -- Logs optimisations performed + -> [CoreBind] -- Bindings in + -> [CoreRule] -- and orphan rules + -> IO (String, Int, SimplCount, ModGuts) + + do_iteration us iteration_no counts binds rules -- iteration_no is the number of the iteration we are -- about to begin, with '1' for the first | iteration_no > max_iterations -- Stop if we've run out of iterations @@ -545,14 +532,15 @@ simplifyPgmIO dump_phase mode switches hsc_env us imp_rule_base fam_inst_env bin " iterations; bailing out. Size = " ++ show (coreBindsSize binds) ++ "\n" )) -- Subtract 1 from iteration_no to get the -- number of iterations we actually completed - return ("Simplifier bailed out", iteration_no - 1, counts, binds) + return ("Simplifier bailed out", iteration_no - 1, counts, + guts { mg_binds = binds, mg_rules = rules }) -- Try and force thunks off the binds; significantly reduces -- space usage, especially with -O. JRS, 000620. | let sz = coreBindsSize binds in sz == sz = do { -- Occurrence analysis - let { tagged_binds = {-# SCC "OccAnal" #-} occurAnalysePgm binds } ; + let { tagged_binds = {-# SCC "OccAnal" #-} occurAnalysePgm binds rules } ; Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis" (pprCoreBindings tagged_binds); @@ -562,8 +550,9 @@ simplifyPgmIO dump_phase mode switches hsc_env us imp_rule_base fam_inst_env bin -- behind the scenes. Otherwise there's a danger we'll simply -- miss the rules for Ids hidden inside imported inlinings eps <- hscEPS hsc_env ; - let { rule_base' = unionRuleBase imp_rule_base (eps_rule_base eps) - ; simpl_env = mkSimplEnv mode sw_chkr + let { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps) + ; rule_base2 = extendRuleBaseList rule_base1 rules + ; simpl_env = mkSimplEnv sw_chkr mode ; simpl_binds = {-# SCC "SimplTopBinds" #-} simplTopBinds simpl_env tagged_binds ; fam_envs = (eps_fam_inst_env eps, fam_inst_env) } ; @@ -579,19 +568,18 @@ simplifyPgmIO dump_phase mode switches hsc_env us imp_rule_base fam_inst_env bin -- case t of {(_,counts') -> if counts'=0 then ... } -- So the conditional didn't force counts', because the -- selection got duplicated. Sigh! - case initSmpl dflags rule_base' fam_envs us1 simpl_binds of { - (binds', counts') -> do { + case initSmpl dflags rule_base2 fam_envs us1 simpl_binds of { + (env1, counts1) -> do { - let { all_counts = counts `plusSimplCount` counts' - ; herald = "Simplifier mode " ++ showPpr mode ++ - ", iteration " ++ show iteration_no ++ - " out of " ++ show max_iterations + let { all_counts = counts `plusSimplCount` counts1 + ; binds1 = getFloats env1 + ; rules1 = substRulesForImportedIds (mkCoreSubst env1) rules } ; -- Stop if nothing happened; don't dump output - if isZeroSimplCount counts' then - return ("Simplifier reached fixed point", iteration_no, - all_counts, binds') + if isZeroSimplCount counts1 then + return ("Simplifier reached fixed point", iteration_no, all_counts, + guts { mg_binds = binds1, mg_rules = rules1 }) else do { -- Short out indirections -- We do this *after* at least one run of the simplifier @@ -601,18 +589,30 @@ simplifyPgmIO dump_phase mode switches hsc_env us imp_rule_base fam_inst_env bin -- -- ToDo: alas, this means that indirection-shorting does not happen at all -- if the simplifier does nothing (not common, I know, but unsavoury) - let { binds'' = {-# SCC "ZapInd" #-} shortOutIndirections binds' } ; + let { binds2 = {-# SCC "ZapInd" #-} shortOutIndirections binds1 } ; -- Dump the result of this iteration - Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald - (pprSimplCount counts') ; - endIteration dflags herald Opt_D_dump_simpl_iterations binds'' ; + end_iteration dflags mode iteration_no max_iterations counts1 binds2 rules1 ; -- Loop - do_iteration us2 (iteration_no + 1) all_counts binds'' + do_iteration us2 (iteration_no + 1) all_counts binds2 rules1 } } } } where (us1, us2) = splitUniqSupply us + +------------------- +end_iteration :: DynFlags -> SimplifierMode -> Int -> Int + -> SimplCount -> [CoreBind] -> [CoreRule] -> IO () +-- Same as endIteration but with simplifier counts +end_iteration dflags mode iteration_no max_iterations counts binds rules + = do { Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations pass_name + (pprSimplCount counts) ; + + ; endIteration dflags pass_name Opt_D_dump_simpl_iterations binds rules } + where + pass_name = "Simplifier mode " ++ showPpr mode ++ + ", iteration " ++ show iteration_no ++ + " out of " ++ show max_iterations \end{code} @@ -639,23 +639,21 @@ save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and makes strictness information propagate better. This used to happen in the final phase, but it's tidier to do it here. +Note [Transferring IdInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~ +We want to propagage any useful IdInfo on x_local to x_exported. + STRICTNESS: if we have done strictness analysis, we want the strictness info on x_local to transfer to x_exported. Hence the copyIdInfo call. RULES: we want to *add* any RULES for x_local to x_exported. -Note [Rules and indirection-zapping] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Problem: what if x_exported has a RULE that mentions something in ...bindings...? -Then the things mentioned can be out of scope! Solution - a) Make sure that in this pass the usage-info from x_exported is - available for ...bindings... - b) If there are any such RULES, rec-ify the entire top-level. - It'll get sorted out next time round -Messing up the rules -~~~~~~~~~~~~~~~~~~~~ -The example that went bad on me at one stage was this one: +Note [Messing up the exported Id's RULES] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must be careful about discarding (obviously) or even merging the +RULES on the exported Id. The example that went bad on me at one stage +was this one: iterate :: (a -> a) -> a -> [a] [Exported] @@ -688,13 +686,28 @@ And now we get an infinite loop in the rule system -> iterateFB (:) f x -> iterate f x -Tiresome old solution: - don't do shorting out if f has rewrite rules (see shortableIdInfo) - -New solution (I think): +Old "solution": use rule switching-off pragmas to get rid of iterateList in the first place +But in principle the user *might* want rules that only apply to the Id +he says. And inline pragmas are similar + {-# NOINLINE f #-} + f = local + local = +Then we do not want to get rid of the NOINLINE. + +Hence hasShortableIdinfo. + + +Note [Rules and indirection-zapping] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Problem: what if x_exported has a RULE that mentions something in ...bindings...? +Then the things mentioned can be out of scope! Solution + a) Make sure that in this pass the usage-info from x_exported is + available for ...bindings... + b) If there are any such RULES, rec-ify the entire top-level. + It'll get sorted out next time round Other remarks ~~~~~~~~~~~~~ @@ -765,6 +778,7 @@ makeIndEnv binds add_pair (exported_id, rhs) env = env +----------------- shortMeOut ind_env exported_id local_id -- The if-then-else stuff is just so I can get a pprTrace to see -- how often I don't get shorting out becuase of IdInfo stuff @@ -779,23 +793,27 @@ shortMeOut ind_env exported_id local_id not (local_id `elemVarEnv` ind_env) -- Only if not already substituted for then - True - -{- No longer needed - if isEmptySpecInfo (specInfo (idInfo exported_id)) -- Only if no rules - then True -- See note on "Messing up rules" - else -#ifdef DEBUG - pprTrace "shortMeOut:" (ppr exported_id) -#endif - False --} + if hasShortableIdInfo exported_id + then True -- See Note [Messing up the exported Id's IdInfo] + else WARN( True, ptext (sLit "Not shorting out:") <+> ppr exported_id ) + False else - False + False +----------------- +hasShortableIdInfo :: Id -> Bool +-- True if there is no user-attached IdInfo on exported_id, +-- so we can safely discard it +-- See Note [Messing up the exported Id's IdInfo] +hasShortableIdInfo id + = isEmptySpecInfo (specInfo info) + && isDefaultInlinePragma (inlinePragInfo info) + where + info = idInfo id ----------------- transferIdInfo :: Id -> Id -> Id +-- See Note [Transferring IdInfo] -- If we have -- lcl_id = e; exp_id = lcl_id -- and lcl_id has useful IdInfo, we don't want to discard it by going @@ -806,8 +824,8 @@ transferIdInfo exported_id local_id = modifyIdInfo transfer exported_id where local_info = idInfo local_id - transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info - `setWorkerInfo` workerInfo local_info + transfer exp_info = exp_info `setStrictnessInfo` strictnessInfo local_info + `setUnfoldingInfo` unfoldingInfo local_info `setInlinePragInfo` inlinePragInfo local_info `setSpecInfo` addSpecInfo (specInfo exp_info) new_info new_info = setSpecInfoHead (idName exported_id)