[commit: ghc] wip/rae-new-coercible: Merge commit '26a3d0f' into wip/rae-new-coercible (1b8a6d7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/rae-new-coercible
Link       : http://ghc.haskell.org/trac/ghc/changeset/1b8a6d7eaa3cfe91e3864a7a6ef38209734b7d58/ghc

>---------------------------------------------------------------

commit 1b8a6d7eaa3cfe91e3864a7a6ef38209734b7d58
Merge: 7f722dd 26a3d0f
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Sun Dec 7 14:26:35 2014 -0500

    Merge commit '26a3d0f' into wip/rae-new-coercible
    
    Conflicts:
    	compiler/typecheck/TcErrors.lhs
    	compiler/typecheck/TcInteract.lhs



>---------------------------------------------------------------

1b8a6d7eaa3cfe91e3864a7a6ef38209734b7d58
 compiler/typecheck/TcBinds.lhs     |   8 +--
 compiler/typecheck/TcCanonical.lhs |   4 +-
 compiler/typecheck/TcErrors.lhs    |   4 +-
 compiler/typecheck/TcFlatten.lhs   |  14 ++---
 compiler/typecheck/TcInteract.lhs  |  30 +++++-----
 compiler/typecheck/TcMType.lhs     |   4 +-
 compiler/typecheck/TcPatSyn.lhs    |   8 +--
 compiler/typecheck/TcRnDriver.lhs  |   6 +-
 compiler/typecheck/TcRnMonad.lhs   |  34 +++++------
 compiler/typecheck/TcRnTypes.lhs   |  16 ++---
 compiler/typecheck/TcRules.lhs     |   4 +-
 compiler/typecheck/TcSMonad.lhs    |  38 ++++++------
 compiler/typecheck/TcSimplify.lhs  |  62 +++++++++----------
 compiler/typecheck/TcType.lhs      | 118 +++++++++++++++++++------------------
 compiler/typecheck/TcUnify.lhs     |  10 ++--
 15 files changed, 181 insertions(+), 179 deletions(-)

diff --cc compiler/typecheck/TcErrors.lhs
index 0b130df,c8406df..94623d8
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@@ -876,8 -792,8 +876,8 @@@ mkTyVarEqErr dflags ctxt extra ct orien
    -- Nastiest case: attempt to unify an untouchable variable
    | (implic:_) <- cec_encl ctxt   -- Get the innermost context
    , Implic { ic_env = env, ic_given = given, ic_info = skol_info } <- implic
 -  = do { let msg = misMatchMsg oriented ty1 ty2
 +  = do { let msg = misMatchMsg oriented eq_rel ty1 ty2
-              untch_extra
+              tclvl_extra
                  = nest 2 $
                    sep [ quotes (ppr tv1) <+> ptext (sLit "is untouchable")
                        , nest 2 $ ptext (sLit "inside the constraints") <+> pprEvVarTheta given
diff --cc compiler/typecheck/TcInteract.lhs
index 51ce56b,bfe470d..ebac310
--- a/compiler/typecheck/TcInteract.lhs
+++ b/compiler/typecheck/TcInteract.lhs
@@@ -830,23 -829,21 +830,23 @@@ interactTyVarEq inerts workItem@(CTyEqC
         ; stopWith ev "Solved from inert (r)" }
  
    | otherwise
-   = do { untch <- getUntouchables
-        ; if canSolveByUnification untch ev eq_rel tv rhs
+   = do { tclvl <- getTcLevel
 -       ; if canSolveByUnification tclvl ev tv rhs
++       ; if canSolveByUnification tclvl ev eq_rel tv rhs
           then do { solveByUnification ev tv rhs
 -                 ; n_kicked <- kickOutRewritable givenFlavour tv
 -                               -- givenFlavour because the tv := xi is given
 +                 ; n_kicked <- kickOutRewritable Given NomEq tv
 +                               -- Given because the tv := xi is given
 +                               -- NomEq because only nominal equalities are solved
 +                               -- by unification
                   ; return (Stop ev (ptext (sLit "Spontaneously solved") <+> ppr_kicked n_kicked)) }
  
           else do { traceTcS "Can't solve tyvar equality"
                         (vcat [ text "LHS:" <+> ppr tv <+> dcolon <+> ppr (tyVarKind tv)
                               , ppWhen (isMetaTyVar tv) $
-                                nest 4 (text "Untouchable level of" <+> ppr tv
-                                        <+> text "is" <+> ppr (metaTyVarUntouchables tv))
+                                nest 4 (text "TcLevel of" <+> ppr tv
+                                        <+> text "is" <+> ppr (metaTyVarTcLevel tv))
                               , text "RHS:" <+> ppr rhs <+> dcolon <+> ppr (typeKind rhs)
-                              , text "Untouchables =" <+> ppr untch ])
+                              , text "TcLevel =" <+> ppr tclvl ])
 -                 ; n_kicked <- kickOutRewritable ev tv
 +                 ; n_kicked <- kickOutRewritable (ctEvFlavour ev) (ctEvEqRel ev) tv
                   ; updInertCans (\ ics -> addInertCan ics workItem)
                   ; return (Stop ev (ptext (sLit "Kept as inert") <+> ppr_kicked n_kicked)) } }
  
@@@ -855,12 -852,8 +855,12 @@@ interactTyVarEq _ wi = pprPanic "intera
  -- @trySpontaneousSolve wi@ solves equalities where one side is a
  -- touchable unification variable.
  -- Returns True <=> spontaneous solve happened
- canSolveByUnification :: Untouchables -> CtEvidence -> EqRel
 -canSolveByUnification :: TcLevel -> CtEvidence -> TcTyVar -> Xi -> Bool
 -canSolveByUnification tclvl gw tv xi
++canSolveByUnification :: TcLevel -> CtEvidence -> EqRel
 +                      -> TcTyVar -> Xi -> Bool
- canSolveByUnification untch gw eq_rel tv xi
++canSolveByUnification tclvl gw eq_rel tv xi
 +  | ReprEq <- eq_rel   -- we never solve representational equalities this way.
 +  = False
 +
    | isGiven gw   -- See Note [Touchables and givens]
    = False
  
@@@ -1988,12 -1983,20 +1988,12 @@@ matchClassInst _ clas [ ty ] 
      = panicTcS (text "Unexpected evidence for" <+> ppr (className clas)
                       $$ vcat (map (ppr . idType) (classMethods clas)))
  
 -matchClassInst _ clas [ _k, ty1, ty2 ] loc
 -  | clas == coercibleClass
 -  = do { traceTcS "matchClassInst for" $
 -         quotes (pprClassPred clas [ty1,ty2]) <+> text "at depth" <+> ppr (ctLocDepth loc)
 -       ; ev <- getCoercibleInst loc ty1 ty2
 -       ; traceTcS "matchClassInst returned" $ ppr ev
 -       ; return ev }
 -
  matchClassInst inerts clas tys loc
     = do { dflags <- getDynFlags
-         ; untch <- getUntouchables
+         ; tclvl <- getTcLevel
          ; traceTcS "matchClassInst" $ vcat [ text "pred =" <+> ppr pred
                                             , text "inerts=" <+> ppr inerts
-                                            , text "untouchables=" <+> ppr untch ]
+                                            , text "untouchables=" <+> ppr tclvl ]
          ; instEnvs <- getInstEnvs
          ; case lookupInstEnv instEnvs clas tys of
              ([], _, _)               -- Nothing matches