diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-01-05 16:57:01 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-01-06 14:24:59 +0000 |
commit | 39337a6d97c853a88fa61d6b12a04eb8c2e5984f (patch) | |
tree | 0dd7051080041ee928429832122b9dd14add302c | |
parent | 32973bf3c2f6fe00e01b44a63ac1904080466938 (diff) | |
download | haskell-39337a6d97c853a88fa61d6b12a04eb8c2e5984f.tar.gz |
Remove redundant constraints in the compiler itself, found by -fwarn-redundant-constraints
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 |