diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2016-03-23 10:41:16 +0100 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2016-03-29 16:53:14 +0200 |
commit | e6e17a095f68509d60b06202e49daaf275b7c320 (patch) | |
tree | 5cc1673c66466313a590104f568e4140c47e404d /compiler | |
parent | 80d4fdf0756ce7edc534b9277d7c6c63c8ceb501 (diff) | |
download | haskell-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.hs | 12 | ||||
-rw-r--r-- | compiler/coreSyn/CoreArity.hs | 2 | ||||
-rw-r--r-- | compiler/coreSyn/PprCore.hs | 3 | ||||
-rw-r--r-- | compiler/iface/MkIface.hs | 2 | ||||
-rw-r--r-- | 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 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 |