[project @ 2000-11-14 17:41:04 by sewardj]

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

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 3e42f13..f1e9618 100644 (file)
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.20 2000/11/13 14:34:37 sewardj Exp $
+-- $Id: DriverPipeline.hs,v 1.25 2000/11/14 17:41:04 sewardj Exp $
 --
 -- GHC Driver
 --
@@ -120,6 +120,7 @@ genPipeline
    :: GhcMode          -- when to stop
    -> String           -- "stop after" flag (for error messages)
    -> Bool             -- True => output is persistent
+   -> HscLang          -- preferred output language for hsc
    -> String           -- original filename
    -> IO [             -- list of phases to run for this file
             (Phase,
@@ -127,11 +128,10 @@ genPipeline
              String)                -- output file suffix
          ]     
 
-genPipeline todo stop_flag persistent_output filename
+genPipeline todo stop_flag persistent_output lang filename 
  = do
    split      <- readIORef v_Split_object_files
    mangle     <- readIORef v_Do_asm_mangling
-   lang       <- readIORef v_Hsc_Lang
    keep_hc    <- readIORef v_Keep_hc_files
    keep_raw_s <- readIORef v_Keep_raw_s_files
    keep_s     <- readIORef v_Keep_s_files
@@ -146,9 +146,9 @@ genPipeline todo stop_flag persistent_output filename
     haskellish = haskellish_suffix suffix
     cish = cish_suffix suffix
 
-   -- for a .hc file, or if the -C flag is given, we need to force lang to HscC
-    real_lang | suffix == "hc"  = HscC
-             | otherwise       = lang
+   -- for a .hc file we need to force lang to HscC
+    real_lang | start_phase == HCc  = HscC
+             | otherwise           = lang
 
    let
    ----------- -----  ----   ---   --   --  -  -  -
@@ -410,8 +410,7 @@ run_phase Hsc basename suff input_fn output_fn
        ohi    <- readIORef v_Output_hi
        hisuf  <- readIORef v_Hi_suf
        let hifile = case ohi of
-                          Nothing -> current_dir ++ "/" ++ basename
-                                       ++ "." ++ hisuf
+                          Nothing -> basename ++ '.':hisuf
                           Just fn -> fn
 
   -- figure out if the source has changed, for recompilation avoidance.
@@ -685,8 +684,9 @@ doLink o_files = do
 #ifdef mingw32_TARGET_OS
     let extra_os = if static || no_hs_main
                    then []
-                   else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
-                          head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
+--                   else [ head (lib_paths (head rts_pkg)) ++ "/Main.dll_o",
+--                          head (lib_paths (head std_pkg)) ++ "/PrelMain.dll_o" ]
+                    else []
 #endif
     (md_c_flags, _) <- machdepCCOpts
     run_something "Linker"
@@ -719,7 +719,8 @@ doLink o_files = do
 preprocess :: FilePath -> IO FilePath
 preprocess filename =
   ASSERT(haskellish_file filename) 
-  do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False filename
+  do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
+                       defaultHscLang filename
      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
 
 
@@ -763,16 +764,17 @@ compile summary old_iface hst hit pcs = do
    init_dyn_flags <- readIORef v_InitDynFlags
    writeIORef v_DynFlags init_dyn_flags
 
-   let location = ms_location summary   
-   let input_fn = unJust (ml_hs_file location) "compile:hs"
+   let location   = ms_location summary   
+   let input_fn   = unJust (ml_hs_file location) "compile:hs"
+   let input_fnpp = unJust (ml_hspp_file location) "compile:hspp"
 
-   when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
+   when verb (hPutStrLn stderr ("compile: input file " ++ input_fnpp))
 
-   opts <- getOptionsFromSource input_fn
+   opts <- getOptionsFromSource input_fnpp
    processArgs dynamic_flags opts []
    dyn_flags <- readIORef v_DynFlags
 
-   hsc_lang <- readIORef v_Hsc_Lang
+   let hsc_lang = hscLang dyn_flags
    output_fn <- case hsc_lang of
                    HscAsm         -> newTempName (phaseInputExt As)
                    HscC           -> newTempName (phaseInputExt HCc)
@@ -781,7 +783,7 @@ compile summary old_iface hst hit pcs = do
 
    -- run the compiler
    hsc_result <- hscMain dyn_flags{ hscOutName = output_fn } 
-                        (panic "compile:source_unchanged")
+                        False -- (panic "compile:source_unchanged")
                          location old_iface hst hit pcs
 
    case hsc_result of {
@@ -812,7 +814,8 @@ compile summary old_iface hst hit pcs = do
                        Nothing -> panic "compile: no interpreted code"
 
                -- we're in batch mode: finish the compilation pipeline.
-               _other -> do pipe <- genPipeline (StopBefore Ln) "" True output_fn
+               _other -> do pipe <- genPipeline (StopBefore Ln) "" True 
+                                       hsc_lang output_fn
                             o_file <- runPipeline pipe output_fn False False
                             return [ DotO o_file ]
 
@@ -853,7 +856,8 @@ dealWithStubs basename maybe_stub_h maybe_stub_c
                        ])
 
                        -- compile the _stub.c file w/ gcc
-               pipeline <- genPipeline (StopBefore Ln) "" True stub_c
+               pipeline <- genPipeline (StopBefore Ln) "" True 
+                               defaultHscLang stub_c
                stub_o <- runPipeline pipeline stub_c False{-no linking-} 
                                False{-no -o option-}