summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Ericson <John.Ericson@Obsidian.Systems>2021-01-10 21:18:30 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-01-23 21:32:47 -0500
commit8ec6d62aa58ad6f226317696a74fea7756694a4a (patch)
tree094ac4a037e06a90869ed6a39362ade7c5c33fc6
parent81f0665513d65c2d7e544cbe8adeff4b0d6fdfff (diff)
downloadhaskell-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.hs2
-rw-r--r--compiler/GHC/Hs/Expr.hs-boot2
-rw-r--r--compiler/Language/Haskell/Syntax.hs14
-rw-r--r--testsuite/tests/parser/should_run/CountAstDeps.hs16
-rw-r--r--testsuite/tests/parser/should_run/CountAstDeps.stdout239
-rw-r--r--testsuite/tests/parser/should_run/CountDeps.hs52
-rw-r--r--testsuite/tests/parser/should_run/CountParserDeps.hs50
-rw-r--r--testsuite/tests/parser/should_run/CountParserDeps.stdout2
-rw-r--r--testsuite/tests/parser/should_run/all.T6
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, [''])