X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=bb832837eab3a0ee3e8146230836db02f130c7b5;hb=2d7794dcb47f8d157d284912dbff3f65dedc0a2b;hp=5c3c789c79b04d7f4ac6664019312a0ab931656d;hpb=9bcd95bad83ee937c178970e8b729732e680fe1e;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 5c3c789..bb83283 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -27,10 +27,7 @@ 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 ) @@ -43,9 +40,9 @@ 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 ) @@ -64,10 +61,10 @@ 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} @@ -100,22 +97,18 @@ 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 - (guts, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do + (guts2, stats) <- runCoreM hsc_env ann_env imp_rule_base cp_us mod $ do -- FIND BUILT-IN PASSES let builtin_core_todos = getCoreToDo dflags - -- Note [Injecting implicit bindings] - let implicit_binds = getImplicitBinds (mg_types guts1) - guts2 = guts1 { mg_binds = implicit_binds ++ mg_binds guts1 } - -- DO THE BUSINESS - doCorePasses builtin_core_todos guts2 + doCorePasses builtin_core_todos guts1 Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "Grand total simplifier statistics" (pprSimplCount stats) - return guts + return guts2 type CorePass = CoreToDo @@ -185,7 +178,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 $ @@ -307,48 +300,6 @@ observe do_pass = doPassM $ \binds -> do %************************************************************************ %* * - Implicit bindings -%* * -%************************************************************************ - -Note [Injecting implicit bindings] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We used to inject the implict bindings right at the end, in CoreTidy. -But some of these bindings, notably record selectors, are not -constructed in an optimised form. E.g. record selector for - data T = MkT { x :: {-# UNPACK #-} !Int } -Then the unfolding looks like - x = \t. case t of MkT x1 -> let x = I# x1 in x -This generates bad code unless it's first simplified a bit. -(Only matters when the selector is used curried; eg map x ys.) -See Trac #2070. - -\begin{code} -getImplicitBinds :: TypeEnv -> [CoreBind] -getImplicitBinds type_env - = map get_defn (concatMap implicit_con_ids (typeEnvTyCons type_env) - ++ concatMap other_implicit_ids (typeEnvElts type_env)) - -- Put the constructor wrappers first, because - -- other implicit bindings (notably the fromT functions arising - -- from generics) use the constructor wrappers. At least that's - -- what External Core likes - where - implicit_con_ids tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc) - - other_implicit_ids (ATyCon tc) = filter (not . isNaughtyRecordSelector) (tyConSelIds tc) - -- The "naughty" ones are not real functions at all - -- They are there just so we can get decent error messages - -- See Note [Naughty record selectors] in MkId.lhs - other_implicit_ids (AClass cl) = classSelIds cl - other_implicit_ids _other = [] - - get_defn :: Id -> CoreBind - get_defn id = NonRec id (unfoldingTemplate (idUnfolding id)) -\end{code} - - -%************************************************************************ -%* * Dealing with rules %* * %************************************************************************ @@ -685,22 +636,20 @@ 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 -~~~~~~~~~~~~~~~~~~~~ +Note [Messing up the exported Id's IdInfo] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must be careful about discarding the IdInfo on the old Id + The example that went bad on me at one stage was this one: iterate :: (a -> a) -> a -> [a] @@ -734,13 +683,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 ~~~~~~~~~~~~~ @@ -811,6 +775,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 @@ -825,23 +790,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