[commit: ghc] master: EvCast needs to take a representational coercion (1df2116)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1df2116c221941ef40a0f6f8fb7dcc42c56738e7/ghc

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

commit 1df2116c221941ef40a0f6f8fb7dcc42c56738e7
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Thu Nov 28 12:07:14 2013 +0000

    EvCast needs to take a representational coercion
    
    as the coercions for type literals are of that role.


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

1df2116c221941ef40a0f6f8fb7dcc42c56738e7
 compiler/deSugar/DsBinds.lhs       |    2 +-
 compiler/typecheck/TcCanonical.lhs |    2 +-
 compiler/typecheck/TcEvidence.lhs  |    4 ++--
 compiler/typecheck/TcSMonad.lhs    |    6 +++---
 4 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 54744bc..9866453 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -740,7 +740,7 @@ dsEvTerm (EvId v) = return (Var v)
 
 dsEvTerm (EvCast tm co) 
   = do { tm' <- dsEvTerm tm
-       ; dsTcCoercion co $ (mkCast tm' . mkSubCo) }
+       ; dsTcCoercion co $ mkCast tm' }
                         -- 'v' is always a lifted evidence variable so it is
                         -- unnecessary to call varToCoreExpr v here.
 
diff --git a/compiler/typecheck/TcCanonical.lhs b/compiler/typecheck/TcCanonical.lhs
index 5428d74..d51fbf6 100644
--- a/compiler/typecheck/TcCanonical.lhs
+++ b/compiler/typecheck/TcCanonical.lhs
@@ -1133,7 +1133,7 @@ canEqLeafTyVar ev tv s2              -- ev :: tv ~ s2
            (Just tv1, Just tv2) | tv1 == tv2
               -> do { when (isWanted ev) $
                       ASSERT ( tcCoercionRole co == Nominal )
-                      setEvBind (ctev_evar ev) (mkEvCast (EvCoercion (mkTcReflCo Nominal xi1)) co)
+                      setEvBind (ctev_evar ev) (mkEvCast (EvCoercion (mkTcReflCo Nominal xi1)) (mkTcSubCo co))
                     ; return Stop }
 
            (Just tv1, _) -> do { dflags <- getDynFlags
diff --git a/compiler/typecheck/TcEvidence.lhs b/compiler/typecheck/TcEvidence.lhs
index a0df74b..6b1ee3e 100644
--- a/compiler/typecheck/TcEvidence.lhs
+++ b/compiler/typecheck/TcEvidence.lhs
@@ -582,7 +582,7 @@ data EvTerm
   | EvCoercion TcCoercion        -- (Boxed) coercion bindings
                                  -- See Note [Coercion evidence terms]
 
-  | EvCast EvTerm TcCoercion     -- d |> co, the coerction being at role nominal
+  | EvCast EvTerm TcCoercion     -- d |> co, the coerction being at role representational
 
   | EvDFunApp DFunId             -- Dictionary instance application
        [Type] [EvTerm]
@@ -709,7 +709,7 @@ The story for kind `Symbol` is analogous:
 \begin{code}
 mkEvCast :: EvTerm -> TcCoercion -> EvTerm
 mkEvCast ev lco
-  | ASSERT2 (tcCoercionRole lco == Nominal, (vcat [ptext (sLit "Coercion of wrong role passed to mkEvCast:"), ppr ev, ppr lco]))
+  | ASSERT2 (tcCoercionRole lco == Representational, (vcat [ptext (sLit "Coercion of wrong role passed to mkEvCast:"), ppr ev, ppr lco]))
     isTcReflCo lco = ev
   | otherwise      = EvCast ev lco
 
diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs
index 57b13ed..90fe446 100644
--- a/compiler/typecheck/TcSMonad.lhs
+++ b/compiler/typecheck/TcSMonad.lhs
@@ -1704,12 +1704,12 @@ rewriteCtFlavor (CtGiven { ctev_evtm = old_tm , ctev_loc = loc }) new_pred co
   = do { new_ev <- newGivenEvVar loc new_pred new_tm  -- See Note [Bind new Givens immediately]
        ; return (Just new_ev) }
   where
-    new_tm = mkEvCast old_tm (mkTcSymCo co)  -- mkEvCast optimises ReflCo
+    new_tm = mkEvCast old_tm (mkTcSubCo (mkTcSymCo co))  -- mkEvCast optimises ReflCo
 
 rewriteCtFlavor (CtWanted { ctev_evar = evar, ctev_loc = loc }) new_pred co
   = do { new_evar <- newWantedEvVar loc new_pred
-       ; ASSERT ( tcCoercionRole co == Nominal ) return ()
-       ; setEvBind evar (mkEvCast (getEvTerm new_evar) co)
+       ; MASSERT ( tcCoercionRole co == Nominal )
+       ; setEvBind evar (mkEvCast (getEvTerm new_evar) (mkTcSubCo co))
        ; case new_evar of
             Fresh ctev -> return (Just ctev)
             _          -> return Nothing }