diff options
author | Herbert Valerio Riedel <hvr@gnu.org> | 2017-09-09 13:47:08 +0200 |
---|---|---|
committer | Herbert Valerio Riedel <hvr@gnu.org> | 2017-09-09 14:27:27 +0200 |
commit | dab0e515eadecaee3e9e9f5f8eee3159fa39bb27 (patch) | |
tree | ba23795bfde3c92dd9567fc5d617ac21ad4d97d1 | |
parent | 400ead81e80f66ad7b1260b11b2a92f25ccc3e5a (diff) | |
download | haskell-dab0e515eadecaee3e9e9f5f8eee3159fa39bb27.tar.gz |
Canonicalise Monoid instances in GHC
IOW, code compiles -Wnoncanonical-monoid-instances clean now
-rw-r--r-- | compiler/ghc.cabal.in | 5 | ||||
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 3 | ||||
-rw-r--r-- | compiler/typecheck/TcErrors.hs | 3 | ||||
-rw-r--r-- | compiler/utils/OrdList.hs | 2 | ||||
-rw-r--r-- | compiler/utils/UniqMap.hs | 4 | ||||
-rw-r--r-- | compiler/utils/UniqSet.hs | 10 | ||||
-rw-r--r-- | ghc/ghc-bin.cabal.in | 3 |
7 files changed, 15 insertions, 15 deletions
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 4348d50092..30592d17e0 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -73,7 +73,10 @@ Library Build-Depends: terminfo == 0.4.* Build-Depends: unix == 2.7.* - GHC-Options: -Wall -fno-warn-name-shadowing + GHC-Options: -Wall + -Wno-name-shadowing + -Wnoncanonical-monad-instances + -Wnoncanonical-monoid-instances if flag(ghci) CPP-Options: -DGHCI diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index f09237c6d9..099e8194bd 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -1867,8 +1867,7 @@ instance Semigroup LlvmAccum where instance Monoid LlvmAccum where mempty = LlvmAccum nilOL [] - LlvmAccum stmtsA declsA `mappend` LlvmAccum stmtsB declsB = - LlvmAccum (stmtsA `mappend` stmtsB) (declsA `mappend` declsB) + mappend = (Semigroup.<>) liftExprData :: LlvmM ExprData -> WriterT LlvmAccum LlvmM LlvmVar liftExprData action = do diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index 3aa5dd8625..85d5404588 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -251,8 +251,7 @@ instance Semigroup Report where instance Monoid Report where mempty = Report [] [] [] - mappend (Report a1 b1 c1) (Report a2 b2 c2) - = Report (a1 ++ a2) (b1 ++ b2) (c1 ++ c2) + mappend = (Semigroup.<>) -- | Put a doc into the important msgs block. important :: SDoc -> Report diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs index 1660090ba7..90fdefb908 100644 --- a/compiler/utils/OrdList.hs +++ b/compiler/utils/OrdList.hs @@ -41,7 +41,7 @@ instance Semigroup (OrdList a) where instance Monoid (OrdList a) where mempty = nilOL - mappend = appOL + mappend = (Semigroup.<>) mconcat = concatOL instance Functor OrdList where diff --git a/compiler/utils/UniqMap.hs b/compiler/utils/UniqMap.hs index 5bd609e597..c0960dd5b2 100644 --- a/compiler/utils/UniqMap.hs +++ b/compiler/utils/UniqMap.hs @@ -49,7 +49,7 @@ import UniqFM import Unique import Outputable -import Data.Semigroup ( Semigroup(..) ) +import Data.Semigroup as Semi ( Semigroup(..) ) import Data.Coerce import Data.Maybe import Data.Typeable @@ -65,7 +65,7 @@ instance Semigroup (UniqMap k a) where instance Monoid (UniqMap k a) where mempty = emptyUniqMap - mappend = plusUniqMap + mappend = (Semi.<>) instance (Outputable k, Outputable a) => Outputable (UniqMap k a) where ppr (UniqMap m) = diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs index fcac865ea8..d09b337d12 100644 --- a/compiler/utils/UniqSet.hs +++ b/compiler/utils/UniqSet.hs @@ -52,7 +52,7 @@ import Data.Coerce import Outputable import Data.Foldable (foldl') import Data.Data -import qualified Data.Semigroup +import qualified Data.Semigroup as Semi -- Note [UniqSet invariant] -- ~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -61,7 +61,8 @@ import qualified Data.Semigroup -- It means that to implement mapUniqSet you have to update -- both the keys and the values. -newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a} deriving Data +newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a} + deriving (Data, Semi.Semigroup, Monoid) emptyUniqSet :: UniqSet a emptyUniqSet = UniqSet emptyUFM @@ -186,11 +187,6 @@ unsafeUFMToUniqSet = UniqSet instance Outputable a => Outputable (UniqSet a) where ppr = pprUniqSet ppr -instance Data.Semigroup.Semigroup (UniqSet a) where - (<>) = mappend -instance Monoid (UniqSet a) where - mempty = UniqSet mempty - UniqSet s `mappend` UniqSet t = UniqSet (s `mappend` t) pprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc pprUniqSet f (UniqSet s) = pprUniqFM f s diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in index b04c13a6c1..06e6fc37b6 100644 --- a/ghc/ghc-bin.cabal.in +++ b/ghc/ghc-bin.cabal.in @@ -45,6 +45,9 @@ Executable ghc C-Sources: hschooks.c GHC-Options: -Wall + -Wnoncanonical-monad-instances + -Wnoncanonical-monoid-instances + if flag(ghci) -- NB: this is never built by the bootstrapping GHC+libraries Build-depends: |