[Git][ghc/ghc][wip/T17676] Rename isBot* to isDeadEnd*

Sebastian Graf gitlab at gitlab.haskell.org
Thu Mar 19 17:36:49 UTC 2020



Sebastian Graf pushed to branch wip/T17676 at Glasgow Haskell Compiler / GHC


Commits:
28a031e8 by Sebastian Graf at 2020-03-19T17:36:40Z
Rename isBot* to isDeadEnd*

- - - - -


17 changed files:

- compiler/GHC.hs
- compiler/GHC/Core/Arity.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/IfaceToCore.hs
- compiler/basicTypes/Demand.hs
- compiler/basicTypes/Id.hs
- compiler/basicTypes/MkId.hs
- compiler/simplCore/CallArity.hs
- compiler/simplCore/FloatOut.hs
- compiler/simplCore/LiberateCase.hs
- compiler/simplCore/SetLevels.hs
- compiler/simplCore/SimplUtils.hs
- compiler/simplCore/Simplify.hs
- compiler/specialise/SpecConstr.hs


Changes:

=====================================
compiler/GHC.hs
=====================================
@@ -179,7 +179,7 @@ module GHC (
         isRecordSelector,
         isPrimOpId, isFCallId, isClassOpId_maybe,
         isDataConWorkId, idDataCon,
-        isBottomingId, isDictonaryId,
+        isDeadEndId, isDictonaryId,
         recordSelectorTyCon,
 
         -- ** Type constructors


=====================================
compiler/GHC/Core/Arity.hs
=====================================
@@ -759,7 +759,7 @@ arityType _ (Var v)
   , not $ isTopSig strict_sig
   , (ds, res) <- splitStrictSig strict_sig
   , let arity = length ds
-  = if isBotDiv res then ABot arity
+  = if isDeadEndDiv res then ABot arity
                     else ATop (take arity one_shots)
   | otherwise
   = ATop (take (idArity v) one_shots)


=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -65,7 +65,7 @@ import Util
 import GHC.Core.InstEnv      ( instanceDFunId )
 import GHC.Core.Coercion.Opt ( checkAxInstCo )
 import GHC.Core.Arity        ( typeArity )
-import Demand ( splitStrictSig, isBotDiv )
+import Demand ( splitStrictSig, isDeadEndDiv )
 
 import GHC.Driver.Types
 import GHC.Driver.Session
@@ -651,7 +651,7 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
            ppr binder)
 
        ; case splitStrictSig (idStrictness binder) of
-           (demands, result_info) | isBotDiv result_info ->
+           (demands, result_info) | isDeadEndDiv result_info ->
              checkL (demands `lengthAtLeast` idArity binder)
                (text "idArity" <+> ppr (idArity binder) <+>
                text "exceeds arity imposed by the strictness signature" <+>


=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -53,7 +53,7 @@ import GHC.Core.SimpleOpt
 import GHC.Core.Arity     ( manifestArity )
 import GHC.Core.Utils
 import Id
-import Demand          ( isBottomingSig )
+import Demand          ( isDeadEndSig )
 import GHC.Core.DataCon
 import Literal
 import PrimOp
@@ -1176,7 +1176,7 @@ certainlyWillInline dflags fn_info
         --    See Note [certainlyWillInline: INLINABLE]
     do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args })
       | arityInfo fn_info > 0  -- See Note [certainlyWillInline: be careful of thunks]
-      , not (isBottomingSig (strictnessInfo fn_info))
+      , not (isDeadEndSig (strictnessInfo fn_info))
               -- Do not unconditionally inline a bottoming functions even if
               -- it seems smallish. We've carefully lifted it out to top level,
               -- so we don't want to re-inline it.


=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -1111,7 +1111,7 @@ exprIsBottom e
   | otherwise
   = go 0 e
   where
-    go n (Var v) = isBottomingId v &&  n >= idArity v
+    go n (Var v) = isDeadEndId v &&  n >= idArity v
     go n (App e a) | isTypeArg a = go n e
                    | otherwise   = go (n+1) e
     go n (Tick _ e)              = go n e
@@ -1434,7 +1434,7 @@ isWorkFreeApp fn n_val_args
 isCheapApp :: CheapAppFun
 isCheapApp fn n_val_args
   | isWorkFreeApp fn n_val_args = True
-  | isBottomingId fn            = True  -- See Note [isCheapApp: bottoming functions]
+  | isDeadEndId fn              = True  -- See Note [isCheapApp: bottoming functions]
   | otherwise
   = case idDetails fn of
       DataConWorkId {} -> True  -- Actually handled by isWorkFreeApp
@@ -1456,7 +1456,7 @@ isExpandableApp fn n_val_args
       RecSelId {}      -> n_val_args == 1  -- See Note [Record selection]
       ClassOpId {}     -> n_val_args == 1
       PrimOpId {}      -> False
-      _ | isBottomingId fn               -> False
+      _ | isDeadEndId fn                 -> False
           -- See Note [isExpandableApp: bottoming functions]
         | isConLike (idRuleMatchInfo fn) -> True
         | all_args_are_preds             -> True
@@ -2202,7 +2202,7 @@ diffExpr top env (Tick n1 e1)   (Tick n2 e2)
  -- generated names, which are allowed to differ.
 diffExpr _   _   (App (App (Var absent) _) _)
                  (App (App (Var absent2) _) _)
-  | isBottomingId absent && isBottomingId absent2 = []
+  | isDeadEndId absent && isDeadEndId absent2 = []
 diffExpr top env (App f1 a1)    (App f2 a2)
   = diffExpr top env f1 f2 ++ diffExpr top env a1 a2
 diffExpr top env (Lam b1 e1)  (Lam b2 e2)


=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -39,7 +39,7 @@ import MkId             ( mkDictSelRhs )
 import IdInfo
 import GHC.Core.InstEnv
 import GHC.Core.Type    ( tidyTopType )
-import Demand           ( appIsBottom, isTopSig, isBottomingSig )
+import Demand           ( appIsBottom, isTopSig, isDeadEndSig )
 import Cpr              ( mkCprSig, botCpr )
 import BasicTypes
 import Name hiding (varName)
@@ -726,7 +726,7 @@ addExternal omit_prags expose_all id
     show_unfold    = show_unfolding unfolding
     never_active   = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo))
     loop_breaker   = isStrongLoopBreaker (occInfo idinfo)
-    bottoming_fn   = isBottomingSig (strictnessInfo idinfo)
+    bottoming_fn   = isDeadEndSig (strictnessInfo idinfo)
 
         -- Stuff to do with the Id's unfolding
         -- We leave the unfolding there even if there is a worker
@@ -1240,7 +1240,7 @@ tidyTopIdInfo dflags rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold
       = minimal_unfold_info
     minimal_unfold_info = zapUnfolding unf_info
     unf_from_rhs = mkTopUnfolding dflags is_bot tidy_rhs
-    is_bot = isBottomingSig final_sig
+    is_bot = isDeadEndSig final_sig
     -- NB: do *not* expose the worker if show_unfold is off,
     --     because that means this thing is a loop breaker or
     --     marked NOINLINE or something like that


=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -1508,7 +1508,7 @@ tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr)
             Nothing -> NoUnfolding
             Just expr -> mkUnfolding dflags unf_src
                            True {- Top level -}
-                           (isBottomingSig strict_sig)
+                           (isDeadEndSig strict_sig)
                            expr
         }
   where


=====================================
compiler/basicTypes/Demand.hs
=====================================
@@ -28,8 +28,8 @@ module Demand (
         DmdEnv, emptyDmdEnv,
         peelFV, findIdDemand,
 
-        Divergence(..), lubDivergence, isBotDiv, topDiv, botDiv, exnDiv, conDiv,
-        appIsBottom, isBottomingSig, pprIfaceStrictSig,
+        Divergence(..), lubDivergence, isDeadEndDiv, topDiv, botDiv, exnDiv, conDiv,
+        appIsBottom, isDeadEndSig, pprIfaceStrictSig,
         StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,
         emptySig, botSig, cprProdSig,
         isTopSig, hasDemandEnvSig,
@@ -240,7 +240,7 @@ The solution is to give 'raiseIO#' 'topDiv' instead of 'botDiv', so that its
 of dead code, namely when 'raiseIO#' occurs in a case scrutinee. Hence we need
 to give it 'exnDiv', which was conceived entirely for this reason. The default
 FV demand of 'exnDiv' is lazy, its default arg dmd is absent, but otherwise (in
-terms of 'Demand.isBotDiv') it behaves exactly as 'botDiv', so that dead code
+terms of 'Demand.isDeadEndDiv') it behaves exactly as 'botDiv', so that dead code
 elimination works as expected.
 -}
 
@@ -988,7 +988,7 @@ splitProdDmd_maybe (JD { sd = s, ud = u })
 data Divergence
   = Diverges -- ^ Definitely throws an imprecise exception or diverges.
   | ExnOrDiv -- ^ Definitely throws a *precise* exception, an imprecise
-             --   exception or diverges. Never converges, hence 'isBotDiv'!
+             --   exception or diverges. Never converges, hence 'isDeadEndDiv'!
              --   See scenario 2 in Note [Precise exceptions and strictness analysis].
   | ConOrDiv -- ^ Definitely converges, throws an imprecise exception or
              --   diverges. Never throws a precise exception! Important for
@@ -1040,11 +1040,11 @@ conDiv = ConOrDiv
 botDiv = Diverges
 
 -- | True if the result indicates that evaluation will not return.
-isBotDiv :: Divergence -> Bool
-isBotDiv Diverges = True
-isBotDiv ExnOrDiv = True
-isBotDiv ConOrDiv = False
-isBotDiv Dunno    = False
+isDeadEndDiv :: Divergence -> Bool
+isDeadEndDiv Diverges = True
+isDeadEndDiv ExnOrDiv = True
+isDeadEndDiv ConOrDiv = False
+isDeadEndDiv Dunno    = False
 
 -- See Notes [Default demand on free variables]
 -- and [defaultFvDmd vs. defaultArgDmd]
@@ -1739,8 +1739,8 @@ strictSigDmdEnv :: StrictSig -> DmdEnv
 strictSigDmdEnv (StrictSig (DmdType env _ _)) = env
 
 -- | True if the signature diverges or throws an exception
-isBottomingSig :: StrictSig -> Bool
-isBottomingSig (StrictSig (DmdType _ _ res)) = isBotDiv res
+isDeadEndSig :: StrictSig -> Bool
+isDeadEndSig (StrictSig (DmdType _ _ res)) = isDeadEndDiv res
 
 -- | See 'emptyDmdType'.
 emptySig :: Divergence ->StrictSig
@@ -1886,7 +1886,7 @@ binders \pqr and \xyz; see Note [Use one-shot information] in OccurAnal.
 -- See Note [Unsaturated applications]
 appIsBottom :: StrictSig -> Int -> Bool
 appIsBottom (StrictSig (DmdType _ ds res)) n
-            | isBotDiv res                   = not $ lengthExceeds ds n
+            | isDeadEndDiv res                   = not $ lengthExceeds ds n
 appIsBottom _                              _ = False
 
 {-


=====================================
compiler/basicTypes/Id.hs
=====================================
@@ -70,7 +70,7 @@ module Id (
         isDataConWrapId, isDataConWrapId_maybe,
         isDataConId_maybe,
         idDataCon,
-        isConLikeId, isBottomingId, idIsFrom,
+        isConLikeId, isDeadEndId, idIsFrom,
         hasNoBinding,
 
         -- ** Join variables
@@ -638,9 +638,9 @@ idFunRepArity :: Id -> RepArity
 idFunRepArity x = countFunRepArgs (idArity x) (idType x)
 
 -- | Returns true if an application to n args would diverge
-isBottomingId :: Var -> Bool
-isBottomingId v
-  | isId v    = isBottomingSig (idStrictness v)
+isDeadEndId :: Var -> Bool
+isDeadEndId v
+  | isId v    = isDeadEndSig (idStrictness v)
   | otherwise = False
 
 -- | Accesses the 'Id''s 'strictnessInfo'.


=====================================
compiler/basicTypes/MkId.hs
=====================================
@@ -1227,7 +1227,7 @@ mkPrimOpId prim_op
 
     -- PrimOps don't ever construct a product, but we want to preserve bottoms
     cpr
-      | isBotDiv (snd (splitStrictSig strict_sig)) = botCpr
+      | isDeadEndDiv (snd (splitStrictSig strict_sig)) = botCpr
       | otherwise                                  = topCpr
 
     info = noCafIdInfo


=====================================
compiler/simplCore/CallArity.hs
=====================================
@@ -701,7 +701,7 @@ trimArity v a = minimum [a, max_arity_by_type, max_arity_by_strsig]
   where
     max_arity_by_type = length (typeArity (idType v))
     max_arity_by_strsig
-        | isBotDiv result_info = length demands
+        | isDeadEndDiv result_info = length demands
         | otherwise = a
 
     (demands, result_info) = splitStrictSig (idStrictness v)


=====================================
compiler/simplCore/FloatOut.hs
=====================================
@@ -20,7 +20,7 @@ import CoreMonad        ( FloatOutSwitches(..) )
 
 import GHC.Driver.Session
 import ErrUtils         ( dumpIfSet_dyn, DumpFormat (..) )
-import Id               ( Id, idArity, idType, isBottomingId,
+import Id               ( Id, idArity, idType, isDeadEndId,
                           isJoinId, isJoinId_maybe )
 import SetLevels
 import UniqSupply       ( UniqSupply )
@@ -221,7 +221,7 @@ floatBind (NonRec (TB var _) rhs)
 
         -- A tiresome hack:
         -- see Note [Bottoming floats: eta expansion] in SetLevels
-    let rhs'' | isBottomingId var = etaExpand (idArity var) rhs'
+    let rhs'' | isDeadEndId var   = etaExpand (idArity var) rhs'
               | otherwise         = rhs'
 
     in (fs, rhs_floats, [NonRec var rhs'']) }


=====================================
compiler/simplCore/LiberateCase.hs
=====================================
@@ -158,8 +158,8 @@ libCaseBind env (Rec pairs)
                                    Let (Rec dup_pairs) (Var unitDataConId)
 
     ok_pair (id,_)
-        =  idArity id > 0          -- Note [Only functions!]
-        && not (isBottomingId id)  -- Note [Not bottoming ids]
+        =  idArity id > 0       -- Note [Only functions!]
+        && not (isDeadEndId id) -- Note [Not bottoming ids]
 
 {- Note [Not bottoming Ids]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~


=====================================
compiler/simplCore/SetLevels.hs
=====================================
@@ -293,7 +293,7 @@ lvlTopBind env (Rec pairs)
 lvl_top :: LevelEnv -> RecFlag -> Id -> CoreExpr -> LvlM LevelledExpr
 lvl_top env is_rec bndr rhs
   = lvlRhs env is_rec
-           (isBottomingId bndr)
+           (isDeadEndId bndr)
            Nothing  -- Not a join point
            (freeVars rhs)
 


=====================================
compiler/simplCore/SimplUtils.hs
=====================================
@@ -499,7 +499,7 @@ mkArgInfo env fun rules n_val_args call_cont
                         -- top-level bindings for (say) strings into
                         -- calls to error.  But now we are more careful about
                         -- inlining lone variables, so its ok (see SimplUtils.analyseCont)
-                   if isBotDiv result_info then
+                   if isDeadEndDiv result_info then
                         map isStrictDmd demands         -- Finite => result is bottom
                    else
                         map isStrictDmd demands ++ vanilla_stricts
@@ -1141,7 +1141,7 @@ preInlineUnconditionally
 preInlineUnconditionally env top_lvl bndr rhs rhs_env
   | not pre_inline_unconditionally           = Nothing
   | not active                               = Nothing
-  | isTopLevel top_lvl && isBottomingId bndr = Nothing -- Note [Top-level bottoming Ids]
+  | isTopLevel top_lvl && isDeadEndId bndr   = Nothing -- Note [Top-level bottoming Ids]
   | isCoVar bndr                             = Nothing -- Note [Do not inline CoVars unconditionally]
   | isExitJoinId bndr                        = Nothing -- Note [Do not inline exit join points]
                                                        -- in module Exitify


=====================================
compiler/simplCore/Simplify.hs
=====================================
@@ -3513,7 +3513,7 @@ mkLetUnfolding dflags top_lvl src id new_rhs
             --             we don't.)  The simple thing is always to have one.
   where
     is_top_lvl   = isTopLevel top_lvl
-    is_bottoming = isBottomingId id
+    is_bottoming = isDeadEndId id
 
 -------------------
 simplStableUnfolding :: SimplEnv -> TopLevelFlag


=====================================
compiler/specialise/SpecConstr.hs
=====================================
@@ -1599,8 +1599,8 @@ specialise env bind_calls (RI { ri_fn = fn, ri_lam_bndrs = arg_bndrs
                               , ri_lam_body = body, ri_arg_occs = arg_occs })
                spec_info@(SI { si_specs = specs, si_n_specs = spec_count
                              , si_mb_unspec = mb_unspec })
-  | isBottomingId fn      -- Note [Do not specialise diverging functions]
-                          -- and do not generate specialisation seeds from its RHS
+  | isDeadEndId fn  -- Note [Do not specialise diverging functions]
+                    -- and do not generate specialisation seeds from its RHS
   = -- pprTrace "specialise bot" (ppr fn) $
     return (nullUsage, spec_info)
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/28a031e817d40fe0366a64e52da2f235b72cbfd3

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/28a031e817d40fe0366a64e52da2f235b72cbfd3
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200319/1363f86a/attachment-0001.html>


More information about the ghc-commits mailing list