summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-rw-r--r--compiler/GHC/Cmm/Utils.hs6
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Cond.hs16
-rw-r--r--compiler/GHC/CmmToAsm/SPARC/Cond.hs27
-rw-r--r--compiler/GHC/CmmToAsm/X86/Cond.hs18
-rw-r--r--compiler/GHC/CmmToLlvm/Base.hs28
-rw-r--r--compiler/GHC/Plugins.hs2
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs1
-rw-r--r--compiler/GHC/SysTools/Tasks.hs13
-rw-r--r--compiler/GHC/Tc/Types/Evidence.hs27
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs24
-rw-r--r--compiler/GHC/Types/Basic.hs18
-rw-r--r--compiler/GHC/Types/Var/Env.hs18
-rw-r--r--compiler/GHC/Utils/Misc.hs8
13 files changed, 14 insertions, 192 deletions
diff --git a/compiler/GHC/Cmm/Utils.hs b/compiler/GHC/Cmm/Utils.hs
index a49557a07e..e81ccafb71 100644
--- a/compiler/GHC/Cmm/Utils.hs
+++ b/compiler/GHC/Cmm/Utils.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/PPC/Cond.hs b/compiler/GHC/CmmToAsm/PPC/Cond.hs
index a8f7aac877..1209307443 100644
--- a/compiler/GHC/CmmToAsm/PPC/Cond.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Cond.hs
@@ -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
diff --git a/compiler/GHC/CmmToAsm/SPARC/Cond.hs b/compiler/GHC/CmmToAsm/SPARC/Cond.hs
index 035de3dd7e..01d5baad75 100644
--- a/compiler/GHC/CmmToAsm/SPARC/Cond.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/Cond.hs
@@ -1,8 +1,5 @@
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
diff --git a/compiler/GHC/CmmToAsm/X86/Cond.hs b/compiler/GHC/CmmToAsm/X86/Cond.hs
index 424a1718b0..c91281e6a8 100644
--- a/compiler/GHC/CmmToAsm/X86/Cond.hs
+++ b/compiler/GHC/CmmToAsm/X86/Cond.hs
@@ -1,7 +1,5 @@
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
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index dc9e830751..f5fa5ea1be 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -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
--
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index 61fcb6fd3b..6f7356cc18 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -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
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 18a69c9509..0660c6dd75 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -38,7 +38,6 @@ module GHC.StgToCmm.Utils (
addToMem, addToMemE, addToMemLblE, addToMemLbl,
newStringCLit, newByteStringCLit,
- blankWord,
-- * Update remembered set operations
whenUpdRemSetEnabled,
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index be5549d577..a83dc8e670 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -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
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs
index d496057f47..49ae605feb 100644
--- a/compiler/GHC/Tc/Types/Evidence.hs
+++ b/compiler/GHC/Tc/Types/Evidence.hs
@@ -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
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 7c01bc112a..4f14d7b251 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -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
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index a361036c3c..799e6950c7 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -18,8 +18,6 @@ types that
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Types.Basic (
- Version, bumpVersion, initialVersion,
-
LeftOrRight(..),
pickLR,
@@ -414,22 +412,6 @@ instance Outputable FunctionOrData where
{-
************************************************************************
* *
-\subsection[Version]{Module and identifier version numbers}
-* *
-************************************************************************
--}
-
-type Version = Int
-
-bumpVersion :: Version -> Version
-bumpVersion v = v+1
-
-initialVersion :: Version
-initialVersion = 1
-
-{-
-************************************************************************
-* *
Deprecations
* *
************************************************************************
diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs
index 883d5bbeca..aea3982226 100644
--- a/compiler/GHC/Types/Var/Env.hs
+++ b/compiler/GHC/Types/Var/Env.hs
@@ -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
diff --git a/compiler/GHC/Utils/Misc.hs b/compiler/GHC/Utils/Misc.hs
index b191507fca..6f0c0a6aa5 100644
--- a/compiler/GHC/Utils/Misc.hs
+++ b/compiler/GHC/Utils/Misc.hs
@@ -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:
--
-- @
View Lorry Controller Status