X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FdeSugar%2FDsCCall.lhs;h=0541f5d97f6f608836e922cf63737cd441ba3fb0;hb=15cb792d18b1094e98c035dca6ecec5dad516056;hp=8467539385eff381d5b93fbef4a2dc97a2accc75;hpb=fb0f3349561dd4493d81ca7c3a140b37fa0dc0de;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsCCall.lhs b/compiler/deSugar/DsCCall.lhs
index 8467539..0541f5d 100644
--- a/compiler/deSugar/DsCCall.lhs
+++ b/compiler/deSugar/DsCCall.lhs
@@ -19,7 +19,7 @@ import CoreSyn
 
 import DsMonad
 
-import CoreUtils	( exprType, coreAltType, mkCoerce2 )
+import CoreUtils	( exprType, coreAltType, mkCoerce )
 import Id		( Id, mkWildId )
 import MkId		( mkFCallId, realWorldPrimId, mkPrimOpId )
 import Maybes		( maybeToBool )
@@ -32,9 +32,9 @@ import Type		( Type, isUnLiftedType, mkFunTys, mkFunTy,
 			  tyVarsOfType, mkForAllTys, mkTyConApp, 
 			  isPrimitiveType, splitTyConApp_maybe, 
 			  splitRecNewType_maybe, splitForAllTy_maybe,
-			  isUnboxedTupleType, coreView
+			  isUnboxedTupleType
 			)
-
+import Coercion         ( Coercion, splitRecNewTypeCo_maybe, mkSymCoercion )
 import PrimOp		( PrimOp(..) )
 import TysPrim		( realWorldStatePrimTy, intPrimTy,
 			  byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
@@ -51,7 +51,7 @@ import TysWiredIn	( unitDataConId,
 			)
 import BasicTypes       ( Boxity(..) )
 import Literal		( mkMachInt )
-import PrelNames	( Unique, hasKey, ioTyConKey, boolTyConKey, unitTyConKey,
+import PrelNames	( Unique, hasKey, boolTyConKey, unitTyConKey,
 			  int8TyConKey, int16TyConKey, int32TyConKey,
 			  word8TyConKey, word16TyConKey, word32TyConKey
 			  -- dotnet interop
@@ -109,7 +109,7 @@ dsCCall :: CLabelString	-- C routine to invoke
 	-> [CoreExpr]	-- Arguments (desugared)
 	-> Safety	-- Safety of the call
 	-> Type		-- Type of the result: IO t
-	-> DsM CoreExpr
+	-> DsM CoreExpr	-- Result, of type ???
 
 dsCCall lbl args may_gc result_ty
   = mapAndUnzipDs unboxArg args	       `thenDs` \ (unboxed_args, arg_wrappers) ->
@@ -160,8 +160,8 @@ unboxArg arg
   = returnDs (arg, \body -> body)
 
   -- Recursive newtypes
-  | Just rep_ty <- splitRecNewType_maybe arg_ty
-  = unboxArg (mkCoerce2 rep_ty arg_ty arg)
+  | Just(rep_ty, co) <- splitRecNewTypeCo_maybe arg_ty
+  = unboxArg (mkCoerce (mkSymCoercion co) arg)
       
   -- Booleans
   | Just (tc,_) <- splitTyConApp_maybe arg_ty, 
@@ -399,9 +399,9 @@ resultWrapper result_ty
 				    (LitAlt (mkMachInt 0),[],Var falseDataConId)])
 
   -- Recursive newtypes
-  | Just rep_ty <- splitRecNewType_maybe result_ty
+  | Just (rep_ty, co) <- splitRecNewTypeCo_maybe result_ty
   = resultWrapper rep_ty `thenDs` \ (maybe_ty, wrapper) ->
-    returnDs (maybe_ty, \e -> mkCoerce2 result_ty rep_ty (wrapper e))
+    returnDs (maybe_ty, \e -> mkCoerce co (wrapper e))
 
   -- The type might contain foralls (eg. for dummy type arguments,
   -- referring to 'Ptr a' is legal).