Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc

5 files changed, 192 insertions, 163 deletions

diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs
index 6b47db3965..0cf98fe3fd 100644
--- a/compiler/ghci/Linker.lhs
+++ b/compiler/ghci/Linker.lhs
@@ -1185,13 +1185,6 @@ searchForLibUsingGcc dflags so dirs = do
 -- ----------------------------------------------------------------------------
 -- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
 
-mkSOName :: Platform -> FilePath -> FilePath
-mkSOName platform root
-    = case platformOS platform of
-      OSDarwin  -> ("lib" ++ root) <.> "dylib"
-      OSMinGW32 ->           root  <.> "dll"
-      _         -> ("lib" ++ root) <.> "so"
-
 -- Darwin / MacOS X only: load a framework
 -- a framework is a dynamic library packaged inside a directory of the same
 -- name. They are searched for in different paths than normal libraries.
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 0566d6ad65..08420efde6 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -371,7 +371,7 @@ linkingNeeded dflags linkables pkg_deps = do
                           | Just c <- map (lookupPackage pkg_map) pkg_deps,
                             lib <- packageHsLibs dflags c ]
 
-        pkg_libfiles <- mapM (uncurry findHSLib) pkg_hslibs
+        pkg_libfiles <- mapM (uncurry (findHSLib dflags)) pkg_hslibs
         if any isNothing pkg_libfiles then return True else do
         e_lib_times <- mapM (tryIO . getModificationUTCTime)
                           (catMaybes pkg_libfiles)
@@ -408,9 +408,11 @@ ghcLinkInfoSectionName :: String
 ghcLinkInfoSectionName = ".debug-ghc-link-info"
    -- if we use the ".debug" prefix, then strip will strip it by default
 
-findHSLib :: [String] -> String -> IO (Maybe FilePath)
-findHSLib dirs lib = do
-  let batch_lib_file = "lib" ++ lib <.> "a"
+findHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath)
+findHSLib dflags dirs lib = do
+  let batch_lib_file = if dopt Opt_Static dflags
+                       then "lib" ++ lib <.> "a"
+                       else mkSOName (targetPlatform dflags) lib
   found <- filterM doesFileExist (map (</> batch_lib_file) dirs)
   case found of
     [] -> return Nothing
@@ -1662,13 +1664,24 @@ linkBinary dflags o_files dep_packages = do
     -- explicit packages with the auto packages and all of their
     -- dependencies, and eliminating duplicates.
 
+    full_output_fn <- if isAbsolute output_fn
+                      then return output_fn
+                      else do d <- getCurrentDirectory
+                              return $ normalise (d </> output_fn)
     pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
-    let pkg_lib_path_opts = concat (map get_pkg_lib_path_opts pkg_lib_paths)
+    let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
         get_pkg_lib_path_opts l
          | osElfTarget (platformOS platform) &&
            dynLibLoader dflags == SystemDependent &&
            not (dopt Opt_Static dflags)
-            = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
+            = let libpath = if dopt Opt_RelativeDynlibPaths dflags
+                            then "$ORIGIN" </>
+                                 (l `makeRelativeTo` full_output_fn)
+                            else l
+                  rpath = if dopt Opt_RPath dflags
+                          then ["-Wl,-rpath",      "-Wl," ++ libpath]
+                          else []
+              in ["-L" ++ l, "-Wl,-rpath-link", "-Wl," ++ l] ++ rpath
          | otherwise = ["-L" ++ l]
 
     let lib_paths = libraryPaths dflags
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 7ae46532c5..ccaf814dbf 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -339,6 +339,8 @@ data DynFlag
    | Opt_SccProfilingOn
    | Opt_Ticky
    | Opt_Static
+   | Opt_RPath
+   | Opt_RelativeDynlibPaths
    | Opt_Hpc
 
    -- output style opts
@@ -768,15 +770,18 @@ pgm_lc dflags = sPgm_lc (settings dflags)
 opt_L                 :: DynFlags -> [String]
 opt_L dflags = sOpt_L (settings dflags)
 opt_P                 :: DynFlags -> [String]
-opt_P dflags = sOpt_P (settings dflags)
+opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
+            ++ sOpt_P (settings dflags)
 opt_F                 :: DynFlags -> [String]
 opt_F dflags = sOpt_F (settings dflags)
 opt_c                 :: DynFlags -> [String]
-opt_c dflags = sOpt_c (settings dflags)
+opt_c dflags = concatMap (wayOptc (targetPlatform dflags)) (ways dflags)
+            ++ sOpt_c (settings dflags)
 opt_a                 :: DynFlags -> [String]
 opt_a dflags = sOpt_a (settings dflags)
 opt_l                 :: DynFlags -> [String]
-opt_l dflags = sOpt_l (settings dflags)
+opt_l dflags = concatMap (wayOptl (targetPlatform dflags)) (ways dflags)
+            ++ sOpt_l (settings dflags)
 opt_windres           :: DynFlags -> [String]
 opt_windres dflags = sOpt_windres (settings dflags)
 opt_lo                :: DynFlags -> [String]
@@ -812,13 +817,6 @@ data HscTarget
   | HscNothing     -- ^ Don't generate any code.  See notes above.
   deriving (Eq, Show)
 
-showHscTargetFlag :: HscTarget -> String
-showHscTargetFlag HscC           = "-fvia-c"
-showHscTargetFlag HscAsm         = "-fasm"
-showHscTargetFlag HscLlvm        = "-fllvm"
-showHscTargetFlag HscInterpreted = "-fbyte-code"
-showHscTargetFlag HscNothing     = "-fno-code"
-
 -- | Will this target result in an object file on the disk?
 isObjectTarget :: HscTarget -> Bool
 isObjectTarget HscC     = True
@@ -969,8 +967,6 @@ wayTag WayDyn      = "dyn"
 wayTag WayProf     = "p"
 wayTag WayEventLog = "l"
 wayTag WayPar      = "mp"
--- wayTag WayPar      = "mt"
--- wayTag WayPar      = "md"
 wayTag WayGran     = "mg"
 wayTag WayNDP      = "ndp"
 
@@ -981,8 +977,6 @@ wayRTSOnly WayDyn      = False
 wayRTSOnly WayProf     = False
 wayRTSOnly WayEventLog = True
 wayRTSOnly WayPar      = False
--- wayRTSOnly WayPar      = False
--- wayRTSOnly WayPar      = False
 wayRTSOnly WayGran     = False
 wayRTSOnly WayNDP      = False
 
@@ -993,33 +987,14 @@ wayDesc WayDyn      = "Dynamic"
 wayDesc WayProf     = "Profiling"
 wayDesc WayEventLog = "RTS Event Logging"
 wayDesc WayPar      = "Parallel"
--- wayDesc WayPar      = "Parallel ticky profiling"
--- wayDesc WayPar      = "Distributed"
 wayDesc WayGran     = "GranSim"
 wayDesc WayNDP      = "Nested data parallelism"
 
-wayOpts :: Platform -> Way -> DynP ()
-wayOpts platform WayThreaded = do
-        -- FreeBSD's default threading library is the KSE-based M:N libpthread,
-        -- which GHC has some problems with.  It's currently not clear whether
-        -- the problems are our fault or theirs, but it seems that using the
-        -- alternative 1:1 threading library libthr works around it:
-          let os = platformOS platform
-          case os of
-              OSFreeBSD -> upd $ addOptl "-lthr"
-              OSSolaris2 -> upd $ addOptl "-lrt"
-              _
-               | os `elem` [OSOpenBSD, OSNetBSD] ->
-                  do upd $ addOptc "-pthread"
-                     upd $ addOptl "-pthread"
-              _ ->
-                  return ()
-wayOpts _ WayDebug = return ()
-wayOpts platform WayDyn = do
-        upd $ addOptP "-DDYNAMIC"
-        upd $ addOptc "-DDYNAMIC"
-        let os = platformOS platform
-        case os of
+wayExtras :: Platform -> Way -> DynP ()
+wayExtras _ WayThreaded = return ()
+wayExtras _ WayDebug = return ()
+wayExtras platform WayDyn =
+        case platformOS platform of
             OSMinGW32 ->
                 -- On Windows, code that is to be linked into a dynamic
                 -- library must be compiled with -fPIC. Labels not in
@@ -1028,59 +1003,69 @@ wayOpts platform WayDyn = do
                 setFPIC
             OSDarwin ->
                 setFPIC
-            _ | os `elem` [OSOpenBSD, OSNetBSD] ->
-                -- Without this, linking the shared libHSffi fails
-                -- because it uses pthread mutexes.
-                upd $ addOptl "-optl-pthread"
             _ ->
                 return ()
-wayOpts _ WayProf = do
-        setDynFlag Opt_SccProfilingOn
-        upd $ addOptP "-DPROFILING"
-        upd $ addOptc "-DPROFILING"
-wayOpts _ WayEventLog = do
-        upd $ addOptP "-DTRACING"
-        upd $ addOptc "-DTRACING"
-wayOpts _ WayPar = do
-        setDynFlag Opt_Parallel
-        upd $ addOptP "-D__PARALLEL_HASKELL__"
-        upd $ addOptc "-DPAR"
-        exposePackage "concurrent"
-        upd $ addOptc "-w"
-        upd $ addOptl "-L${PVM_ROOT}/lib/${PVM_ARCH}"
-        upd $ addOptl "-lpvm3"
-        upd $ addOptl "-lgpvm3"
-{-
-wayOpts WayPar =
-        [ "-fparallel"
-        , "-D__PARALLEL_HASKELL__"
-        , "-optc-DPAR"
-        , "-optc-DPAR_TICKY"
-        , "-package concurrent"
-        , "-optc-w"
-        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
-        , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]
-wayOpts WayPar =
-        [ "-fparallel"
-        , "-D__PARALLEL_HASKELL__"
-        , "-D__DISTRIBUTED_HASKELL__"
-        , "-optc-DPAR"
-        , "-optc-DDIST"
-        , "-package concurrent"
-        , "-optc-w"
-        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
-        , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]
--}
-wayOpts _ WayGran = do
-        setDynFlag Opt_GranMacros
-        upd $ addOptP "-D__GRANSIM__"
-        upd $ addOptc "-DGRAN"
-        exposePackage "concurrent"
-wayOpts _ WayNDP = do
-        setExtensionFlag Opt_ParallelArrays
-        setDynFlag Opt_Vectorise
+wayExtras _ WayProf = setDynFlag Opt_SccProfilingOn
+wayExtras _ WayEventLog = return ()
+wayExtras _ WayPar = do setDynFlag Opt_Parallel
+                        exposePackage "concurrent"
+wayExtras _ WayGran = do setDynFlag Opt_GranMacros
+                         exposePackage "concurrent"
+wayExtras _ WayNDP = do setExtensionFlag Opt_ParallelArrays
+                        setDynFlag Opt_Vectorise
+
+wayOptc :: Platform -> Way -> [String]
+wayOptc platform WayThreaded = case platformOS platform of
+                               OSOpenBSD -> ["-pthread"]
+                               OSNetBSD  -> ["-pthread"]
+                               _         -> []
+wayOptc _ WayDebug      = []
+wayOptc _ WayDyn        = ["-DDYNAMIC"]
+wayOptc _ WayProf       = ["-DPROFILING"]
+wayOptc _ WayEventLog   = ["-DTRACING"]
+wayOptc _ WayPar        = ["-DPAR", "-w"]
+wayOptc _ WayGran       = ["-DGRAN"]
+wayOptc _ WayNDP        = []
+
+wayOptl :: Platform -> Way -> [String]
+wayOptl platform WayThreaded =
+        case platformOS platform of
+        -- FreeBSD's default threading library is the KSE-based M:N libpthread,
+        -- which GHC has some problems with.  It's currently not clear whether
+        -- the problems are our fault or theirs, but it seems that using the
+        -- alternative 1:1 threading library libthr works around it:
+        OSFreeBSD  -> ["-lthr"]
+        OSSolaris2 -> ["-lrt"]
+        OSOpenBSD  -> ["-pthread"]
+        OSNetBSD   -> ["-pthread"]
+        _          -> []
+wayOptl _ WayDebug = []
+wayOptl platform WayDyn =
+        case platformOS platform of
+        OSOpenBSD -> -- Without this, linking the shared libHSffi fails
+                     -- because it uses pthread mutexes.
+                     ["-optl-pthread"]
+        OSNetBSD -> -- Without this, linking the shared libHSffi fails
+                    -- because it uses pthread mutexes.
+                    ["-optl-pthread"]
+        _ -> []
+wayOptl _ WayProf       = []
+wayOptl _ WayEventLog   = []
+wayOptl _ WayPar        = ["-L${PVM_ROOT}/lib/${PVM_ARCH}",
+                           "-lpvm3",
+                           "-lgpvm3"]
+wayOptl _ WayGran       = []
+wayOptl _ WayNDP        = []
+
+wayOptP :: Platform -> Way -> [String]
+wayOptP _ WayThreaded = []
+wayOptP _ WayDebug    = []
+wayOptP _ WayDyn      = ["-DDYNAMIC"]
+wayOptP _ WayProf     = ["-DPROFILING"]
+wayOptP _ WayEventLog = ["-DTRACING"]
+wayOptP _ WayPar      = ["-D__PARALLEL_HASKELL__"]
+wayOptP _ WayGran     = ["-D__GRANSIM__"]
+wayOptP _ WayNDP      = []
 
 -----------------------------------------------------------------------------
 
@@ -1177,7 +1162,7 @@ defaultDynFlags mySettings =
         dirsToClean    = panic "defaultDynFlags: No dirsToClean",
         generatedDumps = panic "defaultDynFlags: No generatedDumps",
         haddockOptions = Nothing,
-        flags = IntSet.fromList (map fromEnum (defaultFlags (sTargetPlatform mySettings))),
+        flags = IntSet.fromList (map fromEnum (defaultFlags mySettings)),
         warningFlags = IntSet.fromList (map fromEnum standardWarnings),
         ghciScripts = [],
         language = Nothing,
@@ -1678,7 +1663,9 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
       ghcError (CmdLineError ("combination not supported: "  ++
                               intercalate "/" (map wayDesc theWays)))
 
-  return (dflags3, leftover, sh_warns ++ warns)
+  let (dflags4, consistency_warnings) = makeDynFlagsConsistent dflags3
+
+  return (dflags4, leftover, consistency_warnings ++ sh_warns ++ warns)
 
 
 -- | Check (and potentially disable) any extensions that aren't allowed
@@ -1790,15 +1777,13 @@ dynamic_flags = [
     -- is required to get the RTS ticky support.
 
         ----- Linker --------------------------------------------------------
-  -- -static is the default. If -dynamic has been given then, due to the
-  -- way wayOpts is currently used, we've already set -DDYNAMIC etc.
-  -- It's too fiddly to undo that, so we just give an error if
-  -- Opt_Static has been unset.
-  , Flag "static"         (noArgM (\dfs -> do unless (dopt Opt_Static dfs) (addErr "Can't use -static after -dynamic")
-                                              return dfs))
-  , Flag "dynamic"        (NoArg (unSetDynFlag Opt_Static >> addWay WayDyn))
+  , Flag "static"         (NoArg (do setDynFlag Opt_Static
+                                     removeWay WayDyn))
+  , Flag "dynamic"        (NoArg (do unSetDynFlag Opt_Static
+                                     addWay WayDyn))
     -- ignored for compat w/ gcc:
   , Flag "rdynamic"       (NoArg (return ()))
+  , Flag "relative-dynlib-paths"  (NoArg (setDynFlag Opt_RelativeDynlibPaths))
 
         ------- Specific phases  --------------------------------------------
     -- need to appear before -pgmL to be parsed as LLVM flags.
@@ -2290,7 +2275,8 @@ fFlags = [
   ( "implicit-import-qualified",        Opt_ImplicitImportQualified, nop ),
   ( "prof-count-entries",               Opt_ProfCountEntries, nop ),
   ( "prof-cafs",                        Opt_AutoSccsOnIndividualCafs, nop ),
-  ( "hpc",                              Opt_Hpc, nop )
+  ( "hpc",                              Opt_Hpc, nop ),
+  ( "use-rpaths",                       Opt_RPath, nop )
   ]
 
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@
@@ -2456,10 +2442,9 @@ xFlags = [
   ( "TypeHoles",                        Opt_TypeHoles, nop )
   ]
 
-defaultFlags :: Platform -> [DynFlag]
-defaultFlags platform
+defaultFlags :: Settings -> [DynFlag]
+defaultFlags settings
   = [ Opt_AutoLinkPackages,
-      Opt_Static,
 
       Opt_SharedImplib,
 
@@ -2471,7 +2456,8 @@ defaultFlags platform
       Opt_GhciSandbox,
       Opt_GhciHistory,
       Opt_HelpfulErrors,
-      Opt_ProfCountEntries
+      Opt_ProfCountEntries,
+      Opt_RPath
     ]
 
     ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns]
@@ -2484,6 +2470,12 @@ defaultFlags platform
             _                  -> []
         _ -> [])
 
+    ++ (if pc_dYNAMIC_BY_DEFAULT (sPlatformConstants settings)
+        then []
+        else [Opt_Static])
+
+    where platform = sTargetPlatform settings
+
 impliedFlags :: [(ExtensionFlag, TurnOnFlag, ExtensionFlag)]
 impliedFlags
   = [ (Opt_RankNTypes,                turnOn, Opt_ExplicitForAll)
@@ -2747,7 +2739,10 @@ setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
 addWay :: Way -> DynP ()
 addWay w = do upd (\dfs -> dfs { ways = w : ways dfs })
               dfs <- liftEwM getCmdLineState
-              wayOpts (targetPlatform dfs) w
+              wayExtras (targetPlatform dfs) w
+
+removeWay :: Way -> DynP ()
+removeWay w = upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) })
 
 --------------------------
 setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
@@ -2881,59 +2876,16 @@ setObjTarget l = updM set
   where
    set dflags
      | isObjectTarget (hscTarget dflags)
-       = case l of
-         HscC
-          | platformUnregisterised (targetPlatform dflags) ->
-             do addWarn ("Compiler not unregisterised, so ignoring " ++ flag)
-                return dflags
-         HscAsm
-          | cGhcWithNativeCodeGen /= "YES" ->
-             do addWarn ("Compiler has no native codegen, so ignoring " ++
-                         flag)
-                return dflags
-         HscLlvm
-          | not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
-            (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags)
-            ->
-             do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform")
-                return dflags
-         _ -> return $ dflags { hscTarget = l }
+       = return $ dflags { hscTarget = l }
      | otherwise = return dflags
-     where platform = targetPlatform dflags
-           arch = platformArch platform
-           os   = platformOS   platform
-           flag = showHscTargetFlag l
 
 setFPIC :: DynP ()
 setFPIC = updM set
-  where
-   set dflags
-    | cGhcWithNativeCodeGen == "YES" || platformUnregisterised (targetPlatform dflags)
-       = let platform = targetPlatform dflags
-         in case hscTarget dflags of
-            HscLlvm
-             | (platformArch platform == ArchX86_64) &&
-               (platformOS platform `elem` [OSLinux, OSDarwin]) ->
-                do addWarn "Ignoring -fPIC as it is incompatible with LLVM on this platform"
-                   return dflags
-            _ -> return $ dopt_set dflags Opt_PIC
-    | otherwise
-       = ghcError $ CmdLineError "-fPIC is not supported on this platform"
+    where set dflags = return $ dopt_set dflags Opt_PIC
 
 unSetFPIC :: DynP ()
 unSetFPIC = updM set
-  where
-   set dflags
-       = let platform = targetPlatform dflags
-         in case platformOS platform of
-            OSDarwin
-             | platformArch platform == ArchX86_64 ->
-                do addWarn "Ignoring -fno-PIC on this platform"
-                   return dflags
-            _ | not (dopt Opt_Static dflags) ->
-                do addWarn "Ignoring -fno-PIC as -fstatic is off"
-                   return dflags
-            _ -> return $ dopt_unset dflags Opt_PIC
+    where set dflags = return $ dopt_unset dflags Opt_PIC
 
 setOptLevel :: Int -> DynFlags -> DynP DynFlags
 setOptLevel n dflags
@@ -3145,6 +3097,8 @@ compilerInfo dflags
        ("Support SMP",                 cGhcWithSMP),
        ("Tables next to code",         cGhcEnableTablesNextToCode),
        ("RTS ways",                    cGhcRTSWays),
+       ("Dynamic by default",          if dYNAMIC_BY_DEFAULT dflags
+                                       then "YES" else "NO"),
        ("Leading underscore",          cLeadingUnderscore),
        ("Debug on",                    show debugIsOn),
        ("LibDir",                      topDir dflags),
@@ -3184,3 +3138,48 @@ tARGET_MAX_WORD dflags
       8 -> toInteger (maxBound :: Word64)
       w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)
 
+-- Whenever makeDynFlagsConsistent does anything, it starts over, to
+-- ensure that a later change doesn't invalidate an earlier check.
+-- Be careful not to introduce potential loops!
+makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
+makeDynFlagsConsistent dflags
+ | hscTarget dflags == HscC &&
+   not (platformUnregisterised (targetPlatform dflags))
+    = if cGhcWithNativeCodeGen == "YES"
+      then let dflags' = dflags { hscTarget = HscAsm }
+               warn = "Compiler not unregisterised, so using native code generator rather than compiling via C"
+           in loop dflags' warn
+      else let dflags' = dflags { hscTarget = HscLlvm }
+               warn = "Compiler not unregisterised, so using LLVM rather than compiling via C"
+           in loop dflags' warn
+ | hscTarget dflags /= HscC &&
+   platformUnregisterised (targetPlatform dflags)
+    = loop (dflags { hscTarget = HscC })
+           "Compiler unregisterised, so compiling via C"
+ | hscTarget dflags == HscAsm &&
+   cGhcWithNativeCodeGen /= "YES"
+      = let dflags' = dflags { hscTarget = HscLlvm }
+            warn = "No native code generator, so using LLVM"
+        in loop dflags' warn
+ | hscTarget dflags == HscLlvm &&
+   not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
+   (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags)
+    = if cGhcWithNativeCodeGen == "YES"
+      then let dflags' = dflags { hscTarget = HscAsm }
+               warn = "Using native code generator rather than LLVM, as LLVM is incompatible with -fPIC and -dynamic on this platform"
+           in loop dflags' warn
+      else ghcError $ CmdLineError "Can't use -fPIC or -dynamic on this platform"
+ | os == OSDarwin &&
+   arch == ArchX86_64 &&
+   not (dopt Opt_PIC dflags)
+    = loop (dopt_set dflags Opt_PIC)
+           "Enabling -fPIC as it is always on for this platform"
+ | otherwise = (dflags, [])
+    where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
+          loop updated_dflags warning
+              = case makeDynFlagsConsistent updated_dflags of
+                (dflags', ws) -> (dflags', L loc warning : ws)
+          platform = targetPlatform dflags
+          arch = platformArch platform
+          os   = platformOS   platform
+
diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 7c1f169440..ec5f6ee792 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -37,6 +37,8 @@ module HscTypes (
 
         PackageInstEnv, PackageRuleBase,
 
+        mkSOName,
+
         -- * Annotations
         prepareAnnotations,
 
@@ -157,6 +159,7 @@ import Fingerprint
 import MonadUtils
 import Bag
 import ErrUtils
+import Platform
 import Util
 
 import Control.Monad    ( mplus, guard, liftM, when )
@@ -1778,6 +1781,15 @@ type OrigNameCache   = ModuleEnv (OccEnv Name)
 \end{code}
 
 
+\begin{code}
+mkSOName :: Platform -> FilePath -> FilePath
+mkSOName platform root
+    = case platformOS platform of
+      OSDarwin  -> ("lib" ++ root) <.> "dylib"
+      OSMinGW32 ->           root  <.> "dll"
+      _         -> ("lib" ++ root) <.> "so"
+\end{code}
+
 
 %************************************************************************
 %*                                                                      *
diff --git a/compiler/utils/Util.lhs b/compiler/utils/Util.lhs
index 87171545f8..f9927de2f0 100644
--- a/compiler/utils/Util.lhs
+++ b/compiler/utils/Util.lhs
@@ -87,6 +87,7 @@ module Util (
         escapeSpaces,
         parseSearchPath,
         Direction(..), reslash,
+        makeRelativeTo,
 
         -- * Utils for defining Data instances
         abstractConstr, abstractDataType, mkNoRepType,
@@ -1006,6 +1007,17 @@ reslash d = f
           slash = case d of
                   Forwards -> '/'
                   Backwards -> '\\'
+
+makeRelativeTo :: FilePath -> FilePath -> FilePath
+this `makeRelativeTo` that = directory </> thisFilename
+    where (thisDirectory, thisFilename) = splitFileName this
+          thatDirectory = dropFileName that
+          directory = joinPath $ f (splitPath thisDirectory)
+                                   (splitPath thatDirectory)
+
+          f (x : xs) (y : ys)
+           | x == y = f xs ys
+          f xs ys = replicate (length ys) ".." ++ xs
 \end{code}
 
 %************************************************************************