[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.

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