[commit: ghc] wip/T10613: Rename isNopSig to isTopSig (d589cfa)
git at git.haskell.org
git at git.haskell.org
Wed Mar 23 13:47:59 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/T10613
Link : http://ghc.haskell.org/trac/ghc/changeset/d589cfae846e475686f50de6974e41a7e3295a74/ghc
>---------------------------------------------------------------
commit d589cfae846e475686f50de6974e41a7e3295a74
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Wed Mar 23 10:41:16 2016 +0100
Rename isNopSig to isTopSig
to be consistent with the other uses of nop vs. top in Demand.hs. Also,
stop prettyprinting top strictness signatures in Core dumps.
>---------------------------------------------------------------
d589cfae846e475686f50de6974e41a7e3295a74
compiler/basicTypes/Demand.hs | 12 ++++++------
compiler/coreSyn/CoreArity.hs | 2 +-
compiler/coreSyn/PprCore.hs | 3 ++-
compiler/iface/MkIface.hs | 2 +-
compiler/main/TidyPgm.hs | 4 ++--
5 files changed, 12 insertions(+), 11 deletions(-)
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 96e02b2..3ce9228 100644
--- a/compiler/basicTypes/Demand.hs
+++ b/compiler/basicTypes/Demand.hs
@@ -37,7 +37,7 @@ module Demand (
appIsBottom, isBottomingSig, pprIfaceStrictSig,
trimCPRInfo, returnsCPR_maybe,
StrictSig(..), mkStrictSig, mkClosedStrictSig, nopSig, botSig, cprProdSig,
- isNopSig, splitStrictSig, increaseStrictSigArity,
+ isTopSig, splitStrictSig, increaseStrictSigArity,
seqDemand, seqDemandList, seqDmdType, seqStrictSig,
@@ -1262,10 +1262,10 @@ cprProdDmdType :: Arity -> DmdType
cprProdDmdType arity
= DmdType emptyDmdEnv [] (vanillaCprProdRes arity)
-isNopDmdType :: DmdType -> Bool
-isNopDmdType (DmdType env [] res)
+isTopDmdType :: DmdType -> Bool
+isTopDmdType (DmdType env [] res)
| isTopRes res && isEmptyVarEnv env = True
-isNopDmdType _ = False
+isTopDmdType _ = False
mkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType
mkDmdType fv ds res = DmdType fv ds res
@@ -1669,8 +1669,8 @@ increaseStrictSigArity :: Int -> StrictSig -> StrictSig
increaseStrictSigArity arity_increase (StrictSig (DmdType env dmds res))
= StrictSig (DmdType env (replicate arity_increase topDmd ++ dmds) res)
-isNopSig :: StrictSig -> Bool
-isNopSig (StrictSig ty) = isNopDmdType ty
+isTopSig :: StrictSig -> Bool
+isTopSig (StrictSig ty) = isTopDmdType ty
isBottomingSig :: StrictSig -> Bool
-- True if the signature diverges or throws an exception
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index 8086299..cf6cd98 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -711,7 +711,7 @@ arityType env (Cast e co)
arityType _ (Var v)
| strict_sig <- idStrictness v
- , not $ isNopSig strict_sig
+ , not $ isTopSig strict_sig
, (ds, res) <- splitStrictSig strict_sig
, let arity = length ds
= if isBotRes res then ABot arity
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs
index d5e3660..60e9a6a 100644
--- a/compiler/coreSyn/PprCore.hs
+++ b/compiler/coreSyn/PprCore.hs
@@ -400,7 +400,7 @@ ppIdInfo id info
, (has_arity, text "Arity=" <> int arity)
, (has_called_arity, text "CallArity=" <> int called_arity)
, (has_caf_info, text "Caf=" <> ppr caf_info)
- , (True, text "Str=" <> pprStrictness str_info)
+ , (has_str_info, text "Str=" <> pprStrictness str_info)
, (has_unf, text "Unf=" <> ppr unf_info)
, (not (null rules), text "RULES:" <+> vcat (map pprRule rules))
] -- Inline pragma, occ, demand, one-shot info
@@ -421,6 +421,7 @@ ppIdInfo id info
has_caf_info = not (mayHaveCafRefs caf_info)
str_info = strictnessInfo info
+ has_str_info = not (isTopSig str_info)
unf_info = unfoldingInfo info
has_unf = hasSomeUnfolding unf_info
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 196dd19..7f8397b 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1684,7 +1684,7 @@ toIfaceIdInfo id_info
------------ Strictness --------------
-- No point in explicitly exporting TopSig
sig_info = strictnessInfo id_info
- strict_hsinfo | not (isNopSig sig_info) = Just (HsStrictness sig_info)
+ strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
| otherwise = Nothing
------------ Unfolding --------------
diff --git a/compiler/main/TidyPgm.hs b/compiler/main/TidyPgm.hs
index 5bbbdb5..4f379e9 100644
--- a/compiler/main/TidyPgm.hs
+++ b/compiler/main/TidyPgm.hs
@@ -37,7 +37,7 @@ import IdInfo
import InstEnv
import FamInstEnv
import Type ( tidyTopType )
-import Demand ( appIsBottom, isNopSig, isBottomingSig )
+import Demand ( appIsBottom, isTopSig, isBottomingSig )
import BasicTypes
import Name hiding (varName)
import NameSet
@@ -1235,7 +1235,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 $ isNopSig sig
+ final_sig | not $ isTopSig sig
= WARN( _bottom_hidden sig , ppr name ) sig
-- try a cheap-and-cheerful bottom analyser
| Just (_, nsig) <- mb_bot_str = nsig
More information about the ghc-commits
mailing list