Add missing Semigroup instances to compiler

This is a pre-requisite for implementing the Semigroup/Monoid proposal.
The instances have been introduced in a way to minimise warnings.

5 files changed, 24 insertions, 9 deletions

diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index 8653485e0c..ee6dd7a415 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -118,6 +118,7 @@ import Data.IORef       ( IORef, newIORef, readIORef, atomicModifyIORef' )
 import Data.Maybe       ( isJust )
 import Data.Char
 import Data.List        ( elemIndex )
+import Data.Semigroup as Semi
 
 import GHC.IO           ( IO(..), unsafeDupablePerformIO )
 
@@ -202,9 +203,12 @@ instance Ord FastString where
 instance IsString FastString where
     fromString = fsLit
 
+instance Semi.Semigroup FastString where
+    (<>) = appendFS
+
 instance Monoid FastString where
     mempty = nilFS
-    mappend = appendFS
+    mappend = (Semi.<>)
     mconcat = concatFS
 
 instance Show FastString where
diff --git a/compiler/utils/Pair.hs b/compiler/utils/Pair.hs
index d816ad3f98..aeb8648b64 100644
--- a/compiler/utils/Pair.hs
+++ b/compiler/utils/Pair.hs
@@ -10,6 +10,7 @@ module Pair ( Pair(..), unPair, toPair, swap, pLiftFst, pLiftSnd ) where
 #include "HsVersions.h"
 
 import Outputable
+import qualified Data.Semigroup as Semi
 
 data Pair a = Pair { pFst :: a, pSnd :: a }
 -- Note that Pair is a *unary* type constructor
@@ -31,9 +32,12 @@ instance Foldable Pair where
 instance Traversable Pair where
   traverse f (Pair x y) = Pair <$> f x <*> f y
 
-instance Monoid a => Monoid (Pair a) where
+instance Semi.Semigroup a => Semi.Semigroup (Pair a) where
+  Pair a1 b1 <> Pair a2 b2 =  Pair (a1 Semi.<> a2) (b1 Semi.<> b2)
+
+instance (Semi.Semigroup a, Monoid a) => Monoid (Pair a) where
   mempty = Pair mempty mempty
-  Pair a1 b1 `mappend` Pair a2 b2 = Pair (a1 `mappend` a2) (b1 `mappend` b2)
+  mappend = (Semi.<>)
 
 instance Outputable a => Outputable (Pair a) where
   ppr (Pair a b) = ppr a <+> char '~' <+> ppr b
diff --git a/compiler/utils/PprColour.hs b/compiler/utils/PprColour.hs
index ba7435d5c2..f8ea28faa9 100644
--- a/compiler/utils/PprColour.hs
+++ b/compiler/utils/PprColour.hs
@@ -1,15 +1,19 @@
 module PprColour where
 import Data.Maybe (fromMaybe)
 import Util (OverridingBool(..), split)
+import Data.Semigroup as Semi
 
 -- | A colour\/style for use with 'coloured'.
 newtype PprColour = PprColour { renderColour :: String }
 
+instance Semi.Semigroup PprColour where
+  PprColour s1 <> PprColour s2 = PprColour (s1 <> s2)
+
 -- | Allow colours to be combined (e.g. bold + red);
 --   In case of conflict, right side takes precedence.
 instance Monoid PprColour where
   mempty = PprColour mempty
-  PprColour s1 `mappend` PprColour s2 = PprColour (s1 `mappend` s2)
+  mappend = (<>)
 
 renderColourAfresh :: PprColour -> String
 renderColourAfresh c = renderColour (colReset `mappend` c)
diff --git a/compiler/utils/UniqDFM.hs b/compiler/utils/UniqDFM.hs
index 17f2747f83..cb3dd7b7bd 100644
--- a/compiler/utils/UniqDFM.hs
+++ b/compiler/utils/UniqDFM.hs
@@ -66,6 +66,7 @@ import qualified Data.IntMap as M
 import Data.Data
 import Data.List (sortBy)
 import Data.Function (on)
+import qualified Data.Semigroup as Semi
 import UniqFM (UniqFM, listToUFM_Directly, nonDetUFMToList, ufmToIntMap)
 
 -- Note [Deterministic UniqFM]
@@ -371,9 +372,12 @@ anyUDFM p (UDFM m _i) = M.foldr ((||) . p . taggedFst) False m
 allUDFM :: (elt -> Bool) -> UniqDFM elt -> Bool
 allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m
 
+instance Semi.Semigroup (UniqDFM a) where
+  (<>) = plusUDFM
+
 instance Monoid (UniqDFM a) where
   mempty = emptyUDFM
-  mappend = plusUDFM
+  mappend = (Semi.<>)
 
 -- This should not be used in commited code, provided for convenience to
 -- make ad-hoc conversions when developing
diff --git a/compiler/utils/UniqFM.hs b/compiler/utils/UniqFM.hs
index 8ea8ba4537..076479f984 100644
--- a/compiler/utils/UniqFM.hs
+++ b/compiler/utils/UniqFM.hs
@@ -85,8 +85,7 @@ import qualified Data.Monoid as Mon
 import qualified Data.IntSet as S
 import Data.Typeable
 import Data.Data
-import Data.Semigroup   ( Semigroup )
-import qualified Data.Semigroup as Semigroup
+import qualified Data.Semigroup as Semi
 
 
 newtype UniqFM ele = UFM (M.IntMap ele)
@@ -356,12 +355,12 @@ equalKeysUFM (UFM m1) (UFM m2) = M.keys m1 == M.keys m2
 
 -- Instances
 
-instance Semigroup (UniqFM a) where
+instance Semi.Semigroup (UniqFM a) where
   (<>) = plusUFM
 
 instance Monoid (UniqFM a) where
     mempty = emptyUFM
-    mappend = plusUFM
+    mappend = (Semi.<>)
 
 -- Output-ery