[project @ 2001-02-14 11:36:07 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / DriverPipeline.hs
index 810d1be..d81b6af 100644 (file)
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.45 2001/01/03 11:13:43 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.50 2001/02/05 17:52:49 rrt Exp $
 --
 -- GHC Driver
 --
@@ -19,12 +19,14 @@ module DriverPipeline (
    preprocess, compile, CompResult(..),
 
        -- batch-mode linking interface
-   doLink
+   doLink,
+        -- DLL building
+   doMkDLL
   ) where
 
 #include "HsVersions.h"
 
-import CmStaticInfo ( GhciMode(..) )
+import CmStaticInfo
 import CmTypes
 import GetImports
 import DriverState
@@ -53,12 +55,15 @@ import IO
 import Monad
 import Maybe
 
+import PackedString
+import MatchPS
+
 -----------------------------------------------------------------------------
 -- GHC modes of operation
 
 data GhcMode
   = DoMkDependHS                       -- ghc -M
-  | DoMkDLL                            -- ghc -mk-dll
+  | DoMkDLL                            -- ghc --mk-dll
   | StopBefore Phase                   -- ghc -E | -C | -S | -c
   | DoMake                             -- ghc --make
   | DoInteractive                      -- ghc --interactive
@@ -69,6 +74,7 @@ GLOBAL_VAR(v_GhcMode, error "todo", GhcMode)
 
 modeFlag :: String -> Maybe GhcMode
 modeFlag "-M"           = Just $ DoMkDependHS
+modeFlag "--mk-dll"      = Just $ DoMkDLL
 modeFlag "-E"           = Just $ StopBefore Hsc
 modeFlag "-C"           = Just $ StopBefore HCc
 modeFlag "-S"           = Just $ StopBefore As
@@ -88,7 +94,7 @@ getGhcMode flags
        ([(flag,one)], rest) -> return (rest, one, flag)
        (_    , _   ) -> 
          throwDyn (OtherError 
-               "only one of the flags -M, -E, -C, -S, -c, --make, --interactive is allowed")
+               "only one of the flags -M, -E, -C, -S, -c, --make, --interactive, -mk-dll is allowed")
 
 -----------------------------------------------------------------------------
 -- genPipeline
@@ -147,12 +153,16 @@ genPipeline todo stop_flag persistent_output lang filename
    ----------- -----  ----   ---   --   --  -  -  -
     (_basename, suffix) = splitFilename filename
 
-    start_phase = startPhase suffix
+    start = startPhase suffix
+
+      -- special case for mkdependHS: .hspp files go through MkDependHS
+    start_phase | todo == DoMkDependHS && start == Hsc  = MkDependHS
+               | otherwise = start
 
     haskellish = haskellish_suffix suffix
     cish = cish_suffix suffix
 
-   -- for a .hc file we need to force lang to HscC
+       -- for a .hc file we need to force lang to HscC
     real_lang | start_phase == HCc  = HscC
              | otherwise           = lang
 
@@ -312,7 +322,7 @@ run_phase Cpp basename suff input_fn output_fn
                           ++ ": static flags are not allowed in {-# OPTIONS #-} pragmas:\n\t" 
                           ++ unwords unhandled_flags)) (ExitFailure 1))
 
-       do_cpp <- readState cpp_flag
+       do_cpp <- dynFlag cppFlag
        if do_cpp
           then do
                    cpp <- readIORef v_Pgm_P
@@ -325,19 +335,21 @@ run_phase Cpp basename suff input_fn output_fn
                                                        ++ pkg_include_dirs)
 
            verb <- getVerbFlag
+           (md_c_flags, _) <- machdepCCOpts
 
            runSomething "C pre-processor" 
                (unwords
-                          (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" -}'", ">", output_fn, "&&",
+                          (["echo '{-# LINE 1 \"" ++ input_fn ++ "\" #-}'", ">", output_fn, "&&",
                     cpp, verb] 
                    ++ include_paths
                    ++ hs_src_cpp_opts
                    ++ hscpp_opts
+                   ++ md_c_flags
                    ++ [ "-x", "c", input_fn, ">>", output_fn ]
                   ))
          else do
            runSomething "Ineffective C pre-processor"
-                  ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" -}' > " 
+                  ("echo '{-# LINE 1 \""  ++ input_fn ++ "\" #-}' > " 
                    ++ output_fn ++ " && cat " ++ input_fn
                    ++ " >> " ++ output_fn)
        return True
@@ -515,7 +527,7 @@ run_phase cc_phase _basename _suff input_fn output_fn
                                                        ++ pkg_include_dirs)
 
        c_includes <- getPackageCIncludes
-       cmdline_includes <- readState cmdline_hc_includes -- -#include options
+       cmdline_includes <- dynFlag cmdlineHcIncludes -- -#include options
 
        let cc_injects | hcc = unlines (map mk_include 
                                        (c_includes ++ reverse cmdline_includes))
@@ -578,7 +590,7 @@ run_phase Mangle _basename _suff input_fn output_fn
        mangler_opts <- getOpts opt_m
        machdep_opts <-
         if (prefixMatch "i386" cTARGETPLATFORM)
-           then do n_regs <- readState stolen_x86_regs
+           then do n_regs <- dynFlag stolen_x86_regs
                    return [ show n_regs ]
            else return []
        runSomething "Assembly Mangler"
@@ -699,9 +711,8 @@ doLink o_files = do
 #ifdef mingw32_TARGET_OS
     let extra_os = if static || no_hs_main
                    then []
---                   else [ head (lib_paths (head rts_pkg)) ++ "/Main.dll_o",
---                          head (lib_paths (head std_pkg)) ++ "/PrelMain.dll_o" ]
-                    else []
+                   else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
+                          head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
 #endif
     (md_c_flags, _) <- machdepCCOpts
     runSomething "Linker"
@@ -728,20 +739,86 @@ doLink o_files = do
        )
 
 -----------------------------------------------------------------------------
+-- Making a DLL
+
+-- only for Win32, but bits that are #ifdefed in doLn are still #ifdefed here
+-- in a vain attempt to aid future portability
+doMkDLL :: [String] -> IO ()
+doMkDLL o_files = do
+    ln <- readIORef v_Pgm_dll
+    verb <- getVerbFlag
+    static <- readIORef v_Static
+    let imp = if static then "" else "_imp"
+    no_hs_main <- readIORef v_NoHsMain
+
+    o_file <- readIORef v_Output_file
+    let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
+
+    pkg_lib_paths <- getPackageLibraryPath
+    let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
+
+    lib_paths <- readIORef v_Library_paths
+    let lib_path_opts = map ("-L"++) lib_paths
+
+    pkg_libs <- getPackageLibraries
+    let pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
+
+    libs <- readIORef v_Cmdline_libraries
+    let lib_opts = map ("-l"++) (reverse libs)
+        -- reverse because they're added in reverse order from the cmd line
+
+    pkg_extra_ld_opts <- getPackageExtraLdOpts
+
+       -- probably _stub.o files
+    extra_ld_inputs <- readIORef v_Ld_inputs
+
+       -- opts from -optdll-<blah>
+    extra_ld_opts <- getStaticOpts v_Opt_dll
+
+    rts_pkg <- getPackageDetails ["rts"]
+    std_pkg <- getPackageDetails ["std"]
+#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" ]
+#endif
+    (md_c_flags, _) <- machdepCCOpts
+    runSomething "DLL creator"
+       (unwords
+        ([ ln, verb, "-o", output_fn ]
+        ++ md_c_flags
+        ++ o_files
+#ifdef mingw32_TARGET_OS
+        ++ extra_os
+        ++ [ "--target=i386-mingw32" ]
+#endif
+        ++ extra_ld_inputs
+        ++ lib_path_opts
+        ++ lib_opts
+        ++ pkg_lib_path_opts
+        ++ pkg_lib_opts
+        ++ pkg_extra_ld_opts
+         ++ (case findPS (packString (concat extra_ld_opts)) (packString "--def") of
+               Nothing -> [ "--export-all" ]
+              Just _  -> [ "" ])
+        ++ extra_ld_opts
+       )
+       )
+
+-----------------------------------------------------------------------------
 -- Just preprocess a file, put the result in a temp. file (used by the
 -- compilation manager during the summary phase).
 
 preprocess :: FilePath -> IO FilePath
 preprocess filename =
   ASSERT(haskellish_file filename) 
-  do init_driver_state <- readIORef v_InitDriverState
-     writeIORef v_Driver_state init_driver_state
-
+  do init_dyn_flags <- readIORef v_InitDynFlags
+     writeIORef v_DynFlags init_dyn_flags
      pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False 
                        defaultHscLang filename
      runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
 
-
 -----------------------------------------------------------------------------
 -- Compile a single module, under the control of the compilation manager.
 --
@@ -781,8 +858,6 @@ data CompResult
 compile ghci_mode summary source_unchanged old_iface hst hit pcs = do 
    init_dyn_flags <- readIORef v_InitDynFlags
    writeIORef v_DynFlags init_dyn_flags
-   init_driver_state <- readIORef v_InitDriverState
-   writeIORef v_Driver_state init_driver_state
 
    showPass init_dyn_flags 
        (showSDoc (text "Compiling" <+> ppr (name_of_summary summary)))