Rename topDmdType to nopDmdType
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 9 Dec 2013 14:36:25 +0000 (14:36 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 9 Dec 2013 15:42:09 +0000 (15:42 +0000)
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.

compiler/basicTypes/Demand.lhs
compiler/basicTypes/Id.lhs
compiler/basicTypes/IdInfo.lhs
compiler/coreSyn/CoreArity.lhs
compiler/iface/MkIface.lhs
compiler/main/TidyPgm.lhs
compiler/stranal/DmdAnal.lhs

index ff6c59f..6f88efd 100644 (file)
@@ -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
index c2e0c21..0c66a50 100644 (file)
@@ -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
index a2bdd5c..db0b058 100644 (file)
@@ -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
index 2c9a137..ff39cfc 100644 (file)
@@ -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
index b7b5448..9aad5ff 100644 (file)
@@ -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  --------------
index 2bfcbb7..91d0035 100644 (file)
@@ -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
index cadc04c..2b4a6b1 100644 (file)
@@ -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]