[Git][ghc/ghc][wip/romes/better-main] driver: Move DynFlags consistency fixes off Main

[Rodrigo Mesquita (@alt-romes)]

Rodrigo Mesquita pushed to branch wip/romes/better-main at Glasgow Haskell Compiler / GHC


Commits:
7c6595fb by Rodrigo Mesquita at 2025-03-10T10:03:45+00:00
driver: Move DynFlags consistency fixes off Main

These consistency fixes found in Main.hs are required for the proper
functioning of the compiler and should live together with all remaining
fixes in `makeDynFlagsConsistent`.

This is especially relevant to GHC applications that shouldn't have to
copy/fix themselves possibly inconsistent DynFlags.

- - - - -


2 changed files:

- compiler/GHC/Driver/Session.hs
- ghc/Main.hs


Changes:

=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3587,7 +3587,38 @@ makeDynFlagsConsistent dflags
 
  | LinkMergedObj <- ghcLink dflags
  , Nothing <- outputFile dflags
- = pgmError "--output must be specified when using --merge-objs"
+    = pgmError "--output must be specified when using --merge-objs"
+
+#if MIN_VERSION_GLASGOW_HASKELL(9,13,0,0)
+  -- When we do ghci, force using dyn ways if the target RTS linker
+  -- only supports dynamic code
+ | LinkInMemory <- ghcLink dflags
+ , sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags
+ , not (dynamicNow dflags) || not (gopt Opt_ExternalInterpreter dflags)
+    = flip loop "Forcing dyn ways, because doing GHCi and target RTS linker only supports dynamic code" $
+        setDynamicNow $
+        -- See checkOptions below, -fexternal-interpreter is
+        -- required when using --interactive with a non-standard
+        -- way (-prof, -static, or -dynamic).
+        setGeneralFlag' Opt_ExternalInterpreter $
+        -- Use .o for dynamic object, otherwise it gets dropped
+        -- with "Warning: ignoring unrecognised input", see
+        -- objish_suffixes
+        dflags { dynObjectSuf_ = objectSuf dflags }
+#endif
+
+ | backendNeedsFullWays (backend dflags)
+ , not (gopt Opt_ExternalInterpreter dflags)
+ , targetWays_ dflags /= hostFullWays
+    = flip loop "Enabling options for all ways, required by the backend" $
+        let dflags_a = dflags { targetWays_ = hostFullWays }
+            dflags_b = foldl gopt_set dflags_a
+                     $ concatMap (wayGeneralFlags platform)
+                                 hostFullWays
+            dflags_c = foldl gopt_unset dflags_b
+                     $ concatMap (wayUnsetGeneralFlags platform)
+                                 hostFullWays
+        in dflags_c
 
  | otherwise = (dflags, mempty)
     where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")


=====================================
ghc/Main.hs
=====================================
@@ -224,41 +224,9 @@ main' postLoadMode units dflags0 args flagWarnings = do
 
         -- The rest of the arguments are "dynamic"
         -- Leftover ones are presumably files
-  (dflags3', fileish_args, dynamicFlagWarnings) <-
+  (dflags4, fileish_args, dynamicFlagWarnings) <-
       GHC.parseDynamicFlags logger2 dflags2 args'
 
-  -- When we do ghci, force using dyn ways if the target RTS linker
-  -- only supports dynamic code
-  let dflags3
-        | LinkInMemory <- link,
-          sTargetRTSLinkerOnlySupportsSharedLibs $ settings dflags3'
-            = setDynamicNow $
-              -- See checkOptions below, -fexternal-interpreter is
-              -- required when using --interactive with a non-standard
-              -- way (-prof, -static, or -dynamic).
-              setGeneralFlag' Opt_ExternalInterpreter $
-              -- Use .o for dynamic object, otherwise it gets dropped
-              -- with "Warning: ignoring unrecognised input", see
-              -- objish_suffixes
-              dflags3' { dynObjectSuf_ = objectSuf dflags3' }
-        | otherwise
-            = dflags3'
-
-  let dflags4 = if backendNeedsFullWays bcknd &&
-                   not (gopt Opt_ExternalInterpreter dflags3)
-                then
-                    let platform = targetPlatform dflags3
-                        dflags3a = dflags3 { targetWays_ = hostFullWays }
-                        dflags3b = foldl gopt_set dflags3a
-                                 $ concatMap (wayGeneralFlags platform)
-                                             hostFullWays
-                        dflags3c = foldl gopt_unset dflags3b
-                                 $ concatMap (wayUnsetGeneralFlags platform)
-                                             hostFullWays
-                    in dflags3c
-                else
-                    dflags3
-
   let logger4 = setLogFlags logger2 (initLogFlags dflags4)
 
   GHC.prettyPrintGhcErrors logger4 $ do



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c6595fbb2b897ef698fa140566bb73e2e091db4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c6595fbb2b897ef698fa140566bb73e2e091db4
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250310/145be931/attachment-0001.html>