driver: Make object merging optional

On Windows we don't have a linker which supports object joining (i.e.
the `-r` flag). Consequently, `-pgmlm` is now a `Maybe`.

See #21068.

5 files changed, 18 insertions, 7 deletions

diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 55a1573d92..c6fcce9e4c 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -1153,7 +1153,7 @@ joinObjectFiles hsc_env o_files output_fn
   withAtomicRename output_fn $ \tmp_ar ->
       liftIO $ runAr logger dflags Nothing $ map Option $ ["rc", tmp_ar] ++ o_files
   where
-    can_merge_objs = False -- XXX
+    can_merge_objs = isJust (pgm_lm (hsc_dflags hsc_env))
     dflags = hsc_dflags hsc_env
     tmpfs = hsc_tmpfs hsc_env
     logger = hsc_logger hsc_env
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 0be53034f3..17090615f8 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -821,7 +821,7 @@ pgm_a                 :: DynFlags -> (String,[Option])
 pgm_a dflags = toolSettings_pgm_a $ toolSettings dflags
 pgm_l                 :: DynFlags -> (String,[Option])
 pgm_l dflags = toolSettings_pgm_l $ toolSettings dflags
-pgm_lm                 :: DynFlags -> (String,[Option])
+pgm_lm                 :: DynFlags -> Maybe (String,[Option])
 pgm_lm dflags = toolSettings_pgm_lm $ toolSettings dflags
 pgm_dll               :: DynFlags -> (String,[Option])
 pgm_dll dflags = toolSettings_pgm_dll $ toolSettings dflags
@@ -2108,7 +2108,8 @@ dynamic_flags_deps = [
   , make_ord_flag defFlag "pgmlc"
       $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lc  = (f,[]) }
   , make_ord_flag defFlag "pgmlm"
-      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lm  = (f,[]) }
+      $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_lm  =
+          if null f then Nothing else Just (f,[]) }
   , make_ord_flag defFlag "pgmi"
       $ hasArg $ \f -> alterToolSettings $ \s -> s { toolSettings_pgm_i   =  f }
   , make_ord_flag defFlag "pgmL"
diff --git a/compiler/GHC/Settings.hs b/compiler/GHC/Settings.hs
index 679d0266fe..d67e632981 100644
--- a/compiler/GHC/Settings.hs
+++ b/compiler/GHC/Settings.hs
@@ -99,7 +99,9 @@ data ToolSettings = ToolSettings
   , toolSettings_pgm_c       :: String
   , toolSettings_pgm_a       :: (String, [Option])
   , toolSettings_pgm_l       :: (String, [Option])
-  , toolSettings_pgm_lm      :: (String, [Option])
+  , toolSettings_pgm_lm      :: Maybe (String, [Option])
+    -- ^ N.B. On Windows we don't have a linker which supports object
+    -- merging, hence the 'Maybe'.
   , toolSettings_pgm_dll     :: (String, [Option])
   , toolSettings_pgm_T       :: String
   , toolSettings_pgm_windres :: String
@@ -207,7 +209,7 @@ sPgm_a :: Settings -> (String, [Option])
 sPgm_a = toolSettings_pgm_a . sToolSettings
 sPgm_l :: Settings -> (String, [Option])
 sPgm_l = toolSettings_pgm_l . sToolSettings
-sPgm_lm :: Settings -> (String, [Option])
+sPgm_lm :: Settings -> Maybe (String, [Option])
 sPgm_lm = toolSettings_pgm_lm . sToolSettings
 sPgm_dll :: Settings -> (String, [Option])
 sPgm_dll = toolSettings_pgm_dll . sToolSettings
diff --git a/compiler/GHC/Settings/IO.hs b/compiler/GHC/Settings/IO.hs
index 7d9be2f403..08e60776a3 100644
--- a/compiler/GHC/Settings/IO.hs
+++ b/compiler/GHC/Settings/IO.hs
@@ -130,6 +130,9 @@ initSettings top_dir = do
         ld_args  = map Option (cc_args ++ words cc_link_args_str)
   ld_r_prog <- getToolSetting "Merge objects command"
   ld_r_args <- getSetting "Merge objects flags"
+  let ld_r
+        | null ld_r_prog = Nothing
+        | otherwise      = Just (ld_r_prog, map Option $ words ld_r_args)
 
   llvmTarget <- getSetting "LLVM target"
 
@@ -171,7 +174,7 @@ initSettings top_dir = do
       , toolSettings_pgm_c   = cc_prog
       , toolSettings_pgm_a   = (as_prog, as_args)
       , toolSettings_pgm_l   = (ld_prog, ld_args)
-      , toolSettings_pgm_lm  = (ld_r_prog, map Option $ words ld_r_args)
+      , toolSettings_pgm_lm  = ld_r
       , toolSettings_pgm_dll = (mkdll_prog,mkdll_args)
       , toolSettings_pgm_T   = touch_path
       , toolSettings_pgm_windres = windres_path
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index 73b3835282..ded526513a 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -29,8 +29,10 @@ import GHC.Utils.Misc
 import GHC.Utils.Logger
 import GHC.Utils.TmpFs
 import GHC.Utils.Constants (isWindowsHost)
+import GHC.Utils.Panic
 
 import Data.List (tails, isPrefixOf)
+import Data.Maybe (fromMaybe)
 import System.IO
 import System.Process
 
@@ -325,7 +327,10 @@ ld: warning: symbol referencing errors
 runMergeObjects :: Logger -> TmpFs -> DynFlags -> [Option] -> IO ()
 runMergeObjects logger tmpfs dflags args =
   traceToolCommand logger "merge-objects" $ do
-    let (p,args0) = pgm_lm dflags
+    let (p,args0) = fromMaybe err (pgm_lm dflags)
+        err = throwGhcException $ UsageError $ unwords
+            [ "Attempted to merge object files but the configured linker"
+            , "does not support object merging." ]
         optl_args = map Option (getOpts dflags opt_lm)
         args2     = args0 ++ args ++ optl_args
     -- N.B. Darwin's ld64 doesn't support response files. Consequently we only