Commit a1b59a18 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-10-03 16:20:57 by simonpj]

Add comments, and nuke strictness info in CoreTidy if totally boring
parent d1bf2fc3
......@@ -249,7 +249,10 @@ data IdInfo
inlinePragInfo :: InlinePragInfo, -- Inline pragma
occInfo :: OccInfo, -- How it occurs
newStrictnessInfo :: Maybe StrictSig,
newStrictnessInfo :: Maybe StrictSig, -- Reason for Maybe: the DmdAnal phase needs to
-- know whether whether this is the first visit,
-- so it can assign botSig. Other customers want
-- topSig. So Nothing is good.
newDemandInfo :: Demand
}
......
......@@ -13,7 +13,7 @@ module NewDemand(
DmdEnv, emptyDmdEnv,
DmdResult(..), isBotRes, returnsCPR,
StrictSig(..), mkStrictSig, topSig, botSig,
StrictSig(..), mkStrictSig, topSig, botSig, isTopSig,
splitStrictSig, strictSigResInfo,
pprIfaceStrictSig, appIsBottom, isBottomingSig
) where
......@@ -80,6 +80,11 @@ emptyDmdEnv = emptyVarEnv
topDmdType = DmdType emptyDmdEnv [] TopRes
botDmdType = DmdType emptyDmdEnv [] BotRes
isTopDmdType :: DmdType -> Bool
-- Only used on top-level types, hence the assert
isTopDmdType (DmdType _ [] TopRes) = ASSERT( isEmptyVarEnv env) True
isTopDmdType other = False
isBotRes :: DmdResult -> Bool
isBotRes BotRes = True
isBotRes other = False
......@@ -152,6 +157,8 @@ splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
strictSigResInfo :: StrictSig -> DmdResult
strictSigResInfo (StrictSig (DmdType _ _ res)) = res
isTopSig (StrictSig ty) = isTopDmdType ty
topSig = StrictSig topDmdType
botSig = StrictSig botDmdType
......
......@@ -25,10 +25,10 @@ import Id ( idType, idInfo, idName, isExportedId,
mkVanillaGlobal, mkGlobalId, isLocalId,
isDataConId, mkUserLocal, isGlobalId, globalIdDetails,
idNewDemandInfo, setIdNewDemandInfo,
idNewStrictness_maybe, setIdNewStrictness
idNewStrictness, setIdNewStrictness
)
import IdInfo {- loads of stuff -}
import NewDemand ( isBottomingSig, topSig, isStrictDmd )
import NewDemand ( isBottomingSig, topSig, isStrictDmd, isTopSig )
import BasicTypes ( isNeverActive )
import Name ( getOccName, nameOccName, globaliseName, setNameOcc,
localiseName, isGlobalName, setNameUnique
......@@ -642,15 +642,15 @@ tidyLetBndr env (id,rhs)
final_id
| totally_boring_info = new_id
| otherwise = new_id `setIdNewDemandInfo` dmd_info
`setIdNewStrictness` fromJust maybe_new_strictness
`setIdNewStrictness` new_strictness
-- 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
maybe_new_strictness = idNewStrictness_maybe id
totally_boring_info = isNothing maybe_new_strictness && not (isStrictDmd dmd_info)
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment