Some more compat fixes

alt-romes · Jan 15, 2024 · 8bc2be5 · 8bc2be5
1 parent 4880c19
commit 8bc2be5
Show file tree

Hide file tree

Showing 3 changed files with 35 additions and 45 deletions.
diff --git a/Cabal/src/Distribution/Simple/GHC/Build.hs b/Cabal/src/Distribution/Simple/GHC/Build.hs
@@ -88,16 +88,20 @@ build numJobs pkg_descr = do
     createDirectoryIfMissingVerbose verbosity True buildTargetDir_absolute
 
   -- See Note [Build Target Dir vs Target Dir] as well
-  targetDir <- makeRelativeToCurrentDirectory targetDir_absolute & liftIO
+  _targetDir <- makeRelativeToCurrentDirectory targetDir_absolute & liftIO
   buildTargetDir <-
+    -- ROMES:TODO: To preserve previous behaviour, we don't use relative dirs
+    -- for executables.  Historically, this isn't needed to reduce the CLI
+    -- limit because we link executables with the module names instead of
+    -- passing the path to object file.
     if isLib
       then makeRelativeToCurrentDirectory buildTargetDir_absolute & liftIO
       else return buildTargetDir_absolute
 
   (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi) & liftIO
 
   let
-    -- wantVanilla is underspecified, maybe we could deprecated it? (TODO)
+    -- wantVanilla seems underspecified, maybe we could deprecated it? (TODO)
     -- wantVanilla vs wantStatic??
     wantVanilla = if isLib then withVanillaLib lbi else False
     wantStatic = if isLib then withStaticLib lbi else withFullyStaticExe lbi
@@ -143,13 +147,13 @@ build numJobs pkg_descr = do
   -- We need a separate build and link phase, and C sources must be compiled
   -- after Haskell modules, because C sources may depend on stub headers
   -- generated from compiling Haskell modules (#842).
-  buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays
-  extraSources <- buildAllExtraSources ghcProg
-  liftIO $ do
-    putStrLn "ROMES:########################"
-    putStrLn "Wanted ways"
-    print wantedWays
-    putStrLn "Extra sources"
-    print extraSources
-    putStrLn "END:ROMES:########################"
-  linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir) (wantedWays, buildOpts)
+  --
+  -- ROMES:TODO: To preserve previous behaviour, we still pass absolute build
+  -- dir to build and extra sources, while passing the relative dir to the
+  -- linker phase. However, linking takes an absolute target dir which used to
+  -- be absolute for the output paths of executables and such.
+  -- We should really fix #9498, then clean this up to always? use the relative dirs.
+  buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays
+  extraSources <- buildAllExtraSources ghcProg buildTargetDir
+  linkOrLoadComponent ghcProg pkg_descr extraSources (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts)
+
diff --git a/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs b/Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs
@@ -21,10 +21,8 @@ import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Program.Types
 import Distribution.System (Arch (JavaScript), Platform (..))
 import Distribution.Types.ComponentLocalBuildInfo
-import Distribution.Types.ComponentName (componentNameRaw)
 import Distribution.Types.Executable
 import Distribution.Verbosity (Verbosity)
-import System.FilePath
 
 import Distribution.Simple.Build.Monad
 
@@ -33,12 +31,13 @@ import Distribution.Simple.Build.Monad
 buildAllExtraSources
   :: ConfiguredProgram
   -- ^ The GHC configured program
+  -> FilePath
+  -- ^ The build directory for this target
   -> BuildM [FilePath]
   -- ^ Returns the list of extra sources that were built
-buildAllExtraSources =
-  fmap concat
-    . sequence
-    . sequence
+buildAllExtraSources ghcProg buildTargetDir =
+  concat <$>
+  traverse (($ buildTargetDir) . ($ ghcProg))
       [ buildCSources
       , buildCxxSources
       , buildJsSources
@@ -53,6 +52,8 @@ buildCSources
   , buildCmmSources
     :: ConfiguredProgram
     -- ^ The GHC configured program
+    -> FilePath
+    -- ^ The build directory for this target
     -> BuildM [FilePath]
     -- ^ Returns the list of extra sources that were built
 buildCSources =
@@ -77,7 +78,7 @@ buildCxxSources =
             CExe exe | isCxx (modulePath exe) -> [modulePath exe]
             _otherwise -> []
     )
-buildJsSources ghcProg = do
+buildJsSources ghcProg buildTargetDir = do
   Platform hostArch _ <- hostPlatform <$> buildLBI
   let hasJsSupport = hostArch == JavaScript
   buildExtraSources
@@ -94,6 +95,7 @@ buildJsSources ghcProg = do
           else mempty
     )
     ghcProg
+    buildTargetDir
 buildAsmSources =
   buildExtraSources
     "Assembler Sources"
@@ -128,9 +130,11 @@ buildExtraSources
   -- if it should be compiled as the rest of them.
   -> ConfiguredProgram
   -- ^ The GHC configured program
+  -> FilePath
+  -- ^ The build directory for this target
   -> BuildM [FilePath]
   -- ^ Returns the list of extra sources that were built
-buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg =
+buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg buildTargetDir =
   BuildM \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} ->
     let
       bi = componentBuildInfo (targetComponent targetInfo)
@@ -153,7 +157,7 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP
                 lbi
                 bi
                 clbi
-                buildDir'
+                buildTargetDir
                 sourceFile
             vanillaSrcOpts
               -- Dynamic GHC requires C sources to be built
@@ -220,16 +224,6 @@ buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcP
             | otherwise ->
                 compileIfNeeded vanillaSrcOpts
 
-      -- Until we get rid of the "exename-tmp" directory within the executable
-      -- build dir, we need to accommodate that fact (see eg @tmpDir@ in @gbuild@)
-      -- This is a workaround for #9498 until it is fixed.
-      cname = componentName (targetComponent targetInfo)
-      buildDir'
-        | CLibName{} <- cname =
-            componentBuildDir lbi clbi
-        | CNotLibName{} <- cname =
-            componentBuildDir lbi clbi
-              </> componentNameRaw cname <> "-tmp"
      in
       -- build any sources
       if (null sources || componentIsIndefinite clbi)

diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs b/Cabal/src/Distribution/Simple/GHC/Build/Modules.hs
@@ -136,10 +136,6 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
         | otherwise = mempty
 
   (inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr
-  liftIO $
-    -- ROMES:TODO: DELETE THIS
-    info verbosity $
-      "ROMES INPUT FILES: " ++ show inputFiles ++ "\nROMES INPUT MODULES: " ++ show inputModules
 
   let
     runGhcProg = runGHC verbosity ghcProg comp platform
@@ -162,17 +158,11 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
           , ghcOptNumJobs = numJobs
           , ghcOptInputModules = toNubListR inputModules
           , ghcOptInputFiles =
-              -- ROMES:TODO: Do we still need to do this? Couldn't the
-              -- inputFiles contain .c files? Or how is that handled by build
-              -- extra C sources? Need to check...
               toNubListR $
                 if PD.package pkg_descr == fakePackageId
                   then filter isHaskell inputFiles
                   else inputFiles
-          , -- ROMES:TODO: We're doing something wrong here, because
-            -- componentInputs doesn't return non-haskell inputFiles.
-            -- Re-think.
-            ghcOptInputScripts =
+          , ghcOptInputScripts =
               toNubListR $
                 if PD.package pkg_descr == fakePackageId
                   then filter (not . isHaskell) inputFiles
@@ -185,10 +175,12 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir wantedWays = do
           then id
           else \x ->
             x
-              { ghcOptHiSuffix = toFlag (buildWayPrefix way ++ "hi")
-              , ghcOptObjSuffix = toFlag (buildWayPrefix way ++ "o")
+              { ghcOptHiSuffix = optSuffixFlag (buildWayPrefix way) "hi"
+              , ghcOptObjSuffix = optSuffixFlag (buildWayPrefix way) "o"
               , ghcOptHPCDir = hpcdir (buildWayHpcWay way)
-              }
+              } where
+          optSuffixFlag "" _ = NoFlag
+          optSuffixFlag pre x = toFlag (pre ++ x)
 
     vanillaOpts = baseOpts VanillaWay