Refactor Libffi and RTS rules

This removes a hack that copies libffi files to the rts
build directory. This was done in a libffi rule, but now
an rts rule correctly needs and copies the relevant
files from the libffi build dir to the rts build dir.

Issues: #16272 #16304

1 files changed, 76 insertions, 98 deletions

diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
index ddc739d735..b185d9a601 100644
--- a/hadrian/src/Rules/Libffi.hs
+++ b/hadrian/src/Rules/Libffi.hs
@@ -1,4 +1,10 @@
-module Rules.Libffi (libffiRules, libffiDependencies, libffiName) where
+{-# LANGUAGE TypeFamilies #-}
+
+module Rules.Libffi (
+    LibffiDynLibs(..),
+    needLibffi, askLibffilDynLibs, libffiRules, libffiLibrary, libffiHeaderFiles,
+    libffiHeaders, libffiSystemHeaders, libffiName
+    ) where
 
 import Hadrian.Utilities
 
@@ -7,26 +13,33 @@ import Settings.Builders.Common
 import Target
 import Utilities
 
-{-
-Note [Hadrian: install libffi hack]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- | Oracle question type. The oracle returns the list of dynamic
+-- libffi library file paths (all but one of which should be symlinks).
+newtype LibffiDynLibs = LibffiDynLibs Stage
+        deriving (Eq, Show, Hashable, Binary, NFData)
+type instance RuleResult LibffiDynLibs = [FilePath]
+
+askLibffilDynLibs :: Stage -> Action [FilePath]
+askLibffilDynLibs stage = askOracle (LibffiDynLibs stage)
 
-There are 2 important steps in handling libffi's .a and .so files:
+-- | The path to the dynamic library manifest file. The file contains all file
+-- paths to libffi dynamic library file paths.
+dynLibManifest' :: Monad m => m FilePath -> Stage -> m FilePath
+dynLibManifest' getRoot stage = do
+    root <- getRoot
+    return $ root -/- stageString stage -/- pkgName libffi -/- ".dynamiclibs"
 
-  1. libffi's .a and .so|.dynlib|.dll files are copied from the libffi build dir
-  to the rts build dir. This is because libffi is ultimately bundled with the
-  rts package. Relevant code is in the libffiRules function.
-  2. The rts is "installed" via the hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
-  copyPackage action. This uses the "cabal copy" command which (among other
-  things) attempts to copy the bundled .a and .so|.dynlib|.dll files from the
-  rts build dir to the install dir.
+dynLibManifestRules :: Stage -> Rules FilePath
+dynLibManifestRules = dynLibManifest' buildRootRules
 
-There is an issue in step 1. that the name of the shared library files is not
-know untill after libffi is built. As a workaround, the rts package needs just
-the libffiDependencies, and the corresponding rule (defined below in
-libffiRules) does the extra work of installing the shared library files into the
-rts build directory after building libffi.
--}
+dynLibManifest :: Stage -> Action FilePath
+dynLibManifest = dynLibManifest' buildRoot
+
+-- | Need the (locally built) libffi library.
+needLibffi :: Stage -> Action ()
+needLibffi stage = do
+    manifest <- dynLibManifest stage
+    need [manifest]
 
 -- | Context for @libffi@.
 libffiContext :: Stage -> Action Context
@@ -51,18 +64,21 @@ libffiName' windows dynamic
     = (if dynamic then "" else "C")
     ++ (if windows then "ffi-6" else "ffi")
 
-libffiDependencies :: [FilePath]
-libffiDependencies = ["ffi.h", "ffitarget.h"]
-
 libffiLibrary :: FilePath
 libffiLibrary = "inst/lib/libffi.a"
 
-rtsLibffiLibrary :: Stage -> Way -> Action FilePath
-rtsLibffiLibrary stage way = do
-    name    <- libffiLibraryName
-    suf     <- libsuf stage way
-    rtsPath <- rtsBuildPath stage
-    return $ rtsPath -/- "lib" ++ name ++ suf
+libffiHeaderFiles :: [FilePath]
+libffiHeaderFiles = ["ffi.h", "ffitarget.h"]
+
+libffiHeaders :: Stage -> Action [FilePath]
+libffiHeaders stage = do
+    path <- libffiBuildPath stage
+    return $ fmap ((path -/- "inst/include") -/-) libffiHeaderFiles
+
+libffiSystemHeaders :: Action [FilePath]
+libffiSystemHeaders = do
+    ffiIncludeDir <- setting FfiIncludeDir
+    return $ fmap (ffiIncludeDir -/-) libffiHeaderFiles
 
 fixLibffiMakefile :: FilePath -> String -> String
 fixLibffiMakefile top =
@@ -88,84 +104,46 @@ configureEnvironment stage = do
              , return . AddEnv "LDFLAGS" $ unwords ldFlags ++ " -w" ]
 
 libffiRules :: Rules ()
-libffiRules = forM_ [Stage1 ..] $ \stage -> do
+libffiRules = do
+  _ <- addOracleCache $ \ (LibffiDynLibs stage)
+                         -> readFileLines =<< dynLibManifest stage
+  forM_ [Stage1 ..] $ \stage -> do
     root <- buildRootRules
     let path       = root -/- stageString stage
         libffiPath = path -/- pkgName libffi -/- "build"
-        libffiOuts = [libffiPath -/- libffiLibrary] ++
-                     fmap ((path -/- "rts/build") -/-) libffiDependencies
 
     -- We set a higher priority because this rule overlaps with the build rule
     -- for static libraries 'Rules.Library.libraryRules'.
-    -- See [Hadrian: install libffi hack], this rule installs libffi into the
-    -- rts build path.
-    priority 2.0 $ libffiOuts &%> \_ -> do
+    dynLibMan <- dynLibManifestRules stage
+    let topLevelTargets =  [ libffiPath -/- libffiLibrary
+                           , dynLibMan
+                           ]
+    priority 2 $ topLevelTargets &%> \_ -> do
         context <- libffiContext stage
-        useSystemFfi <- flag UseSystemFfi
-        rtsPath      <- rtsBuildPath stage
-        if useSystemFfi
-        then do
-            ffiIncludeDir <- setting FfiIncludeDir
-            putBuild "| System supplied FFI library will be used"
-            forM_ ["ffi.h", "ffitarget.h"] $ \file ->
-                copyFile (ffiIncludeDir -/- file) (rtsPath -/- file)
-            putSuccess "| Successfully copied system FFI library header files"
-        else do
-            build $ target context (Make libffiPath) [] []
-
-            -- Here we produce 'libffiDependencies'
-            headers <- liftIO $ getDirectoryFilesIO libffiPath ["inst/include/*"]
-            forM_ headers $ \header -> do
-                let target = rtsPath -/- takeFileName header
-                copyFileUntracked (libffiPath -/- header) target
-                produces [target]
-
-            -- Find ways.
-            ways <- interpretInContext context
-                                       (getLibraryWays <> getRtsWays)
-            let (dynamicWays, staticWays) = partition (wayUnit Dynamic) ways
-
-            -- Install static libraries.
-            forM_ staticWays $ \way -> do
-                rtsLib <- rtsLibffiLibrary stage way
-                copyFileUntracked (libffiPath -/- "inst/lib/libffi.a") rtsLib
-                produces [rtsLib]
-
-            -- Install dynamic libraries.
-            when (not $ null dynamicWays) $ do
-                -- Find dynamic libraries.
-                windows <- windowsHost
-                osx     <- osxHost
-                let libffiName'' = libffiName' windows True
-                (dynLibsSrcDir, dynLibFiles) <- if windows
-                    then do
-                        let libffiDll = "lib" ++ libffiName'' ++ ".dll"
-                        return (libffiPath -/- "inst/bin", [libffiDll])
-                    else do
-                        let libffiLibPath = libffiPath -/- "inst/lib"
-                        dynLibsRelative <- liftIO $ getDirectoryFilesIO
-                            libffiLibPath
-                            (if osx
-                                then ["lib" ++ libffiName'' ++ ".dylib*"]
-                                else ["lib" ++ libffiName'' ++ ".so*"])
-                        return (libffiLibPath, dynLibsRelative)
-
-                -- Install dynamic libraries.
-                rtsPath <- rtsBuildPath stage
-                forM_ dynLibFiles $ \dynLibFile -> do
-                    let target = rtsPath -/- dynLibFile
-                    copyFileUntracked (dynLibsSrcDir -/- dynLibFile) target
-
-                    -- On OSX the dylib's id must be updated to a relative path.
-                    when osx $ cmd
-                        [ "install_name_tool"
-                        , "-id", "@rpath/" ++ dynLibFile
-                        , target
-                        ]
-
-                    produces [target]
-
-            putSuccess "| Successfully bundled custom library 'libffi' with rts"
+
+        -- Note this build needs the Makefile, triggering the rules bellow.
+        build $ target context (Make libffiPath) [] []
+
+        -- Find dynamic libraries.
+        dynLibFiles <- do
+            windows <- windowsHost
+            osx     <- osxHost
+            let libffiName'' = libffiName' windows True
+            if windows
+                then
+                    let libffiDll = "lib" ++ libffiName'' ++ ".dll"
+                    in return [libffiPath -/- "inst/bin" -/- libffiDll]
+                else do
+                    let libffiLibPath = libffiPath -/- "inst/lib"
+                    dynLibsRelative <- liftIO $ getDirectoryFilesIO
+                        libffiLibPath
+                        (if osx
+                            then ["lib" ++ libffiName'' ++ ".dylib*"]
+                            else ["lib" ++ libffiName'' ++ ".so*"])
+                    return (fmap (libffiLibPath -/-) dynLibsRelative)
+
+        writeFileLines dynLibMan dynLibFiles
+        putSuccess "| Successfully build libffi."
 
     fmap (libffiPath -/-) ["Makefile.in", "configure" ] &%> \[mkIn, _] -> do
         -- Extract libffi tar file