summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorJoachim Breitner <mail@joachim-breitner.de>2016-03-23 10:41:16 +0100
committerJoachim Breitner <mail@joachim-breitner.de>2016-03-29 16:53:14 +0200
commite6e17a095f68509d60b06202e49daaf275b7c320 (patch)
tree5cc1673c66466313a590104f568e4140c47e404d /compiler
parent80d4fdf0756ce7edc534b9277d7c6c63c8ceb501 (diff)
downloadhaskell-e6e17a095f68509d60b06202e49daaf275b7c320.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/basicTypes/Demand.hs12
-rw-r--r--compiler/coreSyn/CoreArity.hs2
-rw-r--r--compiler/coreSyn/PprCore.hs3
-rw-r--r--compiler/iface/MkIface.hs2
-rw-r--r--compiler/main/TidyPgm.hs4
5 files changed, 12 insertions, 11 deletions
diff --git a/compiler/basicTypes/Demand.hs b/compiler/basicTypes/Demand.hs
index 96e02b2a23..3ce92280d5 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 808629968e..cf6cd98b99 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 9ce1dad62f..0c62e4fb06 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 196dd19fee..7f8397bf07 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 3a3a9161f3..e31b0ed748 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
@@ -1242,7 +1242,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