[project @ 1999-07-27 10:53:53 by sof]

If calling a 'foreign export'ed Haskell function resulted in an error,
localise the error by supplying the module name as well as the name
of the function.

diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
index f944581..f0370b8 100644 (file)
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ b/ghc/compiler/deSugar/DsForeign.lhs
@@ -24,7 +24,7 @@ import Const          ( Con(..), mkMachInt )
 import DataCon         ( DataCon, dataConId )
 import Id              ( Id, idType, idName, mkWildId, mkVanillaId )
 import Const           ( Literal(..) )
-import Module          ( Module )
+import Module          ( Module, moduleUserString )
 import Name            ( mkGlobalName, nameModule, nameOccName, getOccString, 
                          mkForeignExportOcc, isLocalName,
                          NamedThing(..), Provenance(..), ExportFlag(..)
@@ -293,7 +293,8 @@ dsFExport i ty mod_name ext_name cconv isDyn =
          ExtName fs _ -> fs
          Dynamic      -> panic "dsFExport: Dynamic - shouldn't ever happen."
 
-      (h_stub, c_stub) = fexportEntry c_nm f_helper_glob
+      (h_stub, c_stub) = fexportEntry (moduleUserString mod)
+                                     c_nm f_helper_glob
                                       wrapper_arg_tys the_result_ty cconv isDyn
      in
      returnDs (NonRec f_helper_glob the_body, h_stub, c_stub)
@@ -457,14 +458,15 @@ The C stub constructs the application of the exported Haskell function
 using the hugs/ghc rts invocation API.
 
 \begin{code}
-fexportEntry :: FAST_STRING 
+fexportEntry :: String
+            -> FAST_STRING
             -> Id 
             -> [Type] 
             -> Maybe Type 
             -> CallConv 
             -> Bool
             -> (SDoc, SDoc)
-fexportEntry c_nm helper args res cc isDyn = (header_bits, c_bits)
+fexportEntry mod_nm c_nm helper args res cc isDyn = (header_bits, c_bits)
  where
    -- name of the (Haskell) helper function generated by the desugarer.
   h_nm     = ppr helper <> text "_closure"
@@ -510,7 +512,7 @@ fexportEntry c_nm helper args res cc isDyn = (header_bits, c_bits)
 
   returnResult = 
     text "rts_checkSchedStatus" <> 
-    parens (doubleQuotes (ptext c_nm) <> comma <> text "rc") <> semi $$
+    parens (doubleQuotes (text mod_nm <> char '.' <> ptext c_nm) <> comma <> text "rc") <> semi $$
     (case res of
       Nothing -> text "return"
       Just _  -> text "return" <> parens (res_name)) <> semi