compiler/basicTypes/BasicTypes.hs

@@ -125,10 +125,12 @@ type RepArity = Int
 -}
 
 -- | Type of the tags associated with each constructor possibility
+--   or superclass selector
 type ConTag = Int
 
 fIRST_TAG :: ConTag
 -- ^ Tags are allocated from here for real constructors
+--   or for superclass selectors
 fIRST_TAG =  1
 
 {-

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 *]

compiler/basicTypes/VarSet.hs

@@ -16,7 +16,8 @@ module VarSet (
         unionVarSet, unionVarSets, mapUnionVarSet,
         intersectVarSet, intersectsVarSet, disjointVarSet,
         isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
-        minusVarSet, foldVarSet, filterVarSet, fixVarSet,
+        minusVarSet, foldVarSet, filterVarSet, 
+        transCloVarSet,
         lookupVarSet, mapVarSet, sizeVarSet, seqVarSet,
         elemVarSetByKey, partitionVarSet
     ) where
@@ -69,7 +70,6 @@ extendVarSet_C  :: (Var->Var->Var) -> VarSet -> Var -> VarSet
 
 delVarSetByKey  :: VarSet -> Unique -> VarSet
 elemVarSetByKey :: Unique -> VarSet -> Bool
-fixVarSet       :: (VarSet -> VarSet) -> VarSet -> VarSet
 partitionVarSet :: (Var -> Bool) -> VarSet -> (VarSet, VarSet)
 
 emptyVarSet     = emptyUniqSet
@@ -110,11 +110,26 @@ intersectsVarSet s1 s2 = not (s1 `disjointVarSet` s2)
 disjointVarSet   s1 s2 = isEmptyVarSet (s1 `intersectVarSet` s2)
 subVarSet        s1 s2 = isEmptyVarSet (s1 `minusVarSet` s2)
 
--- Iterate f to a fixpoint
-fixVarSet f s | new_s `subVarSet` s = s
-              | otherwise           = fixVarSet f new_s
-              where
-                new_s = f s
+transCloVarSet :: (VarSet -> VarSet)
+                  -- Map some variables in the set to 
+                  -- *extra* variables that should be in it
+               -> VarSet -> VarSet
+-- (transCloVarSet f s) repeatedly applies f to the set s, adding any
+-- new variables to s that it finds thereby, until it reaches a fixed
+-- point.  The actual algorithm is a bit more efficient.
+transCloVarSet fn seeds
+  = go seeds seeds
+  where
+    go :: VarSet  -- Accumulating result
+       -> VarSet  -- Work-list; un-processed subset of accumulating result
+       -> VarSet
+    -- Specification: go acc vs = acc `union` transClo fn vs
+   
+    go acc candidates
+       | isEmptyVarSet new_vs = acc
+       | otherwise            = go (acc `unionVarSet` new_vs) new_vs
+       where
+         new_vs = fn candidates `minusVarSet` acc
 
 seqVarSet :: VarSet -> ()
 seqVarSet s = sizeVarSet s `seq` ()

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

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)

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 }

compiler/deSugar/DsArrows.hs

@@ -1156,8 +1156,8 @@ collectEvBinders (EvBinds bs)   = foldrBag add_ev_bndr [] bs
 collectEvBinders (TcEvBinds {}) = panic "ToDo: collectEvBinders"
 
 add_ev_bndr :: EvBind -> [Id] -> [Id]
-add_ev_bndr (EvBind b _) bs | isId b    = b:bs
-                            | otherwise = bs
+add_ev_bndr (EvBind { eb_lhs = b }) bs | isId b    = b:bs
+                                       | otherwise = bs
   -- A worry: what about coercion variable binders??
 
 collectLStmtsBinders :: [LStmt Id body] -> [Id]

compiler/deSugar/DsBinds.hs

@@ -13,7 +13,7 @@ lower levels it is preserved with @let@/@letrec@s).
 {-# LANGUAGE CPP #-}
 
 module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, dsSpec,
-                 dsHsWrapper, dsTcEvBinds, dsEvBinds
+                 dsHsWrapper, dsTcEvBinds, dsTcEvBinds_s, dsEvBinds
   ) where
 
 #include "HsVersions.h"
@@ -137,9 +137,9 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
   | ABE { abe_wrap = wrap, abe_poly = global
         , abe_mono = local, abe_prags = prags } <- export
   = do  { dflags <- getDynFlags
-        ; bind_prs    <- ds_lhs_binds binds
-        ; let   core_bind = Rec (fromOL bind_prs)
-        ; ds_binds <- dsTcEvBinds ev_binds
+        ; bind_prs <- ds_lhs_binds binds
+        ; let core_bind = Rec (fromOL bind_prs)
+        ; ds_binds <- dsTcEvBinds_s ev_binds
         ; rhs <- dsHsWrapper wrap $  -- Usually the identity
                             mkLams tyvars $ mkLams dicts $
                             mkCoreLets ds_binds $
@@ -167,7 +167,7 @@ dsHsBind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dicts
               locals       = map abe_mono exports
               tup_expr     = mkBigCoreVarTup locals
               tup_ty       = exprType tup_expr
-        ; ds_binds <- dsTcEvBinds ev_binds
+        ; ds_binds <- dsTcEvBinds_s ev_binds
         ; let poly_tup_rhs = mkLams tyvars $ mkLams dicts $
                              mkCoreLets ds_binds $
                              Let core_bind $
@@ -832,6 +832,11 @@ dsHsWrapper (WpTyLam tv)      e = return $ Lam tv e
 dsHsWrapper (WpEvApp    tm)   e = liftM (App e) (dsEvTerm tm)
 
 --------------------------------------
+dsTcEvBinds_s :: [TcEvBinds] -> DsM [CoreBind]
+dsTcEvBinds_s []       = return []
+dsTcEvBinds_s (b:rest) = ASSERT( null rest )  -- Zonker ensures null
+                         dsTcEvBinds b
+
 dsTcEvBinds :: TcEvBinds -> DsM [CoreBind]
 dsTcEvBinds (TcEvBinds {}) = panic "dsEvBinds"    -- Zonker has got rid of this
 dsTcEvBinds (EvBinds bs)   = dsEvBinds bs
@@ -839,10 +844,11 @@ dsTcEvBinds (EvBinds bs)   = dsEvBinds bs
 dsEvBinds :: Bag EvBind -> DsM [CoreBind]
 dsEvBinds bs = mapM ds_scc (sccEvBinds bs)
   where
-    ds_scc (AcyclicSCC (EvBind v r)) = liftM (NonRec v) (dsEvTerm r)
-    ds_scc (CyclicSCC bs)            = liftM Rec (mapM ds_pair bs)
+    ds_scc (AcyclicSCC (EvBind { eb_lhs = v, eb_rhs = r }))
+                          = liftM (NonRec v) (dsEvTerm r)
+    ds_scc (CyclicSCC bs) = liftM Rec (mapM ds_pair bs)
 
-    ds_pair (EvBind v r) = liftM ((,) v) (dsEvTerm r)
+    ds_pair (EvBind { eb_lhs = v, eb_rhs = r }) = liftM ((,) v) (dsEvTerm r)
 
 sccEvBinds :: Bag EvBind -> [SCC EvBind]
 sccEvBinds bs = stronglyConnCompFromEdgedVertices edges
@@ -851,7 +857,8 @@ sccEvBinds bs = stronglyConnCompFromEdgedVertices edges
     edges = foldrBag ((:) . mk_node) [] bs
 
     mk_node :: EvBind -> (EvBind, EvVar, [EvVar])
-    mk_node b@(EvBind var term) = (b, var, varSetElems (evVarsOfTerm term))
+    mk_node b@(EvBind { eb_lhs = var, eb_rhs = term })
+       = (b, var, varSetElems (evVarsOfTerm term))
 
 
 ---------------------------------------
@@ -974,7 +981,7 @@ ds_tc_coercion subst tc_co
     ds_co_binds eb@(TcEvBinds {}) = pprPanic "ds_co_binds" (ppr eb)
 
     ds_scc :: CvSubst -> SCC EvBind -> CvSubst
-    ds_scc subst (AcyclicSCC (EvBind v ev_term))
+    ds_scc subst (AcyclicSCC (EvBind { eb_lhs = v, eb_rhs = ev_term }))
       = extendCvSubstAndInScope subst v (ds_co_term subst ev_term)
     ds_scc _ (CyclicSCC other) = pprPanic "ds_scc:cyclic" (ppr other $$ ppr tc_co)
 

compiler/deSugar/DsExpr.hs

@@ -142,7 +142,7 @@ dsStrictBind (AbsBinds { abs_tvs = [], abs_ev_vars = []
              bind_export export b = bindNonRec (abe_poly export) (Var (abe_mono export)) b
        ; body2 <- foldlBagM (\body lbind -> dsStrictBind (unLoc lbind) body)
                             body1 lbinds
-       ; ds_binds <- dsTcEvBinds ev_binds
+       ; ds_binds <- dsTcEvBinds_s ev_binds
        ; return (mkCoreLets ds_binds body2) }
 
 dsStrictBind (FunBind { fun_id = L _ fun, fun_matches = matches, fun_co_fn = co_fn

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
 

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)

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)

compiler/hsSyn/HsBinds.hs

@@ -191,8 +191,13 @@ data HsBindLR idL idR
        -- to have the right type
         abs_exports :: [ABExport idL],
 
-        abs_ev_binds :: TcEvBinds,     -- ^ Evidence bindings
-        abs_binds    :: LHsBinds idL   -- ^ Typechecked user bindings
+        -- | Evidence bindings
+        -- Why a list? See TcInstDcls
+        -- Note [Typechecking plan for instance declarations]
+        abs_ev_binds :: [TcEvBinds],
+
+        -- | Typechecked user bindings
+        abs_binds    :: LHsBinds idL
     }
 
   | PatSynBind (PatSynBind idL idR)

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
 

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)

compiler/iface/BuildTyCl.hs

@@ -239,7 +239,7 @@ buildClass tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc_isrec
 
               -- Make selectors for the superclasses
         ; sc_sel_names <- mapM  (newImplicitBinder tycon_name . mkSuperDictSelOcc)
-                                [1..length sc_theta]
+                                (takeList sc_theta [fIRST_TAG..])
         ; let sc_sel_ids = [ mkDictSelId sc_name rec_clas
                            | sc_name <- sc_sel_names]
               -- We number off the Dict superclass selectors, 1, 2, 3 etc so that we

compiler/iface/IfaceSyn.hs

@@ -114,7 +114,7 @@ data IfaceDecl
                                                    -- the tycon)
                    ifFamFlav :: IfaceFamTyConFlav }
 
-  | IfaceClass { ifCtxt    :: IfaceContext,             -- Context...
+  | IfaceClass { ifCtxt    :: IfaceContext,             -- Superclasses
                  ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                  ifTyVars  :: [IfaceTvBndr],            -- Type variables
                  ifRoles   :: [Role],                   -- Roles

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 ()

compiler/main/DynFlags.hs

@@ -467,6 +467,7 @@ data WarningFlag =
 -- See Note [Updating flag description in the User's Guide]
      Opt_WarnDuplicateExports
    | Opt_WarnDuplicateConstraints
+   | Opt_WarnRedundantConstraints
    | Opt_WarnHiShadows
    | Opt_WarnImplicitPrelude
    | Opt_WarnIncompletePatterns
@@ -2825,7 +2826,9 @@ fWarningFlags = [
   flagSpec "warn-dodgy-imports"               Opt_WarnDodgyImports,
   flagSpec "warn-empty-enumerations"          Opt_WarnEmptyEnumerations,
   flagSpec "warn-context-quantification"      Opt_WarnContextQuantification,
-  flagSpec "warn-duplicate-constraints"       Opt_WarnDuplicateConstraints,
+  flagSpec' "warn-duplicate-constraints"      Opt_WarnDuplicateConstraints
+    (\_ -> deprecate "it is subsumed by -fwarn-redundant-constraints"),
+  flagSpec "warn-redundant-constraints"       Opt_WarnRedundantConstraints,
   flagSpec "warn-duplicate-exports"           Opt_WarnDuplicateExports,
   flagSpec "warn-hi-shadowing"                Opt_WarnHiShadows,
   flagSpec "warn-implicit-prelude"            Opt_WarnImplicitPrelude,
@@ -3317,7 +3320,7 @@ standardWarnings -- see Note [Documenting warning flags]
         Opt_WarnPartialTypeSignatures,
         Opt_WarnUnrecognisedPragmas,
         Opt_WarnPointlessPragmas,
-        Opt_WarnDuplicateConstraints,
+        Opt_WarnRedundantConstraints,
         Opt_WarnDuplicateExports,
         Opt_WarnOverflowedLiterals,
         Opt_WarnEmptyEnumerations,

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