Rename topDmdType to nopDmdType

because topDmdType is ''not'' the top of the lattice, as it puts an
implicit absent demand on free variables, but Abs is the bottom of the
Usage lattice.

Why nopDmdType? Becuase it is the demand of doing nothing: Everything
lazy, everything absent, no definite divergence.

7 files changed, 34 insertions, 28 deletions

diff --git a/compiler/basicTypes/Demand.lhs b/compiler/basicTypes/Demand.lhs
index ff6c59f8ee..6f88efdf48 100644
--- a/compiler/basicTypes/Demand.lhs
+++ b/compiler/basicTypes/Demand.lhs
@@ -19,7 +19,7 @@ module Demand (
         peelUseCall, cleanUseDmd_maybe, strictenDmd, bothCleanDmd,
 
         DmdType(..), dmdTypeDepth, lubDmdType, bothDmdEnv, bothDmdType,
-        topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
+        nopDmdType, botDmdType, mkDmdType, mkTopDmdType,
 
         DmdEnv, emptyDmdEnv,
 
@@ -28,8 +28,8 @@ module Demand (
         topRes, botRes, cprProdRes, cprSumRes,
         appIsBottom, isBottomingSig, pprIfaceStrictSig, 
         returnsCPR, returnsCPRProd, returnsCPR_maybe,
-        StrictSig(..), mkStrictSig, topSig, botSig, cprProdSig,
-        isTopSig, splitStrictSig, increaseStrictSigArity,
+        StrictSig(..), mkStrictSig, nopSig, botSig, cprProdSig,
+        isNopSig, splitStrictSig, increaseStrictSigArity,
        
         seqDemand, seqDemandList, seqDmdType, seqStrictSig, 
 
@@ -1030,17 +1030,21 @@ instance Outputable DmdType where
 emptyDmdEnv :: VarEnv Demand
 emptyDmdEnv = emptyVarEnv
 
-topDmdType, botDmdType :: DmdType
-topDmdType = DmdType emptyDmdEnv [] topRes
+-- nopDmdType is the demand of doing nothing
+-- (lazy, absent, no CPR information, no termination information).
+-- Note that it is ''not'' the top of the lattice (which would be "may use everything"),
+-- so it is (no longer) called topDmd
+nopDmdType, botDmdType :: DmdType
+nopDmdType = DmdType emptyDmdEnv [] topRes
 botDmdType = DmdType emptyDmdEnv [] botRes
 
 cprProdDmdType :: DmdType
 cprProdDmdType = DmdType emptyDmdEnv [] cprProdRes
 
-isTopDmdType :: DmdType -> Bool
-isTopDmdType (DmdType env [] res)
+isNopDmdType :: DmdType -> Bool
+isNopDmdType (DmdType env [] res)
   | isTopRes res && isEmptyVarEnv env = True
-isTopDmdType _                        = False
+isNopDmdType _                        = False
 
 mkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType
 mkDmdType fv ds res = DmdType fv ds res
@@ -1096,7 +1100,7 @@ useEnv fv = mapVarEnv useDmd fv
 -- See Note [IO hack in the demand analyser]
 deferAfterIO :: DmdType -> DmdType
 deferAfterIO d@(DmdType _ _ res) =
-    case d `lubDmdType` topDmdType of
+    case d `lubDmdType` nopDmdType of
         DmdType fv ds _ -> DmdType fv ds (defer_res res)
   where
   defer_res BotCPR  = NoCPR
@@ -1132,7 +1136,7 @@ toCleanDmd :: (CleanDemand -> e -> (DmdType, e))
 -- See Note [Analyzing with lazy demand and lambdas]
 toCleanDmd anal (JD { strd = s, absd = u }) e
   = case (s,u) of
-      (_, Abs) -> mf (const topDmdType) (anal (CD { sd = HeadStr, ud = Used }) e)
+      (_, Abs) -> mf (const nopDmdType) (anal (CD { sd = HeadStr, ud = Used }) e)
                   --  See Note [Always analyse in virgin pass]
              
       (Str s', Use c u') -> mf (deferAndUse False c) (anal (CD { sd = s',      ud = u' }) e)
@@ -1240,14 +1244,14 @@ increaseStrictSigArity :: Int -> StrictSig -> StrictSig
 increaseStrictSigArity arity_increase (StrictSig (DmdType env dmds res))
   = StrictSig (DmdType env (replicate arity_increase topDmd ++ dmds) res)
 
-isTopSig :: StrictSig -> Bool
-isTopSig (StrictSig ty) = isTopDmdType ty
+isNopSig :: StrictSig -> Bool
+isNopSig (StrictSig ty) = isNopDmdType ty
 
 isBottomingSig :: StrictSig -> Bool
 isBottomingSig (StrictSig (DmdType _ _ res)) = isBotRes res
 
-topSig, botSig :: StrictSig
-topSig = StrictSig topDmdType
+nopSig, botSig :: StrictSig
+nopSig = StrictSig nopDmdType
 botSig = StrictSig botDmdType
 
 cprProdSig :: StrictSig
@@ -1301,7 +1305,7 @@ dmdTransformSig (StrictSig dmd_ty@(DmdType _ arg_ds _))
     go_abs (_:as) (UCall One d') = go_abs as d'
     go_abs _      _              = False
 
-    -- NB: it's important to use deferType, and not just return topDmdType
+    -- NB: it's important to use deferType, and not just return nopDmdType
     -- Consider     let { f x y = p + x } in f 1
     -- The application isn't saturated, but we must nevertheless propagate 
     --      a lazy demand for p!  
@@ -1319,7 +1323,7 @@ dmdTransformDataConSig arity (StrictSig (DmdType _ _ con_res))
                 -- Must remember whether it's a product, hence con_res, not TopRes
 
   | otherwise   -- Not saturated
-  = topDmdType
+  = nopDmdType
   where
     go_str 0 dmd        = Just (splitStrProdDmd arity dmd)
     go_str n (SCall s') = go_str (n-1) s'
@@ -1340,7 +1344,7 @@ dmdTransformDictSelSig (StrictSig (DmdType _ [dict_dmd] _)) cd
    , Just jds <- splitProdDmd_maybe dict_dmd
    = DmdType emptyDmdEnv [mkManyUsedDmd $ mkProdDmd $ map (enhance cd') jds] topRes
    | otherwise
-   = topDmdType              -- See Note [Demand transformer for a dictionary selector]
+   = nopDmdType              -- See Note [Demand transformer for a dictionary selector]
   where
     enhance cd old | isAbsDmd old = old
                    | otherwise    = mkManyUsedDmd cd
@@ -1359,7 +1363,7 @@ For single-method classes, which are represented by newtypes the signature
 of 'op' won't look like U(...), so the splitProdDmd_maybe will fail.
 That's fine: if we are doing strictness analysis we are also doing inling,
 so we'll have inlined 'op' into a cast.  So we can bale out in a conservative
-way, returning topDmdType.
+way, returning nopDmdType.
 
 It is (just.. Trac #8329) possible to be running strictness analysis *without*
 having inlined class ops from single-method classes.  Suppose you are using
diff --git a/compiler/basicTypes/Id.lhs b/compiler/basicTypes/Id.lhs
index c2e0c2199d..0c66a503b7 100644
--- a/compiler/basicTypes/Id.lhs
+++ b/compiler/basicTypes/Id.lhs
@@ -476,7 +476,7 @@ setIdStrictness :: Id -> StrictSig -> Id
 setIdStrictness id sig = modifyIdInfo (`setStrictnessInfo` sig) id
 
 zapIdStrictness :: Id -> Id
-zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` topSig) id
+zapIdStrictness id = modifyIdInfo (`setStrictnessInfo` nopSig) id
 
 -- | This predicate says whether the 'Id' has a strict demand placed on it or
 -- has a type such that it can always be evaluated strictly (i.e an
diff --git a/compiler/basicTypes/IdInfo.lhs b/compiler/basicTypes/IdInfo.lhs
index a2bdd5ce54..db0b058fc2 100644
--- a/compiler/basicTypes/IdInfo.lhs
+++ b/compiler/basicTypes/IdInfo.lhs
@@ -290,7 +290,7 @@ vanillaIdInfo
 	    inlinePragInfo 	= defaultInlinePragma,
 	    occInfo		= NoOccInfo,
             demandInfo	        = topDmd,
-	    strictnessInfo      = topSig
+	    strictnessInfo      = nopSig
 	   }
 
 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references
diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs
index 2c9a1375fb..ff39cfc9d9 100644
--- a/compiler/coreSyn/CoreArity.lhs
+++ b/compiler/coreSyn/CoreArity.lhs
@@ -730,7 +730,7 @@ arityType env (Cast e co)
 
 arityType _ (Var v)
   | strict_sig <- idStrictness v
-  , not $ isTopSig strict_sig
+  , not $ isNopSig strict_sig
   , (ds, res) <- splitStrictSig strict_sig
   , let arity = length ds
   = if isBotRes res then ABot arity
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index b7b5448012..9aad5ffea2 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1777,7 +1777,7 @@ toIfaceIdInfo id_info
     ------------  Strictness  --------------
         -- No point in explicitly exporting TopSig
     sig_info = strictnessInfo id_info
-    strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
+    strict_hsinfo | not (isNopSig sig_info) = Just (HsStrictness sig_info)
                   | otherwise               = Nothing
 
     ------------  Unfolding  --------------
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index 2bfcbb7574..91d0035b1b 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -30,7 +30,7 @@ import IdInfo
 import InstEnv
 import FamInstEnv
 import Type             ( tidyTopType )
-import Demand           ( appIsBottom, isTopSig, isBottomingSig )
+import Demand           ( appIsBottom, isNopSig, isBottomingSig )
 import BasicTypes
 import Name hiding (varName)
 import NameSet
@@ -1109,7 +1109,7 @@ tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_
     mb_bot_str = exprBotStrictness_maybe orig_rhs
 
     sig = strictnessInfo idinfo
-    final_sig | not $ isTopSig sig 
+    final_sig | not $ isNopSig sig
                  = WARN( _bottom_hidden sig , ppr name ) sig 
                  -- try a cheap-and-cheerful bottom analyser
                  | Just (_, nsig) <- mb_bot_str = nsig
diff --git a/compiler/stranal/DmdAnal.lhs b/compiler/stranal/DmdAnal.lhs
index cadc04c315..2b4a6b1f4c 100644
--- a/compiler/stranal/DmdAnal.lhs
+++ b/compiler/stranal/DmdAnal.lhs
@@ -124,9 +124,9 @@ dmdAnal :: AnalEnv
 -- The CleanDemand is always strict and not absent
 --    See Note [Ensure demand is strict]
 
-dmdAnal _ _ (Lit lit)     = (topDmdType, Lit lit)
-dmdAnal _ _ (Type ty)     = (topDmdType, Type ty)	-- Doesn't happen, in fact
-dmdAnal _ _ (Coercion co) = (topDmdType, Coercion co)
+dmdAnal _ _ (Lit lit)     = (nopDmdType, Lit lit)
+dmdAnal _ _ (Type ty)     = (nopDmdType, Type ty)	-- Doesn't happen, in fact
+dmdAnal _ _ (Coercion co) = (nopDmdType, Coercion co)
 
 dmdAnal env dmd (Var var)
   = (dmdTransform env var dmd, Var var)
@@ -338,6 +338,8 @@ dmdAnalAlt env dmd (con,bndrs,rhs)
 	final_alt_ty | io_hack_reqd = deferAfterIO alt_ty
 		     | otherwise    = alt_ty
 
+        -- Note [IO hack in the demand analyser]
+        --
 	-- There's a hack here for I/O operations.  Consider
 	-- 	case foo x s of { (# s, r #) -> y }
 	-- Is this strict in 'y'.  Normally yes, but what if 'foo' is an I/O
@@ -1069,7 +1071,7 @@ getStrictness :: AnalEnv -> Id -> StrictSig
 getStrictness env fn
   | isGlobalId fn                        = idStrictness fn
   | Just (sig, _) <- lookupSigEnv env fn = sig
-  | otherwise                            = topSig
+  | otherwise                            = nopSig
 
 addInitialSigs :: TopLevelFlag -> AnalEnv -> [Id] -> AnalEnv
 -- See Note [Initialising strictness]