[commit: ghc] master: Canonicalise Monoid instances in GHC (dab0e51)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dab0e515eadecaee3e9e9f5f8eee3159fa39bb27/ghc

>---------------------------------------------------------------

commit dab0e515eadecaee3e9e9f5f8eee3159fa39bb27
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sat Sep 9 13:47:08 2017 +0200

    Canonicalise Monoid instances in GHC
    
    IOW, code compiles -Wnoncanonical-monoid-instances clean now


>---------------------------------------------------------------

dab0e515eadecaee3e9e9f5f8eee3159fa39bb27
 compiler/ghc.cabal.in                   |  5 ++++-
 compiler/llvmGen/LlvmCodeGen/CodeGen.hs |  3 +--
 compiler/typecheck/TcErrors.hs          |  3 +--
 compiler/utils/OrdList.hs               |  2 +-
 compiler/utils/UniqMap.hs               |  4 ++--
 compiler/utils/UniqSet.hs               | 10 +++-------
 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 4348d50..30592d1 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 f09237c..099e819 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 3aa5dd8..85d5404 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 1660090..90fdefb 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 5bd609e..c0960dd 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 fcac865..d09b337 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 b04c13a..06e6fc3 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: