Deprecate -dynamic-too: replace duplicate compilation with symlinks

compiler/GHC/Driver/Main.hs

@@ -1389,21 +1389,18 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
 
     if (write_interface || force_write_interface) then do
 
-      -- FIXME: with -dynamic-too, "change" is only meaningful for the
-      -- non-dynamic interface, not for the dynamic one. We should have another
-      -- flag for the dynamic interface. In the meantime:
-      --
-      --    * when we write a single full interface, we check if we are
-      --    currently writing the dynamic interface due to -dynamic-too, in
-      --    which case we ignore "change".
-      --
-      --    * when we write two simple interfaces at once because of
-      --    dynamic-too, we use "change" both for the non-dynamic and the
-      --    dynamic interfaces. Hopefully both the dynamic and the non-dynamic
-      --    interfaces stay in sync...
-      --
       let change = old_iface /= Just (mi_iface_hash iface)
 
+      -- Create a relative symlink from .dyn_hi -> .hi.
+      -- Used when -dynamic-too is active (deprecated).
+      let symlink_dyn_hi = do
+            let hi_file     = ml_hi_file mod_location
+                dyn_hi_file = ml_dyn_hi_file mod_location
+                rel_hi      = FilePath.takeFileName hi_file
+            exists <- doesPathExist dyn_hi_file
+            when exists $ removeFile dyn_hi_file
+            createFileLink rel_hi dyn_hi_file
+
       let dt = dynamicTooState dflags
 
       when (logHasDumpFlag logger Opt_D_dump_if_trace) $ putMsg logger $
@@ -1414,16 +1411,20 @@ hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
          ]
 
       if is_simple
-         then when change $ do -- FIXME: see 'change' comment above
+         then when change $ do
             write_iface dflags iface
             case dt of
                DT_Dont   -> return ()
                DT_Dyn    -> panic "Unexpected DT_Dyn state when writing simple interface"
-               DT_OK     -> write_iface (setDynamicNow dflags) iface
+               -- -dynamic-too is deprecated: create a symlink .dyn_hi -> .hi
+               -- instead of writing a second copy of the interface file.
+               DT_OK     -> symlink_dyn_hi
          else case dt of
                DT_Dont | change                    -> write_iface dflags iface
-               DT_OK   | change                    -> write_iface dflags iface
-               -- FIXME: see change' comment above
+               DT_OK   | change                    -> do
+                  write_iface dflags iface
+                  -- -dynamic-too is deprecated: create .dyn_hi -> .hi symlink
+                  symlink_dyn_hi
                DT_Dyn                              -> write_iface dflags iface
                _                                   -> return ()
 

compiler/GHC/Driver/Pipeline.hs

@@ -787,23 +787,33 @@ hscBackendPipeline pipe_env hsc_env mod_sum result =
   if backendGeneratesCode (backend (hsc_dflags hsc_env)) then
     do
       res <- hscGenBackendPipeline pipe_env hsc_env mod_sum result
-      -- Only run dynamic-too if the backend generates object files
-      -- See Note [Writing interface files]
-      -- If we are writing a simple interface (not . backendWritesFiles), then
-      -- hscMaybeWriteIface in the regular pipeline will write both the hi and
-      -- dyn_hi files. This way we can avoid running the pipeline twice and
-      -- generating a duplicate linkable.
-      -- We must not run the backend a second time with `dynamicNow` enable because
-      -- all the work has already been done in the first pipeline.
-      when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env) && backendWritesFiles (backend (hsc_dflags hsc_env)) ) $ do
-          let dflags' = setDynamicNow (hsc_dflags hsc_env) -- set "dynamicNow"
-          () <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result
+      -- -dynamic-too is deprecated: instead of running the backend a second
+      -- time to produce .dyn_o files, we create a symlink .dyn_o -> .o
+      -- since all object files are now dynamic-capable.
+      when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env) && backendWritesFiles (backend (hsc_dflags hsc_env)) ) $ liftIO $ do
+          let location = ms_location mod_sum
+              obj_fn     = ml_obj_file location
+              dyn_obj_fn = ml_dyn_obj_file location
+          createOrUpdateSymlink obj_fn dyn_obj_fn
       return res
   else
     case result of
       HscUpdate iface ->  return (iface, emptyHomeModInfoLinkable)
       HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing Nothing NoStubs []) <*> pure emptyHomeModInfoLinkable
 
+-- | Create a symlink from @link@ pointing to @source@, removing any
+-- existing file or symlink at @link@ first. Used by the deprecated
+-- -dynamic-too path to create .dyn_o -> .o and .dyn_hi -> .hi symlinks.
+createOrUpdateSymlink :: FilePath -> FilePath -> IO ()
+createOrUpdateSymlink source link = do
+  -- Use the basename of source so the symlink is relative
+  -- (both files live in the same directory).
+  let relSource = takeFileName source
+  -- doesPathExist detects files, directories, and symlinks (including broken ones)
+  exists <- doesPathExist link
+  when exists $ removeFile link
+  createFileLink relSource link
+
 hscGenBackendPipeline :: P m
   => PipeEnv
   -> HscEnv

compiler/GHC/Driver/Session.hs

@@ -1325,8 +1325,9 @@ dynamic_flags_deps = [
   , make_ord_flag defGhcFlag "ddump-file-prefix"
         (hasArg (setDumpPrefixForce . Just . flip (++) "."))
 
-  , make_ord_flag defGhcFlag "dynamic-too"
+  , make_dep_flag defGhcFlag "dynamic-too"
         (NoArg (setGeneralFlag Opt_BuildDynamicToo))
+        "-dynamic-too is deprecated. All object files are now dynamic-capable; .dyn_o/.dyn_hi are created as symlinks."
 
         ------- Keeping temporary files -------------------------------------
      -- These can be singular (think ghc -c) or plural (think ghc --make)

compiler/GHC/Linker/Deps.hs

@@ -244,9 +244,12 @@ checkNonStdWay _opts interp _srcspan
   -- -dynamic-too)
   | ldForceDyn _opts = do
       let target_ways = fullWays $ ldWays _opts
-      pure $ if target_ways `hasWay` WayDyn
+      -- Ignore WayDyn: since -dynamic-too is deprecated, .dyn_o files are
+      -- symlinks to .o files. Use the plain .o suffix.
+      let non_dyn_ways = removeWay WayDyn target_ways
+      pure $ if null (waysTag non_dyn_ways)
         then Nothing
-        else Just $ waysTag (WayDyn `addWay` target_ways) ++ "_o"
+        else Just $ waysTag non_dyn_ways ++ "_o"
 
   | ExternalInterp {} <- interpInstance interp = return Nothing
     -- with -fexternal-interpreter we load the .o files, whatever way
@@ -257,17 +260,21 @@ checkNonStdWay _opts interp _srcspan
 -- complain that they are redundant.
 #if defined(HAVE_INTERNAL_INTERPRETER)
 checkNonStdWay opts _interp srcspan
-  | hostFullWays == targetFullWays = return Nothing
+  -- Ignore WayDyn when comparing host and target ways: since -dynamic-too
+  -- is deprecated, WayDyn no longer affects object file suffixes.
+  | removeWay WayDyn hostFullWays == removeWay WayDyn targetFullWays
+  = return Nothing
     -- Only if we are compiling with the same ways as GHC is built
     -- with, can we dynamically load those object files. (see #3604)
 
-  | ldObjSuffix opts == normalObjectSuffix && not (null targetFullWays)
+  | ldObjSuffix opts == normalObjectSuffix && not (null targetNonDynWays)
   = failNonStd opts srcspan
 
   | otherwise = return (Just (hostWayTag ++ "o"))
   where
     targetFullWays = fullWays (ldWays opts)
-    hostWayTag = case waysTag hostFullWays of
+    targetNonDynWays = waysTag (removeWay WayDyn targetFullWays)
+    hostWayTag = case waysTag (removeWay WayDyn hostFullWays) of
                   "" -> ""
                   tag -> tag ++ "_"
 

compiler/GHC/Platform/Profile.hs

@@ -50,4 +50,8 @@ profileBuildTag profile
   | otherwise                       =     wayTag
   where
    platform = profilePlatform profile
-   wayTag   = waysBuildTag (profileWays profile)
+   -- Ignore WayDyn: since -dynamic-too is deprecated and .dyn_hi/.dyn_o are
+   -- now symlinks to .hi/.o, the interface file profile tag must be consistent
+   -- regardless of whether -dynamic is active. Only non-dynamic ways (e.g.
+   -- profiling) contribute to the build tag.
+   wayTag   = waysBuildTag (removeWay WayDyn (profileWays profile))