summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBrian Foley <bpfoley@google.com>2020-03-13 22:34:15 -0700
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-03-15 03:58:18 -0400
commitb4774598e6bd060b1b4230b11b734ca40022980d (patch)
tree9b28fdfa3aaa36a41ebc711efa795005953dc93d
parentd30aeb4b38381758025bc1002eb2135ad6bc58b8 (diff)
downloadhaskell-b4774598e6bd060b1b4230b11b734ca40022980d.tar.gz
Remove some dead code
From the notes.ghc.drop list found using weeder in #17713
-rw-r--r--compiler/GHC/Cmm/Dataflow/Block.hs6
-rw-r--r--compiler/GHC/Cmm/Parser.y11
-rw-r--r--compiler/GHC/Core/Utils.hs15
-rw-r--r--compiler/GHC/HsToCore/Utils.hs15
-rw-r--r--compiler/main/Annotations.hs6
-rw-r--r--compiler/simplCore/CoreMonad.hs11
-rw-r--r--compiler/typecheck/Constraint.hs14
-rw-r--r--compiler/types/CoAxiom.hs10
-rw-r--r--compiler/utils/Binary.hs17
9 files changed, 5 insertions, 100 deletions
diff --git a/compiler/GHC/Cmm/Dataflow/Block.hs b/compiler/GHC/Cmm/Dataflow/Block.hs
index d2e52a8904..ac567ca605 100644
--- a/compiler/GHC/Cmm/Dataflow/Block.hs
+++ b/compiler/GHC/Cmm/Dataflow/Block.hs
@@ -66,13 +66,7 @@ data MaybeO ex t where
JustO :: t -> MaybeO O t
NothingO :: MaybeO C t
--- | Maybe type indexed by closed/open
-data MaybeC ex t where
- JustC :: t -> MaybeC C t
- NothingC :: MaybeC O t
-
deriving instance Functor (MaybeO ex)
-deriving instance Functor (MaybeC ex)
-- -----------------------------------------------------------------------------
-- The Block type
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index d303e435d0..95edf0693a 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -873,17 +873,6 @@ section s = OtherSection s
mkString :: String -> CmmStatic
mkString s = CmmString (BS8.pack s)
--- |
--- Given an info table, decide what the entry convention for the proc
--- is. That is, for an INFO_TABLE_RET we want the return convention,
--- otherwise it is a NativeNodeCall.
---
-infoConv :: Maybe CmmInfoTable -> Convention
-infoConv Nothing = NativeNodeCall
-infoConv (Just info)
- | isStackRep (cit_rep info) = NativeReturn
- | otherwise = NativeNodeCall
-
-- mkMachOp infers the type of the MachOp from the type of its first
-- argument. We assume that this is correct: for MachOps that don't have
-- symmetrical args (e.g. shift ops), the first arg determines the type of
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 82d920a58e..0a9d923a32 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -27,7 +27,7 @@ module GHC.Core.Utils (
getIdFromTrivialExpr_maybe,
exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree,
- exprIsBig, exprIsConLike,
+ exprIsConLike,
isCheapApp, isExpandableApp,
exprIsTickedString, exprIsTickedString_maybe,
exprIsTopLevelBindable,
@@ -2075,8 +2075,6 @@ c.f. add_evals in Simplify.simplAlt
-- | A cheap equality test which bales out fast!
-- If it returns @True@ the arguments are definitely equal,
-- otherwise, they may or may not be equal.
---
--- See also 'exprIsBig'
cheapEqExpr :: Expr b -> Expr b -> Bool
cheapEqExpr = cheapEqExpr' (const False)
@@ -2100,17 +2098,6 @@ cheapEqExpr' ignoreTick e1 e2
go _ _ = False
-exprIsBig :: Expr b -> Bool
--- ^ Returns @True@ of expressions that are too big to be compared by 'cheapEqExpr'
-exprIsBig (Lit _) = False
-exprIsBig (Var _) = False
-exprIsBig (Type _) = False
-exprIsBig (Coercion _) = False
-exprIsBig (Lam _ e) = exprIsBig e
-exprIsBig (App f a) = exprIsBig f || exprIsBig a
-exprIsBig (Cast e _) = exprIsBig e -- Hopefully coercions are not too big!
-exprIsBig (Tick _ e) = exprIsBig e
-exprIsBig _ = True
eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool
-- Compares for equality, modulo alpha
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index d11e59a0c8..ce1096995a 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -38,7 +38,7 @@ module GHC.HsToCore.Utils (
mkSelectorBinds,
selectSimpleMatchVarL, selectMatchVars, selectMatchVar,
- mkOptTickBox, mkBinaryTickBox, decideBangHood, addBang,
+ mkOptTickBox, mkBinaryTickBox, decideBangHood,
isTrueLHsExpr
) where
@@ -957,19 +957,6 @@ decideBangHood dflags lpat
BangPat _ _ -> lp
_ -> L l (BangPat noExtField lp)
--- | Unconditionally make a 'Pat' strict.
-addBang :: LPat GhcTc -- ^ Original pattern
- -> LPat GhcTc -- ^ Banged pattern
-addBang = go
- where
- go lp@(L l p)
- = case p of
- ParPat x p -> L l (ParPat x (go p))
- LazyPat _ lp' -> L l (BangPat noExtField lp')
- -- Should we bring the extension value over?
- BangPat _ _ -> lp
- _ -> L l (BangPat noExtField lp)
-
isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
-- Returns Just {..} if we're sure that the expression is True
diff --git a/compiler/main/Annotations.hs b/compiler/main/Annotations.hs
index c282217d33..3c4340e900 100644
--- a/compiler/main/Annotations.hs
+++ b/compiler/main/Annotations.hs
@@ -9,7 +9,6 @@ module Annotations (
-- * Main Annotation data types
Annotation(..), AnnPayload,
AnnTarget(..), CoreAnnTarget,
- getAnnTargetName_maybe,
-- * AnnEnv for collecting and querying Annotations
AnnEnv,
@@ -57,11 +56,6 @@ data AnnTarget name
-- | The kind of annotation target found in the middle end of the compiler
type CoreAnnTarget = AnnTarget Name
--- | Get the 'name' of an annotation target if it exists.
-getAnnTargetName_maybe :: AnnTarget name -> Maybe name
-getAnnTargetName_maybe (NamedTarget nm) = Just nm
-getAnnTargetName_maybe _ = Nothing
-
instance Outputable name => Outputable (AnnTarget name) where
ppr (NamedTarget nm) = text "Named target" <+> ppr nm
ppr (ModuleTarget mod) = text "Module target" <+> ppr mod
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index 2dcafcdbcb..cb17f33b88 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -29,7 +29,7 @@ module CoreMonad (
-- ** Reading from the monad
getHscEnv, getRuleBase, getModule,
- getDynFlags, getOrigNameCache, getPackageFamInstEnv,
+ getDynFlags, getPackageFamInstEnv,
getVisibleOrphanMods, getUniqMask,
getPrintUnqualified, getSrcSpanM,
@@ -66,7 +66,6 @@ import FastString
import ErrUtils( Severity(..), DumpFormat (..), dumpOptionsFromFlag )
import UniqSupply
import MonadUtils
-import NameCache
import NameEnv
import SrcLoc
import Data.Bifunctor ( bimap )
@@ -74,7 +73,6 @@ import ErrUtils (dumpAction)
import Data.List (intersperse, groupBy, sortBy)
import Data.Ord
import Data.Dynamic
-import Data.IORef
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Map.Strict as MapStrict
@@ -709,13 +707,6 @@ instance HasDynFlags CoreM where
instance HasModule CoreM where
getModule = read cr_module
--- | The original name cache is the current mapping from 'Module' and
--- 'OccName' to a compiler-wide unique 'Name'
-getOrigNameCache :: CoreM OrigNameCache
-getOrigNameCache = do
- nameCacheRef <- fmap hsc_NC getHscEnv
- liftIO $ fmap nsNames $ readIORef nameCacheRef
-
getPackageFamInstEnv :: CoreM PackageFamInstEnv
getPackageFamInstEnv = do
hsc_env <- getHscEnv
diff --git a/compiler/typecheck/Constraint.hs b/compiler/typecheck/Constraint.hs
index 40fc8fdedb..c0eefe72b2 100644
--- a/compiler/typecheck/Constraint.hs
+++ b/compiler/typecheck/Constraint.hs
@@ -55,7 +55,7 @@ module Constraint (
isWanted, isGiven, isDerived, isGivenOrWDeriv,
ctEvRole,
- wrapType, wrapTypeWithImplication,
+ wrapType,
CtFlavour(..), ShadowInfo(..), ctEvFlavour,
CtFlavourRole, ctEvFlavourRole, ctFlavourRole,
@@ -86,7 +86,6 @@ import Coercion
import Class
import TyCon
import Var
-import Id
import TcType
import TcEvidence
@@ -1292,17 +1291,6 @@ pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)
--- | Wraps the given type with the constraints (via ic_given) in the given
--- implication, according to the variables mentioned (via ic_skols)
--- in the implication, but taking care to only wrap those variables
--- that are mentioned in the type or the implication.
-wrapTypeWithImplication :: Type -> Implication -> Type
-wrapTypeWithImplication ty impl = wrapType ty mentioned_skols givens
- where givens = map idType $ ic_given impl
- skols = ic_skols impl
- freeVars = fvVarSet $ tyCoFVsOfTypes (ty:givens)
- mentioned_skols = filter (`elemVarSet` freeVars) skols
-
wrapType :: Type -> [TyVar] -> [PredType] -> Type
wrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty
diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs
index 066daefaed..49fc5e07a5 100644
--- a/compiler/types/CoAxiom.hs
+++ b/compiler/types/CoAxiom.hs
@@ -26,7 +26,7 @@ module CoAxiom (
Role(..), fsFromRole,
CoAxiomRule(..), TypeEqn,
- BuiltInSynFamily(..), trivialBuiltInFamily
+ BuiltInSynFamily(..)
) where
import GhcPrelude
@@ -563,11 +563,3 @@ data BuiltInSynFamily = BuiltInSynFamily
, sfInteractInert :: [Type] -> Type ->
[Type] -> Type -> [TypeEqn]
}
-
--- Provides default implementations that do nothing.
-trivialBuiltInFamily :: BuiltInSynFamily
-trivialBuiltInFamily = BuiltInSynFamily
- { sfMatchFam = \_ -> Nothing
- , sfInteractTop = \_ _ -> []
- , sfInteractInert = \_ _ _ _ -> []
- }
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 1c52cb56fb..16d7ccf37d 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -31,10 +31,8 @@ module Binary
-- closeBin,
seekBin,
- seekBy,
tellBin,
castBin,
- isEOFBin,
withBinBuffer,
writeBinMem,
@@ -184,21 +182,6 @@ seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do
then do expandBin h p; writeFastMutInt ix_r p
else writeFastMutInt ix_r p
-seekBy :: BinHandle -> Int -> IO ()
-seekBy h@(BinMem _ ix_r sz_r _) !off = do
- sz <- readFastMutInt sz_r
- ix <- readFastMutInt ix_r
- let ix' = ix + off
- if (ix' >= sz)
- then do expandBin h ix'; writeFastMutInt ix_r ix'
- else writeFastMutInt ix_r ix'
-
-isEOFBin :: BinHandle -> IO Bool
-isEOFBin (BinMem _ ix_r sz_r _) = do
- ix <- readFastMutInt ix_r
- sz <- readFastMutInt sz_r
- return (ix >= sz)
-
writeBinMem :: BinHandle -> FilePath -> IO ()
writeBinMem (BinMem _ ix_r _ arr_r) fn = do
h <- openBinaryFile fn WriteMode