X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FndpFlatten%2FFlattening.hs;h=6072ad634fd432c3cd3bb1039a995e022bbec400;hb=2eb04ca0f8d0ec72b417cddc60672c696b4a3daa;hp=18daaa632395071d485396e8d28cc7749e9ed9c8;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git

diff --git a/compiler/ndpFlatten/Flattening.hs b/compiler/ndpFlatten/Flattening.hs
index 18daaa6..6072ad6 100644
--- a/compiler/ndpFlatten/Flattening.hs
+++ b/compiler/ndpFlatten/Flattening.hs
@@ -55,16 +55,16 @@ module Flattening (
 #include "HsVersions.h"
 
 -- friends
-import NDPCoreUtils (tupleTyArgs, funTyArgs, parrElemTy, isDefault,
+import NDPCoreUtils (tupleTyArgs, funTyArgs, isDefault,
 		     isLit, mkPArrTy, mkTuple, isSimpleExpr, substIdEnv)
 import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext,
 		     liftVar, liftConst, intersectWithContext, mk'fst,
-		     mk'lengthP, mk'replicateP, mk'mapP, mk'bpermuteDftP,
-		     mk'indexOfP,mk'eq,mk'neq) 
+		     mk'mapP, mk'bpermuteDftP, mk'indexOfP,mk'eq,mk'neq) 
 
 -- GHC
 import TcType	    ( tcIsForAllTy, tcView )
 import TypeRep	    ( Type(..) )
+import Coercion     ( coercionKind )
 import StaticFlags  (opt_Flatten)
 import Panic        (panic)
 import ErrUtils     (dumpIfSet_dyn)
@@ -74,9 +74,9 @@ import Literal      (Literal, literalType)
 import Var	    (Var(..), idType, isTyVar)
 import Id	    (setIdType)
 import DataCon	    (DataCon, dataConTag)
-import HscTypes	    ( ModGuts(..), ModGuts, HscEnv(..), hscEPS )
+import HscTypes	    ( ModGuts(..), HscEnv(..), hscEPS )
 import CoreFVs	    (exprFreeVars)
-import CoreSyn	    (Expr(..), Bind(..), Alt(..), AltCon(..), Note(..),
+import CoreSyn	    (Expr(..), Bind(..), Alt, AltCon(..),
 		     CoreBndr, CoreExpr, CoreBind, mkLams, mkLets,
 		     mkApps, mkIntLitInt)  
 import PprCore      (pprCoreExpr)
@@ -91,7 +91,7 @@ import FastString
 
 
 -- FIXME: fro debugging - remove this
-import TRACE    (trace)
+import Debug.Trace  (trace)
 
 -- standard
 import Monad        (liftM, foldM)
@@ -448,11 +448,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