[commit: ghc] wip/rae-new-coercible: Checkpoint (1aa5d57)

[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/1aa5d575b3ec7831c7d61c9128bdd63b927c87cf/ghc

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

commit 1aa5d575b3ec7831c7d61c9128bdd63b927c87cf
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Thu Nov 20 08:46:34 2014 -0500

    Checkpoint


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

1aa5d575b3ec7831c7d61c9128bdd63b927c87cf
 compiler/basicTypes/DataCon.lhs    |  6 +++---
 compiler/typecheck/TcCanonical.lhs |  4 ++--
 compiler/typecheck/TcFlatten.lhs   | 16 +++++++++-------
 3 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index e57439d..3305a90 100644
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -983,9 +983,9 @@ dataConCannotMatch tys con
 
     -- TODO: could gather equalities from superclasses too
     predEqs pred = case classifyPredType pred of
-                     EqPred ty1 ty2 -> [(ty1, ty2)]
-                     TuplePred ts   -> concatMap predEqs ts
-                     _              -> []
+                     EqPred NomEq ty1 ty2 -> [(ty1, ty2)]
+                     TuplePred ts         -> concatMap predEqs ts
+                     _                    -> []
 \end{code}
 
 %************************************************************************
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index df89caf..cb4e5c9 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -824,12 +824,12 @@ canCFunEqCan ev fn tys fsk
                                  , cc_tyargs = tys', cc_fsk = fsk }) } } }
 
 ---------------------
-canEqTyVar :: CtEvidence -> SwapFlag
+canEqTyVar :: CtEvidence -> EqRel -> SwapFlag
            -> TcTyVar
            -> TcType -> TcType
            -> TcS (StopOrContinue Ct)
 -- A TyVar on LHS, but so far un-zonked
-canEqTyVar ev swapped tv1 ty2 ps_ty2              -- ev :: tv ~ s2
+canEqTyVar ev eq_rel swapped tv1 ty2 ps_ty2              -- ev :: tv ~ s2
   = do { traceTcS "canEqTyVar" (ppr tv1 $$ ppr ty2 $$ ppr swapped)
        ; mb_yes <- flattenTyVarOuter ev tv1
        ; case mb_yes of
diff --git a/compiler/typecheck/TcFlatten.lhs b/compiler/typecheck/TcFlatten.lhs
index ac68ec9..ec6050f 100644
--- a/compiler/typecheck/TcFlatten.lhs
+++ b/compiler/typecheck/TcFlatten.lhs
@@ -838,9 +838,8 @@ flattenTyVar fmode tv
                           ; return (ty2, co2 `mkTcTransCo` co1) }
        }
 
-flattenTyVarOuter, flattenTyVarFinal
-   :: CtEvidence -> TcTyVar
-   -> TcS (Either TyVar (TcType, TcCoercion, Bool))
+flattenTyVarOuter :: CtEvidence -> EqRel -> TcTyVar
+                  -> TcS (Either TyVar (TcType, TcCoercion, Bool))
 -- Look up the tyvar in
 --   a) the internal MetaTyVar box
 --   b) the tyvar binds
@@ -849,14 +848,16 @@ flattenTyVarOuter, flattenTyVarFinal
 --        (Right (ty, co, is_flat)) if found, with co :: ty ~ tv;
 --                                  is_flat says if the result is guaranteed flattened
 
-flattenTyVarOuter ctxt_ev tv
+flattenTyVarOuter ctxt_ev eq_rel tv
   | not (isTcTyVar tv)             -- Happens when flatten under a (forall a. ty)
-  = flattenTyVarFinal ctxt_ev tv   -- So ty contains refernces to the non-TcTyVar a
+  = Left <$> flattenTyVarFinal ctxt_ev tv
+          -- So ty contains refernces to the non-TcTyVar a
+    
   | otherwise
   = do { mb_ty <- isFilledMetaTyVar_maybe tv
        ; case mb_ty of {
            Just ty -> do { traceTcS "Following filled tyvar" (ppr tv <+> equals <+> ppr ty)
-                         ; return (Right (ty, mkTcNomReflCo ty, False)) } ;
+                         ; return (Right (ty, mkTcReflCo (eqRelRole eq_rel) ty, False)) } ;
            Nothing ->
 
     -- Try in the inert equalities
@@ -876,12 +877,13 @@ flattenTyVarOuter ctxt_ev tv
            _other -> flattenTyVarFinal ctxt_ev tv
     } } }
 
+flattenTyVarFinal :: CtEvidence -> TcTyVar -> TcS TyVar
 flattenTyVarFinal ctxt_ev tv
   = -- Done, but make sure the kind is zonked
     do { let kind       = tyVarKind tv
              kind_fmode = FE { fe_ev = ctxt_ev, fe_mode = FM_SubstOnly }
        ; (new_knd, _kind_co) <- flatten kind_fmode kind
-       ; return (Left (setVarType tv new_knd)) }
+       ; return (setVarType tv new_knd) }
 \end{code}
 
 Note [Applying the inert substitution]