Commit 39337a6d authored by Simon Peyton Jones's avatar Simon Peyton Jones

Remove redundant constraints in the compiler itself, found by -fwarn-redundant-constraints

parent 32973bf3
......@@ -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 *]
......
......@@ -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
......
......@@ -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)
......
......@@ -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 }
......
......@@ -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
......
......@@ -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)
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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 ()
......
......@@ -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
......
{-# 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'
......
......@@ -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)
......
......@@ -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
......@@ -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
......
......@@ -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;" ++
......
......@@ -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
......
......@@ -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 }
......
......@@ -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)
......
......@@ -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.
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment