[project @ 2002-02-18 12:41:01 by sewardj]

[ghc-hetmet.git] / ghc / compiler / deSugar / DsForeign.lhs

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index 9bb1d3a..8d83f56 100644 (file)
--- 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