diff options
author | Brian Foley <bpfoley@google.com> | 2020-03-13 22:34:15 -0700 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-03-15 03:58:18 -0400 |
commit | b4774598e6bd060b1b4230b11b734ca40022980d (patch) | |
tree | 9b28fdfa3aaa36a41ebc711efa795005953dc93d | |
parent | d30aeb4b38381758025bc1002eb2135ad6bc58b8 (diff) | |
download | haskell-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.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Cmm/Parser.y | 11 | ||||
-rw-r--r-- | compiler/GHC/Core/Utils.hs | 15 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Utils.hs | 15 | ||||
-rw-r--r-- | compiler/main/Annotations.hs | 6 | ||||
-rw-r--r-- | compiler/simplCore/CoreMonad.hs | 11 | ||||
-rw-r--r-- | compiler/typecheck/Constraint.hs | 14 | ||||
-rw-r--r-- | compiler/types/CoAxiom.hs | 10 | ||||
-rw-r--r-- | compiler/utils/Binary.hs | 17 |
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 |