Add defGHCConfOptions option

haskell · Mar 31, 2024 · 243b200 · 243b200
1 parent 700cf74
commit 243b200
Show file tree

Hide file tree

Showing 6 changed files with 77 additions and 30 deletions.
diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs
@@ -90,6 +90,7 @@ toSettings options = do
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
          platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
          mirrors  = fromMaybe (Types.mirrors defaultSettings) uMirrors
+         defGHCConfOptions  = fromMaybe (Types.defGHCConfOptions defaultSettings) uDefGHCConfOptions
      in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
    defaultDownloader = Internal

diff --git a/data/config.yaml b/data/config.yaml
@@ -128,3 +128,12 @@ mirrors:
     authority:
       host: "mirror.sjtu.edu.cn"
 
+# Arguments to pass to the configure script of the prebuilt bindist.
+#
+# Do not pass '--prefix' here.
+#
+# GHCup by default passes '--disable-ld-override', so if you want to enable
+# the vanilla way, which aggressively favors 'ld.gold' linker, add the following:
+def-ghc-conf-options:
+  - "--enable-ld-override"
+
diff --git a/docs/guide.md b/docs/guide.md
@@ -360,6 +360,28 @@ mirrors:
 
 The configuration depends on the host of the mirror and they have to provide the correct configuration.
 
+## Linkers
+
+The GHC bindist configure script by default doesn't honour the system `ld` that is set, but instead
+probes for `ld.lld`, `ld.gold` and only then `ld` in order, see
+[find_ld.m4](https://gitlab.haskell.org/ghc/ghc/-/blob/master/m4/find_ld.m4?ref_type=heads).
+
+This is controlled by the configure switch `--enable-ld-override`/`--disable-ld-override`, which is enabled by default in GHC.
+GHCup however [has decided](https://github.com/haskell/ghcup-hs/issues/1032) **to disable this switch by default**,
+for reasons of stability and simplicity.
+
+That means, when `--disable-ld-override` is passed, the linker is picked simply by:
+
+* checking if `LD` env var is set, then use whatever is specified
+* otherwise use `ld` binary in PATH (system/distro default)
+
+You can restore the GHC vanilla default by adding this to your `~/.ghcup/config.yaml`:
+
+```yaml
+def-ghc-conf-options:
+  - "--enable-ld-override"
+```
+
 # More on installation
 
 ## Customisation of the installation scripts

diff --git a/lib-opt/GHCup/OptParse/Config.hs b/lib-opt/GHCup/OptParse/Config.hs
@@ -133,7 +133,8 @@ updateSettings usl usr =
        gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
        platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
        mirrors' = uMirrors usl <|> uMirrors usr
-   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
+       defGHCconfOptions' = uDefGHCConfOptions usl <|> uDefGHCConfOptions usr
+   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors' defGHCconfOptions'
  where
   updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
   updateKeyBindings Nothing Nothing = Nothing

diff --git a/lib/GHCup/GHC.hs b/lib/GHCup/GHC.hs
@@ -439,13 +439,18 @@ installUnpackedGHC path inst tver forceInstall addConfArgs
       liftE $ mergeGHCFileTree path inst tver forceInstall
   | otherwise = do
       PlatformRequest {..} <- lift getPlatformReq
+      Settings {..} <- lift getSettings
+
+      addConfArgs' <- sanitizefGHCconfOptions (T.unpack <$> addConfArgs)
+      defGHCConfOptions' <- sanitizefGHCconfOptions defGHCConfOptions
 
       lift $ logInfo "Installing GHC (this may take a while)"
       lEM $ execLogged "sh"
                        ("./configure" : ("--prefix=" <> fromInstallDir inst)
                         : (maybe mempty (\x -> ["--target=" <> T.unpack x]) (_tvTarget tver)
                           <> ldOverride (_tvVersion tver)
-                          <> (T.unpack <$> addConfArgs))
+                          <> defGHCConfOptions'
+                          <> addConfArgs')
                        )
                        (Just $ fromGHCupPath path)
                        "ghc-configure"
@@ -1376,3 +1381,8 @@ ldOverride ver
   | otherwise
   = []
 
+sanitizefGHCconfOptions :: MonadFail m => [String] -> m [String]
+sanitizefGHCconfOptions args
+  | "--prefix" `elem` fmap (takeWhile (/= '=')) args = fail "Don't explicitly set --prefix ...aborting"
+  | otherwise = pure args
+
diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs
@@ -379,24 +379,25 @@ data MetaMode = Strict
 instance NFData MetaMode
 
 data UserSettings = UserSettings
-  { uCache       :: Maybe Bool
-  , uMetaCache   :: Maybe Integer
-  , uMetaMode    :: Maybe MetaMode
-  , uNoVerify    :: Maybe Bool
-  , uVerbose     :: Maybe Bool
-  , uKeepDirs    :: Maybe KeepDirs
-  , uDownloader  :: Maybe Downloader
-  , uKeyBindings :: Maybe UserKeyBindings
-  , uUrlSource   :: Maybe URLSource
-  , uNoNetwork   :: Maybe Bool
-  , uGPGSetting  :: Maybe GPGSetting
-  , uPlatformOverride :: Maybe PlatformRequest
-  , uMirrors     :: Maybe DownloadMirrors
+  { uCache             :: Maybe Bool
+  , uMetaCache         :: Maybe Integer
+  , uMetaMode          :: Maybe MetaMode
+  , uNoVerify          :: Maybe Bool
+  , uVerbose           :: Maybe Bool
+  , uKeepDirs          :: Maybe KeepDirs
+  , uDownloader        :: Maybe Downloader
+  , uKeyBindings       :: Maybe UserKeyBindings
+  , uUrlSource         :: Maybe URLSource
+  , uNoNetwork         :: Maybe Bool
+  , uGPGSetting        :: Maybe GPGSetting
+  , uPlatformOverride  :: Maybe PlatformRequest
+  , uMirrors           :: Maybe DownloadMirrors
+  , uDefGHCConfOptions :: Maybe [String]
   }
   deriving (Show, GHC.Generic, Eq)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
@@ -414,6 +415,7 @@ fromSettings Settings{..} Nothing =
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
     , uMirrors = Just mirrors
+    , uDefGHCConfOptions = Just defGHCConfOptions
   }
 fromSettings Settings{..} (Just KeyBindings{..}) =
   let ukb = UserKeyBindings
@@ -440,6 +442,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
     , uMirrors = Just mirrors
+    , uDefGHCConfOptions = Just defGHCConfOptions
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -512,27 +515,28 @@ instance NFData LeanAppState
 
 
 data Settings = Settings
-  { cache            :: Bool
-  , metaCache        :: Integer
-  , metaMode         :: MetaMode
-  , noVerify         :: Bool
-  , keepDirs         :: KeepDirs
-  , downloader       :: Downloader
-  , verbose          :: Bool
-  , urlSource        :: URLSource
-  , noNetwork        :: Bool
-  , gpgSetting       :: GPGSetting
-  , noColor          :: Bool -- this also exists in LoggerConfig
-  , platformOverride :: Maybe PlatformRequest
-  , mirrors          :: DownloadMirrors
+  { cache             :: Bool
+  , metaCache         :: Integer
+  , metaMode          :: MetaMode
+  , noVerify          :: Bool
+  , keepDirs          :: KeepDirs
+  , downloader        :: Downloader
+  , verbose           :: Bool
+  , urlSource         :: URLSource
+  , noNetwork         :: Bool
+  , gpgSetting        :: GPGSetting
+  , noColor           :: Bool -- this also exists in LoggerConfig
+  , platformOverride  :: Maybe PlatformRequest
+  , mirrors           :: DownloadMirrors
+  , defGHCConfOptions :: [String]
   }
   deriving (Show, GHC.Generic)
 
 defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty) []
 
 instance NFData Settings