Commit 6f6d72b2 authored by Brian Foley's avatar Brian Foley Committed by Marge Bot
Browse files

Remove further dead code found by a simple Python script.

Avoid removing some functions that are part of an API even
though they're not used in-tree at the moment.
parent 9afd9251
......@@ -46,9 +46,6 @@ module GHC.Cmm.Utils(
baseExpr, spExpr, hpExpr, spLimExpr, hpLimExpr,
currentTSOExpr, currentNurseryExpr, cccsExpr,
-- Statics
blankWord,
-- Tagging
cmmTagMask, cmmPointerMask, cmmUntag, cmmIsTagged,
cmmConstrTag1,
......@@ -380,9 +377,6 @@ cmmNegate platform = \case
-> CmmLit (CmmInt (-n) rep)
e -> CmmMachOp (MO_S_Neg (cmmExprWidth platform e)) [e]
blankWord :: Platform -> CmmStatic
blankWord platform = CmmUninitialised (platformWordSizeInBytes platform)
cmmToWord :: Platform -> CmmExpr -> CmmExpr
cmmToWord platform e
| w == word = e
......
......@@ -2,8 +2,6 @@ module GHC.CmmToAsm.PPC.Cond (
Cond(..),
condNegate,
condUnsigned,
condToSigned,
condToUnsigned,
)
where
......@@ -47,17 +45,3 @@ condUnsigned LU = True
condUnsigned GEU = True
condUnsigned LEU = True
condUnsigned _ = False
condToSigned :: Cond -> Cond
condToSigned GU = GTT
condToSigned LU = LTT
condToSigned GEU = GE
condToSigned LEU = LE
condToSigned x = x
condToUnsigned :: Cond -> Cond
condToUnsigned GTT = GU
condToUnsigned LTT = LU
condToUnsigned GE = GEU
condToUnsigned LE = LEU
condToUnsigned x = x
module GHC.CmmToAsm.SPARC.Cond (
Cond(..),
condUnsigned,
condToSigned,
condToUnsigned
)
where
......@@ -28,27 +25,3 @@ data Cond
| VC
| VS
deriving Eq
condUnsigned :: Cond -> Bool
condUnsigned GU = True
condUnsigned LU = True
condUnsigned GEU = True
condUnsigned LEU = True
condUnsigned _ = False
condToSigned :: Cond -> Cond
condToSigned GU = GTT
condToSigned LU = LTT
condToSigned GEU = GE
condToSigned LEU = LE
condToSigned x = x
condToUnsigned :: Cond -> Cond
condToUnsigned GTT = GU
condToUnsigned LTT = LU
condToUnsigned GE = GEU
condToUnsigned LE = LEU
condToUnsigned x = x
module GHC.CmmToAsm.X86.Cond (
Cond(..),
condUnsigned,
condToSigned,
condToUnsigned,
maybeFlipCond,
maybeInvertCond
......@@ -31,22 +29,6 @@ data Cond
| NOTPARITY
deriving Eq
condUnsigned :: Cond -> Bool
condUnsigned GU = True
condUnsigned LU = True
condUnsigned GEU = True
condUnsigned LEU = True
condUnsigned _ = False
condToSigned :: Cond -> Cond
condToSigned GU = GTT
condToSigned LU = LTT
condToSigned GEU = GE
condToSigned LEU = LE
condToSigned x = x
condToUnsigned :: Cond -> Cond
condToUnsigned GTT = GU
condToUnsigned LTT = LU
......
......@@ -32,7 +32,7 @@ module GHC.CmmToLlvm.Base (
llvmFunSig, llvmFunArgs, llvmStdFunAttrs, llvmFunAlign, llvmInfAlign,
llvmPtrBits, tysToParams, llvmFunSection, padLiveArgs, isFPR,
strCLabel_llvm, strDisplayName_llvm, strProcedureName_llvm,
strCLabel_llvm,
getGlobalPtr, generateExternDecls,
aliasify, llvmDefLabel
......@@ -514,32 +514,6 @@ strCLabel_llvm lbl = do
sdoc
return (fsLit str)
strDisplayName_llvm :: CLabel -> LlvmM LMString
strDisplayName_llvm lbl = do
dflags <- getDynFlags
let sdoc = pprCLabel dflags lbl
depth = Outp.PartWay 1
style = Outp.mkUserStyle Outp.reallyAlwaysQualify depth
str = Outp.renderWithStyle (initSDocContext dflags style) sdoc
return (fsLit (dropInfoSuffix str))
dropInfoSuffix :: String -> String
dropInfoSuffix = go
where go "_info" = []
go "_static_info" = []
go "_con_info" = []
go (x:xs) = x:go xs
go [] = []
strProcedureName_llvm :: CLabel -> LlvmM LMString
strProcedureName_llvm lbl = do
dflags <- getDynFlags
let sdoc = pprCLabel dflags lbl
depth = Outp.PartWay 1
style = Outp.mkUserStyle Outp.neverQualify depth
str = Outp.renderWithStyle (initSDocContext dflags style) sdoc
return (fsLit str)
-- ----------------------------------------------------------------------------
-- * Global variables / forward references
--
......
......@@ -93,7 +93,7 @@ import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -}
import GHC.Core.TyCon
import GHC.Builtin.Types
import GHC.Driver.Types
import GHC.Types.Basic hiding ( Version {- conflicts with Packages.Version -} )
import GHC.Types.Basic
-- Collections and maps
import GHC.Types.Var.Set
......
......@@ -38,7 +38,6 @@ module GHC.StgToCmm.Utils (
addToMem, addToMemE, addToMemLblE, addToMemLbl,
newStringCLit, newByteStringCLit,
blankWord,
-- * Update remembered set operations
whenUpdRemSetEnabled,
......
......@@ -314,24 +314,11 @@ runAr dflags cwd args = traceToolCommand dflags "ar" $ do
let ar = pgm_ar dflags
runSomethingFiltered dflags id "Ar" ar args cwd Nothing
askAr :: DynFlags -> Maybe FilePath -> [Option] -> IO String
askAr dflags mb_cwd args = traceToolCommand dflags "ar" $ do
let ar = pgm_ar dflags
runSomethingWith dflags "Ar" ar args $ \real_args ->
readCreateProcessWithExitCode' (proc ar real_args){ cwd = mb_cwd }
runRanlib :: DynFlags -> [Option] -> IO ()
runRanlib dflags args = traceToolCommand dflags "ranlib" $ do
let ranlib = pgm_ranlib dflags
runSomethingFiltered dflags id "Ranlib" ranlib args Nothing Nothing
runMkDLL :: DynFlags -> [Option] -> IO ()
runMkDLL dflags args = traceToolCommand dflags "mkdll" $ do
let (p,args0) = pgm_dll dflags
args1 = args0 ++ args
mb_env <- getGccEnv (args0++args)
runSomethingFiltered dflags id "Make DLL" p args1 Nothing mb_env
runWindres :: DynFlags -> [Option] -> IO ()
runWindres dflags args = traceToolCommand dflags "windres" $ do
let cc = pgm_c dflags
......
......@@ -9,7 +9,7 @@ module GHC.Tc.Types.Evidence (
HsWrapper(..),
(<.>), mkWpTyApps, mkWpEvApps, mkWpEvVarApps, mkWpTyLams,
mkWpLams, mkWpLet, mkWpCastN, mkWpCastR, collectHsWrapBinders,
mkWpFun, idHsWrapper, isIdHsWrapper, isErasableHsWrapper,
mkWpFun, idHsWrapper, isIdHsWrapper,
pprHsWrapper, hsWrapDictBinders,
-- * Evidence bindings
......@@ -42,9 +42,9 @@ module GHC.Tc.Types.Evidence (
mkTcCoherenceLeftCo,
mkTcCoherenceRightCo,
mkTcKindCo,
tcCoercionKind, coVarsOfTcCo,
tcCoercionKind,
mkTcCoVarCo,
isTcReflCo, isTcReflexiveCo, isTcGReflMCo, tcCoToMCo,
isTcReflCo, isTcReflexiveCo,
tcCoercionRole,
unwrapIP, wrapIP,
......@@ -135,9 +135,7 @@ mkTcCoVarCo :: CoVar -> TcCoercion
tcCoercionKind :: TcCoercion -> Pair TcType
tcCoercionRole :: TcCoercion -> Role
coVarsOfTcCo :: TcCoercion -> TcTyCoVarSet
isTcReflCo :: TcCoercion -> Bool
isTcGReflMCo :: TcMCoercion -> Bool
-- | This version does a slow check, calculating the related types and seeing
-- if they are equal.
......@@ -170,14 +168,9 @@ mkTcCoVarCo = mkCoVarCo
tcCoercionKind = coercionKind
tcCoercionRole = coercionRole
coVarsOfTcCo = coVarsOfCo
isTcReflCo = isReflCo
isTcGReflMCo = isGReflMCo
isTcReflexiveCo = isReflexiveCo
tcCoToMCo :: TcCoercion -> TcMCoercion
tcCoToMCo = coToMCo
-- | If the EqRel is ReprEq, makes a SubCo; otherwise, does nothing.
-- Note that the input coercion should always be nominal.
maybeTcSubCo :: EqRel -> TcCoercion -> TcCoercion
......@@ -356,20 +349,6 @@ isIdHsWrapper :: HsWrapper -> Bool
isIdHsWrapper WpHole = True
isIdHsWrapper _ = False
-- | Is the wrapper erasable, i.e., will not affect runtime semantics?
isErasableHsWrapper :: HsWrapper -> Bool
isErasableHsWrapper = go
where
go WpHole = True
go (WpCompose wrap1 wrap2) = go wrap1 && go wrap2
go WpFun{} = False
go WpCast{} = True
go WpEvLam{} = False -- case in point
go WpEvApp{} = False
go WpTyLam{} = True
go WpTyApp{} = True
go WpLet{} = False
hsWrapDictBinders :: HsWrapper -> Bag DictId
-- ^ Identifies the /lambda-bound/ dictionaries of an 'HsWrapper'. This is used
-- (only) to allow the pattern-match overlap checker to know what Given
......
......@@ -82,8 +82,8 @@ module GHC.Tc.Utils.Monad(
addLandmarkErrCtxtM, updCtxt, popErrCtxt, getCtLocM, setCtLocM,
-- * Error message generation (type checker)
addErrTc, addErrsTc,
addErrTcM, mkErrTcM, mkErrTc,
addErrTc,
addErrTcM,
failWithTc, failWithTcM,
checkTc, checkTcM,
failIfTc, failIfTcM,
......@@ -539,10 +539,7 @@ updateEps upd_fn = do
-- order to avoid space leaks.
updateEps_ :: (ExternalPackageState -> ExternalPackageState)
-> TcRnIf gbl lcl ()
updateEps_ upd_fn = do
traceIf (text "updating EPS_")
eps_var <- getEpsVar
atomicUpdMutVar' eps_var (\eps -> (upd_fn eps, ()))
updateEps_ upd_fn = updateEps (\eps -> (upd_fn eps, ()))
getHpt :: TcRnIf gbl lcl HomePackageTable
getHpt = do { env <- getTopEnv; return (hsc_HPT env) }
......@@ -1281,27 +1278,12 @@ addErrTc :: MsgDoc -> TcM ()
addErrTc err_msg = do { env0 <- tcInitTidyEnv
; addErrTcM (env0, err_msg) }
addErrsTc :: [MsgDoc] -> TcM ()
addErrsTc err_msgs = mapM_ addErrTc err_msgs
addErrTcM :: (TidyEnv, MsgDoc) -> TcM ()
addErrTcM (tidy_env, err_msg)
= do { ctxt <- getErrCtxt ;
loc <- getSrcSpanM ;
add_err_tcm tidy_env err_msg loc ctxt }
-- Return the error message, instead of reporting it straight away
mkErrTcM :: (TidyEnv, MsgDoc) -> TcM ErrMsg
mkErrTcM (tidy_env, err_msg)
= do { ctxt <- getErrCtxt ;
loc <- getSrcSpanM ;
err_info <- mkErrInfo tidy_env ctxt ;
mkLongErrAt loc err_msg err_info }
mkErrTc :: MsgDoc -> TcM ErrMsg
mkErrTc msg = do { env0 <- tcInitTidyEnv
; mkErrTcM (env0, msg) }
-- The failWith functions add an error message and cause failure
failWithTc :: MsgDoc -> TcM a -- Add an error message and fail
......
......@@ -18,8 +18,6 @@ types that
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Types.Basic (
Version, bumpVersion, initialVersion,
LeftOrRight(..),
pickLR,
......@@ -411,22 +409,6 @@ instance Outputable FunctionOrData where
ppr IsFunction = text "(function)"
ppr IsData = text "(data)"
{-
************************************************************************
* *
\subsection[Version]{Module and identifier version numbers}
* *
************************************************************************
-}
type Version = Int
bumpVersion :: Version -> Version
bumpVersion v = v+1
initialVersion :: Version
initialVersion = 1
{-
************************************************************************
* *
......
......@@ -10,18 +10,18 @@ module GHC.Types.Var.Env (
-- ** Manipulating these environments
emptyVarEnv, unitVarEnv, mkVarEnv, mkVarEnv_Directly,
elemVarEnv, disjointVarEnv,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc, extendVarEnv_Directly,
extendVarEnv, extendVarEnv_C, extendVarEnv_Acc,
extendVarEnvList,
plusVarEnv, plusVarEnv_C, plusVarEnv_CD, plusMaybeVarEnv_C,
plusVarEnvList, alterVarEnv,
delVarEnvList, delVarEnv, delVarEnv_Directly,
delVarEnvList, delVarEnv,
minusVarEnv, intersectsVarEnv,
lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
mapVarEnv, zipVarEnv,
modifyVarEnv, modifyVarEnv_Directly,
isEmptyVarEnv,
elemVarEnvByKey, lookupVarEnv_Directly,
filterVarEnv, filterVarEnv_Directly, restrictVarEnv,
elemVarEnvByKey,
filterVarEnv, restrictVarEnv,
partitionVarEnv,
-- * Deterministic Var environments (maps)
......@@ -463,14 +463,10 @@ alterVarEnv :: (Maybe a -> Maybe a) -> VarEnv a -> Var -> VarEnv a
extendVarEnv :: VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_C :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
extendVarEnv_Acc :: (a->b->b) -> (a->b) -> VarEnv b -> Var -> a -> VarEnv b
extendVarEnv_Directly :: VarEnv a -> Unique -> a -> VarEnv a
plusVarEnv :: VarEnv a -> VarEnv a -> VarEnv a
plusVarEnvList :: [VarEnv a] -> VarEnv a
extendVarEnvList :: VarEnv a -> [(Var, a)] -> VarEnv a
lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
delVarEnv_Directly :: VarEnv a -> Unique -> VarEnv a
partitionVarEnv :: (a -> Bool) -> VarEnv a -> (VarEnv a, VarEnv a)
restrictVarEnv :: VarEnv a -> VarSet -> VarEnv a
delVarEnvList :: VarEnv a -> [Var] -> VarEnv a
......@@ -499,7 +495,6 @@ alterVarEnv = alterUFM
extendVarEnv = addToUFM
extendVarEnv_C = addToUFM_C
extendVarEnv_Acc = addToUFM_Acc
extendVarEnv_Directly = addToUFM_Directly
extendVarEnvList = addListToUFM
plusVarEnv_C = plusUFM_C
plusVarEnv_CD = plusUFM_CD
......@@ -519,12 +514,9 @@ mkVarEnv_Directly= listToUFM_Directly
emptyVarEnv = emptyUFM
unitVarEnv = unitUFM
isEmptyVarEnv = isNullUFM
lookupVarEnv_Directly = lookupUFM_Directly
filterVarEnv_Directly = filterUFM_Directly
delVarEnv_Directly = delFromUFM_Directly
partitionVarEnv = partitionUFM
restrictVarEnv env vs = filterVarEnv_Directly keep env
restrictVarEnv env vs = filterUFM_Directly keep env
where
keep u _ = u `elemVarSetByKey` vs
......
......@@ -29,7 +29,7 @@ module GHC.Utils.Misc (
unzipWith,
mapFst, mapSnd, chkAppend,
mapAndUnzip, mapAndUnzip3, mapAccumL2,
mapAndUnzip, mapAndUnzip3,
filterOut, partitionWith,
dropWhileEndLE, spanEnd, last2, lastMaybe,
......@@ -444,12 +444,6 @@ zipAndUnzip (a:as) (b:bs)
(a:rs1, b:rs2)
zipAndUnzip _ _ = ([],[])
mapAccumL2 :: (s1 -> s2 -> a -> (s1, s2, b)) -> s1 -> s2 -> [a] -> (s1, s2, [b])
mapAccumL2 f s1 s2 xs = (s1', s2', ys)
where ((s1', s2'), ys) = mapAccumL (\(s1, s2) x -> case f s1 s2 x of
(s1', s2', y) -> ((s1', s2'), y))
(s1, s2) xs
-- | @atLength atLen atEnd ls n@ unravels list @ls@ to position @n@. Precisely:
--
-- @
......
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