summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHerbert Valerio Riedel <hvr@gnu.org>2017-09-09 13:47:08 +0200
committerHerbert Valerio Riedel <hvr@gnu.org>2017-09-09 14:27:27 +0200
commitdab0e515eadecaee3e9e9f5f8eee3159fa39bb27 (patch)
treeba23795bfde3c92dd9567fc5d617ac21ad4d97d1
parent400ead81e80f66ad7b1260b11b2a92f25ccc3e5a (diff)
downloadhaskell-dab0e515eadecaee3e9e9f5f8eee3159fa39bb27.tar.gz
Canonicalise Monoid instances in GHC
IOW, code compiles -Wnoncanonical-monoid-instances clean now
-rw-r--r--compiler/ghc.cabal.in5
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs3
-rw-r--r--compiler/typecheck/TcErrors.hs3
-rw-r--r--compiler/utils/OrdList.hs2
-rw-r--r--compiler/utils/UniqMap.hs4
-rw-r--r--compiler/utils/UniqSet.hs10
-rw-r--r--ghc/ghc-bin.cabal.in3
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: