blob: 67a2eef8c8143a10da3328a08eaf126ec5ecc4f5 (
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
|
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 HscTypes
import Module
import DynFlags
import HscMain
import GHC
import Util
import Data.Maybe
import Data.List
import Control.Monad
import Control.Monad.IO.Class
import System.Environment
import System.Exit
import UniqSet
main :: IO ()
main = do
[libdir] <- getArgs
modules <- parserDeps libdir
let num = sizeUniqSet modules
-- print num
-- print (map moduleNameString $ nonDetEltsUniqSet modules)
unless (num < 165) $ 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 "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 (stringToUnitId "ghc")
modDeps :: ModIface -> [ModuleName]
modDeps mi = map fst $ dep_mods (mi_deps mi)
|
