[project @ 2001-05-08 10:58:48 by simonmar]

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

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 04392a1..c8bd8e6 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.60 2001/03/27 16:32:46 rrt Exp $
+-- $Id: DriverPipeline.hs,v 1.66 2001/05/08 10:58:48 simonmar Exp $
 --
 -- GHC Driver
 --
@@ -94,7 +94,7 @@ getGhcMode flags
        ([]   , rest) -> return (rest, DoLink,  "") -- default is to do linking
        ([(flag,one)], rest) -> return (rest, one, flag)
        (_    , _   ) -> 
-         throwDyn (OtherError 
+         throwDyn (UsageError 
                "only one of the flags -M, -E, -C, -S, -c, --make, --interactive, -mk-dll is allowed")
 
 -----------------------------------------------------------------------------
@@ -167,8 +167,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
    ----------- -----  ----   ---   --   --  -  -  -
@@ -199,13 +199,13 @@ genPipeline todo stop_flag persistent_output lang filename
 
        -- ToDo: this is somewhat cryptic
 
-    not_valid = throwDyn (OtherError ("invalid option combination"))
+    not_valid = throwDyn (UsageError ("invalid option combination"))
    ----------- -----  ----   ---   --   --  -  -  -
 
        -- this shouldn't happen.
    if start_phase /= Ln && start_phase `notElem` pipeline
-       then throwDyn (OtherError ("can't find starting phase for "
-                                   ++ filename))
+       then throwDyn (CmdLineError ("can't find starting phase for "
+                                    ++ filename))
        else do
 
    let
@@ -256,11 +256,13 @@ genPipeline todo stop_flag persistent_output lang filename
        -- is already in linkable form (for example).
    if start_phase `elem` pipeline && 
        (stop_phase /= Ln && stop_phase `notElem` pipeline)
-      then throwDyn (OtherError 
+      then throwDyn (UsageError 
                ("flag " ++ stop_flag
                 ++ " is incompatible with source file `" ++ filename ++ "'"))
       else do
 
+   print (show pipeline ++ show annotated_pipeline ++ show stop_phase)
+
    return (
      takeWhile (phase_ne stop_phase ) $
      dropWhile (phase_ne start_phase) $
@@ -366,8 +368,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 basename)  import_sources
-   deps_normals <- mapM (findDependency False basename) 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 +449,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 +484,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 +764,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 (OtherError (
+  = do when (not (null flags)) (throwDyn (ProgramError (
            basename ++ "." ++ suff 
            ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
            ++ unwords flags)) (ExitFailure 1))
@@ -838,7 +840,7 @@ doLink o_files = do
     when (WayPar `elem` ways_) (do 
                                   success <- run_phase_MoveBinary output_fn
                                   if success then return ()
-                                             else throwDyn (OtherError ("cannot move binary to PVM dir")))
+                                             else throwDyn (InstallationError ("cannot move binary to PVM dir")))
 
 -----------------------------------------------------------------------------
 -- Making a DLL
@@ -914,7 +916,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 
@@ -992,6 +994,20 @@ compile ghci_mode summary source_unchanged have_object
                                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