diff options
author | John Ericson <John.Ericson@Obsidian.Systems> | 2021-01-10 21:18:30 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-01-23 21:32:47 -0500 |
commit | 8ec6d62aa58ad6f226317696a74fea7756694a4a (patch) | |
tree | 094ac4a037e06a90869ed6a39362ade7c5c33fc6 | |
parent | 81f0665513d65c2d7e544cbe8adeff4b0d6fdfff (diff) | |
download | haskell-8ec6d62aa58ad6f226317696a74fea7756694a4a.tar.gz |
Track the dependencies of `GHC.Hs.Expr.Types`
Thery is still, in my view, far too numerous, but I believe this won't
be too hard to improve upon. At the very lease, we can always add more
extension points!
-rw-r--r-- | compiler/GHC/Hs/Decls.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Hs/Expr.hs-boot | 2 | ||||
-rw-r--r-- | compiler/Language/Haskell/Syntax.hs | 14 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountAstDeps.hs | 16 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountAstDeps.stdout | 239 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountDeps.hs | 52 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountParserDeps.hs | 50 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/CountParserDeps.stdout | 2 | ||||
-rw-r--r-- | testsuite/tests/parser/should_run/all.T | 6 |
9 files changed, 326 insertions, 57 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index f896d0aeba..6633cf657f 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -11,7 +11,7 @@ {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable {- (c) The University of Glasgow 2006 diff --git a/compiler/GHC/Hs/Expr.hs-boot b/compiler/GHC/Hs/Expr.hs-boot index 3eb1894e70..0f115387f6 100644 --- a/compiler/GHC/Hs/Expr.hs-boot +++ b/compiler/GHC/Hs/Expr.hs-boot @@ -3,7 +3,7 @@ {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension -{-# OPTIONS_GHC -Wno-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable module GHC.Hs.Expr where diff --git a/compiler/Language/Haskell/Syntax.hs b/compiler/Language/Haskell/Syntax.hs index 9da54cd8ed..510d22afe9 100644 --- a/compiler/Language/Haskell/Syntax.hs +++ b/compiler/Language/Haskell/Syntax.hs @@ -44,11 +44,15 @@ Note [Language.Haskell.Syntax.* Hierarchy] Why are these modules not 'GHC.Hs.*', or some other 'GHC.*'? The answer is that they are to be separated from GHC and put into another package, in accordance with the final goals of Trees that Grow. (See Note [Trees -that grow] in 'Language.Haskell.Syntax.Extension'.) - -We cannot separate them yet, but by giving them names like so, we hope -to remind others that the goal is to factor them out, and therefore -dependencies on the rest of GHC should never be added, only removed. +that grow] in 'Language.Haskell.Syntax.Extension'.) In short, the +'Language.Haskell.Syntax.*' tree should be entirely GHC-independent. +GHC-specific stuff related to source-language syntax should be in +'GHC.Hs.*'. + +We cannot move them to the separate package yet, but by giving them +names like so, we hope to remind others that the goal is to factor them +out, and therefore dependencies on the rest of GHC should never be +added, only removed. For more details, see https://gitlab.haskell.org/ghc/ghc/-/wikis/implementing-trees-that-grow diff --git a/testsuite/tests/parser/should_run/CountAstDeps.hs b/testsuite/tests/parser/should_run/CountAstDeps.hs new file mode 100644 index 0000000000..ba7f0c50f9 --- /dev/null +++ b/testsuite/tests/parser/should_run/CountAstDeps.hs @@ -0,0 +1,16 @@ +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/CountAstDeps.stdout b/testsuite/tests/parser/should_run/CountAstDeps.stdout new file mode 100644 index 0000000000..8c96acf235 --- /dev/null +++ b/testsuite/tests/parser/should_run/CountAstDeps.stdout @@ -0,0 +1,239 @@ +Found 238 Language.Haskell.Syntax module dependencies +GHC.Builtin.Names +GHC.Builtin.PrimOps +GHC.Builtin.Types +GHC.Builtin.Types.Prim +GHC.Builtin.Uniques +GHC.ByteCode.Types +GHC.Cmm +GHC.Cmm.BlockId +GHC.Cmm.CLabel +GHC.Cmm.Dataflow.Block +GHC.Cmm.Dataflow.Collections +GHC.Cmm.Dataflow.Graph +GHC.Cmm.Dataflow.Label +GHC.Cmm.Expr +GHC.Cmm.MachOp +GHC.Cmm.Node +GHC.Cmm.Switch +GHC.Cmm.Type +GHC.CmmToAsm.CFG.Weight +GHC.CmmToAsm.Config +GHC.Core +GHC.Core.Class +GHC.Core.Coercion +GHC.Core.Coercion.Axiom +GHC.Core.Coercion.Opt +GHC.Core.ConLike +GHC.Core.DataCon +GHC.Core.FVs +GHC.Core.FamInstEnv +GHC.Core.InstEnv +GHC.Core.Lint +GHC.Core.Make +GHC.Core.Map.Type +GHC.Core.Multiplicity +GHC.Core.Opt.Arity +GHC.Core.Opt.CallerCC +GHC.Core.Opt.ConstantFold +GHC.Core.Opt.Monad +GHC.Core.Opt.OccurAnal +GHC.Core.PatSyn +GHC.Core.Ppr +GHC.Core.Predicate +GHC.Core.Seq +GHC.Core.SimpleOpt +GHC.Core.Stats +GHC.Core.Subst +GHC.Core.TyCo.FVs +GHC.Core.TyCo.Ppr +GHC.Core.TyCo.Rep +GHC.Core.TyCo.Subst +GHC.Core.TyCo.Tidy +GHC.Core.TyCon +GHC.Core.TyCon.Env +GHC.Core.TyCon.RecWalk +GHC.Core.Type +GHC.Core.Unfold +GHC.Core.Unfold.Make +GHC.Core.Unify +GHC.Core.UsageEnv +GHC.Core.Utils +GHC.CoreToIface +GHC.Data.Bag +GHC.Data.BooleanFormula +GHC.Data.EnumSet +GHC.Data.FastMutInt +GHC.Data.FastString +GHC.Data.FastString.Env +GHC.Data.FiniteMap +GHC.Data.Graph.Directed +GHC.Data.IOEnv +GHC.Data.List.SetOps +GHC.Data.Maybe +GHC.Data.OrdList +GHC.Data.Pair +GHC.Data.Stream +GHC.Data.StringBuffer +GHC.Data.TrieMap +GHC.Driver.Backend +GHC.Driver.CmdLine +GHC.Driver.Env +GHC.Driver.Env.Types +GHC.Driver.Errors +GHC.Driver.Flags +GHC.Driver.Hooks +GHC.Driver.Monad +GHC.Driver.Phases +GHC.Driver.Pipeline.Monad +GHC.Driver.Plugins +GHC.Driver.Ppr +GHC.Driver.Session +GHC.Hs +GHC.Hs.Binds +GHC.Hs.Decls +GHC.Hs.Doc +GHC.Hs.Expr +GHC.Hs.Extension +GHC.Hs.ImpExp +GHC.Hs.Instances +GHC.Hs.Lit +GHC.Hs.Pat +GHC.Hs.Type +GHC.Hs.Utils +GHC.Iface.Ext.Fields +GHC.Iface.Recomp.Binary +GHC.Iface.Syntax +GHC.Iface.Type +GHC.Linker.Types +GHC.Parser.Annotation +GHC.Platform +GHC.Platform.AArch64 +GHC.Platform.ARM +GHC.Platform.Constants +GHC.Platform.NoRegs +GHC.Platform.PPC +GHC.Platform.Profile +GHC.Platform.Reg +GHC.Platform.Reg.Class +GHC.Platform.Regs +GHC.Platform.S390X +GHC.Platform.SPARC +GHC.Platform.Ways +GHC.Platform.X86 +GHC.Platform.X86_64 +GHC.Prelude +GHC.Runtime.Context +GHC.Runtime.Eval.Types +GHC.Runtime.Heap.Layout +GHC.Runtime.Interpreter.Types +GHC.Settings +GHC.Settings.Config +GHC.Settings.Constants +GHC.Stg.Syntax +GHC.StgToCmm.Types +GHC.SysTools.BaseDir +GHC.SysTools.FileCleanup +GHC.SysTools.Terminal +GHC.Tc.Errors.Hole.FitTypes +GHC.Tc.Types +GHC.Tc.Types.Constraint +GHC.Tc.Types.Evidence +GHC.Tc.Types.Origin +GHC.Tc.Utils.TcType +GHC.Types.Annotations +GHC.Types.Avail +GHC.Types.Basic +GHC.Types.CompleteMatch +GHC.Types.CostCentre +GHC.Types.CostCentre.State +GHC.Types.Cpr +GHC.Types.Demand +GHC.Types.Error +GHC.Types.FieldLabel +GHC.Types.Fixity +GHC.Types.Fixity.Env +GHC.Types.ForeignCall +GHC.Types.ForeignStubs +GHC.Types.HpcInfo +GHC.Types.Id +GHC.Types.Id.Info +GHC.Types.Id.Make +GHC.Types.Literal +GHC.Types.Meta +GHC.Types.Name +GHC.Types.Name.Cache +GHC.Types.Name.Env +GHC.Types.Name.Occurrence +GHC.Types.Name.Ppr +GHC.Types.Name.Reader +GHC.Types.Name.Set +GHC.Types.RepType +GHC.Types.SafeHaskell +GHC.Types.SourceError +GHC.Types.SourceFile +GHC.Types.SourceText +GHC.Types.SrcLoc +GHC.Types.Target +GHC.Types.TyThing +GHC.Types.TypeEnv +GHC.Types.Unique +GHC.Types.Unique.DFM +GHC.Types.Unique.DSet +GHC.Types.Unique.FM +GHC.Types.Unique.Set +GHC.Types.Unique.Supply +GHC.Types.Var +GHC.Types.Var.Env +GHC.Types.Var.Set +GHC.Unit +GHC.Unit.Env +GHC.Unit.External +GHC.Unit.Finder.Types +GHC.Unit.Home +GHC.Unit.Home.ModInfo +GHC.Unit.Info +GHC.Unit.Module +GHC.Unit.Module.Deps +GHC.Unit.Module.Env +GHC.Unit.Module.Graph +GHC.Unit.Module.Imported +GHC.Unit.Module.Location +GHC.Unit.Module.ModDetails +GHC.Unit.Module.ModGuts +GHC.Unit.Module.ModIface +GHC.Unit.Module.ModSummary +GHC.Unit.Module.Name +GHC.Unit.Module.Status +GHC.Unit.Module.Warnings +GHC.Unit.Parser +GHC.Unit.Ppr +GHC.Unit.State +GHC.Unit.Types +GHC.Utils.Binary +GHC.Utils.Binary.Typeable +GHC.Utils.BufHandle +GHC.Utils.CliOption +GHC.Utils.Error +GHC.Utils.Exception +GHC.Utils.FV +GHC.Utils.Fingerprint +GHC.Utils.GlobalVars +GHC.Utils.IO.Unsafe +GHC.Utils.Json +GHC.Utils.Lexeme +GHC.Utils.Misc +GHC.Utils.Monad +GHC.Utils.Outputable +GHC.Utils.Panic +GHC.Utils.Panic.Plain +GHC.Utils.Ppr +GHC.Utils.Ppr.Colour +Language.Haskell.Syntax +Language.Haskell.Syntax.Binds +Language.Haskell.Syntax.Decls +Language.Haskell.Syntax.Expr +Language.Haskell.Syntax.Extension +Language.Haskell.Syntax.Lit +Language.Haskell.Syntax.Pat +Language.Haskell.Syntax.Type diff --git a/testsuite/tests/parser/should_run/CountDeps.hs b/testsuite/tests/parser/should_run/CountDeps.hs new file mode 100644 index 0000000000..df483c3ff1 --- /dev/null +++ b/testsuite/tests/parser/should_run/CountDeps.hs @@ -0,0 +1,52 @@ +module CountDeps (printDeps) 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.Types.Unique.Set +import GHC.Unit.Module.Deps + +printDeps :: String -> IO () +printDeps modName = do + [libdir] <- getArgs + modules <- calcDeps modName libdir + let num = sizeUniqSet modules + putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies" + forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn + +calcDeps :: String -> FilePath -> IO (UniqSet ModuleName) +calcDeps modName 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 modName] + 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) diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs index ff23263e6f..f1dacb1d62 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.hs +++ b/testsuite/tests/parser/should_run/CountParserDeps.hs @@ -10,53 +10,7 @@ module Main(main) where -- provided with as small a number of modules as possible for when the -- need exists to produce ASTs and nothing more. -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.Types.Unique.Set -import GHC.Unit.Module.Deps +import CountDeps main :: IO () -main = do - [libdir] <- getArgs - modules <- parserDeps libdir - let num = sizeUniqSet modules - putStrLn $ "Found " ++ show num ++ " parser module dependencies" - forM_ (map moduleNameString $ nonDetEltsUniqSet modules) putStrLn - -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) +main = printDeps "GHC.Parser" diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/parser/should_run/CountParserDeps.stdout index 0d4a3a8ca8..81d67c92ae 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.stdout +++ b/testsuite/tests/parser/should_run/CountParserDeps.stdout @@ -1,4 +1,4 @@ -Found 246 parser module dependencies +Found 246 GHC.Parser module dependencies GHC.Builtin.Names GHC.Builtin.PrimOps GHC.Builtin.Types diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T index 2fa6fce766..064ef8fffd 100644 --- a/testsuite/tests/parser/should_run/all.T +++ b/testsuite/tests/parser/should_run/all.T @@ -14,8 +14,12 @@ 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', - [ only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], + [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ], compile_and_run, ['-package ghc']) test('LexNegLit', normal, compile_and_run, ['']) |