Trim unused imports detected by new unused-import code

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

diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 973495e..1849c6b 100644 (file)
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -48,12 +48,12 @@ import Maybes               ( expectJust )
 import ParserCoreUtils ( getCoreModuleName )
 import SrcLoc
 import FastString
-import MonadUtils
+-- import MonadUtils
 
-import Data.Either
+-- import Data.Either
 import Exception
 import Data.IORef      ( readIORef )
-import GHC.Exts                ( Int(..) )
+-- import GHC.Exts             ( Int(..) )
 import System.Directory
 import System.FilePath
 import System.IO
@@ -187,7 +187,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
                             -> return ([], ms_hs_date summary)
                           -- We're in --make mode: finish the compilation pipeline.
                           _other
-                            -> do runPipeline StopLn hsc_env' (output_fn,Nothing)
+                            -> do _ <- runPipeline StopLn hsc_env' (output_fn,Nothing)
                                               (Just basename)
                                               Persistent
                                               (Just location)
@@ -264,7 +264,7 @@ compileStub hsc_env mod location = do
        let (stub_c,_,stub_o) = mkStubPaths (hsc_dflags hsc_env) 
                                    (moduleName mod) location
 
-       runPipeline StopLn hsc_env (stub_c,Nothing)  Nothing
+       _ <- runPipeline StopLn hsc_env (stub_c,Nothing)  Nothing
                (SpecificFile stub_o) Nothing{-no ModLocation-}
 
        return stub_o
@@ -301,8 +301,10 @@ link LinkBinary dflags batch_attempt_linking hpt
 link LinkDynLib dflags batch_attempt_linking hpt
    = link' dflags batch_attempt_linking hpt
 
+#ifndef GHCI
 -- warning suppression
 link other _ _ _ = panicBadLink other
+#endif
 
 panicBadLink :: GhcLink -> a
 panicBadLink other = panic ("link: GHC not built to link this way: " ++
@@ -489,7 +491,7 @@ data PipelineOutput
 -- at which stage to stop.
 --
 -- The DynFlags can be modified by phases in the pipeline (eg. by
--- GHC_OPTIONS pragmas), and the changes affect later phases in the
+-- OPTIONS_GHC pragmas), and the changes affect later phases in the
 -- pipeline.
 runPipeline
   :: GhcMonad m =>
@@ -1109,6 +1111,7 @@ runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
        -- might be a hierarchical module.
        createDirectoryHierarchy (takeDirectory output_fn)
 
+       let (md_c_flags, _) = machdepCCOpts dflags
        SysTools.runAs dflags   
                       (map SysTools.Option as_opts
                       ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
@@ -1126,7 +1129,8 @@ runPhase As _stop hsc_env _basename _suff input_fn get_output_fn maybe_loc
                          , SysTools.FileOption "" input_fn
                          , SysTools.Option "-o"
                          , SysTools.FileOption "" output_fn
-                         ])
+                         ]
+                      ++ map SysTools.Option md_c_flags)
 
        return (StopLn, dflags, maybe_loc, output_fn)
 
@@ -1157,6 +1161,7 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc
             split_obj n = split_odir </>
                           takeFileName base_o ++ "__" ++ show n <.> osuf
 
+        let (md_c_flags, _) = machdepCCOpts dflags
         let assemble_file n
               = SysTools.runAs dflags
                          (map SysTools.Option as_opts ++
@@ -1174,7 +1179,8 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc
                           , SysTools.Option "-o"
                           , SysTools.FileOption "" (split_obj n)
                           , SysTools.FileOption "" (split_s n)
-                          ])
+                          ]
+                       ++ map SysTools.Option md_c_flags)
 
         mapM_ assemble_file [1..n]
 
@@ -1185,7 +1191,9 @@ runPhase SplitAs _stop hsc_env _basename _suff _input_fn get_output_fn maybe_loc
                             SysTools.Option "-Wl,-r",
                             SysTools.Option ld_x_flag,
                             SysTools.Option "-o",
-                            SysTools.FileOption "" output_fn ] ++ args)
+                            SysTools.FileOption "" output_fn ]
+                         ++ map SysTools.Option md_c_flags
+                         ++ args)
             ld_x_flag | null cLD_X = ""
                       | otherwise  = "-Wl,-x"
 
@@ -1226,7 +1234,7 @@ runPhase_MoveBinary dflags input_fn dep_packages
            pvm_executable_base = "=" ++ input_fn
            pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
         -- nuke old binary; maybe use configur'ed names for cp and rm?
-        tryIO (removeFile pvm_executable)
+        _ <- tryIO (removeFile pvm_executable)
         -- move the newly created binary into PVM land
         copy dflags "copying PVM executable" input_fn pvm_executable
         -- generate a wrapper script for running a parallel prg under PVM
@@ -1371,6 +1379,13 @@ linkBinary dflags o_files dep_packages = do
     let lib_paths = libraryPaths dflags
     let lib_path_opts = map ("-L"++) lib_paths
 
+    -- The C "main" function is not in the rts but in a separate static
+    -- library libHSrtsmain.a that sits next to the rts lib files. Assuming
+    -- we're using a Haskell main function then we need to link it in.
+    let no_hs_main = dopt Opt_NoHsMain dflags
+    let main_lib | no_hs_main = []
+                 | otherwise  = [ "-lHSrtsmain" ]
+
     pkg_link_opts <- getPackageLinkOpts dflags dep_packages
 
 #ifdef darwin_TARGET_OS
@@ -1387,12 +1402,6 @@ linkBinary dflags o_files dep_packages = do
         framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ]
         -- reverse because they're added in reverse order from the cmd line
 #endif
-#ifdef mingw32_TARGET_OS
-    let dynMain = if not opt_Static then
-                     (head (libraryDirs (getPackageDetails (pkgState dflags) rtsPackageId))) ++ "/Main.dyn_o"
-                 else
-                     ""
-#endif
        -- probably _stub.o files
     extra_ld_inputs <- readIORef v_Ld_inputs
 
@@ -1434,9 +1443,6 @@ linkBinary dflags o_files dep_packages = do
                      ++ map SysTools.Option (
                         md_c_flags
                      ++ o_files
-#ifdef mingw32_TARGET_OS
-                     ++ [dynMain]
-#endif
                      ++ extra_ld_inputs
                      ++ lib_path_opts
                      ++ extra_ld_opts
@@ -1446,6 +1452,7 @@ linkBinary dflags o_files dep_packages = do
                      ++ framework_opts
 #endif
                      ++ pkg_lib_path_opts
+                      ++ main_lib
                      ++ pkg_link_opts
 #ifdef darwin_TARGET_OS
                      ++ pkg_framework_path_opts
@@ -1554,7 +1561,13 @@ linkDynLib dflags o_files dep_packages = do
     let pkgs_no_rts = pkgs
 #endif
     let pkg_lib_paths = collectLibraryPaths pkgs_no_rts
-    let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
+    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
+#ifdef linux_TARGET_OS
+        get_pkg_lib_path_opts l | (dynLibLoader dflags)==SystemDependent && not opt_Static = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
+                                | otherwise = ["-L" ++ l]
+#else
+        get_pkg_lib_path_opts l = ["-L" ++ l]
+#endif
 
     let lib_paths = libraryPaths dflags
     let lib_path_opts = map ("-L"++) lib_paths
@@ -1654,6 +1667,7 @@ linkDynLib dflags o_files dep_packages = do
            md_c_flags
         ++ o_files
         ++ [ "-shared", "-Wl,-Bsymbolic" ] -- we need symbolic linking to resolve non-PIC intra-package-relocations
+         ++ [ "-Wl,-soname," ++ takeFileName output_fn ] -- set the library soname
         ++ extra_ld_inputs
         ++ lib_path_opts
         ++ extra_ld_opts