[Git][ghc/ghc][wip/T26925] WIP

24 Feb 2026


      Teo Camarasu pushed to branch wip/T26925 at Glasgow Haskell Compiler / GHC


Commits:
15cd0aaa by Teo Camarasu at 2026-02-24T18:31:59+00:00
WIP

- - - - -


3 changed files:

- testsuite/tests/count-deps/Makefile
- testsuite/tests/count-deps/all.T
- utils/count-deps/Main.hs


Changes:

=====================================
testsuite/tests/count-deps/Makefile
=====================================
@@ -23,3 +23,8 @@ count-deps-parser:
 count-deps-ast:
 	$(COUNT_DEPS) $(LIBDIR) "ghc" "Language.Haskell.Syntax" | tee out
 	cat out | tail -n +2 | wc -l > SIZE
+
+.PHONY: count-deps-critical-path-ghc-internal
+count-deps-critical-path-ghc-internal:
+	$(COUNT_DEPS) $(LIBDIR) "ghc-internal" | tee out
+	cat out | tail -n +2 | wc -l > SIZE


=====================================
testsuite/tests/count-deps/all.T
=====================================
@@ -1,2 +1,3 @@
 test('CountDepsAst', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-ast'])
 test('CountDepsParser', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-parser'])
+test('CountDepsGhcInternalCriticalPath', [stat_from_file('deps', 100, 'SIZE'), req_hadrian_deps(["test:count-deps"])], makefile_test, ['count-deps-critical-path-ghc-internal'])


=====================================
utils/count-deps/Main.hs
=====================================
@@ -14,9 +14,14 @@ import System.Environment
 import GHC.Unit.Module.Deps
 import GHC.Unit.State
 import GHC.Unit.Info
+import GHC.Unit.Types
 import GHC.Data.FastString
 import Data.Map.Strict qualified as Map
+import Data.Map.Lazy qualified as Lazy.Map
 import Data.Set qualified as Set
+import Data.Maybe
+import Data.List (maximumBy)
+import Data.Ord (comparing)
 
 -- Example invocation:
 --  inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` ghc "GHC.Parser"
@@ -24,8 +29,13 @@ main :: IO ()
 main = do
   args <- getArgs
   case args of
-    [libdir, packageName, modName, "--dot"] -> printDeps libdir packageName modName True
-    [libdir, packageName, modName] -> printDeps libdir packageName modName False
+    [libdir, packageName, "--dot"] -> printDep libdir packageName Nothing True
+    [libdir, packageName, "--crit-path"] -> do
+      modgraph <- calcDeps Nothing packageName libdir
+      let modgraph' = Map.map (map gwib_mod . filter ((/=) IsBoot . gwib_isBoot)) modgraph
+      mapM_ putStrLn $ criticalPath modgraph'
+    [libdir, packageName, modName, "--dot"] -> printDeps libdir packageName (Just modName) True
+    [libdir, packageName, modName] -> printDeps libdir packageName (Just modName) False
     _ -> fail "usage: count-deps libdir package module [--dot]"
 
 dotSpec :: String -> Map.Map String [String] -> String
@@ -35,23 +45,23 @@ dotSpec name g =
   where
     f acc k ns = acc ++ concat ["  " ++ show k ++ " -> " ++ show n ++ ";\n" | n <- ns]
 
-printDeps :: String -> String -> String -> Bool -> IO ()
+printDeps :: String -> String -> Maybe String -> Bool -> IO ()
 printDeps libdir packageName modName dot = do
   modGraph <-
-    Map.map (map moduleNameString) .
-      Map.mapKeys moduleNameString <$> calcDeps (Just modName) packageName libdir
+    Map.map (map (moduleNameString . gwib_mod)) .
+      Map.mapKeys (moduleNameString) <$> calcDeps modName packageName libdir
   if not dot then
     do
       let modules = Map.keys modGraph
-      putStrLn $ "Found " ++ modName ++ " module dependencies"
+      putStrLn $ "Found " ++ fromMaybe "" modName ++ " module dependencies"
       forM_ modules putStrLn
   else
     -- * Copy the digraph output to a file ('deps.dot' say)
     -- * To render it, use a command along the lines of
     --   'tred deps.dot > deps-tred.dot && dot -Tpdf -o deps.pdf deps-tred.dot'
-    putStr $ dotSpec modName modGraph
+    putStr $ dotSpec (fromMaybe "" modName) modGraph
 
-calcDeps :: Maybe String -> String -> FilePath -> IO (Map.Map ModuleName [ModuleName])
+calcDeps :: Maybe String -> String -> FilePath -> IO (Map.Map ModuleName [ModuleNameWithIsBoot])
 calcDeps mmodName packageName libdir =
   defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
     runGhc (Just libdir) $ do
@@ -75,7 +85,7 @@ calcDeps mmodName packageName libdir =
     -- Source imports are only guaranteed to show up in the 'mi_deps'
     -- of modules that import them directly and don’t propagate
     -- transitively so we loop.
-    loop :: UnitId -> HscEnv -> Map.Map ModuleName [ModuleName] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleName])
+    loop :: UnitId -> HscEnv -> Map.Map ModuleName [ModuleNameWithIsBoot] -> [ModuleName] -> Ghc (Map.Map ModuleName [ModuleNameWithIsBoot])
     loop unitId env modules (m : ms) =
       if m `Map.member` modules
         then loop unitId env modules ms
@@ -83,11 +93,36 @@ calcDeps mmodName packageName libdir =
           mi <- liftIO $ hscGetModuleInterface env (mkModule unitId m)
           let deps = modDeps mi
           modules <- return $ Map.insert m [] modules
-          loop unitId env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) deps
+          loop unitId env (Map.insert m deps modules) $ ms ++ filter (not . (`Map.member` modules)) (map gwib_mod deps)
     loop _ _ modules [] = return modules
 
     mkModule :: UnitId -> ModuleName -> Module
     mkModule unitId = Module (RealUnit $ Definite unitId)
 
-    modDeps :: ModIface -> [ModuleName]
-    modDeps mi = map (gwib_mod . (\(_, _, mn) -> mn)) $ Set.toList $ dep_direct_mods (mi_deps mi)
+    modDeps :: ModIface -> [ModuleNameWithIsBoot]
+    modDeps mi = map (\(_, _, mn) -> mn) $ Set.toList $ dep_direct_mods (mi_deps mi)
+
+criticalPath :: Map.Map ModuleName [ModuleName] -> [String]
+criticalPath modules = crit top
+  where
+    -- Calculate the rank of each module
+    -- The rank of a vertex v is the maximum rank of its children + 1
+    -- We crucially use laziness to give us a nice memoized construction.
+    rank :: Map.Map ModuleName Int
+    rank = Lazy.Map.fromList
+      [ (k, 1 + safeMax (mapMaybe (\d -> Map.lookup d rank) deps))
+        | (k, deps) <- Map.toList modules
+      ]
+    top = fst . maximumBy (comparing snd) $ Lazy.Map.toList rank
+    -- The critical path starts with the module of highest rank
+    -- and then we walk down the tree taking the module of maximum rank at each step.
+    crit x = case deps of
+       [] -> []
+       _ ->
+         let m = fst (maximumBy (comparing snd) depsRank)
+         in moduleNameString m:crit m
+      where
+        depsRank = map (\n -> (n, fromMaybe 0 (Map.lookup n rank))) deps
+        deps = fromMaybe [] $ Map.lookup x modules
+    safeMax [] = 0
+    safeMax xs = maximum xs



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15cd0aaa3464a49aa43183abf5053356...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/15cd0aaa3464a49aa43183abf5053356...
You're receiving this email because of your account on gitlab.haskell.org.

    

Teo Camarasu (＠teo)

tags

participants (1)