X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDsForeign.lhs;h=8d83f56f51f6c396fccf01bf5760e41c67e2d305;hb=45ddebc0dc20f013eff011a157b42acb37ea7598;hp=9bb1d3ac22102a821cefa0722f13ada04ffa8330;hpb=94667d2af5bb451c8f344ea941d3ab9c3d648499;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 9bb1d3a..8d83f56 100644
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -470,15 +470,19 @@ fexportEntry mod_nm c_nm helper args res_ty cc isDyn = (header_bits, c_bits)
 	      parens (hsep (punctuate comma (zipWith (<+>) cParamTypes proto_args)))
 
   c_bits =
-    externDecl $$
     fun_proto  $$
     vcat 
      [ lbrace
      ,   text "SchedulerStatus rc;"
      ,   declareResult
 	  -- create the application + perform it.
-     ,   text "rc=rts_evalIO" <> 
-                  parens (foldl appArg (text "(StgClosure*)&" <> h_nm) (zip args c_args) <> comma <> text "&ret") <> semi
+     ,   text "rc=rts_evalIO" 
+         <> parens (foldl appArg (text "(StgClosure*)deRefStablePtr(a0)") 
+                                 (tail (zip args c_args))
+                    <> comma 
+                    <> text "&ret"
+                   ) 
+         <> semi
      ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (ptext c_nm)
 						<> comma <> text "rc") <> semi
      ,   text "return" <> return_what <> semi
@@ -501,8 +505,6 @@ fexportEntry mod_nm c_nm helper args res_ty cc isDyn = (header_bits, c_bits)
      
   declareResult  = text "HaskellObj ret;"
 
-  externDecl     = mkExtern (text "HaskellObj") h_nm
-
   mkExtern ty nm = text "extern" <+> ty <+> nm <> semi
 
   return_what | res_ty_is_unit = empty