X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FndpFlatten%2FFlattening.hs;h=c339c76f117103c7d89b4fa8ed3e238189a87c6d;hp=18daaa632395071d485396e8d28cc7749e9ed9c8;hb=4714e5142548941592b208c34685ce684d1bf3d6;hpb=2a6d497b719b39d7d7d73051f3baa783db343abb diff --git a/compiler/ndpFlatten/Flattening.hs b/compiler/ndpFlatten/Flattening.hs index 18daaa6..c339c76 100644 --- a/compiler/ndpFlatten/Flattening.hs +++ b/compiler/ndpFlatten/Flattening.hs @@ -65,6 +65,7 @@ import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext, -- GHC import TcType ( tcIsForAllTy, tcView ) import TypeRep ( Type(..) ) +import Coercion ( coercionKind ) import StaticFlags (opt_Flatten) import Panic (panic) import ErrUtils (dumpIfSet_dyn) @@ -448,11 +449,12 @@ lift cExpr@(Case expr b _ alts) = else extendContext [lb] (liftCaseDataCon b alts) letWrapper lExpr b lalts -lift (Note (Coerce t1 t2) expr) = - do +lift (Cast expr co) = + do (lexpr, t) <- lift expr - let lt1 = liftTy t1 - return ((Note (Coerce lt1 (liftTy t2)) lexpr), lt1) + let lco = liftTy co + let (t1, t2) = coercionKind lco + return ((Cast expr lco), t2) lift (Note note expr) = do