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 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 )
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}
-- _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
doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-}
describePassR "SpecConstr" Opt_D_dump_spec $
- doPassDU specConstrProgram
+ specConstrProgram
doCorePass (CoreDoVectorisation be) = {-# SCC "Vectorise" #-}
describePass "Vectorisation" Opt_D_dump_vect $
%************************************************************************
%* *
- 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
%* *
%************************************************************************
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]
-> 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 = <stuff>
+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
~~~~~~~~~~~~~
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
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
projects / ghc-hetmet.git / blobdiff