[project @ 2001-05-25 12:09:43 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / DriverPipeline.hs

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 1e4705f..95c286a 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.61 2001/03/28 11:01:19 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.70 2001/05/25 12:09:43 simonpj Exp $
 --
 -- GHC Driver
 --
@@ -148,10 +148,8 @@ genPipeline todo stop_flag persistent_output lang filename
    keep_hc    <- readIORef v_Keep_hc_files
    keep_raw_s <- readIORef v_Keep_raw_s_files
    keep_s     <- readIORef v_Keep_s_files
-#ifdef ILX
-   writeIORef v_Object_suf (Just "ilx")
-#endif
    osuf       <- readIORef v_Object_suf
+   hcsuf      <- readIORef v_HC_suf
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
@@ -167,8 +165,8 @@ genPipeline todo stop_flag persistent_output lang filename
     cish = cish_suffix suffix
 
        -- for a .hc file we need to force lang to HscC
-    real_lang | start_phase == HCc  = HscC
-             | otherwise           = lang
+    real_lang | start_phase == HCc || start_phase == Mangle = HscC
+             | otherwise                                   = lang
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
@@ -188,10 +186,8 @@ genPipeline todo stop_flag persistent_output lang filename
 
        HscJava | split           -> not_valid
                | otherwise       -> error "not implemented: compiling via Java"
-#ifdef ILX
        HscILX  | split           -> not_valid
                | otherwise       -> [ Unlit, Cpp, Hsc ]
-#endif
 
       | cish      = [ Cc, As ]
 
@@ -209,10 +205,10 @@ genPipeline todo stop_flag persistent_output lang filename
        else do
 
    let
-   ----------- -----  ----   ---   --   --  -  -  -
-      myPhaseInputExt Ln = case osuf of Nothing -> phaseInputExt Ln
-                                       Just s  -> s
-      myPhaseInputExt other = phaseInputExt other
+       -- .o and .hc suffixes can be overriden by command-line options:
+      myPhaseInputExt Ln  | Just s <- osuf  = s
+      myPhaseInputExt HCc | Just s <- hcsuf = s
+      myPhaseInputExt other                 = phaseInputExt other
 
       annotatePipeline
         :: [Phase]             -- raw pipeline
@@ -366,8 +362,9 @@ run_phase MkDependHS basename suff input_fn _output_fn = do
    src <- readFile input_fn
    let (import_sources, import_normals, module_name) = getImports src
 
-   deps_sources <- mapM (findDependency True  src)  import_sources
-   deps_normals <- mapM (findDependency False src) import_normals
+   let orig_fn = basename ++ '.':suff
+   deps_sources <- mapM (findDependency True  orig_fn) import_sources
+   deps_normals <- mapM (findDependency False orig_fn) import_normals
    let deps = deps_sources ++ deps_normals
 
    osuf_opt <- readIORef v_Object_suf
@@ -446,7 +443,7 @@ run_phase Hsc basename suff input_fn output_fn
        cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
 
        let cc_injects = unlines (map mk_include 
-                               (c_includes ++ reverse cmdline_includes))
+                                (c_includes ++ reverse cmdline_includes))
            mk_include h_file = 
                case h_file of 
                   '"':_{-"-} -> "#include "++h_file
@@ -481,8 +478,7 @@ run_phase Hsc basename suff input_fn output_fn
                                  else return False
 
         -- build a ModuleLocation to pass to hscMain.
-        modsrc <- readFile input_fn
-        let (srcimps,imps,mod_name) = getImports modsrc
+        (srcimps,imps,mod_name) <- getImportsFromFile input_fn
 
        Just (mod, location)
           <- mkHomeModuleLocn mod_name basename (basename ++ '.':suff)
@@ -762,7 +758,7 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
 -- Complain about non-dynamic flags in OPTIONS pragmas
 
 checkProcessArgsResult flags basename suff
-  = do when (not (null flags)) (throwDyn (UserError (
+  = do when (not (null flags)) (throwDyn (ProgramError (
            basename ++ "." ++ suff 
            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
            ++ unwords flags)) (ExitFailure 1))
@@ -914,7 +910,7 @@ doMkDLL o_files = do
 
 preprocess :: FilePath -> IO FilePath
 preprocess filename =
-  ASSERT(haskellish_file filename) 
+  ASSERT(haskellish_src_file filename) 
   do init_dyn_flags <- readIORef v_InitDynFlags
      writeIORef v_DynFlags init_dyn_flags
      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
@@ -978,20 +974,33 @@ compile ghci_mode summary source_unchanged have_object
    dyn_flags <- readIORef v_DynFlags
 
    let hsc_lang = hscLang dyn_flags
+       (basename, _) = splitFilename input_fn
+       
    output_fn <- case hsc_lang of
                    HscAsm         -> newTempName (phaseInputExt As)
                    HscC           -> newTempName (phaseInputExt HCc)
                    HscJava        -> newTempName "java" -- ToDo
-#ifdef ILX
-                   HscILX         -> newTempName "ilx" -- ToDo
-#endif
+                   HscILX         -> return (basename ++ ".ilx")       -- newTempName "ilx"    -- ToDo
                    HscInterpreted -> return (error "no output file")
 
-   let (basename, _) = splitFilename input_fn
-       dyn_flags' = dyn_flags { hscOutName = output_fn,
+   let dyn_flags' = dyn_flags { hscOutName = output_fn,
                                hscStubCOutName = basename ++ "_stub.c",
                                hscStubHOutName = basename ++ "_stub.h" }
 
+   -- figure out which header files to #include in a generated .hc file
+   c_includes <- getPackageCIncludes
+   cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
+
+   let cc_injects = unlines (map mk_include 
+                                 (c_includes ++ reverse cmdline_includes))
+       mk_include h_file = 
+       case h_file of 
+           '"':_{-"-} -> "#include "++h_file
+           '<':_      -> "#include "++h_file
+           _          -> "#include \""++h_file++"\""
+
+   writeIORef v_HCHeader cc_injects
+
    -- run the compiler
    hsc_result <- hscMain ghci_mode dyn_flags'
                         (ms_mod summary) location