blob: 5c7cb0eef3296fc649c0a00dbcdb7c7b8c169847 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
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 GHC.Driver.Types
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.Types.Unique.Set
main :: IO ()
main = do
[libdir] <- getArgs
modules <- parserDeps libdir
let num = sizeUniqSet modules
max_num = 203
min_num = max_num - 10 -- so that we don't forget to change the number
-- when the number of dependencies decreases
-- putStrLn $ "Found " ++ show num ++ " parser module dependencies"
-- forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn
unless (num <= max_num && num >= min_num) $ exitWith (ExitFailure num)
parserDeps :: FilePath -> IO (UniqSet ModuleName)
parserDeps libdir =
defaultErrorHandler defaultFatalMessager defaultFlushOut $ do
runGhc (Just libdir) $ do
df <- getSessionDynFlags
(df, _, _) <- parseDynamicFlags df [noLoc "-package=ghc"]
setSessionDynFlags df
env <- getSession
loop env emptyUniqSet [mkModuleName "GHC.Parser"]
where
-- 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 :: HscEnv -> UniqSet ModuleName -> [ModuleName] -> Ghc (UniqSet ModuleName)
loop env modules (m : ms) =
if m `elementOfUniqSet` modules
then loop env modules ms
else do
modules <- return (addOneToUniqSet modules m)
mi <- liftIO $ hscGetModuleInterface env (mkModule m)
loop env modules (ms ++ filter (not . (`elementOfUniqSet` modules)) (modDeps mi))
loop _ modules [] = return modules
mkModule :: ModuleName -> Module
mkModule = Module (stringToUnit "ghc")
modDeps :: ModIface -> [ModuleName]
modDeps mi = map gwib_mod $ dep_mods (mi_deps mi)
|
