From: sof <unknown>
Date: Tue, 27 Jul 1999 10:50:19 +0000 (+0000)
Subject: [project @ 1999-07-27 10:50:17 by sof]
X-Git-Tag: Approximately_9120_patches~5950
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=be1c09e748d4485b4188be256f7772d7b3895101

[project @ 1999-07-27 10:50:17 by sof]
Improve the UI a little for modules contain 'foreign export' declarations -
no longer demand that module name == (basename filename)
---

diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index ec316be..81e1760 100644
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -40,10 +40,10 @@ codeOutput mod_name c_code h_code flat_abstractC ncg_uniqs
     doOutput opt_ProduceS ncg_output_w 			>>
 
     dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d >>
-    outputHStub opt_ProduceExportHStubs stub_h_output_w	>>
+    outputForeignStubs True{-.h output-} opt_ProduceExportHStubs stub_h_output_w	>>
 
     dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d >>
-    outputCStub mod_name opt_ProduceExportCStubs stub_c_output_w	>>
+    outputForeignStubs False{-not .h-}   opt_ProduceExportCStubs stub_c_output_w	>>
 
     dumpIfSet opt_D_dump_realC "Real C" c_output_d 	>>
     doOutput opt_ProduceC c_output_w
@@ -81,21 +81,15 @@ codeOutput mod_name c_code h_code flat_abstractC ncg_uniqs
     -- don't use doOutput for dumping the f. export stubs
     -- since it is more than likely that the stubs file will
     -- turn out to be empty, in which case no file should be created.
-outputCStub mod_name switch ""
-  = return ()
-outputCStub mod_name switch doc_str
-  = case switch of
-	  Nothing    -> return ()
-	  Just fname -> writeFile fname ("#include \"Rts.h\"\n#include \"RtsAPI.h\"\n"++rest)
-	    where
-	     rest = "#include "++show (moduleString mod_name ++ "_stub.h") ++ '\n':doc_str
-	      
-outputHStub switch ""
-  = return ()
-outputHStub switch doc_str
-  = case switch of
-	  Nothing    -> return ()
-	  Just fname -> writeFile fname ("#include \"Rts.h\"\n"++doc_str)
+outputForeignStubs is_header switch ""      = return ()
+outputForeignStubs is_header switch doc_str =
+  case switch of
+    Nothing    -> return ()
+    Just fname -> writeFile fname (include_prefix ++ doc_str)
+ where
+  include_prefix
+   | is_header   = "#include \"Rts.h\"\n"
+   | otherwise   = "#include \"RtsAPI.h\"\n"
 
 doOutput switch io_action
   = case switch of
diff --git a/ghc/driver/ghc.lprl b/ghc/driver/ghc.lprl
index 9886de5..ff08503 100644
--- a/ghc/driver/ghc.lprl
+++ b/ghc/driver/ghc.lprl
@@ -1462,7 +1462,7 @@ Now the Haskell compiler, C compiler, and assembler
     }
 
     if (-f $hsc_out_c_stub) {
-	&run_something("cp $hsc_out_c_stub $ofile_c_stub_target", 'Copy foreign export C stubs');
+	&run_something("rm -f $ofile_c_stub_target && echo '#include \"${ofile_h_stub_target}\"' > $ofile_c_stub_target && cat $hsc_out_c_stub >> $ofile_c_stub_target", 'Copy foreign export C stubs');
 	local ($hsc_out_s_stub);
 	local ($hsc_out_o_stub);
 	($ofile_s_stub_target = $ofile_c_stub_target) =~ s/\.(.*)$/\.s/;