X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FdeSugar%2FDsForeign.lhs;fp=compiler%2FdeSugar%2FDsForeign.lhs;h=0c40318a1f6b66f32dc3cc81a0bf01a3ffdbf3d7;hb=497302c44ad08c6c27d0e15d94a787f332c0cfec;hp=080289e8f9c5e49b8d6b9ef483737498c8ba5ca8;hpb=1353826e5159c9a5a81e75e0b7459271f27c08ea;p=ghc-hetmet.git

diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index 080289e..0c40318 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -142,10 +142,15 @@ dsCImport :: Id
 	  -> DsM ([Binding], SDoc, SDoc)
 dsCImport id (CLabel cid) cconv _ = do
    let ty = idType id
+       fod = case splitTyConApp_maybe (repType ty) of
+             Just (tycon, _)
+              | tyConUnique tycon == funPtrTyConKey ->
+                 IsFunction
+             _ -> IsData
    (resTy, foRhs) <- resultWrapper ty
    ASSERT(fromJust resTy `coreEqType` addrPrimTy)    -- typechecker ensures this
     let
-        rhs = foRhs (Lit (MachLabel cid stdcall_info))
+        rhs = foRhs (Lit (MachLabel cid stdcall_info fod))
         stdcall_info = fun_type_arg_stdcall_info cconv ty
     in
     return ([(id, rhs)], empty, empty)
@@ -355,7 +360,7 @@ dsFExportDynamic id cconv = do
          -}
         adj_args      = [ mkIntLitInt (ccallConvToInt cconv)
                         , Var stbl_value
-                        , Lit (MachLabel fe_nm mb_sz_args)
+                        , Lit (MachLabel fe_nm mb_sz_args IsFunction)
                         , Lit (mkMachString typestring)
                         ]
           -- name of external entry point providing these services.