diff options
18 files changed, 161 insertions, 64 deletions
@@ -569,6 +569,7 @@ ghc/stage2/package-data.mk: compiler/stage2/package-data.mk utils/haddock/dist/package-data.mk: compiler/stage2/package-data.mk utils/check-ppr/dist-install/package-data.mk: compiler/stage2/package-data.mk utils/check-exact/dist-install/package-data.mk: compiler/stage2/package-data.mk +utils/count-deps/dist-install/package-data.mk: compiler/stage2/package-data.mk # add the final package.conf dependency: ghc-prim depends on RTS libraries/ghc-prim/dist-install/package-data.mk : rts/dist/package.conf.inplace @@ -667,6 +668,7 @@ BUILD_DIRS += utils/ghc-pkg BUILD_DIRS += utils/testremove BUILD_DIRS += utils/check-ppr BUILD_DIRS += utils/check-exact +BUILD_DIRS += utils/count-deps BUILD_DIRS += utils/ghc-cabal BUILD_DIRS += utils/hpc BUILD_DIRS += utils/runghc @@ -709,6 +711,7 @@ ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO" # See Note [Stage1Only vs stage=1] in mk/config.mk.in. BUILD_DIRS := $(filter-out utils/check-ppr,$(BUILD_DIRS)) BUILD_DIRS := $(filter-out utils/check-exact,$(BUILD_DIRS)) +BUILD_DIRS := $(filter-out utils/count-deps,$(BUILD_DIRS)) endif endif # CLEANING diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs index c56feae796..f75236cd9a 100644 --- a/hadrian/src/Packages.hs +++ b/hadrian/src/Packages.hs @@ -2,7 +2,7 @@ module Packages ( -- * GHC packages array, base, binary, bytestring, cabal, checkPpr, - checkExact, + checkExact, countDeps, compareSizes, compiler, containers, deepseq, deriveConstants, directory, exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh, ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, @@ -32,7 +32,7 @@ import Oracles.Setting -- packages and modify build default build conditions in "UserSettings". ghcPackages :: [Package] ghcPackages = - [ array, base, binary, bytestring, cabal, checkPpr, checkExact + [ array, base, binary, bytestring, cabal, checkPpr, checkExact, countDeps , compareSizes, compiler, containers, deepseq, deriveConstants, directory , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh , ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs @@ -53,6 +53,7 @@ bytestring = lib "bytestring" cabal = lib "Cabal" `setPath` "libraries/Cabal/Cabal" checkPpr = util "check-ppr" checkExact = util "check-exact" +countDeps = util "count-deps" compareSizes = util "compareSizes" `setPath` "utils/compare_sizes" compiler = top "ghc" `setPath` "compiler" containers = lib "containers" `setPath` "libraries/containers/containers" diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs index 2c90b3fe5c..75178e2fef 100644 --- a/hadrian/src/Rules/BinaryDist.hs +++ b/hadrian/src/Rules/BinaryDist.hs @@ -172,7 +172,7 @@ bindistRules = do need $ map (bindistFilesDir -/-) (["configure", "Makefile"] ++ bindistInstallFiles) need $ map ((bindistFilesDir -/- "wrappers") -/-) - [ "check-ppr", "check-exact", "ghc", "ghc-iserv", "ghc-pkg" + [ "check-ppr", "check-exact", "count-deps", "ghc", "ghc-iserv", "ghc-pkg" , "ghci-script", "haddock", "hpc", "hp2ps", "hsc2hs" , "runghc"] diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs index 495ec3b7cb..ff986f879e 100644 --- a/hadrian/src/Rules/Test.hs +++ b/hadrian/src/Rules/Test.hs @@ -37,11 +37,17 @@ checkExactSourcePath = "utils/check-exact/Main.hs" checkExactExtra :: Maybe String checkExactExtra = Just "-iutils/check-exact" +countDepsProgPath, countDepsSourcePath :: FilePath +countDepsProgPath = "test/bin/count-deps" <.> exe +countDepsSourcePath = "utils/count-deps/Main.hs" +countDepsExtra :: Maybe String +countDepsExtra = Just "-iutils/count-deps" checkPrograms :: [(FilePath, FilePath, Maybe String, Package)] checkPrograms = [ (checkPprProgPath, checkPprSourcePath, checkPprExtra, checkPpr) , (checkExactProgPath, checkExactSourcePath, checkExactExtra, checkExact) + , (countDepsProgPath, countDepsSourcePath, countDepsExtra, countDeps) ] ghcConfigPath :: FilePath @@ -132,7 +138,9 @@ testRules = do pythonPath <- builderPath Python need [ root -/- checkPprProgPath - , root -/- checkExactProgPath ] + , root -/- checkExactProgPath + , root -/- countDepsProgPath + ] -- Set environment variables for test's Makefile. -- TODO: Ideally we would define all those env vars in 'env', so that @@ -149,6 +157,7 @@ testRules = do setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath) setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath) + setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath) -- This lets us bypass the need to generate a config -- through Make, which happens in testsuite/mk/boilerplate.mk diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs index 9efea20275..f00aab9776 100644 --- a/hadrian/src/Settings/Builders/Make.hs +++ b/hadrian/src/Settings/Builders/Make.hs @@ -26,12 +26,14 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do compiler <- expr $ fullpath ghc checkPpr <- expr $ fullpath checkPpr checkExact <- expr $ fullpath checkExact + countDeps <- expr $ fullpath countDeps args <- expr $ userSetting defaultTestArgs return [ setTestSpeed $ testSpeed args , "THREADS=" ++ show threads , "TEST_HC=" ++ (top -/- compiler) , "CHECK_PPR=" ++ (top -/- checkPpr) , "CHECK_EXACT=" ++ (top -/- checkExact) + , "COUNT_DEPS=" ++ (top -/- countDeps) ] where fullpath :: Package -> Action FilePath diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs index 1a28e1ca72..2da096efdb 100644 --- a/hadrian/src/Settings/Default.hs +++ b/hadrian/src/Settings/Default.hs @@ -135,7 +135,7 @@ stage2Packages = stage1Packages -- | Packages that are built only for the testsuite. testsuitePackages :: Action [Package] -testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact ]) +testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps ]) -- | Default build ways for library packages: -- * We always build 'vanilla' way. diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk index a2fb56d1ba..942e6e32c2 100644 --- a/testsuite/mk/boilerplate.mk +++ b/testsuite/mk/boilerplate.mk @@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" "" CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact) endif +ifeq "$(COUNT_DEPS)" "" +COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps) +endif + # ----------------------------------------------------------------------------- # configuration of TEST_HC @@ -296,4 +300,3 @@ FREEBSD = YES else FREEBSD = NO endif - diff --git a/testsuite/tests/parser/should_run/CountAstDeps.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 4b33ad2982..4b33ad2982 100644 --- a/testsuite/tests/parser/should_run/CountAstDeps.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index 16dbb8e185..16dbb8e185 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout diff --git a/testsuite/tests/count-deps/Makefile b/testsuite/tests/count-deps/Makefile new file mode 100644 index 0000000000..41911c47df --- /dev/null +++ b/testsuite/tests/count-deps/Makefile @@ -0,0 +1,23 @@ +TOP=../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +LIBDIR := "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" + +# Calculate the number of module dependencies of 'Parser.' If that +# number exceeds a threshold, that indicates that the dependencies +# have significantly gone up via the commit under test (and the test +# is deemed to fail). In that case, this most likely means a cycle +# has arisen that pulls in modules for Core generation. The +# motivation for not allowing that to happen is so that the +# 'ghc-lib-parser' package subset of the GHC API can continue to be +# provided with as small a number of modules as possible for when the +# need exists to produce ASTs and nothing more. + +.PHONY: count-deps-parser +count-deps-parser: + $(COUNT_DEPS) $(LIBDIR) "GHC.Parser" + +.PHONY: count-deps-ast +count-deps-ast: + $(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax" diff --git a/testsuite/tests/count-deps/all.T b/testsuite/tests/count-deps/all.T new file mode 100644 index 0000000000..6b8abd9c95 --- /dev/null +++ b/testsuite/tests/count-deps/all.T @@ -0,0 +1,2 @@ +test('CountDepsAst', [], makefile_test, ['count-deps-ast']) +test('CountDepsParser', [], makefile_test, ['count-deps-parser']) diff --git a/testsuite/tests/parser/should_run/CountAstDeps.hs b/testsuite/tests/parser/should_run/CountAstDeps.hs deleted file mode 100644 index ba7f0c50f9..0000000000 --- a/testsuite/tests/parser/should_run/CountAstDeps.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main(main) where - --- Calculate the number of module dependencies of 'Parser.' If that --- number exceeds a threshold, that indicates that the dependencies --- have significantly gone up via the commit under test (and the test --- is deemed to fail). In that case, this most likely means a cycle --- has arisen that pulls in modules for Core generation. The --- motivation for not allowing that to happen is so that the --- 'ghc-lib-parser' package subset of the GHC API can continue to be --- provided with as small a number of modules as possible for when the --- need exists to produce ASTs and nothing more. - -import CountDeps - -main :: IO () -main = printDeps "Language.Haskell.Syntax" diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs deleted file mode 100644 index f1dacb1d62..0000000000 --- a/testsuite/tests/parser/should_run/CountParserDeps.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Main(main) where - --- Calculate the number of module dependencies of 'Parser.' If that --- number exceeds a threshold, that indicates that the dependencies --- have significantly gone up via the commit under test (and the test --- is deemed to fail). In that case, this most likely means a cycle --- has arisen that pulls in modules for Core generation. The --- motivation for not allowing that to happen is so that the --- 'ghc-lib-parser' package subset of the GHC API can continue to be --- provided with as small a number of modules as possible for when the --- need exists to produce ASTs and nothing more. - -import CountDeps - -main :: IO () -main = printDeps "GHC.Parser" diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T index 5c2112057e..92c6d0fcb3 100644 --- a/testsuite/tests/parser/should_run/all.T +++ b/testsuite/tests/parser/should_run/all.T @@ -14,14 +14,6 @@ test('NegativeZero', normal, compile_and_run, ['']) test('HexFloatLiterals', normal, compile_and_run, ['']) test('NumericUnderscores0', normal, compile_and_run, ['']) test('NumericUnderscores1', normal, compile_and_run, ['']) -test('CountAstDeps', - [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], - compile_and_run, - ['-package ghc']) -test('CountParserDeps', - [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], - compile_and_run, - ['-package ghc']) test('LexNegLit', normal, compile_and_run, ['']) test('RecordDotSyntax1', normal, compile_and_run, ['']) test('RecordDotSyntax2', normal, compile_and_run, ['']) diff --git a/testsuite/tests/parser/should_run/CountDeps.hs b/utils/count-deps/Main.hs index fab36de4a8..2ce6ea9f5b 100644 --- a/testsuite/tests/parser/should_run/CountDeps.hs +++ b/utils/count-deps/Main.hs @@ -1,19 +1,29 @@ -module CountDeps (printDeps) where +{-# OPTIONS_GHC -Wno-name-shadowing #-} +{-# LANGUAGE ImportQualifiedPost #-} + +module Main where import GHC.Driver.Env import GHC.Unit.Module import GHC.Driver.Session import GHC.Driver.Main import GHC -import GHC.Utils.Misc -import Data.Maybe import Control.Monad import Control.Monad.IO.Class import System.Environment -import System.Exit import GHC.Unit.Module.Deps import Data.Map.Strict qualified as Map +-- Example invocation: +-- inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser" +main :: IO () +main = do + args <- getArgs + case args of + [libdir, modName, "--dot"] -> printDeps libdir modName True + [libdir, modName] -> printDeps libdir modName False + _ -> fail "usage: count-deps libdir module [--dot]" + dotSpec :: String -> Map.Map String [String] -> String dotSpec name g = "digraph \"" ++ name ++ "\" {\n" ++ @@ -21,23 +31,22 @@ dotSpec name g = where f acc k ns = acc ++ concat [" " ++ show k ++ " -> " ++ show n ++ ";\n" | n <- ns] -printDeps :: String -> IO () -printDeps modName = do - [libdir] <- getArgs +printDeps :: String -> String -> Bool -> IO () +printDeps libdir modName dot = do modGraph <- Map.map (map moduleNameString) . Map.mapKeys moduleNameString <$> calcDeps modName libdir - let modules = Map.keys modGraph - num = length modules - putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies" - forM_ modules putStrLn - -- Uncomment the next line to print a dependency graph in dot - -- format: - -- putStr $ dotSpec modName modGraph - -- Then, - -- * 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' + if not dot then + do + let modules = Map.keys modGraph + num = length modules + putStrLn $ "Found " ++ show num ++ " " ++ 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 calcDeps :: String -> FilePath -> IO (Map.Map ModuleName [ModuleName]) calcDeps modName libdir = diff --git a/utils/count-deps/README.md b/utils/count-deps/README.md new file mode 100644 index 0000000000..67d8ed4842 --- /dev/null +++ b/utils/count-deps/README.md @@ -0,0 +1,43 @@ +# README + +The `count-deps` executable is used in the test-suite to detect when +the number of dependencies of certain modules change ([this blog +post](https://blog.shaynefletcher.org/2020/10/ghc-lib-parser-module-count.html) +gives one example of where and why this can be useful). + +More generally it's useful for obtaining insight into a modules' +dependency graph. As used in the tests it produces (1) a count of a +modules' dependencies together with the list of depended upon modules +. However, it can also (2), print a modules' dependency graph in dot +language syntax suitable for rendering with "graphviz" (open source +graph visualization software). + +## Installing graphviz + +To render graphs generated by `count-deps`, first visit [the graphviz +downloads page](https://graphviz.org/download/) to download and +install graphviz on your system. + +## `count-deps` usage examples: + + - `make`: + + (1) ``inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser"`` + (2) ``inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser" --dot`` + + - `hadrian`: + (1) ``_build/stage1/bin/count-deps `_build/stage1/bin/ghc --print-libdir` "GHC.Parser"`` + (2) ``_build/stage1/bin/count-deps `_build/stage1/bin/ghc --print-libdir` "GHC.Parser" --dot`` + +## Rendering dependency graphs + +To render a graph obtained using a type (2) command: + + - Copy the output to a file ('`deps.dot`' say) + + - Render it with a command like (preprocess with `tred` to remove + edges implied by transitivity) + + ```bash + tred deps.dot > deps-tred.dot&& dot -Tpdf -o deps.pdf deps-tred.dot + ``` diff --git a/utils/count-deps/count-deps.cabal b/utils/count-deps/count-deps.cabal new file mode 100644 index 0000000000..38a7621aaa --- /dev/null +++ b/utils/count-deps/count-deps.cabal @@ -0,0 +1,24 @@ +Name: count-deps +Version: 0.1 +Copyright: XXX +License: BSD3 +-- XXX License-File: LICENSE +Author: XXX +Maintainer: XXX +Synopsis: A utilities for analyzing module dependencies +Description: + This utility is used inspect the dependencies of a module + @utils/count-deps/README@ in GHC's source distribution for + details. +Category: Development +build-type: Simple +cabal-version: >=1.10 + +Executable count-deps + Default-Language: Haskell2010 + Main-Is: Main.hs + Ghc-Options: -Wall + other-modules: + Build-Depends: base >= 4 && < 5, + containers, + ghc diff --git a/utils/count-deps/ghc.mk b/utils/count-deps/ghc.mk new file mode 100644 index 0000000000..45259efee6 --- /dev/null +++ b/utils/count-deps/ghc.mk @@ -0,0 +1,18 @@ +# ----------------------------------------------------------------------------- +# +# (c) 2009 The University of Glasgow +# +# This file is part of the GHC build system. +# +# To understand how the build system works and how to modify it, see +# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture +# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying +# +# ----------------------------------------------------------------------------- + +utils/count-deps_USES_CABAL = YES +utils/count-deps_PACKAGE = count-deps +utils/count-deps_dist-install_PROGNAME = count-deps +utils/count-deps_dist-install_INSTALL = NO +utils/count-deps_dist-install_INSTALL_INPLACE = YES +$(eval $(call build-prog,utils/count-deps,dist-install,2)) |