X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsForeign.lhs;h=f9445814c7ddfa3d6f9bc4f39736d7c62c0c141f;hb=9d787ef5a8072b6c1f576f2de1b66edfa59813ed;hp=1abd67fed5f156af82d848c9d0a3cc967616dc9e;hpb=5c60f4ca21334fa8b6324423b70ae044e5ad5bf9;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 1abd67f..f944581 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -30,7 +30,7 @@ import Name		( mkGlobalName, nameModule, nameOccName, getOccString,
 			  NamedThing(..), Provenance(..), ExportFlag(..)
 			)
 import PrelInfo		( deRefStablePtr_NAME, bindIO_NAME, makeStablePtr_NAME, realWorldPrimId )
-import Type		( splitAlgTyConApp_maybe, 
+import Type		( splitAlgTyConApp_maybe,  unUsgTy,
 			  splitTyConApp_maybe, splitFunTys, splitForAllTys,
 			  Type, mkFunTys, mkForAllTys, mkTyConApp,
 			  mkTyVarTy, mkFunTy, splitAppTy
@@ -423,7 +423,7 @@ dsFExportDynamic i ty mod_name ext_name cconv =
      let ccall_io_adj = 
 	    mkLams [stbl_value]		     $
 	    bindNonRec x_ccall_adj ccall_adj $
-	    Note (Coerce (mkTyConApp ioTyCon [res_ty]) ccall_adj_ty)
+	    Note (Coerce (mkTyConApp ioTyCon [res_ty]) (unUsgTy ccall_adj_ty))
 		 (Var x_ccall_adj)
      in
      newSysLocalDs (coreExprType ccall_io_adj)	  `thenDs` \ x_ccall_io_adj ->