Fix Haddock errors.

[ghc-hetmet.git] / compiler / typecheck / TcSimplify.lhs

diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index ee62c0e..9ebae01 100644 (file)
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -6,13 +6,6 @@
 TcSimplify
 
 \begin{code}
 TcSimplify
 
 \begin{code}

-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-

 module TcSimplify (
        tcSimplifyInfer, tcSimplifyInferCheck,
        tcSimplifyCheck, tcSimplifyRestricted,
 module TcSimplify (
        tcSimplifyInfer, tcSimplifyInferCheck,
        tcSimplifyCheck, tcSimplifyRestricted,

@@ -33,6 +26,7 @@ import {-# SOURCE #-} TcUnify( unifyType )
 import HsSyn
 
 import TcRnMonad
 import HsSyn
 
 import TcRnMonad

+import TcHsSyn ( hsLPatType )

 import Inst
 import TcEnv
 import InstEnv
 import Inst
 import TcEnv
 import InstEnv

@@ -40,7 +34,7 @@ import TcType
 import TcMType
 import TcIface
 import TcTyFuns
 import TcMType
 import TcIface
 import TcTyFuns

-import TypeRep
+import DsUtils -- Big-tuple functions

 import Var
 import Name
 import NameSet
 import Var
 import Name
 import NameSet

@@ -54,14 +48,12 @@ import ErrUtils
 import BasicTypes
 import VarSet
 import VarEnv
 import BasicTypes
 import VarSet
 import VarEnv

-import Module

 import FiniteMap
 import Bag
 import Outputable
 import Maybes
 import ListSetOps
 import Util
 import FiniteMap
 import Bag
 import Outputable
 import Maybes
 import ListSetOps
 import Util

-import UniqSet

 import SrcLoc
 import DynFlags
 import FastString
 import SrcLoc
 import DynFlags
 import FastString

@@ -99,34 +91,36 @@ we reduce the (C a b1) constraint from the call of f to (D a b1).
 
 Here is a more complicated example:
 
 
 Here is a more complicated example:
 

-| > class Foo a b | a->b
-| >
-| > class Bar a b | a->b
-| >
-| > data Obj = Obj
-| >
-| > instance Bar Obj Obj
-| >
-| > instance (Bar a b) => Foo a b
-| >
-| > foo:: (Foo a b) => a -> String
-| > foo _ = "works"
-| >
-| > runFoo:: (forall a b. (Foo a b) => a -> w) -> w
-| > runFoo f = f Obj
-| 
-| *Test> runFoo foo
-| 
-| <interactive>:1:
-|     Could not deduce (Bar a b) from the context (Foo a b)
-|       arising from use of `foo' at <interactive>:1
-|     Probable fix:
-|         Add (Bar a b) to the expected type of an expression
-|     In the first argument of `runFoo', namely `foo'
-|     In the definition of `it': it = runFoo foo
-| 
-| Why all of the sudden does GHC need the constraint Bar a b? The
-| function foo didn't ask for that... 
+@
+  > class Foo a b | a->b
+  >
+  > class Bar a b | a->b
+  >
+  > data Obj = Obj
+  >
+  > instance Bar Obj Obj
+  >
+  > instance (Bar a b) => Foo a b
+  >
+  > foo:: (Foo a b) => a -> String
+  > foo _ = "works"
+  >
+  > runFoo:: (forall a b. (Foo a b) => a -> w) -> w
+  > runFoo f = f Obj
+
+  *Test> runFoo foo
+
+  <interactive>:1:
+      Could not deduce (Bar a b) from the context (Foo a b)
+        arising from use of `foo' at <interactive>:1
+      Probable fix:
+          Add (Bar a b) to the expected type of an expression
+      In the first argument of `runFoo', namely `foo'
+      In the definition of `it': it = runFoo foo
+
+  Why all of the sudden does GHC need the constraint Bar a b? The
+  function foo didn't ask for that...
+@

 
 The trouble is that to type (runFoo foo), GHC has to solve the problem:
 
 
 The trouble is that to type (runFoo foo), GHC has to solve the problem:
 

@@ -889,7 +883,9 @@ isFreeWhenChecking qtvs ips inst
   && isFreeWrtIPs    ips inst
 -}
 
   && isFreeWrtIPs    ips inst
 -}
 

+isFreeWrtTyVars :: VarSet -> Inst -> Bool

 isFreeWrtTyVars qtvs inst = tyVarsOfInst inst `disjointVarSet` qtvs
 isFreeWrtTyVars qtvs inst = tyVarsOfInst inst `disjointVarSet` qtvs

+isFreeWrtIPs :: NameSet -> Inst -> Bool

 isFreeWrtIPs     ips inst = not (any (`elemNameSet` ips) (ipNamesOfInst inst))
 \end{code}
 
 isFreeWrtIPs     ips inst = not (any (`elemNameSet` ips) (ipNamesOfInst inst))
 \end{code}
 

@@ -1003,19 +999,17 @@ makeImplicationBind loc all_tvs
                                         tci_given = (eq_givens ++ dict_givens),
                                         tci_wanted = irreds, tci_loc = loc }
        ; let   -- only create binder for dict_irreds
                                         tci_given = (eq_givens ++ dict_givens),
                                         tci_wanted = irreds, tci_loc = loc }
        ; let   -- only create binder for dict_irreds

-             (eq_irreds, dict_irreds) = partition isEqInst irreds
-              n_dict_irreds = length dict_irreds
+             (_, dict_irreds) = partition isEqInst irreds

              dict_irred_ids = map instToId dict_irreds
              dict_irred_ids = map instToId dict_irreds

-             tup_ty = mkTupleTy Boxed n_dict_irreds (map idType dict_irred_ids)
-             pat = TuplePat (map nlVarPat dict_irred_ids) Boxed tup_ty
+             lpat = mkBigLHsPatTup (map (L span . VarPat) dict_irred_ids)

              rhs = L span (mkHsWrap co (HsVar (instToId implic_inst)))
              co  = mkWpApps (map instToId dict_givens)
                    <.> mkWpTyApps eq_tyvar_cos
                    <.> mkWpTyApps (mkTyVarTys all_tvs)
              bind | [dict_irred_id] <- dict_irred_ids  = VarBind dict_irred_id rhs
              rhs = L span (mkHsWrap co (HsVar (instToId implic_inst)))
              co  = mkWpApps (map instToId dict_givens)
                    <.> mkWpTyApps eq_tyvar_cos
                    <.> mkWpTyApps (mkTyVarTys all_tvs)
              bind | [dict_irred_id] <- dict_irred_ids  = VarBind dict_irred_id rhs

-                  | otherwise        = PatBind { pat_lhs = L span pat, 
+                  | otherwise        = PatBind { pat_lhs = lpat, 

                                                  pat_rhs = unguardedGRHSs rhs, 
                                                  pat_rhs = unguardedGRHSs rhs, 

-                                                 pat_rhs_ty = tup_ty,
+                                                 pat_rhs_ty = hsLPatType lpat,

                                                  bind_fvs = placeHolderNames }
        ; traceTc $ text "makeImplicationBind" <+> ppr implic_inst
        ; return ([implic_inst], unitBag (L span bind)) 
                                                  bind_fvs = placeHolderNames }
        ; traceTc $ text "makeImplicationBind" <+> ppr implic_inst
        ; return ([implic_inst], unitBag (L span bind)) 

@@ -1031,7 +1025,7 @@ tryHardCheckLoop doc wanteds
        ; return (irreds,binds)
        }
   where
        ; return (irreds,binds)
        }
   where

-    try_me inst = ReduceMe AddSCs
+    try_me _ = ReduceMe AddSCs

        -- Here's the try-hard bit
 
 -----------------------------------------------------------
        -- Here's the try-hard bit
 
 -----------------------------------------------------------

@@ -1231,7 +1225,7 @@ tcSimplifySuperClasses loc givens sc_wanteds
        ; return binds1 }
   where
     env = mkRedEnv (pprInstLoc loc) try_me givens
        ; return binds1 }
   where
     env = mkRedEnv (pprInstLoc loc) try_me givens

-    try_me inst = ReduceMe NoSCs
+    try_me _ = ReduceMe NoSCs

        -- Like tryHardCheckLoop, but with NoSCs
 \end{code}
 
        -- Like tryHardCheckLoop, but with NoSCs
 \end{code}
 

@@ -1364,7 +1358,7 @@ tcSimplifyRestricted doc top_lvl bndrs tau_tvs wanteds
        -- BUT do no improvement!  See Plan D above
        -- HOWEVER, some unification may take place, if we instantiate
        --          a method Inst with an equality constraint
        -- BUT do no improvement!  See Plan D above
        -- HOWEVER, some unification may take place, if we instantiate
        --          a method Inst with an equality constraint

-       ; let env = mkNoImproveRedEnv doc (\i -> ReduceMe AddSCs)
+       ; let env = mkNoImproveRedEnv doc (\_ -> ReduceMe AddSCs)

        ; (_imp, _binds, constrained_dicts, elim_skolems) 
             <- reduceContext env wanteds'
         ; elim_skolems
        ; (_imp, _binds, constrained_dicts, elim_skolems) 
             <- reduceContext env wanteds'
         ; elim_skolems

@@ -1774,12 +1768,12 @@ reduceContext env wanteds
                                                             given_dicts0
 
           -- 5. Build the Avail mapping from "given_dicts"
                                                             given_dicts0
 
           -- 5. Build the Avail mapping from "given_dicts"

-       ; (init_state, extra_givens) <- getLIE $ do 
+       ; (init_state, _) <- getLIE $ do 

                { init_state <- foldlM addGiven emptyAvails given_dicts
                ; return init_state
                 }
 
                { init_state <- foldlM addGiven emptyAvails given_dicts
                ; return init_state
                 }
 

-       -- *** ToDo: what to do with the "extra_givens"?  For the
+       -- !!! ToDo: what to do with the "extra_givens"?  For the

        -- moment I'm simply discarding them, which is probably wrong
 
           -- 6. Solve the *wanted* *dictionary* constraints (not implications)
        -- moment I'm simply discarding them, which is probably wrong
 
           -- 6. Solve the *wanted* *dictionary* constraints (not implications)

@@ -1889,8 +1883,11 @@ unifyEqns eqns
            mapM_ (unif_pr tenv) pairs
     unif_pr tenv (ty1,ty2) =  unifyType (substTy tenv ty1) (substTy tenv ty2)
 
            mapM_ (unif_pr tenv) pairs
     unif_pr tenv (ty1,ty2) =  unifyType (substTy tenv ty1) (substTy tenv ty2)
 

-pprEquationDoc (eqn, (p1,w1), (p2,w2)) = vcat [pprEquation eqn, nest 2 (ppr p1), nest 2 (ppr p2)]
+pprEquationDoc :: (Equation, (PredType, SDoc), (PredType, SDoc)) -> SDoc
+pprEquationDoc (eqn, (p1, _), (p2, _)) = vcat [pprEquation eqn, nest 2 (ppr p1), nest 2 (ppr p2)]

 
 

+mkEqnMsg :: (TcPredType, SDoc) -> (TcPredType, SDoc) -> TidyEnv
+         -> TcM (TidyEnv, SDoc)

 mkEqnMsg (pred1,from1) (pred2,from2) tidy_env
   = do { pred1' <- zonkTcPredType pred1; pred2' <- zonkTcPredType pred2
        ; let { pred1'' = tidyPred tidy_env pred1'; pred2'' = tidyPred tidy_env pred2' }
 mkEqnMsg (pred1,from1) (pred2,from2) tidy_env
   = do { pred1' <- zonkTcPredType pred1; pred2' <- zonkTcPredType pred2
        ; let { pred1'' = tidyPred tidy_env pred1'; pred2'' = tidyPred tidy_env pred2' }

@@ -1920,9 +1917,10 @@ reduceList env@(RedEnv {red_stack = (n,stk)}) wanteds state
                         ; go ws state' }
 
     -- Base case: we're done!
                         ; go ws state' }
 
     -- Base case: we're done!

+reduce :: RedEnv -> Inst -> Avails -> TcM Avails

 reduce env wanted avails
     -- It's the same as an existing inst, or a superclass thereof
 reduce env wanted avails
     -- It's the same as an existing inst, or a superclass thereof

-  | Just avail <- findAvail avails wanted
+  | Just _ <- findAvail avails wanted

   = do { traceTc (text "reduce: found " <+> ppr wanted)
        ; return avails
        }
   = do { traceTc (text "reduce: found " <+> ppr wanted)
        ; return avails
        }

@@ -1962,7 +1960,7 @@ reduce env wanted avails
       = do { res <- lookupSimpleInst wanted
           ; case res of
                GenInst [] rhs -> addWanted AddSCs avails wanted rhs []
       = do { res <- lookupSimpleInst wanted
           ; case res of
                GenInst [] rhs -> addWanted AddSCs avails wanted rhs []

-               other          -> do_this_otherwise avails wanted }
+               _              -> do_this_otherwise avails wanted }

 \end{code}
 
 
 \end{code}
 
 

@@ -2053,7 +2051,7 @@ contributing clauses.
 \begin{code}
 ---------------------------------------------
 reduceInst :: RedEnv -> Avails -> Inst -> TcM (Avails, LookupInstResult)
 \begin{code}
 ---------------------------------------------
 reduceInst :: RedEnv -> Avails -> Inst -> TcM (Avails, LookupInstResult)

-reduceInst env avails other_inst
+reduceInst _ avails other_inst

   = do { result <- lookupSimpleInst other_inst
        ; return (avails, result) }
 \end{code}
   = do { result <- lookupSimpleInst other_inst
        ; return (avails, result) }
 \end{code}

@@ -2124,7 +2122,7 @@ reduceImplication env
                                  tci_tyvars = tvs,
                                  tci_given = extra_givens, tci_wanted = wanteds })
   = do {       -- Solve the sub-problem
                                  tci_tyvars = tvs,
                                  tci_given = extra_givens, tci_wanted = wanteds })
   = do {       -- Solve the sub-problem

-       ; let try_me inst = ReduceMe AddSCs  -- Note [Freeness and implications]
+       ; let try_me _ = ReduceMe AddSCs  -- Note [Freeness and implications]

              env' = env { red_givens = extra_givens ++ red_givens env
                         , red_doc = sep [ptext (sLit "reduceImplication for") 
                                             <+> ppr name,
              env' = env { red_givens = extra_givens ++ red_givens env
                         , red_doc = sep [ptext (sLit "reduceImplication for") 
                                             <+> ppr name,

@@ -2187,19 +2185,19 @@ reduceImplication env
                      <.> WpLet (binds `unionBags` bind)
                wrap_inline | null dict_ids = idHsWrapper
                            | otherwise     = WpInline
                      <.> WpLet (binds `unionBags` bind)
                wrap_inline | null dict_ids = idHsWrapper
                            | otherwise     = WpInline

-               rhs = mkHsWrap co payload
+               rhs = mkLHsWrap co payload

                loc = instLocSpan inst_loc
                loc = instLocSpan inst_loc

-               payload | [dict_wanted] <- dict_wanteds = HsVar (instToId dict_wanted)
-                       | otherwise = ExplicitTuple (map (L loc . HsVar . instToId) dict_wanteds) Boxed
+               payload = mkBigLHsTup (map (L loc . HsVar . instToId) dict_wanteds)

 
        
        ; traceTc (vcat [text "reduceImplication" <+> ppr name,
                         ppr simpler_implic_insts,
                         text "->" <+> ppr rhs])
 
        
        ; traceTc (vcat [text "reduceImplication" <+> ppr name,
                         ppr simpler_implic_insts,
                         text "->" <+> ppr rhs])

-       ; return (unitBag (L loc (VarBind (instToId orig_implic) (L loc rhs))),
+       ; return (unitBag (L loc (VarBind (instToId orig_implic) rhs)),

                  simpler_implic_insts)
        } 
     }
                  simpler_implic_insts)
        } 
     }

+reduceImplication _ i = pprPanic "reduceImplication" (ppr i)

 \end{code}
 
 Note [Always inline implication constraints]
 \end{code}
 
 Note [Always inline implication constraints]

@@ -2237,12 +2235,29 @@ We can satisfy the (C Int) from the superclass of D, so we don't want
 to float the (C Int) out, even though it mentions no type variable in
 the constraints!
 
 to float the (C Int) out, even though it mentions no type variable in
 the constraints!
 

+One more example: the constraint
+       class C a => D a b
+       instance (C a, E c) => E (a,c)
+
+       constraint: forall b. D Int b => E (Int,c)
+
+You might think that the (D Int b) can't possibly contribute
+to solving (E (Int,c)), since the latter mentions 'c'.  But 
+in fact it can, because solving the (E (Int,c)) constraint needs 
+dictionaries
+       C Int, E c
+and the (C Int) can be satisfied from the superclass of (D Int b).
+So we must still not float (E (Int,c)) out.
+
+To think about: special cases for unary type classes?
+

 Note [Pruning the givens in an implication constraint]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Suppose we are about to form the implication constraint
        forall tvs.  Eq a => Ord b
 The (Eq a) cannot contribute to the (Ord b), because it has no access to
 the type variable 'b'.  So we could filter out the (Eq a) from the givens.
 Note [Pruning the givens in an implication constraint]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Suppose we are about to form the implication constraint
        forall tvs.  Eq a => Ord b
 The (Eq a) cannot contribute to the (Ord b), because it has no access to
 the type variable 'b'.  So we could filter out the (Eq a) from the givens.

+But BE CAREFUL of the examples above in [Freeness and implications].

 
 Doing so would be a bit tidier, but all the implication constraints get
 simplified away by the optimiser, so it's no great win.   So I don't take
 
 Doing so would be a bit tidier, but all the implication constraints get
 simplified away by the optimiser, so it's no great win.   So I don't take

@@ -2280,6 +2295,7 @@ data AvailHow
 instance Outputable Avails where
   ppr = pprAvails
 
 instance Outputable Avails where
   ppr = pprAvails
 

+pprAvails :: Avails -> SDoc

 pprAvails (Avails imp avails)
   = vcat [ ptext (sLit "Avails") <> (if imp then ptext (sLit "[improved]") else empty)
         , nest 2 $ braces $ 
 pprAvails (Avails imp avails)
   = vcat [ ptext (sLit "Avails") <> (if imp then ptext (sLit "[improved]") else empty)
         , nest 2 $ braces $ 

@@ -2324,11 +2340,8 @@ extendAvails avails@(Avails imp env) inst avail
 availsInsts :: Avails -> [Inst]
 availsInsts (Avails _ avails) = keysFM avails
 
 availsInsts :: Avails -> [Inst]
 availsInsts (Avails _ avails) = keysFM avails
 

-availsImproved (Avails imp _) = imp
-
-updateImprovement :: Avails -> Avails -> Avails
--- (updateImprovement a1 a2) sets a1's improvement flag from a2
-updateImprovement (Avails _ avails1) (Avails imp2 _) = Avails imp2 avails1
+_availsImproved :: Avails -> ImprovementDone
+_availsImproved (Avails imp _) = imp

 \end{code}
 
 Extracting the bindings from a bunch of Avails.
 \end{code}
 
 Extracting the bindings from a bunch of Avails.

@@ -2356,7 +2369,7 @@ extractResults (Avails _ avails) wanteds
        -> DoneEnv      -- Has an entry for each inst in the above three sets
        -> [Inst]       -- Wanted
        -> TcM (TcDictBinds, [Inst], [Inst])
        -> DoneEnv      -- Has an entry for each inst in the above three sets
        -> [Inst]       -- Wanted
        -> TcM (TcDictBinds, [Inst], [Inst])

-    go binds bound_dicts irreds done [] 
+    go binds bound_dicts irreds _ [] 

       = return (binds, bound_dicts, irreds)
 
     go binds bound_dicts irreds done (w:ws)
       = return (binds, bound_dicts, irreds)
 
     go binds bound_dicts irreds done (w:ws)

@@ -2438,7 +2451,7 @@ addAvailAndSCs want_scs avails inst avail
     -- Watch out, though.  Since the avails may contain loops 
     -- (see Note [RECURSIVE DICTIONARIES]), so we need to track the ones we've seen so far
     findAllDeps so_far (Rhs _ kids) = foldl find_all so_far kids
     -- Watch out, though.  Since the avails may contain loops 
     -- (see Note [RECURSIVE DICTIONARIES]), so we need to track the ones we've seen so far
     findAllDeps so_far (Rhs _ kids) = foldl find_all so_far kids

-    findAllDeps so_far other       = so_far
+    findAllDeps so_far _            = so_far

 
     find_all :: IdSet -> Inst -> IdSet
     find_all so_far kid
 
     find_all :: IdSet -> Inst -> IdSet
     find_all so_far kid

@@ -2478,7 +2491,7 @@ addSCs is_loop avails dict
     is_given :: Inst -> Bool
     is_given sc_dict = case findAvail avails sc_dict of
                          Just (Given _) -> True        -- Given is cheaper than superclass selection
     is_given :: Inst -> Bool
     is_given sc_dict = case findAvail avails sc_dict of
                          Just (Given _) -> True        -- Given is cheaper than superclass selection

-                         other          -> False       
+                         _              -> False

 
 -- From the a set of insts obtain all equalities that (transitively) occur in
 -- superclass contexts of class constraints (aka the ancestor equalities). 
 
 -- From the a set of insts obtain all equalities that (transitively) occur in
 -- superclass contexts of class constraints (aka the ancestor equalities). 

@@ -2542,6 +2555,7 @@ tcSimplifyInteractive wanteds
 
 -- The TcLclEnv should be valid here, solely to improve
 -- error message generation for the monomorphism restriction
 
 -- The TcLclEnv should be valid here, solely to improve
 -- error message generation for the monomorphism restriction

+tc_simplify_top :: SDoc -> Bool -> [Inst] -> TcM (Bag (LHsBind TcId))

 tc_simplify_top doc interactive wanteds
   = do { dflags <- getDOpts
        ; wanteds <- zonkInsts wanteds
 tc_simplify_top doc interactive wanteds
   = do { dflags <- getDOpts
        ; wanteds <- zonkInsts wanteds

@@ -2551,7 +2565,7 @@ tc_simplify_top doc interactive wanteds
        ; (irreds1, binds1) <- tryHardCheckLoop doc1 wanteds
 --     ; (irreds1, binds1) <- gentleInferLoop doc1 wanteds
        ; traceTc (text "tc_simplify_top 1: " <+> ppr irreds1)
        ; (irreds1, binds1) <- tryHardCheckLoop doc1 wanteds
 --     ; (irreds1, binds1) <- gentleInferLoop doc1 wanteds
        ; traceTc (text "tc_simplify_top 1: " <+> ppr irreds1)

-       ; (irreds2, binds2) <- approximateImplications doc2 (\d -> True) irreds1
+       ; (irreds2, binds2) <- approximateImplications doc2 (\_ -> True) irreds1

        ; traceTc (text "tc_simplify_top 2: " <+> ppr irreds2)
 
                -- Use the defaulting rules to do extra unification
        ; traceTc (text "tc_simplify_top 2: " <+> ppr irreds2)
 
                -- Use the defaulting rules to do extra unification

@@ -2658,7 +2672,7 @@ disambiguate doc interactive dflags insts
        | extended_defaulting = any isInteractiveClass clss
        | otherwise           = all is_std_class clss && (any is_num_class clss)
 
        | extended_defaulting = any isInteractiveClass clss
        | otherwise           = all is_std_class clss && (any is_num_class clss)
 

-       -- In interactive mode, or with -fextended-default-rules,
+       -- In interactive mode, or with -XExtendedDefaultRules,

        -- we default Show a to Show () to avoid graututious errors on "show []"
    isInteractiveClass cls 
        = is_num_class cls || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])
        -- we default Show a to Show () to avoid graututious errors on "show []"
    isInteractiveClass cls 
        = is_num_class cls || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])

@@ -2719,12 +2733,12 @@ getDefaultTys extended_deflts ovl_strings
                  opt_deflt ovl_strings string_ty) } } }
   where
     opt_deflt True  ty = [ty]
                  opt_deflt ovl_strings string_ty) } } }
   where
     opt_deflt True  ty = [ty]

-    opt_deflt False ty = []
+    opt_deflt False _  = []

 \end{code}
 
 Note [Default unitTy]
 ~~~~~~~~~~~~~~~~~~~~~
 \end{code}
 
 Note [Default unitTy]
 ~~~~~~~~~~~~~~~~~~~~~

-In interative mode (or with -fextended-default-rules) we add () as the first type we
+In interative mode (or with -XExtendedDefaultRules) we add () as the first type we

 try when defaulting.  This has very little real impact, except in the following case.
 Consider: 
        Text.Printf.printf "hello"
 try when defaulting.  This has very little real impact, except in the following case.
 Consider: 
        Text.Printf.printf "hello"

@@ -2836,7 +2850,7 @@ groupErrs :: ([Inst] -> TcM ())   -- Deal with one group
 -- Group together insts with the same origin
 -- We want to report them together in error messages
 
 -- Group together insts with the same origin
 -- We want to report them together in error messages
 

-groupErrs report_err [] 
+groupErrs _ [] 

   = return ()
 groupErrs report_err (inst:insts)
   = do { do_one (inst:friends)
   = return ()
 groupErrs report_err (inst:insts)
   = do { do_one (inst:friends)

@@ -2856,7 +2870,7 @@ addInstLoc :: [Inst] -> Message -> Message
 addInstLoc insts msg = msg $$ nest 2 (pprInstArising (head insts))
 
 addTopIPErrs :: [Name] -> [Inst] -> TcM ()
 addInstLoc insts msg = msg $$ nest 2 (pprInstArising (head insts))
 
 addTopIPErrs :: [Name] -> [Inst] -> TcM ()

-addTopIPErrs bndrs [] 
+addTopIPErrs _ [] 

   = return ()
 addTopIPErrs bndrs ips
   = do { dflags <- getDOpts
   = return ()
 addTopIPErrs bndrs ips
   = do { dflags <- getDOpts

@@ -2899,6 +2913,7 @@ reportNoInstances
 reportNoInstances tidy_env mb_what insts 
   = groupErrs (report_no_instances tidy_env mb_what) insts
 
 reportNoInstances tidy_env mb_what insts 
   = groupErrs (report_no_instances tidy_env mb_what) insts
 

+report_no_instances :: TidyEnv -> Maybe (InstLoc, [Inst]) -> [Inst] -> TcM ()

 report_no_instances tidy_env mb_what insts
   = do { inst_envs <- tcGetInstEnvs
        ; let (implics, insts1)  = partition isImplicInst insts
 report_no_instances tidy_env mb_what insts
   = do { inst_envs <- tcGetInstEnvs
        ; let (implics, insts1)  = partition isImplicInst insts

@@ -2930,7 +2945,7 @@ report_no_instances tidy_env mb_what insts
                -- The case of exactly one match and no unifiers means a
                -- successful lookup.  That can't happen here, because dicts
                -- only end up here if they didn't match in Inst.lookupInst
                -- The case of exactly one match and no unifiers means a
                -- successful lookup.  That can't happen here, because dicts
                -- only end up here if they didn't match in Inst.lookupInst

-               ([m],[])
+               ([_],[])

                 | debugIsOn -> pprPanic "reportNoInstance" (ppr wanted)
                res -> Right (mk_overlap_msg wanted res)
          where
                 | debugIsOn -> pprPanic "reportNoInstance" (ppr wanted)
                res -> Right (mk_overlap_msg wanted res)
          where

@@ -2949,7 +2964,7 @@ report_no_instances tidy_env mb_what insts
                ASSERT( not (null unifiers) )
                parens (vcat [ptext (sLit "The choice depends on the instantiation of") <+>
                                 quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst dict))),
                ASSERT( not (null unifiers) )
                parens (vcat [ptext (sLit "The choice depends on the instantiation of") <+>
                                 quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst dict))),

-                             ptext (sLit "To pick the first instance above, use -fallow-incoherent-instances"),
+                             ptext (sLit "To pick the first instance above, use -XIncoherentInstances"),

                              ptext (sLit "when compiling the other instance declarations")])]
       where
        ispecs = [ispec | (ispec, _) <- matches]
                              ptext (sLit "when compiling the other instance declarations")])]
       where
        ispecs = [ispec | (ispec, _) <- matches]

@@ -2992,6 +3007,7 @@ report_no_instances tidy_env mb_what insts
        show_fixes (f:fs) = sep [ptext (sLit "Possible fix:"), 
                                 nest 2 (vcat (f : map (ptext (sLit "or") <+>) fs))]
 
        show_fixes (f:fs) = sep [ptext (sLit "Possible fix:"), 
                                 nest 2 (vcat (f : map (ptext (sLit "or") <+>) fs))]
 

+addTopAmbigErrs :: [Inst] -> TcRn ()

 addTopAmbigErrs dicts
 -- Divide into groups that share a common set of ambiguous tyvars
   = ifErrsM (return ()) $      -- Only report ambiguity if no other errors happened
 addTopAmbigErrs dicts
 -- Divide into groups that share a common set of ambiguous tyvars
   = ifErrsM (return ()) $      -- Only report ambiguity if no other errors happened

@@ -3047,10 +3063,11 @@ monomorphism_fix dflags
   = ptext (sLit "Probable fix:") <+> vcat
        [ptext (sLit "give these definition(s) an explicit type signature"),
         if dopt Opt_MonomorphismRestriction dflags
   = ptext (sLit "Probable fix:") <+> vcat
        [ptext (sLit "give these definition(s) an explicit type signature"),
         if dopt Opt_MonomorphismRestriction dflags

-           then ptext (sLit "or use -fno-monomorphism-restriction")
-           else empty] -- Only suggest adding "-fno-monomorphism-restriction"
+           then ptext (sLit "or use -XNoMonomorphismRestriction")
+           else empty] -- Only suggest adding "-XNoMonomorphismRestriction"

                        -- if it is not already set!
     
                        -- if it is not already set!
     

+warnDefault :: [(Inst, Class, Var)] -> Type -> TcM ()

 warnDefault ups default_ty = do
     warn_flag <- doptM Opt_WarnTypeDefaults
     addInstCtxt (instLoc (head (dicts))) (warnTc warn_flag warn_msg)
 warnDefault ups default_ty = do
     warn_flag <- doptM Opt_WarnTypeDefaults
     addInstCtxt (instLoc (head (dicts))) (warnTc warn_flag warn_msg)

@@ -3063,10 +3080,12 @@ warnDefault ups default_ty = do
                                quotes (ppr default_ty),
                      pprDictsInFull tidy_dicts]
 
                                quotes (ppr default_ty),
                      pprDictsInFull tidy_dicts]
 

+reduceDepthErr :: Int -> [Inst] -> SDoc

 reduceDepthErr n stack
   = vcat [ptext (sLit "Context reduction stack overflow; size =") <+> int n,
          ptext (sLit "Use -fcontext-stack=N to increase stack size to N"),
          nest 4 (pprStack stack)]
 
 reduceDepthErr n stack
   = vcat [ptext (sLit "Context reduction stack overflow; size =") <+> int n,
          ptext (sLit "Use -fcontext-stack=N to increase stack size to N"),
          nest 4 (pprStack stack)]
 

+pprStack :: [Inst] -> SDoc

 pprStack stack = vcat (map pprInstInFull stack)
 \end{code}
 pprStack stack = vcat (map pprInstInFull stack)
 \end{code}