X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsForeign.lhs;h=aee1594b765b002ca778471619777cbfaca8e106;hp=b391b8f02aaba37f3d3719dd59870639abaece5c;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=fdf8656855d26105ff36bdd24d41827b05037b91

diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs
index b391b8f..aee1594 100644
--- a/compiler/deSugar/DsForeign.lhs
+++ b/compiler/deSugar/DsForeign.lhs
@@ -524,7 +524,7 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
   the_cfun
      = case maybe_target of
           Nothing    -> text "(StgClosure*)deRefStablePtr(the_stableptr)"
-          Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure"
+          Just hs_fn -> char '&' <> ppr hs_fn <> text (closureSuffix hs_fn)
 
   cap = text "cap" <> comma
 
@@ -549,9 +549,8 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
   extern_decl
      = case maybe_target of
           Nothing -> empty
-          Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi
+          Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text (closureSuffix hs_fn) <> semi
 
-   
   -- finally, the whole darn thing
   c_bits =
     space $$
@@ -589,6 +588,10 @@ mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
      , rbrace
      ]
 
+closureSuffix :: Id -> String
+closureSuffix hs_fn =
+    if depth==0 then "_closure" else "_"++(show depth)++"closure"
+        where depth = getNameDepth (Var.varName hs_fn)
 
 foreignExportInitialiser :: Id -> SDoc
 foreignExportInitialiser hs_fn =
@@ -605,11 +608,10 @@ foreignExportInitialiser hs_fn =
          <> text "() __attribute__((constructor));"
     , text "static void stginit_export_" <> ppr hs_fn <> text "()"
     , braces (text "getStablePtr"
-       <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
+       <> parens (text "(StgPtr) &" <> ppr hs_fn <> text (closureSuffix hs_fn))
        <> semi)
     ]
 
-
 mkHObj :: Type -> SDoc
 mkHObj t = text "rts_mk" <> text (showFFIType t)