summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-01-05 16:57:01 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2015-01-06 14:24:59 +0000
commit39337a6d97c853a88fa61d6b12a04eb8c2e5984f (patch)
tree0dd7051080041ee928429832122b9dd14add302c
parent32973bf3c2f6fe00e01b44a63ac1904080466938 (diff)
downloadhaskell-39337a6d97c853a88fa61d6b12a04eb8c2e5984f.tar.gz
Remove redundant constraints in the compiler itself, found by -fwarn-redundant-constraints
-rw-r--r--compiler/basicTypes/Name.hs3
-rw-r--r--compiler/cmm/CmmExpr.hs8
-rw-r--r--compiler/cmm/Hoopl/Dataflow.hs2
-rw-r--r--compiler/coreSyn/TrieMap.hs4
-rw-r--r--compiler/deSugar/MatchLit.hs2
-rw-r--r--compiler/ghci/ByteCodeItbls.hs6
-rw-r--r--compiler/ghci/Linker.hs2
-rw-r--r--compiler/hsSyn/HsDecls.hs8
-rw-r--r--compiler/hsSyn/HsExpr.hs8
-rw-r--r--compiler/main/CmdLineParser.hs2
-rw-r--r--compiler/main/GHC.hs10
-rw-r--r--compiler/main/GhcMonad.hs17
-rw-r--r--compiler/main/InteractiveEval.hs3
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/SpillClean.hs11
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/Main.hs4
-rw-r--r--compiler/nativeGen/SPARC/Base.hs2
-rw-r--r--compiler/typecheck/TcRnMonad.hs3
-rw-r--r--compiler/types/CoAxiom.hs2
-rw-r--r--compiler/utils/Binary.hs2
-rw-r--r--compiler/utils/GraphColor.hs6
-rw-r--r--compiler/utils/GraphOps.hs24
-rw-r--r--compiler/utils/GraphPpr.hs9
-rw-r--r--compiler/utils/Maybes.hs4
-rw-r--r--compiler/utils/Serialized.hs4
-rw-r--r--compiler/utils/UniqSet.hs2
25 files changed, 79 insertions, 69 deletions
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index ffdd1a14d8..3b0da643ba 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -564,11 +564,12 @@ getSrcLoc = nameSrcLoc . getName
getSrcSpan = nameSrcSpan . getName
getOccString = occNameString . getOccName
-pprInfixName, pprPrefixName :: (Outputable a, NamedThing a) => a -> SDoc
+pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc
-- See Outputable.pprPrefixVar, pprInfixVar;
-- add parens or back-quotes as appropriate
pprInfixName n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)
+pprPrefixName :: NamedThing a => a -> SDoc
pprPrefixName thing
| name `hasKey` liftedTypeKindTyConKey
= ppr name -- See Note [Special treatment for kind *]
diff --git a/compiler/cmm/CmmExpr.hs b/compiler/cmm/CmmExpr.hs
index 4d9bbf8915..aa5cef1ebb 100644
--- a/compiler/cmm/CmmExpr.hs
+++ b/compiler/cmm/CmmExpr.hs
@@ -280,15 +280,15 @@ type RegSet r = Set r
type LocalRegSet = RegSet LocalReg
type GlobalRegSet = RegSet GlobalReg
-emptyRegSet :: Ord r => RegSet r
-nullRegSet :: Ord r => RegSet r -> Bool
+emptyRegSet :: RegSet r
+nullRegSet :: RegSet r -> Bool
elemRegSet :: Ord r => r -> RegSet r -> Bool
extendRegSet :: Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet :: Ord r => RegSet r -> r -> RegSet r
mkRegSet :: Ord r => [r] -> RegSet r
minusRegSet, plusRegSet, timesRegSet :: Ord r => RegSet r -> RegSet r -> RegSet r
-sizeRegSet :: Ord r => RegSet r -> Int
-regSetToList :: Ord r => RegSet r -> [r]
+sizeRegSet :: RegSet r -> Int
+regSetToList :: RegSet r -> [r]
emptyRegSet = Set.empty
nullRegSet = Set.null
diff --git a/compiler/cmm/Hoopl/Dataflow.hs b/compiler/cmm/Hoopl/Dataflow.hs
index 4fbf42e607..29c7afedb4 100644
--- a/compiler/cmm/Hoopl/Dataflow.hs
+++ b/compiler/cmm/Hoopl/Dataflow.hs
@@ -763,7 +763,7 @@ normalizeGraph g = (mapGraphBlocks dropFact g, facts g)
exitFacts (JustO (DBlock f b)) = mapSingleton (entryLabel b) f
bodyFacts :: LabelMap (DBlock f n C C) -> FactBase f
bodyFacts body = mapFoldWithKey f noFacts body
- where f :: forall t a x. (NonLocal t) => Label -> DBlock a t C x -> LabelMap a -> LabelMap a
+ where f :: forall t a x. Label -> DBlock a t C x -> LabelMap a -> LabelMap a
f lbl (DBlock f _) fb = mapInsert lbl f fb
--- implementation of the constructors (boring)
diff --git a/compiler/coreSyn/TrieMap.hs b/compiler/coreSyn/TrieMap.hs
index efae2865cd..9197386ccb 100644
--- a/compiler/coreSyn/TrieMap.hs
+++ b/compiler/coreSyn/TrieMap.hs
@@ -154,12 +154,12 @@ mapMb :: TrieMap m => (a->b) -> MaybeMap m a -> MaybeMap m b
mapMb f (MM { mm_nothing = mn, mm_just = mj })
= MM { mm_nothing = fmap f mn, mm_just = mapTM f mj }
-lkMaybe :: TrieMap m => (forall b. k -> m b -> Maybe b)
+lkMaybe :: (forall b. k -> m b -> Maybe b)
-> Maybe k -> MaybeMap m a -> Maybe a
lkMaybe _ Nothing = mm_nothing
lkMaybe lk (Just x) = mm_just >.> lk x
-xtMaybe :: TrieMap m => (forall b. k -> XT b -> m b -> m b)
+xtMaybe :: (forall b. k -> XT b -> m b -> m b)
-> Maybe k -> XT a -> MaybeMap m a -> MaybeMap m a
xtMaybe _ Nothing f m = m { mm_nothing = f (mm_nothing m) }
xtMaybe tr (Just x) f m = m { mm_just = mm_just m |> tr x f }
diff --git a/compiler/deSugar/MatchLit.hs b/compiler/deSugar/MatchLit.hs
index 1f54780c6d..914b21016c 100644
--- a/compiler/deSugar/MatchLit.hs
+++ b/compiler/deSugar/MatchLit.hs
@@ -394,7 +394,7 @@ hsLitKey _ (HsString _ s) = MachStr (fastStringToByteString s)
hsLitKey _ l = pprPanic "hsLitKey" (ppr l)
---------------------------
-hsOverLitKey :: OutputableBndr a => HsOverLit a -> Bool -> Literal
+hsOverLitKey :: HsOverLit a -> Bool -> Literal
-- Ditto for HsOverLit; the boolean indicates to negate
hsOverLitKey (OverLit { ol_val = l }) neg = litValKey l neg
diff --git a/compiler/ghci/ByteCodeItbls.hs b/compiler/ghci/ByteCodeItbls.hs
index d6399baf64..872d728992 100644
--- a/compiler/ghci/ByteCodeItbls.hs
+++ b/compiler/ghci/ByteCodeItbls.hs
@@ -235,12 +235,14 @@ mkJumpToAddr dflags a = case platformArch (targetPlatform dflags) of
arch ->
panic ("mkJumpToAddr not defined for " ++ show arch)
-byte0, byte1, byte2, byte3 :: (Integral w, Bits w) => w -> Word8
+byte0 :: (Integral w) => w -> Word8
byte0 w = fromIntegral w
+
+byte1, byte2, byte3, byte4, byte5, byte6, byte7
+ :: (Integral w, Bits w) => w -> Word8
byte1 w = fromIntegral (w `shiftR` 8)
byte2 w = fromIntegral (w `shiftR` 16)
byte3 w = fromIntegral (w `shiftR` 24)
-byte4, byte5, byte6, byte7 :: (Integral w, Bits w) => w -> Word8
byte4 w = fromIntegral (w `shiftR` 32)
byte5 w = fromIntegral (w `shiftR` 40)
byte6 w = fromIntegral (w `shiftR` 48)
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 91706da7cb..5a32d0761d 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -199,7 +199,7 @@ linkDependencies hsc_env pls span needed_mods = do
-- | Temporarily extend the linker state.
-withExtendedLinkEnv :: (MonadIO m, ExceptionMonad m) =>
+withExtendedLinkEnv :: (ExceptionMonad m) =>
[(Name,HValue)] -> m a -> m a
withExtendedLinkEnv new_env action
= gbracket (liftIO $ extendLinkEnv new_env)
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs
index f81d0a1ece..4b54a8d702 100644
--- a/compiler/hsSyn/HsDecls.hs
+++ b/compiler/hsSyn/HsDecls.hs
@@ -601,12 +601,10 @@ isDataFamilyDecl _other = False
-- Dealing with names
-tyFamInstDeclName :: OutputableBndr name
- => TyFamInstDecl name -> name
+tyFamInstDeclName :: TyFamInstDecl name -> name
tyFamInstDeclName = unLoc . tyFamInstDeclLName
-tyFamInstDeclLName :: OutputableBndr name
- => TyFamInstDecl name -> Located name
+tyFamInstDeclLName :: TyFamInstDecl name -> Located name
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
(L _ (TyFamEqn { tfe_tycon = ln })) })
= ln
@@ -618,7 +616,7 @@ tyClDeclLName decl = tcdLName decl
tcdName :: TyClDecl name -> name
tcdName = unLoc . tyClDeclLName
-tyClDeclTyVars :: OutputableBndr name => TyClDecl name -> LHsTyVarBndrs name
+tyClDeclTyVars :: TyClDecl name -> LHsTyVarBndrs name
tyClDeclTyVars (FamDecl { tcdFam = FamilyDecl { fdTyVars = tvs } }) = tvs
tyClDeclTyVars d = tcdTyVars d
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 384222b6a0..a5a1aaf4b8 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -1064,14 +1064,14 @@ pprMatch ctxt (Match pats maybe_ty grhss)
Nothing -> empty
-pprGRHSs :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
+pprGRHSs :: (OutputableBndr idR, Outputable body)
=> HsMatchContext idL -> GRHSs idR body -> SDoc
pprGRHSs ctxt (GRHSs grhss binds)
= vcat (map (pprGRHS ctxt . unLoc) grhss)
$$ ppUnless (isEmptyLocalBinds binds)
(text "where" $$ nest 4 (pprBinds binds))
-pprGRHS :: (OutputableBndr idL, OutputableBndr idR, Outputable body)
+pprGRHS :: (OutputableBndr idR, Outputable body)
=> HsMatchContext idL -> GRHS idR body -> SDoc
pprGRHS ctxt (GRHS [] body)
= pp_rhs ctxt body
@@ -1355,8 +1355,8 @@ In any other context than 'MonadComp', the fields for most of these
'SyntaxExpr's stay bottom.
-}
-instance (OutputableBndr idL, OutputableBndr idR)
- => Outputable (ParStmtBlock idL idR) where
+instance (OutputableBndr idL)
+ => Outputable (ParStmtBlock idL idR) where
ppr (ParStmtBlock stmts _ _) = interpp'SP stmts
instance (OutputableBndr idL, OutputableBndr idR, Outputable body)
diff --git a/compiler/main/CmdLineParser.hs b/compiler/main/CmdLineParser.hs
index 94c786b567..0f7d45df27 100644
--- a/compiler/main/CmdLineParser.hs
+++ b/compiler/main/CmdLineParser.hs
@@ -108,7 +108,7 @@ instance Monad m => Monad (EwM m) where
unEwM (k r) l e' w')
return v = EwM (\_ e w -> return (e, w, v))
-setArg :: Monad m => Located String -> EwM m () -> EwM m ()
+setArg :: Located String -> EwM m () -> EwM m ()
setArg l (EwM f) = EwM (\_ es ws -> f l es ws)
addErr :: Monad m => String -> EwM m ()
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 6462aa648a..539961be90 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -345,7 +345,7 @@ import Prelude hiding (init)
-- Unless you want to handle exceptions yourself, you should wrap this around
-- the top level of your program. The default handlers output the error
-- message(s) to stderr and exit cleanly.
-defaultErrorHandler :: (ExceptionMonad m, MonadIO m)
+defaultErrorHandler :: (ExceptionMonad m)
=> FatalMessager -> FlushOut -> m a -> m a
defaultErrorHandler fm (FlushOut flushOut) inner =
-- top-level exception handler: any unrecognised exception is a compiler bug.
@@ -386,7 +386,7 @@ defaultErrorHandler fm (FlushOut flushOut) inner =
-- a GHC run. This is separate from 'defaultErrorHandler', because you might
-- want to override the error handling, but still get the ordinary cleanup
-- behaviour.
-defaultCleanupHandler :: (ExceptionMonad m, MonadIO m) =>
+defaultCleanupHandler :: (ExceptionMonad m) =>
DynFlags -> m a -> m a
defaultCleanupHandler dflags inner =
-- make sure we clean up after ourselves
@@ -432,7 +432,11 @@ runGhc mb_top_dir ghc = do
-- to this function will create a new session which should not be shared among
-- several threads.
-runGhcT :: (ExceptionMonad m, Functor m, MonadIO m) =>
+#if __GLASGOW_HASKELL__ < 710
+runGhcT :: (ExceptionMonad m, Functor m) =>
+#else
+runGhcT :: (ExceptionMonad m) =>
+#endif
Maybe FilePath -- ^ See argument to 'initGhcMonad'.
-> GhcT m a -- ^ The action to perform.
-> m a
diff --git a/compiler/main/GhcMonad.hs b/compiler/main/GhcMonad.hs
index ebcaf368e1..6a3e107801 100644
--- a/compiler/main/GhcMonad.hs
+++ b/compiler/main/GhcMonad.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP, RankNTypes #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
-- -----------------------------------------------------------------------------
--
@@ -156,7 +156,8 @@ reifyGhc act = Ghc $ act
--
-- Note that the wrapped monad must support IO and handling of exceptions.
newtype GhcT m a = GhcT { unGhcT :: Session -> m a }
-liftGhcT :: Monad m => m a -> GhcT m a
+
+liftGhcT :: m a -> GhcT m a
liftGhcT m = GhcT $ \_ -> m
instance Functor m => Functor (GhcT m) where
@@ -183,10 +184,18 @@ instance ExceptionMonad m => ExceptionMonad (GhcT m) where
in
unGhcT (f g_restore) s
-instance (Functor m, ExceptionMonad m, MonadIO m) => HasDynFlags (GhcT m) where
+#if __GLASGOW_HASKELL__ < 710
+instance (ExceptionMonad m, Functor m) => HasDynFlags (GhcT m) where
+#else
+instance (ExceptionMonad m) => HasDynFlags (GhcT m) where
+#endif
getDynFlags = getSessionDynFlags
-instance (Functor m, ExceptionMonad m, MonadIO m) => GhcMonad (GhcT m) where
+#if __GLASGOW_HASKELL__ < 710
+instance (ExceptionMonad m, Functor m) => GhcMonad (GhcT m) where
+#else
+instance (ExceptionMonad m) => GhcMonad (GhcT m) where
+#endif
getSession = GhcT $ \(Session r) -> liftIO $ readIORef r
setSession s' = GhcT $ \(Session r) -> liftIO $ writeIORef r s'
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 6f16d4ef0c..959b7e83a9 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -75,7 +75,6 @@ import BreakArray
import RtClosureInspect
import Outputable
import FastString
-import MonadUtils
import System.Mem.Weak
import System.Directory
@@ -427,7 +426,7 @@ rethrow dflags io = Exception.catch io $ \se -> do
-- resets everything when the computation has stopped running. This
-- is a not-very-good way to ensure that only the interactive
-- evaluation should generate breakpoints.
-withBreakAction :: (ExceptionMonad m, MonadIO m) =>
+withBreakAction :: (ExceptionMonad m) =>
Bool -> DynFlags -> MVar () -> MVar Status -> m a -> m a
withBreakAction step dflags breakMVar statusMVar act
= gbracket (liftIO setBreakAction) (liftIO . resetBreakAction) (\_ -> act)
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index a81d76dd8d..01ab3efff1 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -543,7 +543,7 @@ addAssoc a b m
-- | Delete all associations to a node.
-delAssoc :: (Outputable a, Uniquable a)
+delAssoc :: (Uniquable a)
=> a -> Assoc a -> Assoc a
delAssoc a m
@@ -566,7 +566,7 @@ delAssoc1 a b m
-- | Check if these two things are associated.
-elemAssoc :: (Outputable a, Uniquable a)
+elemAssoc :: (Uniquable a)
=> a -> a -> Assoc a -> Bool
elemAssoc a b m
@@ -574,7 +574,7 @@ elemAssoc a b m
-- | Find the refl. trans. closure of the association from this point.
-closeAssoc :: (Outputable a, Uniquable a)
+closeAssoc :: (Uniquable a)
=> a -> Assoc a -> UniqSet a
closeAssoc a assoc
@@ -604,10 +604,7 @@ closeAssoc a assoc
(unionUniqSets toVisit neighbors)
-- | Intersect two associations.
-intersectAssoc
- :: Uniquable a
- => Assoc a -> Assoc a -> Assoc a
-
+intersectAssoc :: Assoc a -> Assoc a -> Assoc a
intersectAssoc a b
= intersectUFM_C (intersectUniqSets) a b
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index d602d60d10..434c00f9b8 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -606,7 +606,7 @@ releaseRegs regs = do
--
saveClobberedTemps
- :: (Outputable instr, Instruction instr, FR freeRegs)
+ :: (Instruction instr, FR freeRegs)
=> [RealReg] -- real registers clobbered by this instruction
-> [Reg] -- registers which are no longer live after this insn
-> RegM freeRegs [instr] -- return: instructions to spill any temps that will
@@ -873,7 +873,7 @@ newLocation _ my_reg = InReg my_reg
-- | Load up a spilled temporary if we need to (read from memory).
loadTemp
- :: (Outputable instr, Instruction instr)
+ :: (Instruction instr)
=> VirtualReg -- the temp being loaded
-> SpillLoc -- the current location of this temp
-> RealReg -- the hreg to load the temp into
diff --git a/compiler/nativeGen/SPARC/Base.hs b/compiler/nativeGen/SPARC/Base.hs
index 96fb5e7797..a57d5e1c9a 100644
--- a/compiler/nativeGen/SPARC/Base.hs
+++ b/compiler/nativeGen/SPARC/Base.hs
@@ -66,7 +66,7 @@ is32BitInteger i
-- | Sadness.
-largeOffsetError :: (Integral a, Show a) => a -> b
+largeOffsetError :: (Show a) => a -> b
largeOffsetError i
= panic ("ERROR: SPARC native-code generator cannot handle large offset ("
++ show i ++ ");\nprobably because of large constant data structures;" ++
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 31391e4082..0f98726db8 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -893,10 +893,11 @@ failIfErrsM :: TcRn ()
-- Useful to avoid error cascades
failIfErrsM = ifErrsM failM (return ())
-checkTH :: Outputable a => a -> String -> TcRn ()
#ifdef GHCI
+checkTH :: a -> String -> TcRn ()
checkTH _ _ = return () -- OK
#else
+checkTH :: Outputable a => a -> String -> TcRn ()
checkTH e what = failTH e what -- Raise an error in a stage-1 compiler
#endif
diff --git a/compiler/types/CoAxiom.hs b/compiler/types/CoAxiom.hs
index a3e2bb220a..78cc6ba450 100644
--- a/compiler/types/CoAxiom.hs
+++ b/compiler/types/CoAxiom.hs
@@ -184,7 +184,7 @@ brListFoldlM_ :: forall a b m br. Monad m
=> (a -> b -> m a) -> a -> BranchList b br -> m ()
brListFoldlM_ f z brs = do { _ <- go z brs
; return () }
- where go :: forall br'. Monad m => a -> BranchList b br' -> m a
+ where go :: forall br'. a -> BranchList b br' -> m a
go acc (FirstBranch b) = f acc b
go acc (NextBranch h t) = do { fh <- f acc h
; go fh t }
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index 1e85a73d0e..a83e613029 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -549,7 +549,7 @@ writeByteArray arr i (W8# w) = IO $ \s ->
indexByteArray :: ByteArray# -> Int# -> Word8
indexByteArray a# n# = W8# (indexWord8Array# a# n#)
-instance (Integral a, Binary a) => Binary (Ratio a) where
+instance (Binary a) => Binary (Ratio a) where
put_ bh (a :% b) = do put_ bh a; put_ bh b
get bh = do a <- get bh; b <- get bh; return (a :% b)
diff --git a/compiler/utils/GraphColor.hs b/compiler/utils/GraphColor.hs
index 7ba8efbd03..41b367692a 100644
--- a/compiler/utils/GraphColor.hs
+++ b/compiler/utils/GraphColor.hs
@@ -34,7 +34,7 @@ import Data.List
--
colorGraph
:: ( Uniquable k, Uniquable cls, Uniquable color
- , Eq color, Eq cls, Ord k
+ , Eq cls, Ord k
, Outputable k, Outputable cls, Outputable color)
=> Bool -- ^ whether to do iterative coalescing
-> Int -- ^ how many times we've tried to color this graph so far.
@@ -250,7 +250,7 @@ colorScan_spill iterative triv spill graph
assignColors
:: ( Uniquable k, Uniquable cls, Uniquable color
- , Eq color, Outputable cls)
+ , Outputable cls)
=> UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
-> Graph k cls color -- ^ the graph
-> [k] -- ^ nodes to assign a color to.
@@ -288,7 +288,7 @@ assignColors colors graph ks
--
selectColor
:: ( Uniquable k, Uniquable cls, Uniquable color
- , Eq color, Outputable cls)
+ , Outputable cls)
=> UniqFM (UniqSet color) -- ^ map of (node class -> set of colors available for this class).
-> Graph k cls color -- ^ the graph
-> k -- ^ key of the node to select a color for.
diff --git a/compiler/utils/GraphOps.hs b/compiler/utils/GraphOps.hs
index 7bf3ecdffb..804153dad2 100644
--- a/compiler/utils/GraphOps.hs
+++ b/compiler/utils/GraphOps.hs
@@ -76,7 +76,7 @@ addNode k node graph
-- | Delete a node and all its edges from the graph.
-delNode :: (Uniquable k, Outputable k)
+delNode :: (Uniquable k)
=> k -> Graph k cls color -> Maybe (Graph k cls color)
delNode k graph
@@ -119,16 +119,14 @@ modNode f k graph
-- | Get the size of the graph, O(n)
-size :: Uniquable k
- => Graph k cls color -> Int
+size :: Graph k cls color -> Int
size graph
= sizeUFM $ graphMap graph
-- | Union two graphs together.
-union :: Uniquable k
- => Graph k cls color -> Graph k cls color -> Graph k cls color
+union :: Graph k cls color -> Graph k cls color -> Graph k cls color
union graph1 graph2
= Graph
@@ -333,7 +331,7 @@ coalesceGraph' aggressive triv graph kkPairsAcc
-- Nothing if either of the nodes weren't in the graph
coalesceNodes
- :: (Uniquable k, Ord k, Eq cls, Outputable k)
+ :: (Uniquable k, Ord k, Eq cls)
=> Bool -- ^ If True, coalesce nodes even if this might make the graph
-- less colorable (aggressive coalescing)
-> Triv k cls color
@@ -364,7 +362,7 @@ coalesceNodes aggressive triv graph (k1, k2)
= (graph, Nothing)
coalesceNodes_merge
- :: (Uniquable k, Ord k, Eq cls, Outputable k)
+ :: (Uniquable k, Eq cls)
=> Bool
-> Triv k cls color
-> Graph k cls color
@@ -410,7 +408,7 @@ coalesceNodes_merge aggressive triv graph kMin kMax nMin nMax
in coalesceNodes_check aggressive triv graph kMin kMax node
coalesceNodes_check
- :: (Uniquable k, Ord k, Eq cls, Outputable k)
+ :: Uniquable k
=> Bool
-> Triv k cls color
-> Graph k cls color
@@ -483,7 +481,7 @@ freezeNode k
-- right here, and add it to a worklist if known triv\/non-move nodes.
--
freezeOneInGraph
- :: (Uniquable k, Outputable k)
+ :: (Uniquable k)
=> Graph k cls color
-> ( Graph k cls color -- the new graph
, Bool ) -- whether we found a node to freeze
@@ -512,7 +510,7 @@ freezeOneInGraph graph
-- for debugging the iterative allocator.
--
freezeAllInGraph
- :: (Uniquable k, Outputable k)
+ :: (Uniquable k)
=> Graph k cls color
-> Graph k cls color
@@ -525,8 +523,7 @@ freezeAllInGraph graph
-- | Find all the nodes in the graph that meet some criteria
--
scanGraph
- :: Uniquable k
- => (Node k cls color -> Bool)
+ :: (Node k cls color -> Bool)
-> Graph k cls color
-> [Node k cls color]
@@ -611,8 +608,7 @@ checkNode graph node
-- | Slurp out a map of how many nodes had a certain number of conflict neighbours
slurpNodeConflictCount
- :: Uniquable k
- => Graph k cls color
+ :: Graph k cls color
-> UniqFM (Int, Int) -- ^ (conflict neighbours, num nodes with that many conflicts)
slurpNodeConflictCount graph
diff --git a/compiler/utils/GraphPpr.hs b/compiler/utils/GraphPpr.hs
index df85fddc5b..6f7e9d5bb2 100644
--- a/compiler/utils/GraphPpr.hs
+++ b/compiler/utils/GraphPpr.hs
@@ -20,7 +20,7 @@ import Data.Maybe
-- | Pretty print a graph in a somewhat human readable format.
dumpGraph
- :: (Outputable k, Outputable cls, Outputable color)
+ :: (Outputable k, Outputable color)
=> Graph k cls color -> SDoc
dumpGraph graph
@@ -28,7 +28,7 @@ dumpGraph graph
$$ (vcat $ map dumpNode $ eltsUFM $ graphMap graph)
dumpNode
- :: (Outputable k, Outputable cls, Outputable color)
+ :: (Outputable k, Outputable color)
=> Node k cls color -> SDoc
dumpNode node
@@ -74,8 +74,7 @@ dotGraph colorMap triv graph
, space ])
-dotNode :: ( Uniquable k
- , Outputable k, Outputable cls, Outputable color)
+dotNode :: ( Outputable k, Outputable cls, Outputable color)
=> (color -> SDoc)
-> Triv k cls color
-> Node k cls color -> SDoc
@@ -132,7 +131,7 @@ dotNode colorMap triv node
dotNodeEdges
:: ( Uniquable k
- , Outputable k, Outputable cls, Outputable color)
+ , Outputable k)
=> UniqSet k
-> Node k cls color
-> (UniqSet k, Maybe SDoc)
diff --git a/compiler/utils/Maybes.hs b/compiler/utils/Maybes.hs
index fc8e3199ae..f5083fdab5 100644
--- a/compiler/utils/Maybes.hs
+++ b/compiler/utils/Maybes.hs
@@ -67,7 +67,11 @@ newtype MaybeT m a = MaybeT {runMaybeT :: m (Maybe a)}
instance Functor m => Functor (MaybeT m) where
fmap f x = MaybeT $ fmap (fmap f) $ runMaybeT x
+#if __GLASGOW_HASKELL__ < 710
instance (Monad m, Functor m) => Applicative (MaybeT m) where
+#else
+instance (Monad m) => Applicative (MaybeT m) where
+#endif
pure = return
(<*>) = ap
diff --git a/compiler/utils/Serialized.hs b/compiler/utils/Serialized.hs
index b1576a087f..d4e0048467 100644
--- a/compiler/utils/Serialized.hs
+++ b/compiler/utils/Serialized.hs
@@ -100,7 +100,7 @@ deserializeConstr bytes k = deserializeWord8 bytes $ \constr_ix bytes ->
serializeFixedWidthNum :: forall a. (Num a, Integral a, Bits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum what = go (bitSize what) what
#else
-serializeFixedWidthNum :: forall a. (Num a, Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
+serializeFixedWidthNum :: forall a. (Integral a, FiniteBits a) => a -> [Word8] -> [Word8]
serializeFixedWidthNum what = go (finiteBitSize what) what
#endif
where
@@ -113,7 +113,7 @@ serializeFixedWidthNum what = go (finiteBitSize what) what
deserializeFixedWidthNum :: forall a b. (Num a, Integral a, Bits a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum bytes k = go (bitSize (undefined :: a)) bytes k
#else
-deserializeFixedWidthNum :: forall a b. (Num a, Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b
+deserializeFixedWidthNum :: forall a b. (Integral a, FiniteBits a) => [Word8] -> (a -> [Word8] -> b) -> b
deserializeFixedWidthNum bytes k = go (finiteBitSize (undefined :: a)) bytes k
#endif
where
diff --git a/compiler/utils/UniqSet.hs b/compiler/utils/UniqSet.hs
index 5a82303157..4ceeec0000 100644
--- a/compiler/utils/UniqSet.hs
+++ b/compiler/utils/UniqSet.hs
@@ -54,7 +54,7 @@ addOneToUniqSet_C :: Uniquable a => (a -> a -> a) -> UniqSet a -> a -> UniqSet a
addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
-delOneFromUniqSet_Directly :: Uniquable a => UniqSet a -> Unique -> UniqSet a
+delOneFromUniqSet_Directly :: UniqSet a -> Unique -> UniqSet a
delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a