diff --git a/hadrian/src/Base.hs b/hadrian/src/Base.hs
index e135d355e03f857adf62f8dea6fa25e3b81d2ea1..9000c114426561da642611ca8ba76d47fea66932 100644
--- a/hadrian/src/Base.hs
+++ b/hadrian/src/Base.hs
@@ -32,7 +32,7 @@ module Base (
     hadrianPath, configPath, configFile, sourcePath, shakeFilesDir,
     stageBinPath, stageLibPath, templateHscPath,
     buildTargetFile, hostTargetFile, targetTargetFile,
-    ghcBinDeps, ghcLibDeps, haddockDeps,
+    ghcLibDeps, haddockDeps,
     relativePackageDbPath, packageDbPath, packageDbStamp, mingwStamp,
     systemCxxStdLibConf, systemCxxStdLibConfPath
     , PackageDbLoc(..), Inplace(..)
@@ -151,17 +151,12 @@ ghcLibDeps stage iplace = do
         , "llvm-passes"
         , "ghc-interp.js"
         , "settings"
+        , "ghc-usage.txt"
+        , "ghci-usage.txt"
         ]
     cxxStdLib <- systemCxxStdLibConfPath (PackageDbLoc stage iplace)
     return (cxxStdLib : ps)
 
--- | Files the GHC binary depends on.
-ghcBinDeps :: Stage -> Action [FilePath]
-ghcBinDeps stage = mapM (\f -> stageLibPath stage <&> (-/- f))
-    [ "ghc-usage.txt"
-    , "ghci-usage.txt"
-    ]
-
 -- | Files the `haddock` binary depends on
 haddockDeps :: Stage -> Action [FilePath]
 haddockDeps stage = do
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index a97a9033b117ad5e1436be6b1a9d7fc97dc097a9..87171c960977c13344520007e788e0022b20b5ed 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -238,17 +238,12 @@ instance H.Builder Builder where
           -- changes (#18001).
           _bootGhcVersion <- setting GhcVersion
           pure []
-        Ghc _ stage -> do
+        Ghc {} -> do
             root <- buildRoot
             touchyPath <- programPath (vanillaContext (Stage0 InTreeLibs) touchy)
             unlitPath  <- builderPath Unlit
 
-            -- GHC from the previous stage is used to build artifacts in the
-            -- current stage. Need the previous stage's GHC deps.
-            ghcdeps <- ghcBinDeps (predStage stage)
-
             return $ [ unlitPath ]
-                  ++ ghcdeps
                   ++ [ touchyPath          | windowsHost ]
                   ++ [ root -/- mingwStamp | windowsHost ]
                      -- proxy for the entire mingw toolchain that
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
index 09965ee64ce4163cc1a5ebe6a1acab14af352e9d..3c5e9f00d4618277650dfe3ede8b75c3352b09b6 100644
--- a/hadrian/src/Rules/Program.hs
+++ b/hadrian/src/Rules/Program.hs
@@ -85,8 +85,6 @@ buildProgram bin ctx@(Context{..}) rs = do
     need [template]
   -- Custom dependencies: this should be modeled better in the
   -- Cabal file somehow.
-  when (package == ghc) $ do
-    need =<< ghcBinDeps stage
   when (package == haddock) $ do
     -- Haddock has a resource folder
     need =<< haddockDeps stage