Commit b4774598 authored by Brian Foley's avatar Brian Foley Committed by Marge Bot

Remove some dead code

From the notes.ghc.drop list found using weeder in #17713
parent d30aeb4b
Pipeline #16737 passed with stages
in 407 minutes and 19 seconds
...@@ -66,13 +66,7 @@ data MaybeO ex t where ...@@ -66,13 +66,7 @@ data MaybeO ex t where
JustO :: t -> MaybeO O t JustO :: t -> MaybeO O t
NothingO :: MaybeO C 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 (MaybeO ex)
deriving instance Functor (MaybeC ex)
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- The Block type -- The Block type
......
...@@ -873,17 +873,6 @@ section s = OtherSection s ...@@ -873,17 +873,6 @@ section s = OtherSection s
mkString :: String -> CmmStatic mkString :: String -> CmmStatic
mkString s = CmmString (BS8.pack s) 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 -- 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 -- 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 -- symmetrical args (e.g. shift ops), the first arg determines the type of
......
...@@ -27,7 +27,7 @@ module GHC.Core.Utils ( ...@@ -27,7 +27,7 @@ module GHC.Core.Utils (
getIdFromTrivialExpr_maybe, getIdFromTrivialExpr_maybe,
exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun, exprIsCheap, exprIsExpandable, exprIsCheapX, CheapAppFun,
exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree, exprIsHNF, exprOkForSpeculation, exprOkForSideEffects, exprIsWorkFree,
exprIsBig, exprIsConLike, exprIsConLike,
isCheapApp, isExpandableApp, isCheapApp, isExpandableApp,
exprIsTickedString, exprIsTickedString_maybe, exprIsTickedString, exprIsTickedString_maybe,
exprIsTopLevelBindable, exprIsTopLevelBindable,
...@@ -2075,8 +2075,6 @@ c.f. add_evals in Simplify.simplAlt ...@@ -2075,8 +2075,6 @@ c.f. add_evals in Simplify.simplAlt
-- | A cheap equality test which bales out fast! -- | A cheap equality test which bales out fast!
-- If it returns @True@ the arguments are definitely equal, -- If it returns @True@ the arguments are definitely equal,
-- otherwise, they may or may not be equal. -- otherwise, they may or may not be equal.
--
-- See also 'exprIsBig'
cheapEqExpr :: Expr b -> Expr b -> Bool cheapEqExpr :: Expr b -> Expr b -> Bool
cheapEqExpr = cheapEqExpr' (const False) cheapEqExpr = cheapEqExpr' (const False)
...@@ -2100,17 +2098,6 @@ cheapEqExpr' ignoreTick e1 e2 ...@@ -2100,17 +2098,6 @@ cheapEqExpr' ignoreTick e1 e2
go _ _ = False 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 eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool
-- Compares for equality, modulo alpha -- Compares for equality, modulo alpha
......
...@@ -38,7 +38,7 @@ module GHC.HsToCore.Utils ( ...@@ -38,7 +38,7 @@ module GHC.HsToCore.Utils (
mkSelectorBinds, mkSelectorBinds,
selectSimpleMatchVarL, selectMatchVars, selectMatchVar, selectSimpleMatchVarL, selectMatchVars, selectMatchVar,
mkOptTickBox, mkBinaryTickBox, decideBangHood, addBang, mkOptTickBox, mkBinaryTickBox, decideBangHood,
isTrueLHsExpr isTrueLHsExpr
) where ) where
...@@ -957,19 +957,6 @@ decideBangHood dflags lpat ...@@ -957,19 +957,6 @@ decideBangHood dflags lpat
BangPat _ _ -> lp BangPat _ _ -> lp
_ -> L l (BangPat noExtField 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) isTrueLHsExpr :: LHsExpr GhcTc -> Maybe (CoreExpr -> DsM CoreExpr)
-- Returns Just {..} if we're sure that the expression is True -- Returns Just {..} if we're sure that the expression is True
......
...@@ -9,7 +9,6 @@ module Annotations ( ...@@ -9,7 +9,6 @@ module Annotations (
-- * Main Annotation data types -- * Main Annotation data types
Annotation(..), AnnPayload, Annotation(..), AnnPayload,
AnnTarget(..), CoreAnnTarget, AnnTarget(..), CoreAnnTarget,
getAnnTargetName_maybe,
-- * AnnEnv for collecting and querying Annotations -- * AnnEnv for collecting and querying Annotations
AnnEnv, AnnEnv,
...@@ -57,11 +56,6 @@ data AnnTarget name ...@@ -57,11 +56,6 @@ data AnnTarget name
-- | The kind of annotation target found in the middle end of the compiler -- | The kind of annotation target found in the middle end of the compiler
type CoreAnnTarget = AnnTarget Name 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 instance Outputable name => Outputable (AnnTarget name) where
ppr (NamedTarget nm) = text "Named target" <+> ppr nm ppr (NamedTarget nm) = text "Named target" <+> ppr nm
ppr (ModuleTarget mod) = text "Module target" <+> ppr mod ppr (ModuleTarget mod) = text "Module target" <+> ppr mod
......
...@@ -29,7 +29,7 @@ module CoreMonad ( ...@@ -29,7 +29,7 @@ module CoreMonad (
-- ** Reading from the monad -- ** Reading from the monad
getHscEnv, getRuleBase, getModule, getHscEnv, getRuleBase, getModule,
getDynFlags, getOrigNameCache, getPackageFamInstEnv, getDynFlags, getPackageFamInstEnv,
getVisibleOrphanMods, getUniqMask, getVisibleOrphanMods, getUniqMask,
getPrintUnqualified, getSrcSpanM, getPrintUnqualified, getSrcSpanM,
...@@ -66,7 +66,6 @@ import FastString ...@@ -66,7 +66,6 @@ import FastString
import ErrUtils( Severity(..), DumpFormat (..), dumpOptionsFromFlag ) import ErrUtils( Severity(..), DumpFormat (..), dumpOptionsFromFlag )
import UniqSupply import UniqSupply
import MonadUtils import MonadUtils
import NameCache
import NameEnv import NameEnv
import SrcLoc import SrcLoc
import Data.Bifunctor ( bimap ) import Data.Bifunctor ( bimap )
...@@ -74,7 +73,6 @@ import ErrUtils (dumpAction) ...@@ -74,7 +73,6 @@ import ErrUtils (dumpAction)
import Data.List (intersperse, groupBy, sortBy) import Data.List (intersperse, groupBy, sortBy)
import Data.Ord import Data.Ord
import Data.Dynamic import Data.Dynamic
import Data.IORef
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Map.Strict as MapStrict import qualified Data.Map.Strict as MapStrict
...@@ -709,13 +707,6 @@ instance HasDynFlags CoreM where ...@@ -709,13 +707,6 @@ instance HasDynFlags CoreM where
instance HasModule CoreM where instance HasModule CoreM where
getModule = read cr_module 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 :: CoreM PackageFamInstEnv
getPackageFamInstEnv = do getPackageFamInstEnv = do
hsc_env <- getHscEnv hsc_env <- getHscEnv
......
...@@ -55,7 +55,7 @@ module Constraint ( ...@@ -55,7 +55,7 @@ module Constraint (
isWanted, isGiven, isDerived, isGivenOrWDeriv, isWanted, isGiven, isDerived, isGivenOrWDeriv,
ctEvRole, ctEvRole,
wrapType, wrapTypeWithImplication, wrapType,
CtFlavour(..), ShadowInfo(..), ctEvFlavour, CtFlavour(..), ShadowInfo(..), ctEvFlavour,
CtFlavourRole, ctEvFlavourRole, ctFlavourRole, CtFlavourRole, ctEvFlavourRole, ctFlavourRole,
...@@ -86,7 +86,6 @@ import Coercion ...@@ -86,7 +86,6 @@ import Coercion
import Class import Class
import TyCon import TyCon
import Var import Var
import Id
import TcType import TcType
import TcEvidence import TcEvidence
...@@ -1292,17 +1291,6 @@ pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v) ...@@ -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 :: Type -> [TyVar] -> [PredType] -> Type
wrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty wrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty
......
...@@ -26,7 +26,7 @@ module CoAxiom ( ...@@ -26,7 +26,7 @@ module CoAxiom (
Role(..), fsFromRole, Role(..), fsFromRole,
CoAxiomRule(..), TypeEqn, CoAxiomRule(..), TypeEqn,
BuiltInSynFamily(..), trivialBuiltInFamily BuiltInSynFamily(..)
) where ) where
import GhcPrelude import GhcPrelude
...@@ -563,11 +563,3 @@ data BuiltInSynFamily = BuiltInSynFamily ...@@ -563,11 +563,3 @@ data BuiltInSynFamily = BuiltInSynFamily
, sfInteractInert :: [Type] -> Type -> , sfInteractInert :: [Type] -> Type ->
[Type] -> Type -> [TypeEqn] [Type] -> Type -> [TypeEqn]
} }
-- Provides default implementations that do nothing.
trivialBuiltInFamily :: BuiltInSynFamily
trivialBuiltInFamily = BuiltInSynFamily
{ sfMatchFam = \_ -> Nothing
, sfInteractTop = \_ _ -> []
, sfInteractInert = \_ _ _ _ -> []
}
...@@ -31,10 +31,8 @@ module Binary ...@@ -31,10 +31,8 @@ module Binary
-- closeBin, -- closeBin,
seekBin, seekBin,
seekBy,
tellBin, tellBin,
castBin, castBin,
isEOFBin,
withBinBuffer, withBinBuffer,
writeBinMem, writeBinMem,
...@@ -184,21 +182,6 @@ seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do ...@@ -184,21 +182,6 @@ seekBin h@(BinMem _ ix_r sz_r _) (BinPtr !p) = do
then do expandBin h p; writeFastMutInt ix_r p then do expandBin h p; writeFastMutInt ix_r p
else 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 :: BinHandle -> FilePath -> IO ()
writeBinMem (BinMem _ ix_r _ arr_r) fn = do writeBinMem (BinMem _ ix_r _ arr_r) fn = do
h <- openBinaryFile fn WriteMode h <- openBinaryFile fn WriteMode
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment