#include "HsVersions.h"
-import CmdLineOpts ( opt_D_dump_simpl, opt_D_verbose_core2core, opt_UsageSPOn )
+import CmdLineOpts ( DynFlags, DynFlag(..), opt_UsageSPOn, dopt )
import CoreSyn
import CoreUnfold ( noUnfolding )
-import CoreLint ( beginPass, endPass )
-import Rules ( ProtoCoreRule(..) )
+import CoreLint ( showPass, endPass )
import UsageSPInf ( doUsageSPInf )
import VarEnv
import VarSet
import Var ( Id, Var )
-import Id ( idType, idInfo, idName,
+import Id ( idType, idInfo, idName, isExportedId,
mkVanillaId, mkId, exportWithOrigOccName,
idStrictness, setIdStrictness,
idDemandInfo, setIdDemandInfo,
)
import IdInfo ( specInfo, setSpecInfo,
- inlinePragInfo, setInlinePragInfo, InlinePragInfo(..),
setUnfoldingInfo, setDemandInfo,
workerInfo, setWorkerInfo, WorkerInfo(..)
)
import Demand ( wwLazy )
-import Name ( getOccName, tidyTopName, mkLocalName, isLocallyDefined )
+import Name ( getOccName, tidyTopName, mkLocalName )
import OccName ( initTidyOccEnv, tidyOccName )
-import Type ( tidyTopType, tidyType, tidyTypes, tidyTyVar, tidyTyVars )
+import Type ( tidyTopType, tidyType, tidyTyVar )
import Module ( Module )
-import UniqSupply ( UniqSupply )
+import UniqSupply ( mkSplitUniqSupply )
import Unique ( Uniquable(..) )
+import ErrUtils ( showPass )
import SrcLoc ( noSrcLoc )
import Util ( mapAccumL )
-import Outputable
\end{code}
Several tasks are done by @tidyCorePgm@
-1. Make certain top-level bindings into Globals. The point is that
+1. If @opt_UsageSPOn@ then compute usage information (which is
+ needed by Core2Stg). ** NOTE _scc_ HERE **
+ Do this first, because it may introduce new binders.
+
+2. Make certain top-level bindings into Globals. The point is that
Global things get externally-visible labels at code generation
time
-2. Give all binders a nice print-name. Their uniques aren't changed;
+3. Give all binders a nice print-name. Their uniques aren't changed;
rather we give them lexically unique occ-names, so that we can
safely print the OccNae only in the interface file. [Bad idea to
change the uniques, because the code generator makes global labels
from the uniques for local thunks etc.]
-
-3. If @opt_UsageSPOn@ then compute usage information (which is
- needed by Core2Stg). ** NOTE _scc_ HERE **
-
\begin{code}
-tidyCorePgm :: UniqSupply -> Module -> [CoreBind] -> [ProtoCoreRule]
- -> IO ([CoreBind], [ProtoCoreRule])
-tidyCorePgm us module_name binds_in rules
+tidyCorePgm :: DynFlags -> Module
+ -> [CoreBind] -> [IdCoreRule]
+ -> IO ([CoreBind], [IdCoreRule])
+tidyCorePgm dflags module_name binds_in orphans_in
= do
- beginPass "Tidy Core"
+ us <- mkSplitUniqSupply 'u'
+
+ showPass dflags "Tidy Core"
+
+ binds_in1 <- if opt_UsageSPOn
+ then _scc_ "CoreUsageSPInf"
+ doUsageSPInf dflags us binds_in
+ else return binds_in
- let (tidy_env1, binds_tidy) = mapAccumL (tidyBind (Just module_name)) init_tidy_env binds_in
- rules_out = tidyProtoRules tidy_env1 rules
+ let (tidy_env1, binds_out) = mapAccumL (tidyBind (Just module_name))
+ init_tidy_env binds_in1
+ orphans_out = tidyIdRules tidy_env1 orphans_in
- binds_out <- if opt_UsageSPOn
- then _scc_ "CoreUsageSPInf" doUsageSPInf us binds_tidy
- else return binds_tidy
+ endPass dflags "Tidy Core" (dopt Opt_D_dump_simpl dflags ||
+ dopt Opt_D_verbose_core2core dflags)
+ binds_out
- endPass "Tidy Core" (opt_D_dump_simpl || opt_D_verbose_core2core) binds_out
- return (binds_out, rules_out)
+ return (binds_out, orphans_out)
where
-- We also make sure to avoid any exported binders. Consider
-- f{-u1-} = 1 -- Local decl
tidyTopId mod env@(tidy_env, var_env) env_idinfo id
= -- Top level variables
let
- (tidy_env', name') | exportWithOrigOccName id = (tidy_env, idName id)
- | otherwise = tidyTopName mod tidy_env (idName id)
+ (tidy_env', name') = tidyTopName mod tidy_env (isExportedId id) (idName id)
ty' = tidyTopType (idType id)
idinfo' = tidyIdInfo env_idinfo (idInfo id)
id' = mkId name' ty' idinfo'
| otherwise = info `setSpecInfo` tidyRules env rules
info3 = info2 `setUnfoldingInfo` noUnfolding
- info4 = info3 `setDemandInfo` wwLazy -- I don't understand why...
+ info4 = info3 `setDemandInfo` wwLazy
info5 = case workerInfo info of
NoWorker -> info4
HasWorker w a -> info4 `setWorkerInfo` HasWorker (tidyVarOcc env w) a
-tidyProtoRules :: TidyEnv -> [ProtoCoreRule] -> [ProtoCoreRule]
-tidyProtoRules env rules
- = [ ProtoCoreRule is_local (tidyVarOcc env fn) (tidyRule env rule)
- | ProtoCoreRule is_local fn rule <- rules
- ]
+tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
+tidyIdRules env rules
+ = [ (tidyVarOcc env fn, tidyRule env rule) | (fn,rule) <- rules ]
tidyRules :: TidyEnv -> CoreRules -> CoreRules
tidyRules env (Rules rules fvs)