diff --git a/compiler/GHC/Cmm/CallConv.hs b/compiler/GHC/Cmm/CallConv.hs index 21dde6a4d260274ee0232368658d31c90d13997d..e1f31fee0f3234ba936d8e1cd93e96bf69930e32 100644 --- a/compiler/GHC/Cmm/CallConv.hs +++ b/compiler/GHC/Cmm/CallConv.hs @@ -321,4 +321,4 @@ backend is liable to compile code using e.g. the ZMM1 STG register to uses of X86 machine registers xmm1, xmm2, xmm3, xmm4, instead of just zmm1. This would mean that LLVM produces ABI-incompatible code that would result in segfaults in the RTS. --} \ No newline at end of file +-} diff --git a/compiler/GHC/Cmm/Liveness.hs b/compiler/GHC/Cmm/Liveness.hs index deb2390052ba81496a432f252bef5d2255c53a8b..6c27280ac7be05545a5cce7eb93a50ecff82c706 100644 --- a/compiler/GHC/Cmm/Liveness.hs +++ b/compiler/GHC/Cmm/Liveness.hs @@ -155,4 +155,3 @@ xferLiveL platform (BlockCC eNode middle xNode) fBase = !result = foldNodesBwdOO (gen_killL platform) middle joined in mapSingleton (entryLabel eNode) result - diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs index a58296bea85586637acf1498006333b1568a4dab..ec96160f3ab3111f95cc65d89f1b88fc432e4953 100644 --- a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs +++ b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs @@ -207,4 +207,3 @@ data RA_State freeRegs } - diff --git a/compiler/GHC/CmmToAsm/X86/RegInfo.hs b/compiler/GHC/CmmToAsm/X86/RegInfo.hs index e50d97f687c219b033ea92d2c5b05bdea2b47168..1339b7b9e12e115629c87e12620ef62b1d96fd89 100644 --- a/compiler/GHC/CmmToAsm/X86/RegInfo.hs +++ b/compiler/GHC/CmmToAsm/X86/RegInfo.hs @@ -68,4 +68,3 @@ normalRegColors platform = -- ,"#afafaf","#b6b6b6","#bdbdbd","#c4c4c4","#cbcbcb" -- ,"#d2d2d2","#d9d9d9","#e0e0e0"] - diff --git a/compiler/GHC/Core/LateCC/TopLevelBinds.hs b/compiler/GHC/Core/LateCC/TopLevelBinds.hs index 6c215b78b1c5f50da5cc65c4f8415ca212a9a9ce..d3e0477e082107517be6caa6bd0b877bf2ea04e5 100644 --- a/compiler/GHC/Core/LateCC/TopLevelBinds.hs +++ b/compiler/GHC/Core/LateCC/TopLevelBinds.hs @@ -125,4 +125,4 @@ topLevelBindsCC pred core_bind = let name = idName bndr cc_loc = nameSrcSpan name cc_name = getOccFS name - insertCC cc_name cc_loc rhs \ No newline at end of file + insertCC cc_name cc_loc rhs diff --git a/compiler/GHC/Data/BooleanFormula.hs b/compiler/GHC/Data/BooleanFormula.hs index 1c5ebb331663c9f61751f65517afed9bf517ffef..31fa2549d0f79f155393de236b2ef82d26f553f3 100644 --- a/compiler/GHC/Data/BooleanFormula.hs +++ b/compiler/GHC/Data/BooleanFormula.hs @@ -237,4 +237,4 @@ pprBooleanFormulaNormal = go go (And xs) = fsep $ punctuate comma (map (go . unLoc) xs) go (Or []) = keyword $ text "FALSE" go (Or xs) = fsep $ intersperse vbar (map (go . unLoc) xs) - go (Parens x) = parens (go $ unLoc x) \ No newline at end of file + go (Parens x) = parens (go $ unLoc x) diff --git a/compiler/GHC/Data/Graph/Color.hs b/compiler/GHC/Data/Graph/Color.hs index 7429ad3317fb0973d5c4065979ef79cc1908333f..c7a9ce4157e57b7be74cf31800d316c7bd82b2b6 100644 --- a/compiler/GHC/Data/Graph/Color.hs +++ b/compiler/GHC/Data/Graph/Color.hs @@ -380,5 +380,3 @@ selectColor colors graph u in chooseColor - - diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs index 0a3b8e93b7e302629891bff49997543565599d26..4df651f5722eeca7dee33faa45f3c4b861c9d377 100644 --- a/compiler/GHC/Hs/Instances.hs +++ b/compiler/GHC/Hs/Instances.hs @@ -594,4 +594,4 @@ deriving instance Data XViaStrategyPs -- --------------------------------------------------------------------- deriving instance (Typeable p, Data (Anno (IdGhcP p)), Data (IdGhcP p)) => Data (BooleanFormula (GhcPass p)) ---------------------------------------------------------------------- \ No newline at end of file +--------------------------------------------------------------------- diff --git a/compiler/GHC/Hs/Specificity.hs b/compiler/GHC/Hs/Specificity.hs index 6b892713a36c1b905718da482130a24ae42dd483..88e720c46a6205f6221289abefef19998d1a0eb3 100644 --- a/compiler/GHC/Hs/Specificity.hs +++ b/compiler/GHC/Hs/Specificity.hs @@ -49,4 +49,3 @@ instance NFData ForAllTyFlag where rnf (Invisible spec) = rnf spec rnf Required = () - diff --git a/compiler/GHC/JS/Opt/Expr.hs b/compiler/GHC/JS/Opt/Expr.hs index 390a5b9cd8c62eb199fbf6e689ed20e94951bbb9..a071d2dec0a253edf0e69d957931db53cb94c409 100644 --- a/compiler/GHC/JS/Opt/Expr.hs +++ b/compiler/GHC/JS/Opt/Expr.hs @@ -183,4 +183,4 @@ eqVal (JStr s1) (JStr s2) = s1 == s2 eqVal (JBool b1) (JBool b2) = b1 == b2 eqVal (JDouble (SaneDouble d1)) (JDouble (SaneDouble d2)) | not (isNaN d1) && not (isNaN d2) = d1 == d2 -eqVal _ _ = False \ No newline at end of file +eqVal _ _ = False diff --git a/compiler/GHC/JS/Opt/Simple.hs b/compiler/GHC/JS/Opt/Simple.hs index f2d24bb0d8908029cc5a7cdf507061e7c60f6fb2..5ff175ede8cccde3741d47e3b3915e0f6540fda4 100644 --- a/compiler/GHC/JS/Opt/Simple.hs +++ b/compiler/GHC/JS/Opt/Simple.hs @@ -604,4 +604,4 @@ isClosureAllocator "h$c21" = True isClosureAllocator "h$c22" = True isClosureAllocator "h$c23" = True isClosureAllocator "h$c24" = True -isClosureAllocator _ = False \ No newline at end of file +isClosureAllocator _ = False diff --git a/compiler/GHC/Platform/LoongArch64.hs b/compiler/GHC/Platform/LoongArch64.hs index deabbbb4c08df13911428a40f299bfe564bf7a4a..adefed8760f117c64547fc1c566b4970807498e5 100644 --- a/compiler/GHC/Platform/LoongArch64.hs +++ b/compiler/GHC/Platform/LoongArch64.hs @@ -6,4 +6,4 @@ import GHC.Prelude #define MACHREGS_NO_REGS 0 #define MACHREGS_loongarch64 1 -#include "CodeGen.Platform.h" \ No newline at end of file +#include "CodeGen.Platform.h" diff --git a/compiler/GHC/StgToCmm/TagCheck.hs b/compiler/GHC/StgToCmm/TagCheck.hs index c2476b84905e520847a20bf7c06d91334e860e26..5b3cf2e7e1e84df7e28c62a337e08e0796d707fa 100644 --- a/compiler/GHC/StgToCmm/TagCheck.hs +++ b/compiler/GHC/StgToCmm/TagCheck.hs @@ -175,4 +175,3 @@ checkArgStatic msg MarkedStrict arg = whenCheckTags $ then return () else pprPanic "Arg not tagged as expected" (ppr msg <+> ppr arg) - diff --git a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs index 344862d15613fa30165e5e3ec554f5e3080ad9db..4aae4a11a17f14c4b5123131a6bd3f0ac6133449 100644 --- a/compiler/GHC/Tc/Errors/Hole/FitTypes.hs +++ b/compiler/GHC/Tc/Errors/Hole/FitTypes.hs @@ -128,4 +128,3 @@ hfIsLcl hf@(HoleFit {}) = case hfCand hf of NameHFCand _ -> False GreHFCand gre -> gre_lcl gre - diff --git a/compiler/GHC/Tc/Errors/Hole/Plugin.hs b/compiler/GHC/Tc/Errors/Hole/Plugin.hs index 8ae72558fcf707ca7f9e2aad02211cd974d22f49..b2d5642c7aed35bc970acbe4a441dd931a5f4344 100644 --- a/compiler/GHC/Tc/Errors/Hole/Plugin.hs +++ b/compiler/GHC/Tc/Errors/Hole/Plugin.hs @@ -26,4 +26,4 @@ data HoleFitPluginR = forall s. HoleFitPluginR -- ^ The function defining the plugin itself , hfPluginStop :: TcRef s -> TcM () -- ^ Cleanup of state, guaranteed to be called even on error - } \ No newline at end of file + } diff --git a/compiler/GHC/Tc/Solver/Solve.hs b/compiler/GHC/Tc/Solver/Solve.hs index fdb1773393bed0ee11449e240f340a689867a7ef..996e8140914f0b5edbf27c203104e8b799d21f07 100644 --- a/compiler/GHC/Tc/Solver/Solve.hs +++ b/compiler/GHC/Tc/Solver/Solve.hs @@ -1538,4 +1538,3 @@ runTcPluginSolvers solvers all_cts CtGiven {} -> (ct:givens, wanteds) CtWanted {} -> (givens, (ev,ct):wanteds) - diff --git a/compiler/GHC/Tc/TyCl/Class.hs b/compiler/GHC/Tc/TyCl/Class.hs index a44437285d35081e09f1fc7fda1c26673042d3c1..2303a41e4435c5e150e07f7926121582a68b75aa 100644 --- a/compiler/GHC/Tc/TyCl/Class.hs +++ b/compiler/GHC/Tc/TyCl/Class.hs @@ -598,4 +598,4 @@ warnMissingAT name $ InvalidAssoc $ InvalidAssocInstance $ AssocInstanceMissing name ; diagnosticTc (warn && hsc_src == HsSrcFile) diag - } \ No newline at end of file + } diff --git a/compiler/GHC/Tc/Types/TcRef.hs b/compiler/GHC/Tc/Types/TcRef.hs index 57246d385cc085feddcb6d44461954e97ee74c23..4e6c3fd988867b43ec20f88fc58b528fe31a8420 100644 --- a/compiler/GHC/Tc/Types/TcRef.hs +++ b/compiler/GHC/Tc/Types/TcRef.hs @@ -34,4 +34,4 @@ updTcRefM ref upd = do { contents <- readTcRef ref ; !new_contents <- upd contents ; writeTcRef ref new_contents } -{-# INLINE updTcRefM #-} \ No newline at end of file +{-# INLINE updTcRefM #-} diff --git a/compiler/GHC/Types/PkgQual.hs b/compiler/GHC/Types/PkgQual.hs index 3504bb3ecc90767bd23e89053a606ee3dec39b84..b0e417becd139f9af3babd52aae2045deafc711f 100644 --- a/compiler/GHC/Types/PkgQual.hs +++ b/compiler/GHC/Types/PkgQual.hs @@ -57,4 +57,3 @@ instance Binary PkgQual where 2 -> do u <- get bh return (OtherPkg u) _ -> fail "instance Binary PkgQual: Invalid tag" - diff --git a/compiler/GHC/Types/SptEntry.hs b/compiler/GHC/Types/SptEntry.hs index f88852052cbc2f96838bd059d6af8c1f21722fb6..ac5acb3e28f365d530504ca789c4d81546fc8a53 100644 --- a/compiler/GHC/Types/SptEntry.hs +++ b/compiler/GHC/Types/SptEntry.hs @@ -14,4 +14,3 @@ data SptEntry = SptEntry Id Fingerprint instance Outputable SptEntry where ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr - diff --git a/compiler/GHC/Utils/Unique.hs b/compiler/GHC/Utils/Unique.hs index 786b611236d25a24deb91b475656e95e5f88e784..174bfa52e5ebaa4fc9c0093622e2be4a3224cdb4 100644 --- a/compiler/GHC/Utils/Unique.hs +++ b/compiler/GHC/Utils/Unique.hs @@ -32,4 +32,4 @@ sameUnique x y = getUnique x == getUnique y {-# INLINE anyOfUnique #-} #endif anyOfUnique :: Uniquable a => a -> [Unique] -> Bool -anyOfUnique tc xs = getUnique tc `elem` xs \ No newline at end of file +anyOfUnique tc xs = getUnique tc `elem` xs