Track the dependencies of `GHC.Hs.Expr.Types`wip/fix-18936

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!

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, [''])