Commit 1df2116c authored by Joachim Breitner's avatar Joachim Breitner

EvCast needs to take a representational coercion

as the coercions for type literals are of that role.
parent 3fcde749
......@@ -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.
......
......@@ -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
......
......@@ -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
......
......@@ -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 }
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment