From a1b59a18845ddaa5e752c9fbc0ad8b947642b50d Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 3 Oct 2001 16:20:57 +0000
Subject: [PATCH] [project @ 2001-10-03 16:20:57 by simonpj] Add comments, and
 nuke strictness info in CoreTidy if totally boring

---
 ghc/compiler/basicTypes/IdInfo.lhs    |    5 ++++-
 ghc/compiler/basicTypes/NewDemand.lhs |    9 ++++++++-
 ghc/compiler/coreSyn/CoreTidy.lhs     |   10 +++++-----
 3 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 045d765..cfc1d38 100644
--- 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
--- 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
--- 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
-- 
1.7.10.4