idSpecialisation, idUnique, isDataConWrapId,
mkVanillaGlobal, mkGlobalId, isLocalId,
isDataConId, mkUserLocal, isGlobalId, globalIdDetails,
- idNewDemandInfo, setIdNewDemandInfo,
+ idNewDemandInfo, setIdNewDemandInfo, setIdCgInfo,
idNewStrictness, setIdNewStrictness
)
import IdInfo {- loads of stuff -}
-import NewDemand ( isBottomingSig, topSig, isStrictDmd, isTopSig )
+import NewDemand ( isBottomingSig, topSig )
import BasicTypes ( isNeverActive )
import Name ( getOccName, nameOccName, globaliseName, setNameOcc,
localiseName, isGlobalName, setNameUnique
import UniqSupply ( splitUniqSupply, uniqFromSupply )
import List ( partition )
import Util ( mapAccumL )
-import Maybe ( isJust, fromJust, isNothing )
+import Maybe ( isJust )
import Outputable
\end{code}
isGlobalName (idName bndr)]
; let ((orig_ns', occ_env, subst_env), tidy_binds)
- = mapAccumL (tidyTopBind mod ext_ids cg_info_env)
+ = mapAccumL (tidyTopBind mod ext_ids)
init_tidy_env binds_in
; let tidy_rules = tidyIdRules (occ_env,subst_env) ext_rules
; let prs' = prs { prsOrig = orig_ns' }
pcs' = pcs { pcs_PRS = prs' }
- ; let final_ids = [ id | bind <- tidy_binds
+ ; let final_ids = [ addCgInfo cg_info_env id
+ | bind <- tidy_binds
, id <- bindersOf bind
, isGlobalName (idName id)]
; return (pcs', tidy_details)
}
+addCgInfo :: CgInfoEnv -> Id -> Id
+-- Pin on the info that comes from the code generator
+-- This doesn't make its way into the *bindings* that
+-- go on to the code generator (that might give black holes etc)
+-- Rather, it's pinned onto the Id in the type environment
+-- that (a) generates the interface file
+-- (b) in GHCi goes into subsequent compilations
+addCgInfo cg_info_env id
+ = id `setIdCgInfo` lookupCgInfo cg_info_env (idName id)
+
tidyCoreExpr :: CoreExpr -> IO CoreExpr
tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
\end{code}
tidyTopBind :: Module
-> IdEnv Bool -- Domain = Ids that should be external
-- True <=> their unfolding is external too
- -> CgInfoEnv
-> TopTidyEnv -> CoreBind
-> (TopTidyEnv, CoreBind)
-tidyTopBind mod ext_ids cg_info_env top_tidy_env (NonRec bndr rhs)
+tidyTopBind mod ext_ids top_tidy_env (NonRec bndr rhs)
= ((orig,occ,subst) , NonRec bndr' rhs')
where
((orig,occ,subst), bndr')
- = tidyTopBinder mod ext_ids cg_info_env rec_tidy_env rhs' top_tidy_env bndr
+ = tidyTopBinder mod ext_ids rec_tidy_env rhs' top_tidy_env bndr
rec_tidy_env = (occ,subst)
rhs' = tidyExpr rec_tidy_env rhs
-tidyTopBind mod ext_ids cg_info_env top_tidy_env (Rec prs)
+tidyTopBind mod ext_ids top_tidy_env (Rec prs)
= (final_env, Rec prs')
where
(final_env@(_,occ,subst), prs') = mapAccumL do_one top_tidy_env prs
= ((orig,occ,subst), (bndr',rhs'))
where
((orig,occ,subst), bndr')
- = tidyTopBinder mod ext_ids cg_info_env
+ = tidyTopBinder mod ext_ids
rec_tidy_env rhs' top_tidy_env bndr
rhs' = tidyExpr rec_tidy_env rhs
tidyTopBinder :: Module -> IdEnv Bool
- -> CgInfoEnv
-> TidyEnv -> CoreExpr
-- The TidyEnv is used to tidy the IdInfo
-- The expr is the already-tided RHS
-> TopTidyEnv -> Id -> (TopTidyEnv, Id)
-- NB: tidyTopBinder doesn't affect the unique supply
-tidyTopBinder mod ext_ids cg_info_env tidy_env rhs
+tidyTopBinder mod ext_ids tidy_env rhs
env@(ns2, occ_env2, subst_env2) id
| isDataConWrapId id -- Don't tidy constructor wrappers
is_external
(idName id)
ty' = tidyTopType (idType id)
- cg_info = lookupCgInfo cg_info_env name'
- idinfo' = tidyIdInfo tidy_env is_external unfold_info cg_info id
+ idinfo' = tidyIdInfo tidy_env is_external unfold_info id
id' | isGlobalId id = mkGlobalId (globalIdDetails id) name' ty' idinfo'
| otherwise = mkVanillaGlobal name' ty' idinfo'
| otherwise = noUnfolding
-tidyIdInfo tidy_env is_external unfold_info cg_info id
+tidyIdInfo tidy_env is_external unfold_info id
| opt_OmitInterfacePragmas || not is_external
-- No IdInfo if the Id isn't external, or if we don't have -O
= vanillaIdInfo
- `setCgInfo` cg_info
+ `setArityInfo` arityInfo core_idinfo
`setNewStrictnessInfo` newStrictnessInfo core_idinfo
- -- Keep strictness; it's used by CorePrep
+ -- Keep strictness and arity; both are used by CorePrep
| otherwise
= vanillaIdInfo
- `setCgInfo` cg_info
+ `setArityInfo` arityInfo core_idinfo
`setNewStrictnessInfo` newStrictnessInfo core_idinfo
`setInlinePragInfo` inlinePragInfo core_idinfo
`setUnfoldingInfo` unfold_info
--
-- Similarly for the demand info - on a let binder, this tells
-- CorePrep to turn the let into a case.
- final_id
- | totally_boring_info = new_id
- | otherwise = new_id `setIdNewDemandInfo` dmd_info
- `setIdNewStrictness` new_strictness
+ final_id = new_id `setIdNewDemandInfo` idNewDemandInfo id
+ `setIdNewStrictness` idNewStrictness id
- -- override the env we get back from tidyId with the new IdInfo
+ -- Override the env we get back from tidyId with the new IdInfo
-- so it gets propagated to the usage sites.
new_var_env = extendVarEnv var_env id final_id
- dmd_info = idNewDemandInfo id
- new_strictness = idNewStrictness id
- totally_boring_info = isTopSig new_strictness && not (isStrictDmd dmd_info)
-
tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
tidyIdBndr env@(tidy_env, var_env) id
= -- Non-top-level variables
projects / ghc-hetmet.git / blobdiff