[project @ 2003-08-19 22:03:04 by krc]

[ghc-hetmet.git] / ghc / compiler / main / CodeOutput.lhs

diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
index 1a08ded..5e9e7e5 100644 (file)
--- a/ghc/compiler/main/CodeOutput.lhs
+++ b/ghc/compiler/main/CodeOutput.lhs
@@ -34,7 +34,10 @@ import CmdLineOpts
 import ErrUtils                ( dumpIfSet_dyn, showPass )
 import Outputable
 import Pretty          ( Mode(..), printDoc )
-import CmdLineOpts     ( DynFlags, HscLang(..), dopt_OutName )
+import Module          ( Module )
+import ListSetOps      ( removeDupsEq )
+
+import System.Directory ( doesFileExist )
 import Monad           ( when )
 import IO
 \end{code}
@@ -48,17 +51,13 @@ import IO
 
 \begin{code}
 codeOutput :: DynFlags
-          -> ModGuts
+          -> Module
+          -> ForeignStubs
+          -> Dependencies
           -> AbstractC                 -- Compiled abstract C
           -> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-})
 
-codeOutput dflags 
-          (ModGuts {mg_module = mod_name,
-                    mg_types  = type_env,
-                    mg_foreign = foreign_stubs,
-                    mg_deps    = deps,
-                    mg_binds   = core_binds})
-          flat_abstractC
+codeOutput dflags this_mod foreign_stubs deps flat_abstractC
   = 
     -- You can have C (c_output) or assembly-language (ncg_output),
     -- but not both.  [Allowing for both gives a space leak on
@@ -104,7 +103,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
 
 \begin{code}
 outputC dflags filenm flat_absC 
-       (stub_h_exists, _) dependencies (ForeignStubs _ _ ffi_decl_headers _ ) 
+       (stub_h_exists, _) dependencies foreign_stubs
   = do dumpIfSet_dyn dflags Opt_D_dump_realC "Real C" (dumpRealC flat_absC)
 
        -- figure out which header files to #include in the generated .hc file:
@@ -120,10 +119,16 @@ outputC dflags filenm flat_absC
        c_includes <- getPackageCIncludes pkg_configs
        let cmdline_includes = cmdlineHcIncludes dflags -- -#include options
        
+          ffi_decl_headers 
+             = case foreign_stubs of
+                 NoStubs                 -> []
+                 ForeignStubs _ _ fdhs _ -> map unpackFS (fst (removeDupsEq fdhs))
+                       -- Remove duplicates, because distinct foreign import decls
+                       -- may cite the same #include.  Order doesn't matter.
+
            all_headers =  c_includes
                       ++ reverse cmdline_includes
-                      ++ reverse (map unpackFS ffi_decl_headers)
-                          -- reverse correct?
+                      ++ ffi_decl_headers
 
        let cc_injects = unlines (map mk_include all_headers)
                   mk_include h_file = 
@@ -216,7 +221,12 @@ outputIlx dflags filename mod tycons stg_binds
 outputForeignStubs :: DynFlags -> ForeignStubs
                   -> IO (Bool,         -- Header file created
                          Bool)         -- C file created
-outputForeignStubs dflags NoStubs = return (False, False)
+outputForeignStubs dflags NoStubs = do
+-- When compiling External Core files, may need to use stub files from a 
+-- previous compilation
+   hFileExists <- doesFileExist (hscStubHOutName dflags)
+   cFileExists <- doesFileExist (hscStubCOutName dflags)
+   return (hFileExists, cFileExists)
 outputForeignStubs dflags (ForeignStubs h_code c_code _ _)
   = do
        dumpIfSet_dyn dflags Opt_D_dump_foreign