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

Add comments, and nuke strictness info in CoreTidy if totally boring

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 045d765..cfc1d38 100644 (file)
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -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
     }
 

diff --git a/ghc/compiler/basicTypes/NewDemand.lhs b/ghc/compiler/basicTypes/NewDemand.lhs
index d496c96..2c83d95 100644 (file)
--- a/ghc/compiler/basicTypes/NewDemand.lhs
+++ b/ghc/compiler/basicTypes/NewDemand.lhs
@@ -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
 

diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
index 357ba9b..0dccf94 100644 (file)
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ b/ghc/compiler/coreSyn/CoreTidy.lhs
@@ -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