X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsForeign.lhs;h=53400393f54721047c95d14f1c3f5306e4acd78c;hp=83dac634915110c787118695f8d880c42d402b80;hb=72462499b891d5779c19f3bda03f96e24f9554ae;hpb=ad23a496a860063ab01025051d9c9baf45725a61

diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 83dac63..5340039 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -19,6 +19,7 @@ import DsMonad
 import HsSyn
 import DataCon
 import CoreUtils
+import CoreUnfold
 import Id
 import Literal
 import Module
@@ -205,9 +206,10 @@ dsFCall fn_id fcall = do
         -- Build the wrapper
         work_app     = mkApps (mkVarApps (Var work_id) tvs) val_args
         wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers
-        wrap_rhs     = mkInlineMe (mkLams (tvs ++ args) wrapper_body)
+        wrap_rhs     = mkLams (tvs ++ args) wrapper_body
+        fn_id_w_inl  = fn_id `setIdUnfolding` mkInlineRule InlSat wrap_rhs (length args)
     
-    return ([(work_id, work_rhs), (fn_id, wrap_rhs)], empty, empty)
+    return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs)], empty, empty)
 \end{code}
 
 
@@ -567,8 +569,8 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
 						<> comma <> text "cap") <> semi
      ,   assignCResult
      ,   ptext (sLit "rts_unlock(cap);")
-     ,   if res_hty_is_unit then empty
-            else if libffi 
+     ,   ppUnless res_hty_is_unit $
+         if libffi 
                   then char '*' <> parens (cResType <> char '*') <> 
                        ptext (sLit "resp = cret;")
                   else ptext (sLit "return cret;")