diff options
-rw-r--r-- | compiler/GHC/Cmm/Utils.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/PPC/Cond.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/SPARC/Cond.hs | 27 | ||||
-rw-r--r-- | compiler/GHC/CmmToAsm/X86/Cond.hs | 18 | ||||
-rw-r--r-- | compiler/GHC/CmmToLlvm/Base.hs | 28 | ||||
-rw-r--r-- | compiler/GHC/Plugins.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/SysTools/Tasks.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Tc/Types/Evidence.hs | 27 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/Monad.hs | 24 | ||||
-rw-r--r-- | compiler/GHC/Types/Basic.hs | 18 | ||||
-rw-r--r-- | compiler/GHC/Types/Var/Env.hs | 18 | ||||
-rw-r--r-- | compiler/GHC/Utils/Misc.hs | 8 |
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: -- -- @ |