[commit: ghc] wip/nfs-locking: Automate dependency analysis of installed packages (#342) (5f0e385)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/5f0e385d4377c5d51997ed3f51340d1405095c5d/ghc

>---------------------------------------------------------------

commit 5f0e385d4377c5d51997ed3f51340d1405095c5d
Author: Zhen Zhang <izgzhen at gmail.com>
Date:   Sat Jul 8 20:35:23 2017 +0800

    Automate dependency analysis of installed packages (#342)


>---------------------------------------------------------------

5f0e385d4377c5d51997ed3f51340d1405095c5d
 src/Oracles/Dependencies.hs | 19 +++++++++++++++++--
 src/Rules.hs                |  1 -
 src/Rules/Install.hs        | 20 +++++++-------------
 3 files changed, 24 insertions(+), 16 deletions(-)

diff --git a/src/Oracles/Dependencies.hs b/src/Oracles/Dependencies.hs
index 2775b3e..447df25 100644
--- a/src/Oracles/Dependencies.hs
+++ b/src/Oracles/Dependencies.hs
@@ -1,7 +1,7 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
 module Oracles.Dependencies (
     fileDependencies, contextDependencies, needContext, dependenciesOracles,
-    pkgDependencies
+    pkgDependencies, sortPkgsByDep
     ) where
 
 import qualified Data.HashMap.Strict as Map
@@ -81,3 +81,18 @@ dependenciesOracles = do
         putLoud $ "Reading dependencies from " ++ file ++ "..."
         contents <- map words <$> readFileLines file
         return $ Map.fromList [ (key, values) | (key:values) <- contents ]
+
+-- | Sort packages by their dependency
+-- HACK (izgzhen): See https://github.com/snowleopard/hadrian/issues/344 for details
+sortPkgsByDep :: [Package] -> Action [Package]
+sortPkgsByDep pkgs = do
+    elems <- mapM (\p -> (p,) <$> pkgDependencies p) pkgs
+    return $ map fst $ topSort elems
+  where
+    annotateInDeg es e =
+     (foldr (\e' s -> if fst e' `elem` snd e then s + 1 else s) 0 es, e)
+    topSort [] = []
+    topSort es =
+      let annotated = map (annotateInDeg es) es
+          inDegZero = map snd $ filter ((== 0). fst) annotated
+      in  inDegZero ++ topSort (es \\ inDegZero)
diff --git a/src/Rules.hs b/src/Rules.hs
index 3ba6ba7..2081585 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -19,7 +19,6 @@ import qualified Rules.Perl
 import qualified Rules.Program
 import qualified Rules.Register
 import Oracles.Dependencies (needContext)
-import Util (needBuilder)
 import Settings
 import Settings.Path
 
diff --git a/src/Rules/Install.hs b/src/Rules/Install.hs
index 0492a62..8530f50 100644
--- a/src/Rules/Install.hs
+++ b/src/Rules/Install.hs
@@ -15,7 +15,7 @@ import Rules.Libffi
 import Rules.Generate
 import Settings.Packages.Rts
 import Oracles.Config.Setting
-import Oracles.PackageData
+import Oracles.Dependencies (sortPkgsByDep)
 import Oracles.Path
 
 import qualified System.Directory as IO
@@ -81,7 +81,6 @@ installLibExecs = do
                          (destDir ++ libExecDir -/- "ghc" <.> exe)
 
 -- | Binaries to install
--- TODO: Consider Stage1Only
 installBinPkgs :: [Package]
 installBinPkgs =
     [ ghc, ghcPkg, ghcSplit, hp2ps
@@ -176,14 +175,10 @@ installPackages = do
 
     copyFile ghcBootPlatformHeader (pkgPath compiler -/- "ghc_boot_platform.h")
 
-    -- TODO: Consider Stage1Only
-    -- TODO: Use automatic dependency analysis, rather than hardcoding
-    -- the ordering
-    let installLibPkgs = [ ghcPrim, integerSimple, base, filepath
-                         , array, deepseq, bytestring, containers, time, unix
-                         , directory, process, hpc, pretty, binary, cabal
-                         , ghcBootTh, ghcBoot, templateHaskell
-                         , transformers, terminfo, haskeline, ghci, compiler ]
+    activePackages <- filterM ((isJust <$>) . latestBuildStage)
+                              (knownPackages \\ [rts, libffi])
+
+    installLibPkgs <- sortPkgsByDep (filter isLibrary activePackages)
 
     forM_ installLibPkgs $ \pkg at Package{..} -> do
         when (isLibrary pkg) $
@@ -194,10 +189,9 @@ installPackages = do
                 buildPackage stg pkg
                 docDir <- installDocDir
                 ghclibDir <- installGhcLibDir
-                version <- interpretInContext context (getPkgData Version)
+
                 -- Copy over packages
-                let targetDest = destDir ++ ghclibDir -/-
-                                 pkgNameString pkg ++ "-" ++ version
+
                 strip <- stripCmdPath context
                 ways <- interpretInContext context getLibraryWays
                 let ghcCabalInplace = inplaceBinPath -/- "ghc-cabal" -- HACK?