summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2020-04-11 17:03:18 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-04-30 01:56:56 -0400
commit8bfb0219587b969d5c8f723c46d433e9493958b4 (patch)
tree7ed243039324e5a85905985589d7defd91543625 /compiler/GHC
parent10d15f1ec4bab4dd6152d87fc66e61658a705eb3 (diff)
downloadhaskell-8bfb0219587b969d5c8f723c46d433e9493958b4.tar.gz
Unit: split and rename modules
Introduce GHC.Unit.* hierarchy for everything concerning units, packages and modules. Update Haddock submodule
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Builtin/Names.hs6
-rw-r--r--compiler/GHC/Builtin/Names.hs-boot2
-rw-r--r--compiler/GHC/Builtin/Names/TH.hs2
-rw-r--r--compiler/GHC/Builtin/PrimOps.hs2
-rw-r--r--compiler/GHC/Builtin/Types.hs2
-rw-r--r--compiler/GHC/ByteCode/Linker.hs2
-rw-r--r--compiler/GHC/Cmm/CLabel.hs4
-rw-r--r--compiler/GHC/Cmm/DebugBlock.hs2
-rw-r--r--compiler/GHC/Cmm/Info/Build.hs2
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/CmmToAsm.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs2
-rw-r--r--compiler/GHC/CmmToAsm/Monad.hs2
-rw-r--r--compiler/GHC/CmmToAsm/PIC.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/CodeGen.hs2
-rw-r--r--compiler/GHC/Core.hs2
-rw-r--r--compiler/GHC/Core/DataCon.hs2
-rw-r--r--compiler/GHC/Core/InstEnv.hs2
-rw-r--r--compiler/GHC/Core/Opt/Driver.hs2
-rw-r--r--compiler/GHC/Core/Opt/Monad.hs2
-rw-r--r--compiler/GHC/Core/Opt/OccurAnal.hs2
-rw-r--r--compiler/GHC/Core/Opt/Simplify.hs2
-rw-r--r--compiler/GHC/Core/Opt/SpecConstr.hs2
-rw-r--r--compiler/GHC/Core/Opt/Specialise.hs2
-rw-r--r--compiler/GHC/Core/Rules.hs3
-rw-r--r--compiler/GHC/Core/SimpleOpt.hs2
-rw-r--r--compiler/GHC/Core/TyCon.hs2
-rw-r--r--compiler/GHC/CoreToByteCode.hs2
-rw-r--r--compiler/GHC/CoreToStg.hs2
-rw-r--r--compiler/GHC/CoreToStg/Prep.hs2
-rw-r--r--compiler/GHC/Data/IOEnv.hs2
-rw-r--r--compiler/GHC/Driver/Backpack.hs15
-rw-r--r--compiler/GHC/Driver/Backpack/Syntax.hs3
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs3
-rw-r--r--compiler/GHC/Driver/Finder.hs3
-rw-r--r--compiler/GHC/Driver/Hooks.hs2
-rw-r--r--compiler/GHC/Driver/Main.hs4
-rw-r--r--compiler/GHC/Driver/Make.hs4
-rw-r--r--compiler/GHC/Driver/MakeFile.hs2
-rw-r--r--compiler/GHC/Driver/Pipeline.hs4
-rw-r--r--compiler/GHC/Driver/Pipeline/Monad.hs2
-rw-r--r--compiler/GHC/Driver/Plugins.hs2
-rw-r--r--compiler/GHC/Driver/Session.hs8
-rw-r--r--compiler/GHC/Driver/Session.hs-boot2
-rw-r--r--compiler/GHC/Driver/Types.hs3
-rw-r--r--compiler/GHC/Hs.hs2
-rw-r--r--compiler/GHC/Hs/Dump.hs2
-rw-r--r--compiler/GHC/Hs/ImpExp.hs2
-rw-r--r--compiler/GHC/HsToCore.hs2
-rw-r--r--compiler/GHC/HsToCore/Binds.hs2
-rw-r--r--compiler/GHC/HsToCore/Coverage.hs4
-rw-r--r--compiler/GHC/HsToCore/Expr.hs2
-rw-r--r--compiler/GHC/HsToCore/Foreign/Decl.hs2
-rw-r--r--compiler/GHC/HsToCore/Monad.hs2
-rw-r--r--compiler/GHC/HsToCore/Quote.hs2
-rw-r--r--compiler/GHC/HsToCore/Usage.hs3
-rw-r--r--compiler/GHC/HsToCore/Utils.hs2
-rw-r--r--compiler/GHC/Iface/Binary.hs2
-rw-r--r--compiler/GHC/Iface/Env.hs2
-rw-r--r--compiler/GHC/Iface/Env.hs-boot2
-rw-r--r--compiler/GHC/Iface/Ext/Ast.hs2
-rw-r--r--compiler/GHC/Iface/Ext/Binary.hs2
-rw-r--r--compiler/GHC/Iface/Ext/Debug.hs2
-rw-r--r--compiler/GHC/Iface/Ext/Types.hs2
-rw-r--r--compiler/GHC/Iface/Load.hs2
-rw-r--r--compiler/GHC/Iface/Load.hs-boot2
-rw-r--r--compiler/GHC/Iface/Make.hs2
-rw-r--r--compiler/GHC/Iface/Recomp.hs4
-rw-r--r--compiler/GHC/Iface/Recomp/Flags.hs2
-rw-r--r--compiler/GHC/Iface/Rename.hs12
-rw-r--r--compiler/GHC/Iface/Syntax.hs2
-rw-r--r--compiler/GHC/Iface/Tidy.hs2
-rw-r--r--compiler/GHC/Iface/Tidy/StaticPtrTable.hs2
-rw-r--r--compiler/GHC/IfaceToCore.hs2
-rw-r--r--compiler/GHC/Parser.y2
-rw-r--r--compiler/GHC/Parser/Header.hs2
-rw-r--r--compiler/GHC/Parser/Lexer.x2
-rw-r--r--compiler/GHC/Plugins.hs8
-rw-r--r--compiler/GHC/Rename/Bind.hs2
-rw-r--r--compiler/GHC/Rename/Env.hs2
-rw-r--r--compiler/GHC/Rename/Expr.hs2
-rw-r--r--compiler/GHC/Rename/Fixity.hs2
-rw-r--r--compiler/GHC/Rename/Module.hs2
-rw-r--r--compiler/GHC/Rename/Names.hs2
-rw-r--r--compiler/GHC/Rename/Splice.hs2
-rw-r--r--compiler/GHC/Rename/Unbound.hs2
-rw-r--r--compiler/GHC/Runtime/Eval.hs2
-rw-r--r--compiler/GHC/Runtime/Eval/Types.hs2
-rw-r--r--compiler/GHC/Runtime/Heap/Inspect.hs2
-rw-r--r--compiler/GHC/Runtime/Interpreter.hs2
-rw-r--r--compiler/GHC/Runtime/Linker.hs4
-rw-r--r--compiler/GHC/Runtime/Linker/Types.hs2
-rw-r--r--compiler/GHC/Runtime/Loader.hs2
-rw-r--r--compiler/GHC/Stg/DepAnal.hs2
-rw-r--r--compiler/GHC/Stg/Lint.hs2
-rw-r--r--compiler/GHC/Stg/Pipeline.hs2
-rw-r--r--compiler/GHC/Stg/Syntax.hs4
-rw-r--r--compiler/GHC/StgToCmm.hs2
-rw-r--r--compiler/GHC/StgToCmm/Bind.hs2
-rw-r--r--compiler/GHC/StgToCmm/DataCon.hs2
-rw-r--r--compiler/GHC/StgToCmm/ExtCode.hs2
-rw-r--r--compiler/GHC/StgToCmm/Heap.hs2
-rw-r--r--compiler/GHC/StgToCmm/Hpc.hs2
-rw-r--r--compiler/GHC/StgToCmm/Layout.hs2
-rw-r--r--compiler/GHC/StgToCmm/Monad.hs2
-rw-r--r--compiler/GHC/StgToCmm/Prim.hs2
-rw-r--r--compiler/GHC/StgToCmm/Prof.hs6
-rw-r--r--compiler/GHC/StgToCmm/Ticky.hs2
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs2
-rw-r--r--compiler/GHC/SysTools.hs3
-rw-r--r--compiler/GHC/SysTools/ExtraObj.hs4
-rw-r--r--compiler/GHC/Tc/Deriv/Generics.hs2
-rw-r--r--compiler/GHC/Tc/Deriv/Utils.hs2
-rw-r--r--compiler/GHC/Tc/Errors.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Annotation.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Export.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Sig.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs2
-rw-r--r--compiler/GHC/Tc/Instance/Family.hs2
-rw-r--r--compiler/GHC/Tc/Instance/Typeable.hs4
-rw-r--r--compiler/GHC/Tc/Module.hs2
-rw-r--r--compiler/GHC/Tc/Plugin.hs2
-rw-r--r--compiler/GHC/Tc/Solver/Monad.hs2
-rw-r--r--compiler/GHC/Tc/TyCl.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/Utils.hs2
-rw-r--r--compiler/GHC/Tc/Types.hs4
-rw-r--r--compiler/GHC/Tc/Types/EvTerm.hs2
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs4
-rw-r--r--compiler/GHC/Tc/Utils/Env.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs2
-rw-r--r--compiler/GHC/ThToHs.hs2
-rw-r--r--compiler/GHC/Types/Annotations.hs6
-rw-r--r--compiler/GHC/Types/CostCentre.hs2
-rw-r--r--compiler/GHC/Types/ForeignCall.hs2
-rw-r--r--compiler/GHC/Types/Id.hs2
-rw-r--r--compiler/GHC/Types/Id/Info.hs2
-rw-r--r--compiler/GHC/Types/Module.hs1487
-rw-r--r--compiler/GHC/Types/Module.hs-boot17
-rw-r--r--compiler/GHC/Types/Name.hs2
-rw-r--r--compiler/GHC/Types/Name/Cache.hs2
-rw-r--r--compiler/GHC/Types/Name/Reader.hs2
-rw-r--r--compiler/GHC/Types/Name/Shape.hs2
-rw-r--r--compiler/GHC/Unit.hs257
-rw-r--r--compiler/GHC/Unit/Info.hs28
-rw-r--r--compiler/GHC/Unit/Module.hs151
-rw-r--r--compiler/GHC/Unit/Module/Env.hs224
-rw-r--r--compiler/GHC/Unit/Module/Env.hs-boot6
-rw-r--r--compiler/GHC/Unit/Module/Location.hs78
-rw-r--r--compiler/GHC/Unit/Module/Name.hs98
-rw-r--r--compiler/GHC/Unit/Module/Name.hs-boot6
-rw-r--r--compiler/GHC/Unit/Parser.hs63
-rw-r--r--compiler/GHC/Unit/Ppr.hs31
-rw-r--r--compiler/GHC/Unit/State.hs (renamed from compiler/GHC/Driver/Packages.hs)37
-rw-r--r--compiler/GHC/Unit/State.hs-boot (renamed from compiler/GHC/Driver/Packages.hs-boot)7
-rw-r--r--compiler/GHC/Unit/Subst.hs69
-rw-r--r--compiler/GHC/Unit/Types.hs636
-rw-r--r--compiler/GHC/Unit/Types.hs-boot18
-rw-r--r--compiler/GHC/Utils/Outputable.hs3
160 files changed, 1849 insertions, 1729 deletions
diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index d6eacd9562..52d5bf0fa2 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -143,7 +143,8 @@ this constructor directly (see CorePrep.lookupIntegerSDataConName)
When GHC reads the package data base, it (internally only) pretends it has UnitId
`integer-wired-in` instead of the actual UnitId (which includes the version
number); just like for `base` and other packages, as described in
-Note [Wired-in packages] in GHC.Types.Module. This is done in Packages.findWiredInPackages.
+Note [Wired-in units] in GHC.Unit.Module. This is done in
+GHC.Unit.State.findWiredInPackages.
-}
{-# LANGUAGE CPP #-}
@@ -165,7 +166,8 @@ where
import GHC.Prelude
-import GHC.Types.Module
+import GHC.Unit.Types
+import GHC.Unit.Module.Name
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader
import GHC.Types.Unique
diff --git a/compiler/GHC/Builtin/Names.hs-boot b/compiler/GHC/Builtin/Names.hs-boot
index 8dcd62e716..da448e09e4 100644
--- a/compiler/GHC/Builtin/Names.hs-boot
+++ b/compiler/GHC/Builtin/Names.hs-boot
@@ -1,6 +1,6 @@
module GHC.Builtin.Names where
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique
mAIN :: Module
diff --git a/compiler/GHC/Builtin/Names/TH.hs b/compiler/GHC/Builtin/Names/TH.hs
index 5123754c55..94407b51fb 100644
--- a/compiler/GHC/Builtin/Names/TH.hs
+++ b/compiler/GHC/Builtin/Names/TH.hs
@@ -9,7 +9,7 @@ module GHC.Builtin.Names.TH where
import GHC.Prelude ()
import GHC.Builtin.Names( mk_known_key_name )
-import GHC.Types.Module( Module, mkModuleNameFS, mkModule, thUnitId )
+import GHC.Unit
import GHC.Types.Name( Name )
import GHC.Types.Name.Occurrence( tcName, clsName, dataName, varName )
import GHC.Types.Name.Reader( RdrName, nameRdrName )
diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index 1a7a03fe8a..8ad0b731f8 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -44,7 +44,7 @@ import GHC.Types.Basic ( Arity, Fixity(..), FixityDirection(..), Boxity(..),
import GHC.Types.SrcLoc ( wiredInSrcSpan )
import GHC.Types.ForeignCall ( CLabelString )
import GHC.Types.Unique ( Unique, mkPrimOpIdUnique, mkPrimOpWrapperUnique )
-import GHC.Types.Module ( Unit )
+import GHC.Unit ( Unit )
import GHC.Utils.Outputable
import GHC.Data.FastString
diff --git a/compiler/GHC/Builtin/Types.hs b/compiler/GHC/Builtin/Types.hs
index 51d3ff608b..0c0bab60ea 100644
--- a/compiler/GHC/Builtin/Types.hs
+++ b/compiler/GHC/Builtin/Types.hs
@@ -143,7 +143,7 @@ import {-# SOURCE #-} GHC.Builtin.Uniques
import GHC.Core.Coercion.Axiom
import GHC.Types.Id
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE, mAX_SUM_SIZE )
-import GHC.Types.Module ( Module )
+import GHC.Unit.Module ( Module )
import GHC.Core.Type
import GHC.Types.RepType
import GHC.Core.DataCon
diff --git a/compiler/GHC/ByteCode/Linker.hs b/compiler/GHC/ByteCode/Linker.hs
index 9a1e562c2a..bda0e03445 100644
--- a/compiler/GHC/ByteCode/Linker.hs
+++ b/compiler/GHC/ByteCode/Linker.hs
@@ -31,7 +31,7 @@ import GHC.Driver.Types
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Builtin.PrimOps
-import GHC.Types.Module
+import GHC.Unit
import GHC.Data.FastString
import GHC.Utils.Panic
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index ba9fecbd08..891384aa55 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -119,8 +119,8 @@ import GHC.Prelude
import GHC.Types.Id.Info
import GHC.Types.Basic
import {-# SOURCE #-} GHC.Cmm.BlockId (BlockId, mkBlockId)
-import GHC.Driver.Packages
-import GHC.Types.Module
+import GHC.Unit.State
+import GHC.Unit
import GHC.Types.Name
import GHC.Types.Unique
import GHC.Builtin.PrimOps
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index a3a7566a8b..0cc3d5924f 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -34,7 +34,7 @@ import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Core
import GHC.Data.FastString ( nilFS, mkFastString )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Cmm.Ppr.Expr ( pprExpr )
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index bf936d41d9..6eabd638b9 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -18,7 +18,7 @@ import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Platform
import GHC.Data.Graph.Directed
import GHC.Cmm.CLabel
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 8e35e83b6a..630c20e125 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -236,7 +236,7 @@ import GHC.Parser.Lexer
import GHC.Types.CostCentre
import GHC.Types.ForeignCall
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Platform
import GHC.Types.Literal
import GHC.Types.Unique
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 374b6c47e8..34b877d696 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -95,7 +95,7 @@ import GHC.Utils.Outputable as Outputable
import GHC.Data.FastString
import GHC.Types.Unique.Set
import GHC.Utils.Error
-import GHC.Types.Module
+import GHC.Unit
import GHC.Data.Stream (Stream)
import qualified GHC.Data.Stream as Stream
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index bc5e82c316..e15e9b3fdb 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -10,7 +10,7 @@ import Config ( cProjectName, cProjectVersion )
import GHC.Core ( Tickish(..) )
import GHC.Cmm.DebugBlock
import GHC.Driver.Session
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Platform
import GHC.Types.Unique
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index 9d5cf246c2..b973634d66 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -64,7 +64,7 @@ import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
import GHC.Types.Unique ( Unique )
import GHC.Driver.Session
-import GHC.Types.Module
+import GHC.Unit.Module
import Control.Monad ( ap )
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 5b237fc7db..87bc5968d6 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -71,7 +71,7 @@ import GHC.Cmm.CLabel ( mkForeignLabel )
import GHC.Types.Basic
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index 2796bc32dc..b8751238ea 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -67,7 +67,7 @@ import GHC.Platform
-- Our intermediate code:
import GHC.Types.Basic
import GHC.Cmm.BlockId
-import GHC.Types.Module ( primUnitId )
+import GHC.Unit ( primUnitId )
import GHC.Cmm.Utils
import GHC.Cmm.Switch
import GHC.Cmm
diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 6c9bf98ca5..3730e8e919 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -112,7 +112,7 @@ import GHC.Types.Name.Set
import GHC.Types.Name.Env( NameEnv, emptyNameEnv )
import GHC.Types.Literal
import GHC.Core.DataCon
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Basic
import GHC.Utils.Outputable
import GHC.Utils.Misc
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index 68b6ac3bfa..5877ce35e0 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -78,7 +78,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Types.Basic
import GHC.Data.FastString
-import GHC.Types.Module
+import GHC.Unit
import GHC.Utils.Binary
import GHC.Types.Unique.Set
import GHC.Types.Unique( mkAlphaTyVarUnique )
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs
index b80b237733..ef05747920 100644
--- a/compiler/GHC/Core/InstEnv.hs
+++ b/compiler/GHC/Core/InstEnv.hs
@@ -36,7 +36,7 @@ import GHC.Prelude
import GHC.Tc.Utils.TcType -- InstEnv is really part of the type checker,
-- and depends on TcType in many ways
import GHC.Core ( IsOrphan(..), isOrphan, chooseOrphanAnchor )
-import GHC.Types.Module
+import GHC.Unit
import GHC.Core.Class
import GHC.Types.Var
import GHC.Types.Var.Set
diff --git a/compiler/GHC/Core/Opt/Driver.hs b/compiler/GHC/Core/Opt/Driver.hs
index 43470240a6..2d75a22a5c 100644
--- a/compiler/GHC/Core/Opt/Driver.hs
+++ b/compiler/GHC/Core/Opt/Driver.hs
@@ -51,7 +51,7 @@ import GHC.Core.Opt.Exitify ( exitifyProgram )
import GHC.Core.Opt.WorkWrap ( wwTopBinds )
import GHC.Types.SrcLoc
import GHC.Utils.Misc
-import GHC.Types.Module
+import GHC.Unit.Module.Env
import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
import GHC.Runtime.Loader -- ( initializePlugins )
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index 19d0eec4a9..44023a1b57 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -52,7 +52,7 @@ import GHC.Prelude hiding ( read )
import GHC.Core
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Driver.Session
import GHC.Types.Basic ( CompilerPhase(..) )
import GHC.Types.Annotations
diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs
index 21c7f86d78..578a3e12d4 100644
--- a/compiler/GHC/Core/Opt/OccurAnal.hs
+++ b/compiler/GHC/Core/Opt/OccurAnal.hs
@@ -28,7 +28,7 @@ import GHC.Core.Arity ( joinRhsArity )
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Basic
-import GHC.Types.Module( Module )
+import GHC.Unit.Module( Module )
import GHC.Core.Coercion
import GHC.Core.Type
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 8198ba32cf..483bd5f38c 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -57,7 +57,7 @@ import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Error
-import GHC.Types.Module ( moduleName, pprModuleName )
+import GHC.Unit.Module ( moduleName, pprModuleName )
import GHC.Builtin.PrimOps ( PrimOp (SeqOp) )
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index 60029cb478..0f65b487da 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -60,7 +60,7 @@ import GHC.Utils.Monad
import Control.Monad ( zipWithM )
import Data.List
import GHC.Builtin.Names ( specTyConName )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Core.TyCon ( TyCon )
import GHC.Exts( SpecConstrAnnotation(..) )
import Data.Ord( comparing )
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index f40e67adcd..18173e1644 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -19,7 +19,7 @@ import GHC.Types.Id
import GHC.Tc.Utils.TcType hiding( substTy )
import GHC.Core.Type hiding( substTy, extendTvSubstList )
import GHC.Core.Predicate
-import GHC.Types.Module( Module, HasModule(..) )
+import GHC.Unit.Module( Module, HasModule(..) )
import GHC.Core.Coercion( Coercion )
import GHC.Core.Opt.Monad
import qualified GHC.Core.Subst as Core
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index d4e60446bf..4989b22ff0 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -31,7 +31,8 @@ module GHC.Core.Rules (
import GHC.Prelude
import GHC.Core -- All of it
-import GHC.Types.Module ( Module, ModuleSet, elemModuleSet )
+import GHC.Unit.Module ( Module )
+import GHC.Unit.Module.Env
import GHC.Core.Subst
import GHC.Core.SimpleOpt ( exprIsLambda_maybe )
import GHC.Core.FVs ( exprFreeVars, exprsFreeVars, bindFreeVars
diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index 2f9d86627f..1f3c950ffe 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -48,7 +48,7 @@ import GHC.Core.TyCon ( tyConArity )
import GHC.Builtin.Types
import GHC.Builtin.Names
import GHC.Types.Basic
-import GHC.Types.Module ( Module )
+import GHC.Unit.Module ( Module )
import GHC.Utils.Error
import GHC.Driver.Session
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Core/TyCon.hs b/compiler/GHC/Core/TyCon.hs
index c45b744c7b..863c3b2f46 100644
--- a/compiler/GHC/Core/TyCon.hs
+++ b/compiler/GHC/Core/TyCon.hs
@@ -167,7 +167,7 @@ import GHC.Settings.Constants
import GHC.Utils.Misc
import GHC.Types.Unique( tyConRepNameUnique, dataConTyRepNameUnique )
import GHC.Types.Unique.Set
-import GHC.Types.Module
+import GHC.Unit.Module
import qualified Data.Data as Data
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 1f3c0dd85d..99a0e2849e 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -64,7 +64,7 @@ import Control.Monad
import Data.Char
import GHC.Types.Unique.Supply
-import GHC.Types.Module
+import GHC.Unit.Module
import Control.Exception
import Data.Array
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 8534ff7738..24e21b1901 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -32,7 +32,7 @@ import GHC.Types.Id.Info
import GHC.Core.DataCon
import GHC.Types.CostCentre
import GHC.Types.Var.Env
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name ( isExternalName, nameModule_maybe )
import GHC.Types.Basic ( Arity )
import GHC.Builtin.Types ( unboxedUnitDataCon, unitDataConId )
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index c4c2463153..8d4750c9e4 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -46,7 +46,7 @@ import GHC.Types.Id.Info
import GHC.Builtin.Types
import GHC.Core.DataCon
import GHC.Types.Basic
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique.Supply
import GHC.Data.Maybe
import GHC.Data.OrdList
diff --git a/compiler/GHC/Data/IOEnv.hs b/compiler/GHC/Data/IOEnv.hs
index 345482094e..86f16b229b 100644
--- a/compiler/GHC/Data/IOEnv.hs
+++ b/compiler/GHC/Data/IOEnv.hs
@@ -35,7 +35,7 @@ import GHC.Prelude
import GHC.Driver.Session
import GHC.Utils.Exception
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Panic
import Data.IORef ( IORef, newIORef, readIORef, writeIORef, modifyIORef,
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 8dfada00af..041c63c60d 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -25,14 +25,13 @@ import GHC.Driver.Backpack.Syntax
import GHC.Parser.Annotation
import GHC hiding (Failed, Succeeded)
-import GHC.Driver.Packages hiding (packageNameMap)
import GHC.Parser
import GHC.Parser.Lexer
import GHC.Driver.Monad
import GHC.Driver.Session
import GHC.Tc.Utils.Monad
import GHC.Tc.Module
-import GHC.Types.Module
+import GHC.Unit
import GHC.Driver.Types
import GHC.Data.StringBuffer
import GHC.Data.FastString
@@ -88,7 +87,7 @@ doBackpack [src_filename] = do
-- OK, so we have an LHsUnit PackageName, but we want an
-- LHsUnit HsComponentId. So let's rename it.
let pkgstate = pkgState dflags
- let bkp = renameHsUnits pkgstate (packageNameMap pkgstate pkgname_bkp) pkgname_bkp
+ let bkp = renameHsUnits pkgstate (bkpPackageNameMap pkgstate pkgname_bkp) pkgname_bkp
initBkpM src_filename bkp $
forM_ (zip [1..] bkp) $ \(i, lunit) -> do
let comp_name = unLoc (hsunitName (unLoc lunit))
@@ -192,7 +191,7 @@ withBkpSession cid insts deps session_type do_this = do
importPaths = [],
-- Synthesized the flags
packageFlags = packageFlags dflags ++ map (\(uid0, rn) ->
- let uid = unwireUnit dflags (improveUnit (getUnitInfoMap dflags) $ renameHoleUnit dflags (listToUFM insts) uid0)
+ let uid = unwireUnit dflags (improveUnit (unitInfoMap (pkgState dflags)) $ renameHoleUnit (pkgState dflags) (listToUFM insts) uid0)
in ExposePackage
(showSDoc dflags
(text "-unit-id" <+> ppr uid <+> ppr rn))
@@ -260,7 +259,7 @@ buildUnit session cid insts lunit = do
-- The compilation dependencies are just the appropriately filled
-- in unit IDs which must be compiled before we can compile.
let hsubst = listToUFM insts
- deps0 = map (renameHoleUnit dflags hsubst) raw_deps
+ deps0 = map (renameHoleUnit (pkgState dflags) hsubst) raw_deps
-- Build dependencies OR make sure they make sense. BUT NOTE,
-- we can only check the ones that are fully filled; the rest
@@ -273,7 +272,7 @@ buildUnit session cid insts lunit = do
dflags <- getDynFlags
-- IMPROVE IT
- let deps = map (improveUnit (getUnitInfoMap dflags)) deps0
+ let deps = map (improveUnit (unitInfoMap (pkgState dflags))) deps0
mb_old_eps <- case session of
TcSession -> fmap Just getEpsGhc
@@ -562,8 +561,8 @@ unitDefines :: PackageState -> LHsUnit PackageName -> (PackageName, HsComponentI
unitDefines pkgstate (L _ HsUnit{ hsunitName = L _ pn@(PackageName fs) })
= (pn, HsComponentId pn (mkIndefUnitId pkgstate fs))
-packageNameMap :: PackageState -> [LHsUnit PackageName] -> PackageNameMap HsComponentId
-packageNameMap pkgstate units = Map.fromList (map (unitDefines pkgstate) units)
+bkpPackageNameMap :: PackageState -> [LHsUnit PackageName] -> PackageNameMap HsComponentId
+bkpPackageNameMap pkgstate units = Map.fromList (map (unitDefines pkgstate) units)
renameHsUnits :: PackageState -> PackageNameMap HsComponentId -> [LHsUnit PackageName] -> [LHsUnit HsComponentId]
renameHsUnits pkgstate m units = map (fmap renameHsUnit) units
diff --git a/compiler/GHC/Driver/Backpack/Syntax.hs b/compiler/GHC/Driver/Backpack/Syntax.hs
index e579fe42a1..d4d36b59b2 100644
--- a/compiler/GHC/Driver/Backpack/Syntax.hs
+++ b/compiler/GHC/Driver/Backpack/Syntax.hs
@@ -22,8 +22,7 @@ import GHC.Driver.Phases
import GHC.Hs
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Types.Module
-import GHC.Unit.Info
+import GHC.Unit
{-
************************************************************************
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 446deb2c99..bc29a4a654 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -25,7 +25,6 @@ import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
import GHC.Driver.Finder ( mkStubPaths )
import GHC.CmmToC ( writeC )
import GHC.Cmm.Lint ( cmmLint )
-import GHC.Driver.Packages
import GHC.Cmm ( RawCmmGroup )
import GHC.Cmm.CLabel
import GHC.Driver.Types
@@ -36,7 +35,7 @@ import GHC.SysTools.FileCleanup
import GHC.Utils.Error
import GHC.Utils.Outputable
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.SrcLoc
import GHC.Types.CostCentre
diff --git a/compiler/GHC/Driver/Finder.hs b/compiler/GHC/Driver/Finder.hs
index 1b50d280a6..b5bd91e3cb 100644
--- a/compiler/GHC/Driver/Finder.hs
+++ b/compiler/GHC/Driver/Finder.hs
@@ -36,9 +36,8 @@ module GHC.Driver.Finder (
import GHC.Prelude
-import GHC.Types.Module
+import GHC.Unit
import GHC.Driver.Types
-import GHC.Driver.Packages
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Builtin.Names ( gHC_PRIM )
diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs
index b7915ed3af..474b30aa77 100644
--- a/compiler/GHC/Driver/Hooks.hs
+++ b/compiler/GHC/Driver/Hooks.hs
@@ -48,7 +48,7 @@ import GHC.Types.SrcLoc
import GHC.Core.Type
import System.Process
import GHC.Types.Basic
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Core.TyCon
import GHC.Types.CostCentre
import GHC.Stg.Syntax
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index c62b40cf0d..b2649ff0d3 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -101,8 +101,8 @@ import GHC.Utils.Panic
import GHC.Core.ConLike
import GHC.Parser.Annotation
-import GHC.Types.Module
-import GHC.Driver.Packages
+import GHC.Unit.Module
+import GHC.Unit.State
import GHC.Types.Name.Reader
import GHC.Hs
import GHC.Hs.Dump
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 866d1a080b..874bd2b253 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -45,7 +45,7 @@ import GHC.Driver.Finder
import GHC.Driver.Monad
import GHC.Parser.Header
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.IfaceToCore ( typecheckIface )
import GHC.Tc.Utils.Monad ( initIfaceCheck )
import GHC.Driver.Main
@@ -65,7 +65,7 @@ import GHC.Data.StringBuffer
import GHC.Types.Unique.FM
import GHC.Types.Unique.DSet
import GHC.Tc.Utils.Backpack
-import GHC.Driver.Packages
+import GHC.Unit.State
import GHC.Types.Unique.Set
import GHC.Utils.Misc
import qualified GHC.LanguageExtensions as LangExt
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index 01af21d461..f0de5b75c8 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -24,7 +24,7 @@ import GHC.Driver.Ways
import GHC.Utils.Misc
import GHC.Driver.Types
import qualified GHC.SysTools as SysTools
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Data.Graph.Directed ( SCC(..) )
import GHC.Driver.Finder
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 6656b2d98a..afcf1bd0bb 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -39,7 +39,7 @@ module GHC.Driver.Pipeline (
import GHC.Prelude
import GHC.Driver.Pipeline.Monad
-import GHC.Driver.Packages
+import GHC.Unit.State
import GHC.Driver.Ways
import GHC.Parser.Header
import GHC.Driver.Phases
@@ -49,7 +49,7 @@ import GHC.Driver.Main
import GHC.Driver.Finder
import GHC.Driver.Types hiding ( Hsc )
import GHC.Utils.Outputable
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Error
import GHC.Driver.Session
import GHC.Utils.Panic
diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs
index bf22ae6e9d..6ee92328bd 100644
--- a/compiler/GHC/Driver/Pipeline/Monad.hs
+++ b/compiler/GHC/Driver/Pipeline/Monad.hs
@@ -18,7 +18,7 @@ import GHC.Utils.Outputable
import GHC.Driver.Session
import GHC.Driver.Phases
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.SysTools.FileCleanup (TempFileLifetime)
import Control.Monad
diff --git a/compiler/GHC/Driver/Plugins.hs b/compiler/GHC/Driver/Plugins.hs
index f10dafda27..61fb9d69fa 100644
--- a/compiler/GHC/Driver/Plugins.hs
+++ b/compiler/GHC/Driver/Plugins.hs
@@ -58,7 +58,7 @@ import GHC.Driver.Session
import GHC.Driver.Types
import GHC.Driver.Monad
import GHC.Driver.Phases
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Fingerprint
import Data.List (sort)
import GHC.Utils.Outputable (Outputable(..), text, (<+>))
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 5c39848a8d..ef6de96340 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -242,11 +242,13 @@ import GHC.Prelude
import GHC.Platform
import GHC.UniqueSubdir (uniqueSubdir)
-import GHC.Types.Module
+import GHC.Unit.Types
+import GHC.Unit.Parser
+import GHC.Unit.Module
import {-# SOURCE #-} GHC.Driver.Plugins
import {-# SOURCE #-} GHC.Driver.Hooks
import {-# SOURCE #-} GHC.Builtin.Names ( mAIN )
-import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase, mkIndefUnitId, updateIndefUnitId)
+import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, PackageDatabase, mkIndefUnitId, updateIndefUnitId)
import GHC.Driver.Phases ( Phase(..), phaseInputExt )
import GHC.Driver.Flags
import GHC.Driver.Ways
@@ -630,7 +632,7 @@ data DynFlags = DynFlags {
-- ^ Stack of package databases for the target platform.
--
-- A "package database" is a misleading name as it is really a Unit
- -- database (cf Note [The identifier lexicon]).
+ -- database (cf Note [About Units]).
--
-- This field is populated by `initPackages`.
--
diff --git a/compiler/GHC/Driver/Session.hs-boot b/compiler/GHC/Driver/Session.hs-boot
index 509535ba71..e35241aec1 100644
--- a/compiler/GHC/Driver/Session.hs-boot
+++ b/compiler/GHC/Driver/Session.hs-boot
@@ -3,11 +3,13 @@ module GHC.Driver.Session where
import GHC.Prelude
import GHC.Platform
import {-# SOURCE #-} GHC.Utils.Outputable
+import {-# SOURCE #-} GHC.Unit.State
data DynFlags
targetPlatform :: DynFlags -> Platform
pprUserLength :: DynFlags -> Int
+pkgState :: DynFlags -> PackageState
unsafeGlobalDynFlags :: DynFlags
hasPprDebug :: DynFlags -> Bool
hasNoDebugOutput :: DynFlags -> Bool
diff --git a/compiler/GHC/Driver/Types.hs b/compiler/GHC/Driver/Types.hs
index 07e7cd7001..12424a48c5 100644
--- a/compiler/GHC/Driver/Types.hs
+++ b/compiler/GHC/Driver/Types.hs
@@ -170,7 +170,7 @@ import GHC.Types.Unique.FM
import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Types.Avail
-import GHC.Types.Module
+import GHC.Unit
import GHC.Core.InstEnv ( InstEnv, ClsInst, identicalClsInstHead )
import GHC.Core.FamInstEnv
import GHC.Core ( CoreProgram, RuleBase, CoreRule )
@@ -192,7 +192,6 @@ import GHC.Core.DataCon
import GHC.Core.PatSyn
import GHC.Builtin.Names ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
import GHC.Builtin.Types
-import GHC.Driver.Packages hiding ( Version(..) )
import GHC.Driver.CmdLine
import GHC.Driver.Session
import GHC.Runtime.Linker.Types ( DynLinker, Linkable(..), Unlinked(..), SptEntry(..) )
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 59fe3e36b0..fa71e65599 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -53,7 +53,7 @@ import GHC.Hs.Instances () -- For Data instances
-- others:
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
-import GHC.Types.Module ( ModuleName )
+import GHC.Unit.Module ( ModuleName )
-- libraries:
import Data.Data hiding ( Fixity )
diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs
index ee9df10c5d..6ce865a36a 100644
--- a/compiler/GHC/Hs/Dump.hs
+++ b/compiler/GHC/Hs/Dump.hs
@@ -27,7 +27,7 @@ import GHC.Core.DataCon
import GHC.Types.SrcLoc
import GHC.Hs
import GHC.Types.Var
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import qualified Data.ByteString as B
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 813d0ef9bf..02eb9db1ca 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -18,7 +18,7 @@ module GHC.Hs.ImpExp where
import GHC.Prelude
-import GHC.Types.Module ( ModuleName )
+import GHC.Unit.Module ( ModuleName )
import GHC.Hs.Doc ( HsDocString )
import GHC.Types.Name.Occurrence ( HasOccName(..), isTcOcc, isSymOcc )
import GHC.Types.Basic ( SourceText(..), StringLiteral(..), pprWithSourceText )
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index af204f474f..b3266ece76 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -49,7 +49,7 @@ import GHC.Core.Coercion
import GHC.Builtin.Types
import GHC.Core.DataCon ( dataConWrapId )
import GHC.Core.Make
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Core.Rules
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index 7bc6fe2512..49a8d78215 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -62,7 +62,7 @@ import GHC.Core.Rules
import GHC.Types.Var.Env
import GHC.Types.Var( EvVar )
import GHC.Utils.Outputable
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Data.Maybe
import GHC.Data.OrdList
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index a057e4bd49..8130565837 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -21,7 +21,7 @@ import GHC.ByteCode.Types
import GHC.Stack.CCS
import GHC.Core.Type
import GHC.Hs
-import GHC.Types.Module as Module
+import GHC.Unit
import GHC.Utils.Outputable as Outputable
import GHC.Driver.Session
import GHC.Core.ConLike
@@ -1334,7 +1334,7 @@ hpcInitCode this_mod (HpcInfo tickCount hashNo)
tickboxes = ppr (mkHpcTicksLabel $ this_mod)
module_name = hcat (map (text.charToC) $ BS.unpack $
- bytesFS (moduleNameFS (Module.moduleName this_mod)))
+ bytesFS (moduleNameFS (moduleName this_mod)))
package_name = hcat (map (text.charToC) $ BS.unpack $
bytesFS (unitFS (moduleUnit this_mod)))
full_name_str
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 2ea1c17e04..36599cbbab 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -53,7 +53,7 @@ import GHC.Driver.Session
import GHC.Types.CostCentre
import GHC.Types.Id
import GHC.Types.Id.Make
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCo.Ppr( pprWithTYPE )
diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs
index 9eb867a098..cb1cb6fe11 100644
--- a/compiler/GHC/HsToCore/Foreign/Decl.hs
+++ b/compiler/GHC/HsToCore/Foreign/Decl.hs
@@ -30,7 +30,7 @@ import GHC.Core.DataCon
import GHC.Core.Unfold
import GHC.Types.Id
import GHC.Types.Literal
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Core.Type
import GHC.Types.RepType
diff --git a/compiler/GHC/HsToCore/Monad.hs b/compiler/GHC/HsToCore/Monad.hs
index a2163209c3..1914498f4e 100644
--- a/compiler/GHC/HsToCore/Monad.hs
+++ b/compiler/GHC/HsToCore/Monad.hs
@@ -75,7 +75,7 @@ import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.HsToCore.PmCheck.Types
import GHC.Types.Id
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
import GHC.Core.Type
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index 3e4de72006..166127f9d1 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -39,7 +39,7 @@ import qualified Language.Haskell.TH as TH
import GHC.Hs
import GHC.Builtin.Names
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Id
import GHC.Types.Name hiding( varName, tcName )
import GHC.Builtin.Names.TH
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index e536e29b11..182466bd7d 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -19,14 +19,13 @@ import GHC.Driver.Types
import GHC.Tc.Types
import GHC.Types.Name
import GHC.Types.Name.Set
-import GHC.Types.Module
+import GHC.Unit
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Types.Unique.Set
import GHC.Types.Unique.FM
import GHC.Utils.Fingerprint
import GHC.Data.Maybe
-import GHC.Driver.Packages
import GHC.Driver.Finder
import Control.Monad (filterM)
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 20ba64bbc5..48673a18d5 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -73,7 +73,7 @@ import GHC.Types.Basic
import GHC.Core.ConLike
import GHC.Types.Unique.Set
import GHC.Types.Unique.Supply
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Builtin.Names
import GHC.Types.Name( isInternalName )
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index e954413940..baaa17ce5f 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -39,7 +39,7 @@ import GHC.Tc.Utils.Monad
import GHC.Builtin.Utils ( isKnownKeyName, lookupKnownKeyName )
import GHC.Iface.Env
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Name
import GHC.Driver.Session
import GHC.Types.Unique.FM
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index 75b93605be..088bce8d77 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -30,7 +30,7 @@ import GHC.Core.Type
import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Avail
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Data.FastString
import GHC.Data.FastString.Env
import GHC.Iface.Type
diff --git a/compiler/GHC/Iface/Env.hs-boot b/compiler/GHC/Iface/Env.hs-boot
index 72d0c26ba7..a5d73559d0 100644
--- a/compiler/GHC/Iface/Env.hs-boot
+++ b/compiler/GHC/Iface/Env.hs-boot
@@ -1,6 +1,6 @@
module GHC.Iface.Env where
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name.Occurrence
import GHC.Tc.Utils.Monad
import GHC.Types.Name
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index f35cf8f2f0..ffd7d26415 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -30,7 +30,7 @@ import GHC.HsToCore ( deSugarExpr )
import GHC.Types.FieldLabel
import GHC.Hs
import GHC.Driver.Types
-import GHC.Types.Module ( ModuleName, ml_hs_file )
+import GHC.Unit.Module ( ModuleName, ml_hs_file )
import GHC.Utils.Monad ( concatMapM, liftIO )
import GHC.Types.Name ( Name, nameSrcSpan, setNameLoc )
import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 0077c23ee4..9735f204dd 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -23,7 +23,7 @@ import GHC.Utils.Binary
import GHC.Iface.Binary ( getDictFastString )
import GHC.Data.FastMutInt
import GHC.Data.FastString ( FastString )
-import GHC.Types.Module ( Module )
+import GHC.Unit.Module ( Module )
import GHC.Types.Name
import GHC.Types.Name.Cache
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Iface/Ext/Debug.hs b/compiler/GHC/Iface/Ext/Debug.hs
index bb0c827627..66a6eec349 100644
--- a/compiler/GHC/Iface/Ext/Debug.hs
+++ b/compiler/GHC/Iface/Ext/Debug.hs
@@ -10,7 +10,7 @@ module GHC.Iface.Ext.Debug where
import GHC.Prelude
import GHC.Types.SrcLoc
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Data.FastString
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index 88cb9c2042..bddabedf13 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -18,7 +18,7 @@ import Config
import GHC.Utils.Binary
import GHC.Data.FastString ( FastString )
import GHC.Iface.Type
-import GHC.Types.Module ( ModuleName, Module )
+import GHC.Unit.Module ( ModuleName, Module )
import GHC.Types.Name ( Name )
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Types.SrcLoc ( RealSrcSpan )
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index c35a426e07..d208eb7433 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -63,7 +63,7 @@ import GHC.Core.FamInstEnv
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Avail
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Data.Maybe
import GHC.Utils.Error
import GHC.Driver.Finder
diff --git a/compiler/GHC/Iface/Load.hs-boot b/compiler/GHC/Iface/Load.hs-boot
index 7e7d235bb7..78c5dd2e67 100644
--- a/compiler/GHC/Iface/Load.hs-boot
+++ b/compiler/GHC/Iface/Load.hs-boot
@@ -1,6 +1,6 @@
module GHC.Iface.Load where
-import GHC.Types.Module (Module)
+import GHC.Unit.Module (Module)
import GHC.Tc.Utils.Monad (IfM)
import GHC.Driver.Types (ModIface)
import GHC.Utils.Outputable (SDoc)
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 0b0c46019f..15d1c720ea 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -52,7 +52,7 @@ import GHC.Types.Avail
import GHC.Types.Name.Reader
import GHC.Types.Name.Env
import GHC.Types.Name.Set
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Types.Basic hiding ( SuccessFlag(..) )
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index bec782ff48..fea2fe666d 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -28,7 +28,7 @@ import GHC.Driver.Finder
import GHC.Driver.Session
import GHC.Types.Name
import GHC.Types.Name.Set
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Error
import GHC.Data.Graph.Directed
import GHC.Types.SrcLoc
@@ -40,7 +40,7 @@ import GHC.Utils.Binary
import GHC.Utils.Fingerprint
import GHC.Utils.Exception
import GHC.Types.Unique.Set
-import GHC.Driver.Packages
+import GHC.Unit.State
import Control.Monad
import Data.Function
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index 66b6b9f15f..03313c61f2 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -13,7 +13,7 @@ import GHC.Prelude
import GHC.Utils.Binary
import GHC.Driver.Session
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Utils.Fingerprint
import GHC.Iface.Recomp.Binary
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 29c0b3e593..d7da10382c 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -22,7 +22,7 @@ import GHC.Prelude
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Unique.FM
import GHC.Types.Avail
import GHC.Iface.Syntax
@@ -164,7 +164,7 @@ rnDepModules sel deps = do
-- not to do it in this case either...)
--
-- This mistake was bug #15594.
- let mod' = renameHoleModule dflags hmap mod
+ let mod' = renameHoleModule (pkgState dflags) hmap mod
if isHoleModule mod
then do iface <- liftIO . initIfaceCheck (text "rnDepModule") hsc_env
$ loadSysInterface (text "rnDepModule") mod'
@@ -186,7 +186,7 @@ initRnIface hsc_env iface insts nsubst do_this = do
errs_var <- newIORef emptyBag
let dflags = hsc_dflags hsc_env
hsubst = listToUFM insts
- rn_mod = renameHoleModule dflags hsubst
+ rn_mod = renameHoleModule (pkgState dflags) hsubst
env = ShIfEnv {
sh_if_module = rn_mod (mi_module iface),
sh_if_semantic_module = rn_mod (mi_semantic_module iface),
@@ -233,7 +233,7 @@ rnModule :: Rename Module
rnModule mod = do
hmap <- getHoleSubst
dflags <- getDynFlags
- return (renameHoleModule dflags hmap mod)
+ return (renameHoleModule (pkgState dflags) hmap mod)
rnAvailInfo :: Rename AvailInfo
rnAvailInfo (Avail n) = Avail <$> rnIfaceGlobal n
@@ -302,7 +302,7 @@ rnIfaceGlobal n = do
mb_nsubst <- fmap sh_if_shape getGblEnv
hmap <- getHoleSubst
let m = nameModule n
- m' = renameHoleModule dflags hmap m
+ m' = renameHoleModule (pkgState dflags) hmap m
case () of
-- Did we encounter {A.T} while renaming p[A=<B>]:A? If so,
-- do NOT assume B.hi is available.
@@ -363,7 +363,7 @@ rnIfaceNeverExported name = do
hmap <- getHoleSubst
dflags <- getDynFlags
iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
- let m = renameHoleModule dflags hmap $ nameModule name
+ let m = renameHoleModule (pkgState dflags) hmap $ nameModule name
-- Doublecheck that this DFun/coercion axiom was, indeed, locally defined.
MASSERT2( iface_semantic_mod == m, ppr iface_semantic_mod <+> ppr m )
setNameModule (Just m) name
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 9db82731d8..e69e546a89 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -60,7 +60,7 @@ import GHC.Types.ForeignCall
import GHC.Types.Annotations( AnnPayload, AnnTarget )
import GHC.Types.Basic
import GHC.Utils.Outputable as Outputable
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Utils.Fingerprint
import GHC.Utils.Binary
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index e3c3c0b01c..2a6fce5f5c 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -52,7 +52,7 @@ import GHC.Tc.Utils.Monad
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.Class
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Driver.Types
import GHC.Data.Maybe
import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
index 453f859233..1494db96fc 100644
--- a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
+++ b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
@@ -132,7 +132,7 @@ import GHC.Driver.Session
import GHC.Driver.Types
import GHC.Types.Id
import GHC.Core.Make (mkStringExprFSWith)
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Utils.Outputable as Outputable
import GHC.Platform
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index f9edcfe196..0a78e28790 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -63,7 +63,7 @@ import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique.FM
import GHC.Types.Unique.Supply
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 81b0607a49..afa8a0e1d8 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -70,7 +70,7 @@ import GHC.Types.Name.Reader
import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, startsWithUnderscore )
import GHC.Core.DataCon ( DataCon, dataConName )
import GHC.Types.SrcLoc
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Basic
import GHC.Types.ForeignCall
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index 12fd44dc4b..f6be2a2487 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -32,7 +32,7 @@ import GHC.Parser ( parseHeader )
import GHC.Parser.Lexer
import GHC.Data.FastString
import GHC.Hs
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Builtin.Names
import GHC.Data.StringBuffer
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 8b1fd41146..5bdf4c41f3 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -105,7 +105,7 @@ import GHC.Driver.Session as DynFlags
-- compiler/basicTypes
import GHC.Types.SrcLoc
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Basic ( InlineSpec(..), RuleMatchInfo(..),
IntegralLit(..), FractionalLit(..),
SourceText(..) )
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index c51ac4c053..a523e7b32c 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -26,8 +26,8 @@ module GHC.Plugins
, module GHC.Core.Rules
, module GHC.Types.Annotations
, module GHC.Driver.Session
- , module GHC.Driver.Packages
- , module GHC.Types.Module
+ , module GHC.Unit.State
+ , module GHC.Unit.Module
, module GHC.Core.Type
, module GHC.Core.TyCon
, module GHC.Core.Coercion
@@ -81,10 +81,10 @@ import GHC.Types.Annotations
-- Pipeline-related stuff
import GHC.Driver.Session
-import GHC.Driver.Packages
+import GHC.Unit.State
-- Important GHC types
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Core.Type hiding {- conflict with GHC.Core.Subst -}
( substTy, extendTvSubst, extendTvSubstList, isInScope )
import GHC.Core.Coercion hiding {- conflict with GHC.Core.Subst -}
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 5f624a3000..c6c175c07c 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -45,7 +45,7 @@ import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, extendTyVarEnvFVRn
, checkUnusedRecordWildcard
, checkDupAndShadowedNames, bindLocalNamesFV )
import GHC.Driver.Session
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
diff --git a/compiler/GHC/Rename/Env.hs b/compiler/GHC/Rename/Env.hs
index 1c22cf781e..e6fa48c004 100644
--- a/compiler/GHC/Rename/Env.hs
+++ b/compiler/GHC/Rename/Env.hs
@@ -59,7 +59,7 @@ import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
import GHC.Types.Avail
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 62afe116df..773b194db8 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -33,7 +33,7 @@ import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBind
import GHC.Hs
import GHC.Tc.Utils.Env ( isBrackStage )
import GHC.Tc.Utils.Monad
-import GHC.Types.Module ( getModule )
+import GHC.Unit.Module ( getModule )
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( HsDocContext(..), bindLocalNamesFV, checkDupNames
diff --git a/compiler/GHC/Rename/Fixity.hs b/compiler/GHC/Rename/Fixity.hs
index 5920a1ee9a..eb9e59035b 100644
--- a/compiler/GHC/Rename/Fixity.hs
+++ b/compiler/GHC/Rename/Fixity.hs
@@ -25,7 +25,7 @@ import GHC.Driver.Types
import GHC.Tc.Utils.Monad
import GHC.Types.Name
import GHC.Types.Name.Env
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Basic ( Fixity(..), FixityDirection(..), minPrecedence,
defaultFixity, SourceText(..) )
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 0f17a3c6f2..10a707c9ee 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -42,7 +42,7 @@ import GHC.Tc.Gen.Annotation ( annCtxt )
import GHC.Tc.Utils.Monad
import GHC.Types.ForeignCall ( CCallTarget(..) )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Driver.Types ( Warnings(..), plusWarns )
import GHC.Builtin.Names( applicativeClassName, pureAName, thenAName
, monadClassName, returnMName, thenMName
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 68f08a9cfd..df39d01adb 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -44,7 +44,7 @@ import GHC.Rename.Utils ( warnUnusedTopBinds, mkFieldEnv )
import GHC.Iface.Load ( loadSrcInterface )
import GHC.Tc.Utils.Monad
import GHC.Builtin.Names
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index 1842cd0c44..78d943bed8 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -29,7 +29,7 @@ import GHC.Rename.Module ( rnSrcDecls, findSplice )
import GHC.Rename.Pat ( rnPat )
import GHC.Types.Basic ( TopLevelFlag, isTopLevel, SourceText(..) )
import GHC.Utils.Outputable
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Rename.HsType ( rnLHsType )
diff --git a/compiler/GHC/Rename/Unbound.hs b/compiler/GHC/Rename/Unbound.hs
index c0cc6eeb64..d37c7d62c0 100644
--- a/compiler/GHC/Rename/Unbound.hs
+++ b/compiler/GHC/Rename/Unbound.hs
@@ -23,7 +23,7 @@ import GHC.Types.Name.Reader
import GHC.Driver.Types
import GHC.Tc.Utils.Monad
import GHC.Types.Name
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.SrcLoc as SrcLoc
import GHC.Utils.Outputable as Outputable
import GHC.Builtin.Names ( mkUnboundName, isUnboundName, getUnique)
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 802de13186..edf8163a43 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -83,7 +83,7 @@ import GHC.LanguageExtensions
import GHC.Types.Unique
import GHC.Types.Unique.Supply
import GHC.Utils.Monad
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Builtin.Names ( toDynName, pretendNameIsInScope )
import GHC.Builtin.Types ( isCTupleTyConName )
import GHC.Utils.Panic
diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs
index 0f2cd80c34..9586947742 100644
--- a/compiler/GHC/Runtime/Eval/Types.hs
+++ b/compiler/GHC/Runtime/Eval/Types.hs
@@ -18,7 +18,7 @@ import GHCi.RemoteTypes
import GHCi.Message (EvalExpr, ResumeContext)
import GHC.Types.Id
import GHC.Types.Name
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name.Reader
import GHC.Core.Type
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 9434e2e9ec..5b2bf597d2 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -48,7 +48,7 @@ import GHC.Tc.Utils.Env
import GHC.Core.TyCon
import GHC.Types.Name
import GHC.Types.Name.Occurrence as OccName
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Iface.Env
import GHC.Utils.Misc
import GHC.Types.Var.Set
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 081c71d388..1495c5c82e 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -73,7 +73,7 @@ import GHC.Runtime.Eval.Types(BreakInfo(..))
import GHC.Utils.Outputable(brackets, ppr, showSDocUnqual)
import GHC.Types.SrcLoc
import GHC.Data.Maybe
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.ByteCode.Types
import GHC.Types.Unique
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index d93c5acebc..18a8ad735d 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -39,14 +39,14 @@ import GHC.ByteCode.Linker
import GHC.ByteCode.Asm
import GHC.ByteCode.Types
import GHC.Tc.Utils.Monad
-import GHC.Driver.Packages as Packages
+import GHC.Unit.State as Packages
import GHC.Driver.Phases
import GHC.Driver.Finder
import GHC.Driver.Types
import GHC.Driver.Ways
import GHC.Types.Name
import GHC.Types.Name.Env
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Data.List.SetOps
import GHC.Runtime.Linker.Types (DynLinker(..), LinkerUnitId, PersistentLinkerState(..))
import GHC.Driver.Session
diff --git a/compiler/GHC/Runtime/Linker/Types.hs b/compiler/GHC/Runtime/Linker/Types.hs
index afbd0dae73..6e9dd5c8e9 100644
--- a/compiler/GHC/Runtime/Linker/Types.hs
+++ b/compiler/GHC/Runtime/Linker/Types.hs
@@ -19,7 +19,7 @@ import GHC.Prelude ( FilePath, String, show )
import Data.Time ( UTCTime )
import Data.Maybe ( Maybe )
import Control.Concurrent.MVar ( MVar )
-import GHC.Types.Module ( UnitId, Module )
+import GHC.Unit ( UnitId, Module )
import GHC.ByteCode.Types ( ItblEnv, CompiledByteCode )
import GHC.Utils.Outputable
import GHC.Types.Var ( Id )
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 81168f7c28..8eb48881c9 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -45,7 +45,7 @@ import GHC.Core.TyCo.Ppr ( pprTyThingCategory )
import GHC.Core.TyCon ( TyCon )
import GHC.Types.Name ( Name, nameModule_maybe )
import GHC.Types.Id ( idType )
-import GHC.Types.Module ( Module, ModuleName )
+import GHC.Unit.Module ( Module, ModuleName )
import GHC.Utils.Panic
import GHC.Data.FastString
import GHC.Utils.Error
diff --git a/compiler/GHC/Stg/DepAnal.hs b/compiler/GHC/Stg/DepAnal.hs
index 3f35acbb16..d0d1b76322 100644
--- a/compiler/GHC/Stg/DepAnal.hs
+++ b/compiler/GHC/Stg/DepAnal.hs
@@ -11,7 +11,7 @@ import GHC.Types.Name.Env
import GHC.Utils.Outputable
import GHC.Types.Unique.Set (nonDetEltsUniqSet)
import GHC.Types.Var.Set
-import GHC.Types.Module (Module)
+import GHC.Unit.Module (Module)
import Data.Graph (SCC (..))
diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs
index 69c961a081..0d57be2722 100644
--- a/compiler/GHC/Stg/Lint.hs
+++ b/compiler/GHC/Stg/Lint.hs
@@ -55,7 +55,7 @@ import GHC.Core.Type
import GHC.Types.RepType
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
-import GHC.Types.Module ( Module )
+import GHC.Unit.Module ( Module )
import qualified GHC.Utils.Error as Err
import Control.Applicative ((<|>))
import Control.Monad
diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs
index 59b592fbc1..8359788b92 100644
--- a/compiler/GHC/Stg/Pipeline.hs
+++ b/compiler/GHC/Stg/Pipeline.hs
@@ -23,7 +23,7 @@ import GHC.Stg.DepAnal ( depSortStgPgm )
import GHC.Stg.Unarise ( unarise )
import GHC.Stg.CSE ( stgCse )
import GHC.Stg.Lift ( stgLiftLams )
-import GHC.Types.Module ( Module )
+import GHC.Unit.Module ( Module )
import GHC.Driver.Session
import GHC.Utils.Error
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 71f1b5fbc1..c37a15b4c1 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -74,9 +74,9 @@ import GHC.Types.ForeignCall ( ForeignCall )
import GHC.Types.Id
import GHC.Types.Var.Set
import GHC.Types.Literal ( Literal, literalType )
-import GHC.Types.Module ( Module )
+import GHC.Unit.Module ( Module )
import GHC.Utils.Outputable
-import GHC.Driver.Packages ( isDynLinkName )
+import GHC.Unit.State ( isDynLinkName )
import GHC.Platform
import GHC.Core.Ppr( {- instances -} )
import GHC.Builtin.PrimOps ( PrimOp, PrimCall )
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 4a2c379b36..1a4bd47439 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -41,7 +41,7 @@ import GHC.Types.Id.Info
import GHC.Types.RepType
import GHC.Core.DataCon
import GHC.Core.TyCon
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Data.Stream
import GHC.Types.Basic
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 851da5ed21..566f4ad281 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -42,7 +42,7 @@ import GHC.Types.CostCentre
import GHC.Types.Id
import GHC.Types.Id.Info
import GHC.Types.Name
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Data.List.SetOps
import GHC.Utils.Misc
import GHC.Types.Var.Set
diff --git a/compiler/GHC/StgToCmm/DataCon.hs b/compiler/GHC/StgToCmm/DataCon.hs
index 6d2ca60944..752d4df681 100644
--- a/compiler/GHC/StgToCmm/DataCon.hs
+++ b/compiler/GHC/StgToCmm/DataCon.hs
@@ -35,7 +35,7 @@ import GHC.Cmm.CLabel
import GHC.Cmm.Graph
import GHC.Runtime.Heap.Layout
import GHC.Types.CostCentre
-import GHC.Types.Module
+import GHC.Unit
import GHC.Core.DataCon
import GHC.Driver.Session
import GHC.Data.FastString
diff --git a/compiler/GHC/StgToCmm/ExtCode.hs b/compiler/GHC/StgToCmm/ExtCode.hs
index cb57d970f0..49f6a21b9c 100644
--- a/compiler/GHC/StgToCmm/ExtCode.hs
+++ b/compiler/GHC/StgToCmm/ExtCode.hs
@@ -49,7 +49,7 @@ import GHC.Cmm.Graph
import GHC.Cmm.BlockId
import GHC.Driver.Session
import GHC.Data.FastString
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique.FM
import GHC.Types.Unique
import GHC.Types.Unique.Supply
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 65c2e7beff..17b57e1f1d 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -44,7 +44,7 @@ import GHC.Cmm.Utils
import GHC.Types.CostCentre
import GHC.Types.Id.Info( CafInfo(..), mayHaveCafRefs )
import GHC.Types.Id ( Id )
-import GHC.Types.Module
+import GHC.Unit
import GHC.Driver.Session
import GHC.Platform
import GHC.Data.FastString( mkFastString, fsLit )
diff --git a/compiler/GHC/StgToCmm/Hpc.hs b/compiler/GHC/StgToCmm/Hpc.hs
index e418d03fde..77b1e0af47 100644
--- a/compiler/GHC/StgToCmm/Hpc.hs
+++ b/compiler/GHC/StgToCmm/Hpc.hs
@@ -16,7 +16,7 @@ import GHC.Platform
import GHC.Cmm.Graph
import GHC.Cmm.Expr
import GHC.Cmm.CLabel
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Cmm.Utils
import GHC.StgToCmm.Utils
import GHC.Driver.Types
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index a02d66906f..ce04371ce2 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -54,7 +54,7 @@ import GHC.Core.TyCon ( PrimRep(..), primRepSizeB )
import GHC.Types.Basic ( RepArity )
import GHC.Driver.Session
import GHC.Platform
-import GHC.Types.Module
+import GHC.Unit
import GHC.Utils.Misc
import Data.List
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index 894b8a0fd2..7d948e4c5a 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -70,7 +70,7 @@ import GHC.Cmm.Graph as CmmGraph
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Runtime.Heap.Layout
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Id
import GHC.Types.Var.Env
import GHC.Data.OrdList
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 18acc11304..b0f9fddad6 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -42,7 +42,7 @@ import GHC.Cmm.BlockId
import GHC.Cmm.Graph
import GHC.Stg.Syntax
import GHC.Cmm
-import GHC.Types.Module ( rtsUnitId )
+import GHC.Unit ( rtsUnitId )
import GHC.Core.Type ( Type, tyConAppTyCon )
import GHC.Core.TyCon
import GHC.Cmm.CLabel
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index ae123fd9c7..bd045ca465 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -39,7 +39,7 @@ import GHC.Cmm.CLabel
import GHC.Types.CostCentre
import GHC.Driver.Session
import GHC.Data.FastString
-import GHC.Types.Module as Module
+import GHC.Unit.Module as Module
import GHC.Utils.Outputable
import Control.Monad
@@ -220,8 +220,8 @@ emitCostCentreDecl cc = do
| otherwise = zero platform
-- NB. bytesFS: we want the UTF-8 bytes here (#5559)
; label <- newByteStringCLit (bytesFS $ costCentreUserNameFS cc)
- ; modl <- newByteStringCLit (bytesFS $ Module.moduleNameFS
- $ Module.moduleName
+ ; modl <- newByteStringCLit (bytesFS $ moduleNameFS
+ $ moduleName
$ cc_mod cc)
; loc <- newByteStringCLit $ bytesFS $ mkFastString $
showPpr dflags (costCentreSrcSpan cc)
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 8eff2f608c..1170e48a73 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -120,7 +120,7 @@ import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Runtime.Heap.Layout
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Name
import GHC.Types.Id
import GHC.Types.Basic
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 6bb1022819..18a69c9509 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -67,7 +67,7 @@ import GHC.Types.Id.Info
import GHC.Core.Type
import GHC.Core.TyCon
import GHC.Runtime.Heap.Layout
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Literal
import GHC.Data.Graph.Directed
import GHC.Utils.Misc
diff --git a/compiler/GHC/SysTools.hs b/compiler/GHC/SysTools.hs
index 604cd60fd1..036220b7c1 100644
--- a/compiler/GHC/SysTools.hs
+++ b/compiler/GHC/SysTools.hs
@@ -42,8 +42,7 @@ import GHC.Prelude
import GHC.Settings.Utils
-import GHC.Types.Module
-import GHC.Driver.Packages
+import GHC.Unit
import GHC.Utils.Outputable
import GHC.Utils.Error
import GHC.Platform
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index e8715d4048..7901a318b8 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -16,11 +16,11 @@ module GHC.SysTools.ExtraObj (
import GHC.Utils.Asm
import GHC.Utils.Error
import GHC.Driver.Session
-import GHC.Driver.Packages
+import GHC.Unit.State
import GHC.Platform
import GHC.Utils.Outputable as Outputable
import GHC.Types.SrcLoc ( noSrcSpan )
-import GHC.Types.Module
+import GHC.Unit
import GHC.SysTools.Elf
import GHC.Utils.Misc
import GHC.Prelude
diff --git a/compiler/GHC/Tc/Deriv/Generics.hs b/compiler/GHC/Tc/Deriv/Generics.hs
index 9205856996..ced6f4b690 100644
--- a/compiler/GHC/Tc/Deriv/Generics.hs
+++ b/compiler/GHC/Tc/Deriv/Generics.hs
@@ -30,7 +30,7 @@ import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Core.FamInstEnv ( FamInst, FamFlavor(..), mkSingleCoAxiom )
import GHC.Tc.Instance.Family
-import GHC.Types.Module ( moduleName, moduleNameFS
+import GHC.Unit.Module ( moduleName, moduleNameFS
, moduleUnit, unitFS, getModule )
import GHC.Iface.Env ( newGlobalBinder )
import GHC.Types.Name hiding ( varName )
diff --git a/compiler/GHC/Tc/Deriv/Utils.hs b/compiler/GHC/Tc/Deriv/Utils.hs
index 72ee0e6af3..66adb4e554 100644
--- a/compiler/GHC/Tc/Deriv/Utils.hs
+++ b/compiler/GHC/Tc/Deriv/Utils.hs
@@ -35,7 +35,7 @@ import GHC.Hs
import GHC.Tc.Utils.Instantiate
import GHC.Core.InstEnv
import GHC.Iface.Load (loadInterfaceForName)
-import GHC.Types.Module (getModule)
+import GHC.Unit.Module (getModule)
import GHC.Types.Name
import GHC.Utils.Outputable
import GHC.Builtin.Names
diff --git a/compiler/GHC/Tc/Errors.hs b/compiler/GHC/Tc/Errors.hs
index b90eae080b..edbccbb134 100644
--- a/compiler/GHC/Tc/Errors.hs
+++ b/compiler/GHC/Tc/Errors.hs
@@ -32,7 +32,7 @@ import GHC.Core.Coercion
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Ppr ( pprTyVars, pprWithExplicitKindsWhen, pprSourceTyCon, pprWithTYPE )
import GHC.Core.Unify ( tcMatchTys )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Tc.Instance.Family
import GHC.Core.FamInstEnv ( flattenTys )
import GHC.Tc.Utils.Instantiate
diff --git a/compiler/GHC/Tc/Gen/Annotation.hs b/compiler/GHC/Tc/Gen/Annotation.hs
index 47bca17766..6e9c7ac5ed 100644
--- a/compiler/GHC/Tc/Gen/Annotation.hs
+++ b/compiler/GHC/Tc/Gen/Annotation.hs
@@ -13,7 +13,7 @@ module GHC.Tc.Gen.Annotation ( tcAnnotations, annCtxt ) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Tc.Gen.Splice ( runAnnotation )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Driver.Session
import Control.Monad ( when )
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 929e02cc07..c2af14b93d 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -51,7 +51,7 @@ import GHC.Types.Id
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env( TidyEnv )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index d4235ba171..3aed54a802 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -21,7 +21,7 @@ import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Utils.Error
import GHC.Types.Id
import GHC.Types.Id.Info
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index a8cdd08bce..18582c40ed 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -46,7 +46,7 @@ import GHC.Types.Var ( TyVar, tyVarKind )
import GHC.Types.Id ( Id, idName, idType, idInlinePragma, setInlinePragma, mkLocalId )
import GHC.Builtin.Names( mkUnboundName )
import GHC.Types.Basic
-import GHC.Types.Module( getModule )
+import GHC.Unit.Module( getModule )
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 2b308bf753..f959b85278 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -89,7 +89,7 @@ import GHC.Builtin.Types
import GHC.Types.Name.Occurrence as OccName
import GHC.Driver.Hooks
import GHC.Types.Var
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Iface.Load
import GHC.Core.Class
import GHC.Core.TyCon
diff --git a/compiler/GHC/Tc/Instance/Family.hs b/compiler/GHC/Tc/Instance/Family.hs
index 507da20c92..448ef0bd8c 100644
--- a/compiler/GHC/Tc/Instance/Family.hs
+++ b/compiler/GHC/Tc/Instance/Family.hs
@@ -27,7 +27,7 @@ import GHC.Core.TyCon
import GHC.Tc.Utils.TcType
import GHC.Core.Coercion.Axiom
import GHC.Driver.Session
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Misc
import GHC.Types.Name.Reader
diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs
index 2de4e057b0..3f8b7d8281 100644
--- a/compiler/GHC/Tc/Instance/Typeable.hs
+++ b/compiler/GHC/Tc/Instance/Typeable.hs
@@ -34,7 +34,7 @@ import GHC.Types.Id
import GHC.Core.Type
import GHC.Core.TyCon
import GHC.Core.DataCon
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Hs
import GHC.Driver.Session
import GHC.Data.Bag
@@ -56,7 +56,7 @@ The overall plan is this:
1. Generate a binding for each module p:M
(done in GHC.Tc.Instance.Typeable by mkModIdBindings)
- M.$trModule :: GHC.Types.Module
+ M.$trModule :: GHC.Unit.Module
M.$trModule = Module "p" "M"
("tr" is short for "type representation"; see GHC.Types)
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 516aea677e..eeb2beb876 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -110,7 +110,7 @@ import GHC.Utils.Error
import GHC.Types.Id as Id
import GHC.Types.Id.Info( IdDetails(..) )
import GHC.Types.Var.Env
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique.FM
import GHC.Types.Name
import GHC.Types.Name.Env
diff --git a/compiler/GHC/Tc/Plugin.hs b/compiler/GHC/Tc/Plugin.hs
index 228647767d..db9c3a1b81 100644
--- a/compiler/GHC/Tc/Plugin.hs
+++ b/compiler/GHC/Tc/Plugin.hs
@@ -71,7 +71,7 @@ import GHC.Tc.Types.Evidence ( TcCoercion, CoercionHole, EvTerm(..)
, EvExpr, EvBind, mkGivenEvBind )
import GHC.Types.Var ( EvVar )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Core.TyCon
import GHC.Core.DataCon
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs
index 0baad1ff4b..bbf3c2084b 100644
--- a/compiler/GHC/Tc/Solver/Monad.hs
+++ b/compiler/GHC/Tc/Solver/Monad.hs
@@ -155,7 +155,7 @@ import GHC.Core.TyCon
import GHC.Tc.Errors ( solverDepthErrorTcS )
import GHC.Types.Name
-import GHC.Types.Module ( HasModule, getModule )
+import GHC.Unit.Module ( HasModule, getModule )
import GHC.Types.Name.Reader ( GlobalRdrEnv, GlobalRdrElt )
import qualified GHC.Rename.Env as TcM
import GHC.Types.Var
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index 93637329ad..5da467d770 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -60,7 +60,7 @@ import GHC.Types.Id
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index ad0aec3ac1..249f08beea 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -65,7 +65,7 @@ import GHC.Data.Maybe
import GHC.Data.Bag
import GHC.Data.FastString
import GHC.Utils.FV as FV
-import GHC.Types.Module
+import GHC.Unit.Module
import qualified GHC.LanguageExtensions as LangExt
import Control.Monad
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 2dab080afb..deafb5539d 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -110,7 +110,7 @@ import GHC.Types.Name.Set
import GHC.Types.Avail
import GHC.Types.Var
import GHC.Types.Var.Env
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.SrcLoc
import GHC.Types.Var.Set
import GHC.Utils.Error
@@ -553,7 +553,7 @@ data TcGblEnv
-- Things defined in this module, or (in GHCi)
-- in the declarations for a single GHCi command.
-- For the latter, see Note [The interactive package] in GHC.Driver.Types
- tcg_tr_module :: Maybe Id, -- Id for $trModule :: GHC.Types.Module
+ tcg_tr_module :: Maybe Id, -- Id for $trModule :: GHC.Unit.Module
-- for which every module has a top-level defn
-- except in GHCi in which case we have Nothing
tcg_binds :: LHsBinds GhcTc, -- Value bindings in this module
diff --git a/compiler/GHC/Tc/Types/EvTerm.hs b/compiler/GHC/Tc/Types/EvTerm.hs
index 063b5652cc..61738f431e 100644
--- a/compiler/GHC/Tc/Types/EvTerm.hs
+++ b/compiler/GHC/Tc/Types/EvTerm.hs
@@ -15,7 +15,7 @@ import GHC.Tc.Types.Evidence
import GHC.Driver.Types
import GHC.Driver.Session
import GHC.Types.Name
-import GHC.Types.Module
+import GHC.Unit
import GHC.Core.Utils
import GHC.Builtin.Names
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index d21f594aef..58f1a9e7b8 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -35,7 +35,7 @@ import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.PatSyn
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Reader
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 70e163c0c6..d28dad8f70 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -21,7 +21,7 @@ module GHC.Tc.Utils.Backpack (
import GHC.Prelude
import GHC.Types.Basic (defaultFixity, TypeOrKind(..))
-import GHC.Driver.Packages
+import GHC.Unit.State
import GHC.Tc.Gen.Export
import GHC.Driver.Session
import GHC.Hs
@@ -41,7 +41,7 @@ import GHC.Iface.Load
import GHC.Rename.Names
import GHC.Utils.Error
import GHC.Types.Id
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 4658b63f00..8c2a60ba50 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -100,7 +100,7 @@ import GHC.Driver.Types
import GHC.Driver.Session
import GHC.Types.SrcLoc
import GHC.Types.Basic hiding( SuccessFlag(..) )
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Encoding
import GHC.Data.FastString
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 5d753e7b23..b256be47f2 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -153,7 +153,7 @@ import GHC.Tc.Types.Origin
import GHC.Hs hiding (LIE)
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit
import GHC.Types.Name.Reader
import GHC.Types.Name
import GHC.Core.Type
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 1c44d0f6c0..6c7e121bd6 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -30,7 +30,7 @@ import GHC.Hs as Hs
import GHC.Builtin.Names
import GHC.Types.Name.Reader
import qualified GHC.Types.Name as Name
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Parser.PostProcess
import GHC.Types.Name.Occurrence as OccName
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Types/Annotations.hs b/compiler/GHC/Types/Annotations.hs
index c096558651..90cbe64f53 100644
--- a/compiler/GHC/Types/Annotations.hs
+++ b/compiler/GHC/Types/Annotations.hs
@@ -20,10 +20,8 @@ module GHC.Types.Annotations (
import GHC.Prelude
import GHC.Utils.Binary
-import GHC.Types.Module ( Module
- , ModuleEnv, emptyModuleEnv, extendModuleEnvWith
- , plusModuleEnv_C, lookupWithDefaultModuleEnv
- , mapModuleEnv )
+import GHC.Unit.Module ( Module )
+import GHC.Unit.Module.Env
import GHC.Types.Name.Env
import GHC.Types.Name
import GHC.Utils.Outputable
diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs
index a8fb03cef7..730c469a04 100644
--- a/compiler/GHC/Types/CostCentre.hs
+++ b/compiler/GHC/Types/CostCentre.hs
@@ -25,7 +25,7 @@ import GHC.Prelude
import GHC.Utils.Binary
import GHC.Types.Var
import GHC.Types.Name
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique
import GHC.Utils.Outputable
import GHC.Types.SrcLoc
diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs
index 6c0fc2a4a8..2a42a2b51e 100644
--- a/compiler/GHC/Types/ForeignCall.hs
+++ b/compiler/GHC/Types/ForeignCall.hs
@@ -23,7 +23,7 @@ import GHC.Prelude
import GHC.Data.FastString
import GHC.Utils.Binary
import GHC.Utils.Outputable
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Basic ( SourceText, pprWithSourceText )
import Data.Char
diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs
index ebb762dacd..028bfd45f0 100644
--- a/compiler/GHC/Types/Id.hs
+++ b/compiler/GHC/Types/Id.hs
@@ -142,7 +142,7 @@ import GHC.Core.DataCon
import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Types.Name
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Core.Class
import {-# SOURCE #-} GHC.Builtin.PrimOps (PrimOp)
import GHC.Types.ForeignCall
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index 0e7d2d1b5f..896d54463c 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -100,7 +100,7 @@ import GHC.Core.PatSyn
import GHC.Core.Type
import GHC.Types.ForeignCall
import GHC.Utils.Outputable
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Demand
import GHC.Types.Cpr
import GHC.Utils.Misc
diff --git a/compiler/GHC/Types/Module.hs b/compiler/GHC/Types/Module.hs
deleted file mode 100644
index aa1baad89f..0000000000
--- a/compiler/GHC/Types/Module.hs
+++ /dev/null
@@ -1,1487 +0,0 @@
-{-
-(c) The University of Glasgow, 2004-2006
-
-
-Module
-~~~~~~~~~~
-Simply the name of a module, represented as a FastString.
-These are Uniquable, hence we can build Maps with Modules as
-the keys.
--}
-
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ExplicitNamespaces #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveFunctor #-}
-
-module GHC.Types.Module
- (
- -- * The ModuleName type
- ModuleName,
- pprModuleName,
- moduleNameFS,
- moduleNameString,
- moduleNameSlashes, moduleNameColons,
- moduleStableString,
- moduleFreeHoles,
- moduleIsDefinite,
- mkModuleName,
- mkModuleNameFS,
- stableModuleNameCmp,
-
- -- * The Unit type
- Indefinite(..),
- IndefUnitId,
- UnitPprInfo(..),
- GenUnit(..),
- mapGenUnit,
- Unit,
- unitFS,
- unitKey,
- GenInstantiatedUnit(..),
- InstantiatedUnit,
- instUnitToUnit,
- instModuleToModule,
- UnitId(..),
- toUnitId,
- ShHoleSubst,
- Instantiations,
- GenInstantiations,
-
- unitIsDefinite,
- unitString,
- unitFreeModuleHoles,
-
- mkGenVirtUnit,
- mkVirtUnit,
- mkGenInstantiatedUnit,
- mkInstantiatedUnit,
- mkGenInstantiatedUnitHash,
- mkInstantiatedUnitHash,
- fsToUnit,
- stringToUnit,
- stableUnitCmp,
-
- -- * HOLE renaming
- renameHoleUnit,
- renameHoleModule,
- renameHoleUnit',
- renameHoleModule',
-
- -- * Generalization
- getModuleInstantiation,
- getUnitInstantiations,
- uninstantiateInstantiatedUnit,
- uninstantiateInstantiatedModule,
-
- -- * Parsers
- parseModuleName,
- parseUnit,
- parseIndefUnitId,
- parseHoleyModule,
- parseModSubst,
-
- -- * Wired-in UnitIds
- primUnitId,
- integerUnitId,
- baseUnitId,
- rtsUnitId,
- thUnitId,
- mainUnitId,
- thisGhcUnitId,
- isHoleModule,
- interactiveUnitId, isInteractiveModule,
- wiredInUnitIds,
-
- -- * The Module type
- GenModule(..),
- type Module,
- type InstalledModule,
- type InstantiatedModule,
- pprModule,
- mkModule,
- mkHoleModule,
- stableModuleCmp,
- HasModule(..),
- ContainsModule(..),
-
- -- * Installed unit ids and modules
- InstalledModuleEnv,
- installedModuleEq,
- unitIdEq,
- unitIdString,
- fsToUnitId,
- stringToUnitId,
- emptyInstalledModuleEnv,
- lookupInstalledModuleEnv,
- extendInstalledModuleEnv,
- filterInstalledModuleEnv,
- delInstalledModuleEnv,
- DefUnitId,
- Definite(..),
-
- -- * The ModuleLocation type
- ModLocation(..),
- addBootSuffix, addBootSuffix_maybe,
- addBootSuffixLocn, addBootSuffixLocnOut,
-
- -- * Module mappings
- ModuleEnv,
- elemModuleEnv, extendModuleEnv, extendModuleEnvList,
- extendModuleEnvList_C, plusModuleEnv_C,
- delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
- lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
- moduleEnvKeys, moduleEnvElts, moduleEnvToList,
- unitModuleEnv, isEmptyModuleEnv,
- extendModuleEnvWith, filterModuleEnv,
-
- -- * ModuleName mappings
- ModuleNameEnv, DModuleNameEnv,
-
- -- * Sets of Modules
- ModuleSet,
- emptyModuleSet, mkModuleSet, moduleSetElts,
- extendModuleSet, extendModuleSetList, delModuleSet,
- elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet,
- unitModuleSet
- ) where
-
-import GHC.Prelude
-
-import GHC.Utils.Outputable
-import GHC.Types.Unique
-import GHC.Types.Unique.FM
-import GHC.Types.Unique.DFM
-import GHC.Types.Unique.DSet
-import GHC.Data.FastString
-import GHC.Utils.Binary
-import GHC.Utils.Misc
-import Data.List (sortBy, sort)
-import Data.Ord
-import Data.Version
-import GHC.Utils.Fingerprint
-
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS.Char8
-import GHC.Utils.Encoding
-
-import qualified Text.ParserCombinators.ReadP as Parse
-import Text.ParserCombinators.ReadP (ReadP, (<++))
-import Data.Char (isAlphaNum)
-import Control.DeepSeq
-import Data.Coerce
-import Data.Data
-import Data.Function
-import Data.Bifunctor
-import Data.Map (Map)
-import Data.Set (Set)
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import qualified GHC.Data.FiniteMap as Map
-import System.FilePath
-
-import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
-import {-# SOURCE #-} GHC.Driver.Packages (improveUnit, UnitInfoMap, getUnitInfoMap, displayUnitId, getPackageState, PackageState, unitInfoMap)
-
--- Note [The identifier lexicon]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- Haskell users are used to manipulate Cabal packages. These packages are
--- identified by:
--- - a package name :: String
--- - a package version :: Version
--- - (a revision number, when they are registered on Hackage)
---
--- Cabal packages may contain several components (libraries, programs,
--- testsuites). In GHC we are mostly interested in libraries because those are
--- the components that can be depended upon by other components. Components in a
--- package are identified by their component name. Historically only one library
--- component was allowed per package, hence it didn't need a name. For this
--- reason, component name may be empty for one library component in each
--- package:
--- - a component name :: Maybe String
---
--- UnitId
--- ------
---
--- Cabal libraries can be compiled in various ways (different compiler options
--- or Cabal flags, different dependencies, etc.), hence using package name,
--- package version and component name isn't enough to identify a built library.
--- We use another identifier called UnitId:
---
--- package name \
--- package version | ________
--- component name | hash of all this ==> | UnitId |
--- Cabal flags | --------
--- compiler options |
--- dependencies' UnitId /
---
--- Fortunately GHC doesn't have to generate these UnitId: they are provided by
--- external build tools (e.g. Cabal) with `-this-unit-id` command-line flag.
---
--- UnitIds are important because they are used to generate internal names
--- (symbols, etc.).
---
--- Wired-in units
--- --------------
---
--- Certain libraries are known to the compiler, in that we know about certain
--- entities that reside in these libraries. The compiler needs to declare static
--- Modules and Names that refer to units built from these libraries.
---
--- Hence UnitIds of wired-in libraries are fixed. Instead of letting Cabal chose
--- the UnitId for these libraries, their .cabal file use the following stanza to
--- force it to a specific value:
---
--- ghc-options: -this-unit-id ghc-prim -- taken from ghc-prim.cabal
---
--- The RTS also uses entities of wired-in units by directly referring to symbols
--- such as "base_GHCziIOziException_heapOverflow_closure" where the prefix is
--- the UnitId of "base" unit.
---
--- Unit databases
--- --------------
---
--- Units are stored in databases in order to be reused by other codes:
---
--- UnitKey ---> UnitInfo { exposed modules, package name, package version
--- component name, various file paths,
--- dependencies :: [UnitKey], etc. }
---
--- Because of the wired-in units described above, we can't exactly use UnitIds
--- as UnitKeys in the database: if we did this, we could only have a single unit
--- (compiled library) in the database for each wired-in library. As we want to
--- support databases containing several different units for the same wired-in
--- library, we do this:
---
--- * for non wired-in units:
--- * UnitId = UnitKey = Identifier (hash) computed by Cabal
---
--- * for wired-in units:
--- * UnitKey = Identifier computed by Cabal (just like for non wired-in units)
--- * UnitId = unit-id specified with -this-unit-id command-line flag
---
--- We can expose several units to GHC via the `package-id <UnitKey>`
--- command-line parameter. We must use the UnitKeys of the units so that GHC can
--- find them in the database.
---
--- GHC then replaces the UnitKeys with UnitIds by taking into account wired-in
--- units: these units are detected thanks to their UnitInfo (especially their
--- package name).
---
--- For example, knowing that "base", "ghc-prim" and "rts" are wired-in packages,
--- the following dependency graph expressed with UnitKeys (as found in the
--- database) will be transformed into a similar graph expressed with UnitIds
--- (that are what matters for compilation):
---
--- UnitKeys
--- ~~~~~~~~ ---> rts-1.0-hashABC <--
--- | |
--- | |
--- foo-2.0-hash123 --> base-4.1-hashXYZ ---> ghc-prim-0.5.3-hashABC
---
--- UnitIds
--- ~~~~~~~ ---> rts <--
--- | |
--- | |
--- foo-2.0-hash123 --> base ---------------> ghc-prim
---
---
--- Module signatures / indefinite units / instantiated units
--- ---------------------------------------------------------
---
--- GHC distinguishes two kinds of units:
---
--- * definite: units for which every module has an associated code object
--- (i.e. real compiled code in a .o/.a/.so/.dll/...)
---
--- * indefinite: units for which some modules are replaced by module
--- signatures.
---
--- Module signatures are a kind of interface (similar to .hs-boot files). They
--- are used in place of some real code. GHC allows real modules from other
--- units to be used to fill these module holes. The process is called
--- "unit/module instantiation".
---
--- You can think of this as polymorphism at the module level: module signatures
--- give constraints on the "type" of module that can be used to fill the hole
--- (where "type" means types of the exported module entitites, etc.).
---
--- Module signatures contain enough information (datatypes, abstract types, type
--- synonyms, classes, etc.) to typecheck modules depending on them but not
--- enough to compile them. As such, indefinite units found in databases only
--- provide module interfaces (the .hi ones this time), not object code.
---
--- To distinguish between indefinite and finite unit ids at the type level, we
--- respectively use 'IndefUnitId' and 'DefUnitId' datatypes that are basically
--- wrappers over 'UnitId'.
---
--- Unit instantiation
--- ------------------
---
--- Indefinite units can be instantiated with modules from other units. The
--- instantiating units can also be instantiated themselves (if there are
--- indefinite) and so on. The 'Unit' datatype represents a unit which may have
--- been instantiated:
---
--- data Unit = RealUnit DefUnitId
--- | VirtUnit InstantiatedUnit
---
--- 'InstantiatedUnit' has two interesting fields:
---
--- * instUnitInstanceOf :: IndefUnitId
--- -- ^ the indefinite unit that is instantiated
---
--- * instUnitInsts :: [(ModuleName,(Unit,ModuleName)]
--- -- ^ a list of instantiations, where an instantiation is:
--- (module hole name, (instantiating unit, instantiating module name))
---
--- A 'Unit' may be indefinite or definite, it depends on whether some holes
--- remain in the instantiated unit OR in the instantiating units (recursively).
---
--- Pretty-printing UnitId
--- ----------------------
---
--- GHC mostly deals with UnitIds which are some opaque strings. We could display
--- them when we pretty-print a module origin, a name, etc. But it wouldn't be
--- very friendly to the user because of the hash they usually contain. E.g.
---
--- foo-4.18.1:thelib-XYZsomeUglyHashABC
---
--- Instead when we want to pretty-print a 'UnitId' we query the database to
--- get the 'UnitInfo' and print something nicer to the user:
---
--- foo-4.18.1:thelib
---
--- We do the same for wired-in units.
---
--- Currently (2020-04-06), we don't thread the database into every function that
--- pretty-prints a Name/Module/Unit. Instead querying the database is delayed
--- until the `SDoc` is transformed into a `Doc` using the database that is
--- active at this point in time. This is an issue because we want to be able to
--- unload units from the database and we also want to support several
--- independent databases loaded at the same time (see #14335). The alternatives
--- we have are:
---
--- * threading the database into every function that pretty-prints a UnitId
--- for the user (directly or indirectly).
---
--- * storing enough info to correctly display a UnitId into the UnitId
--- datatype itself. This is done in the IndefUnitId wrapper (see
--- 'UnitPprInfo' datatype) but not for every 'UnitId'. Statically defined
--- 'UnitId' for wired-in units would have empty UnitPprInfo so we need to
--- find some places to update them if we want to display wired-in UnitId
--- correctly. This leads to a solution similar to the first one above.
---
-
-{-
-************************************************************************
-* *
-\subsection{Module locations}
-* *
-************************************************************************
--}
-
--- | Module Location
---
--- Where a module lives on the file system: the actual locations
--- of the .hs, .hi and .o files, if we have them
-data ModLocation
- = ModLocation {
- ml_hs_file :: Maybe FilePath,
- -- The source file, if we have one. Package modules
- -- probably don't have source files.
-
- ml_hi_file :: FilePath,
- -- Where the .hi file is, whether or not it exists
- -- yet. Always of form foo.hi, even if there is an
- -- hi-boot file (we add the -boot suffix later)
-
- ml_obj_file :: FilePath,
- -- Where the .o file is, whether or not it exists yet.
- -- (might not exist either because the module hasn't
- -- been compiled yet, or because it is part of a
- -- package with a .a file)
- ml_hie_file :: FilePath
- } deriving Show
-
-instance Outputable ModLocation where
- ppr = text . show
-
-{-
-For a module in another package, the hs_file and obj_file
-components of ModLocation are undefined.
-
-The locations specified by a ModLocation may or may not
-correspond to actual files yet: for example, even if the object
-file doesn't exist, the ModLocation still contains the path to
-where the object file will reside if/when it is created.
--}
-
-addBootSuffix :: FilePath -> FilePath
--- ^ Add the @-boot@ suffix to .hs, .hi and .o files
-addBootSuffix path = path ++ "-boot"
-
-addBootSuffix_maybe :: Bool -> FilePath -> FilePath
--- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
-addBootSuffix_maybe is_boot path
- | is_boot = addBootSuffix path
- | otherwise = path
-
-addBootSuffixLocn :: ModLocation -> ModLocation
--- ^ Add the @-boot@ suffix to all file paths associated with the module
-addBootSuffixLocn locn
- = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
- , ml_hi_file = addBootSuffix (ml_hi_file locn)
- , ml_obj_file = addBootSuffix (ml_obj_file locn)
- , ml_hie_file = addBootSuffix (ml_hie_file locn) }
-
-addBootSuffixLocnOut :: ModLocation -> ModLocation
--- ^ Add the @-boot@ suffix to all output file paths associated with the
--- module, not including the input file itself
-addBootSuffixLocnOut locn
- = locn { ml_hi_file = addBootSuffix (ml_hi_file locn)
- , ml_obj_file = addBootSuffix (ml_obj_file locn)
- , ml_hie_file = addBootSuffix (ml_hie_file locn) }
-
-{-
-************************************************************************
-* *
-\subsection{The name of a module}
-* *
-************************************************************************
--}
-
--- | A ModuleName is essentially a simple string, e.g. @Data.List@.
-newtype ModuleName = ModuleName FastString
-
-instance Uniquable ModuleName where
- getUnique (ModuleName nm) = getUnique nm
-
-instance Eq ModuleName where
- nm1 == nm2 = getUnique nm1 == getUnique nm2
-
-instance Ord ModuleName where
- nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
-
-instance Outputable ModuleName where
- ppr = pprModuleName
-
-instance Binary ModuleName where
- put_ bh (ModuleName fs) = put_ bh fs
- get bh = do fs <- get bh; return (ModuleName fs)
-
-instance Data ModuleName where
- -- don't traverse?
- toConstr _ = abstractConstr "ModuleName"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "ModuleName"
-
-instance NFData ModuleName where
- rnf x = x `seq` ()
-
-stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
--- ^ Compares module names lexically, rather than by their 'Unique's
-stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
-
-pprModuleName :: ModuleName -> SDoc
-pprModuleName (ModuleName nm) =
- getPprStyle $ \ sty ->
- if codeStyle sty
- then ztext (zEncodeFS nm)
- else ftext nm
-
-moduleNameFS :: ModuleName -> FastString
-moduleNameFS (ModuleName mod) = mod
-
-moduleNameString :: ModuleName -> String
-moduleNameString (ModuleName mod) = unpackFS mod
-
--- | Get a string representation of a 'Module' that's unique and stable
--- across recompilations.
--- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
-moduleStableString :: Module -> String
-moduleStableString Module{..} =
- "$" ++ unitString moduleUnit ++ "$" ++ moduleNameString moduleName
-
-mkModuleName :: String -> ModuleName
-mkModuleName s = ModuleName (mkFastString s)
-
-mkModuleNameFS :: FastString -> ModuleName
-mkModuleNameFS s = ModuleName s
-
--- |Returns the string version of the module name, with dots replaced by slashes.
---
-moduleNameSlashes :: ModuleName -> String
-moduleNameSlashes = dots_to_slashes . moduleNameString
- where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
-
--- |Returns the string version of the module name, with dots replaced by colons.
---
-moduleNameColons :: ModuleName -> String
-moduleNameColons = dots_to_colons . moduleNameString
- where dots_to_colons = map (\c -> if c == '.' then ':' else c)
-
-{-
-************************************************************************
-* *
-\subsection{A fully qualified module}
-* *
-************************************************************************
--}
-
--- | A generic module is a pair of a unit identifier and a 'ModuleName'.
-data GenModule unit = Module
- { moduleUnit :: !unit -- ^ Unit the module belongs to
- , moduleName :: !ModuleName -- ^ Module name (e.g. A.B.C)
- }
- deriving (Eq,Ord,Data,Functor)
-
--- | A Module is a pair of a 'Unit' and a 'ModuleName'.
-type Module = GenModule Unit
-
--- | A 'InstalledModule' is a 'Module' whose unit is identified with an
--- 'UnitId'.
-type InstalledModule = GenModule UnitId
-
--- | An `InstantiatedModule` is a 'Module' whose unit is identified with an `InstantiatedUnit`.
-type InstantiatedModule = GenModule InstantiatedUnit
-
-type GenInstantiations unit = [(ModuleName,GenModule (GenUnit unit))]
-type Instantiations = GenInstantiations UnitId
-
--- | Calculate the free holes of a 'Module'. If this set is non-empty,
--- this module was defined in an indefinite library that had required
--- signatures.
---
--- If a module has free holes, that means that substitutions can operate on it;
--- if it has no free holes, substituting over a module has no effect.
-moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName
-moduleFreeHoles (Module HoleUnit name) = unitUniqDSet name
-moduleFreeHoles (Module u _ ) = unitFreeModuleHoles u
-
--- | A 'Module' is definite if it has no free holes.
-moduleIsDefinite :: Module -> Bool
-moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles
-
-instance Uniquable Module where
- getUnique (Module p n) = getUnique (unitFS p `appendFS` moduleNameFS n)
-
-instance Outputable Module where
- ppr = pprModule
-
-instance Outputable InstalledModule where
- ppr (Module p n) =
- ppr p <> char ':' <> pprModuleName n
-
-instance Outputable InstantiatedModule where
- ppr (Module uid m) =
- ppr uid <> char ':' <> ppr m
-
-instance Binary a => Binary (GenModule a) where
- put_ bh (Module p n) = put_ bh p >> put_ bh n
- get bh = do p <- get bh; n <- get bh; return (Module p n)
-
-instance NFData (GenModule a) where
- rnf (Module unit name) = unit `seq` name `seq` ()
-
--- | This gives a stable ordering, as opposed to the Ord instance which
--- gives an ordering based on the 'Unique's of the components, which may
--- not be stable from run to run of the compiler.
-stableModuleCmp :: Module -> Module -> Ordering
-stableModuleCmp (Module p1 n1) (Module p2 n2)
- = (p1 `stableUnitCmp` p2) `thenCmp`
- (n1 `stableModuleNameCmp` n2)
-
-mkModule :: u -> ModuleName -> GenModule u
-mkModule = Module
-
-pprModule :: Module -> SDoc
-pprModule mod@(Module p n) = getPprStyle doc
- where
- doc sty
- | codeStyle sty =
- (if p == mainUnitId
- then empty -- never qualify the main package in code
- else ztext (zEncodeFS (unitFS p)) <> char '_')
- <> pprModuleName n
- | qualModule sty mod =
- case p of
- HoleUnit -> angleBrackets (pprModuleName n)
- _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n
- | otherwise =
- pprModuleName n
-
-class ContainsModule t where
- extractModule :: t -> Module
-
-class HasModule m where
- getModule :: m Module
-
-
------------------------------------------------------------------------
--- IndefUnitId
------------------------------------------------------------------------
-
--- | An 'IndefUnitId' is an 'UnitId' with the invariant that it only
--- refers to an indefinite library; i.e., one that can be instantiated.
-type IndefUnitId = Indefinite UnitId
-
-data Indefinite unit = Indefinite
- { indefUnit :: unit -- ^ Unit identifier
- , indefUnitPprInfo :: Maybe UnitPprInfo -- ^ Cache for some unit info retrieved from the DB
- }
- deriving (Functor)
-
-instance Eq unit => Eq (Indefinite unit) where
- a == b = indefUnit a == indefUnit b
-
-instance Ord unit => Ord (Indefinite unit) where
- compare a b = compare (indefUnit a) (indefUnit b)
-
--- | Subset of UnitInfo: just enough to pretty-print a unit-id
---
--- Instead of printing the unit-id which may contain a hash, we print:
--- package-version:componentname
---
-data UnitPprInfo = UnitPprInfo
- { unitPprPackageName :: String -- ^ Source package name
- , unitPprPackageVersion :: Version -- ^ Source package version
- , unitPprComponentName :: Maybe String -- ^ Component name
- }
-
-instance Outputable UnitPprInfo where
- ppr pprinfo = text $ mconcat
- [ unitPprPackageName pprinfo
- , case unitPprPackageVersion pprinfo of
- Version [] [] -> ""
- version -> "-" ++ showVersion version
- , case unitPprComponentName pprinfo of
- Nothing -> ""
- Just cname -> ":" ++ cname
- ]
-
-
-instance Uniquable unit => Uniquable (Indefinite unit) where
- getUnique (Indefinite n _) = getUnique n
-
-instance Outputable unit => Outputable (Indefinite unit) where
- ppr (Indefinite uid Nothing) = ppr uid
- ppr (Indefinite uid (Just pprinfo)) =
- getPprStyle $ \sty ->
- if debugStyle sty
- then ppr uid
- else ppr pprinfo
-
-
-
-{-
-************************************************************************
-* *
- Unit
-* *
-************************************************************************
--}
-
--- | A unit identifier identifies a (possibly partially) instantiated library.
--- It is primarily used as part of 'Module', which in turn is used in 'Name',
--- which is used to give names to entities when typechecking.
---
--- There are two possible forms for a 'Unit':
---
--- 1) It can be a 'RealUnit', in which case we just have a 'DefUnitId' that
--- uniquely identifies some fully compiled, installed library we have on disk.
---
--- 2) It can be an 'VirtUnit'. When we are typechecking a library with missing
--- holes, we may need to instantiate a library on the fly (in which case we
--- don't have any on-disk representation.) In that case, you have an
--- 'InstantiatedUnit', which explicitly records the instantiation, so that we
--- can substitute over it.
-type Unit = GenUnit UnitId
-
-data GenUnit unit
- = RealUnit !(Definite unit)
- -- ^ Installed definite unit (either a fully instantiated unit or a closed unit)
-
- | VirtUnit !(GenInstantiatedUnit unit)
- -- ^ Virtual unit instantiated on-the-fly. It may be definite if all the
- -- holes are instantiated but we don't have code objects for it.
-
- | HoleUnit
- -- ^ Fake hole unit
-
--- | Map over the unit type of a 'GenUnit'
-mapGenUnit :: (u -> v) -> (v -> FastString) -> GenUnit u -> GenUnit v
-mapGenUnit f gunitFS = go
- where
- go gu = case gu of
- HoleUnit -> HoleUnit
- RealUnit d -> RealUnit (fmap f d)
- VirtUnit i ->
- VirtUnit $ mkGenInstantiatedUnit gunitFS
- (fmap f (instUnitInstanceOf i))
- (fmap (second (fmap go)) (instUnitInsts i))
-
-unitFS :: Unit -> FastString
-unitFS = genUnitFS unitIdFS
-
-holeFS :: FastString
-holeFS = fsLit "<hole>"
-
-holeUnique :: Unique
-holeUnique = getUnique holeFS
-
-genUnitFS :: (unit -> FastString) -> GenUnit unit -> FastString
-genUnitFS _gunitFS (VirtUnit x) = instUnitFS x
-genUnitFS gunitFS (RealUnit (Definite x)) = gunitFS x
-genUnitFS _gunitFS HoleUnit = holeFS
-
-unitKey :: Unit -> Unique
-unitKey (VirtUnit x) = instUnitKey x
-unitKey (RealUnit (Definite x)) = unitIdKey x
-unitKey HoleUnit = holeUnique
-
--- | A dynamically instantiated unit.
---
--- It identifies an indefinite library (with holes) that has been *on-the-fly*
--- instantiated.
---
--- This unit may be indefinite or not (i.e. with remaining holes or not). In any
--- case, it hasn't been compiled and installed (yet). Nevertheless, we have a
--- mechanism called "improvement" to try to match a fully instantiated unit
--- (i.e. definite, without any remaining hole) with existing compiled and
--- installed units: see Note [VirtUnit to RealUnit improvement].
---
--- An indefinite unit identifier pretty-prints to something like
--- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'IndefUnitId', and the
--- brackets enclose the module substitution).
-type InstantiatedUnit = GenInstantiatedUnit UnitId
-
-data GenInstantiatedUnit unit
- = InstantiatedUnit {
- -- | A private, uniquely identifying representation of
- -- an InstantiatedUnit. This string is completely private to GHC
- -- and is just used to get a unique.
- instUnitFS :: FastString,
- -- | Cached unique of 'unitFS'.
- instUnitKey :: Unique,
- -- | The indefinite unit being instantiated.
- instUnitInstanceOf :: !(Indefinite unit),
- -- | The sorted (by 'ModuleName') instantiations of this unit.
- instUnitInsts :: !(GenInstantiations unit),
- -- | A cache of the free module holes of 'instUnitInsts'.
- -- This lets us efficiently tell if a 'InstantiatedUnit' has been
- -- fully instantiated (empty set of free module holes)
- -- and whether or not a substitution can have any effect.
- instUnitHoles :: UniqDSet ModuleName
- }
-
-instance Eq InstantiatedUnit where
- u1 == u2 = instUnitKey u1 == instUnitKey u2
-
-instance Ord InstantiatedUnit where
- u1 `compare` u2 = instUnitFS u1 `compare` instUnitFS u2
-
-instance Binary InstantiatedUnit where
- put_ bh indef = do
- put_ bh (instUnitInstanceOf indef)
- put_ bh (instUnitInsts indef)
- get bh = do
- cid <- get bh
- insts <- get bh
- let fs = mkInstantiatedUnitHash cid insts
- return InstantiatedUnit {
- instUnitInstanceOf = cid,
- instUnitInsts = insts,
- instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
- instUnitFS = fs,
- instUnitKey = getUnique fs
- }
-
--- | Create a new 'GenInstantiatedUnit' given an explicit module substitution.
-mkGenInstantiatedUnit :: (unit -> FastString) -> Indefinite unit -> GenInstantiations unit -> GenInstantiatedUnit unit
-mkGenInstantiatedUnit gunitFS cid insts =
- InstantiatedUnit {
- instUnitInstanceOf = cid,
- instUnitInsts = sorted_insts,
- instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
- instUnitFS = fs,
- instUnitKey = getUnique fs
- }
- where
- fs = mkGenInstantiatedUnitHash gunitFS cid sorted_insts
- sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
-
--- | Create a new 'InstantiatedUnit' given an explicit module substitution.
-mkInstantiatedUnit :: IndefUnitId -> Instantiations -> InstantiatedUnit
-mkInstantiatedUnit = mkGenInstantiatedUnit unitIdFS
-
--- | Check the database to see if we already have an installed unit that
--- corresponds to the given 'InstantiatedUnit'.
---
--- Return a `UnitId` which either wraps the `InstantiatedUnit` unchanged or
--- references a matching installed unit.
---
--- See Note [VirtUnit to RealUnit improvement]
-instUnitToUnit :: PackageState -> InstantiatedUnit -> Unit
-instUnitToUnit pkgstate iuid =
- -- NB: suppose that we want to compare the indefinite
- -- unit id p[H=impl:H] against p+abcd (where p+abcd
- -- happens to be the existing, installed version of
- -- p[H=impl:H]. If we *only* wrap in p[H=impl:H]
- -- VirtUnit, they won't compare equal; only
- -- after improvement will the equality hold.
- improveUnit (unitInfoMap pkgstate) $
- VirtUnit iuid
-
--- | Injects an 'InstantiatedModule' to 'Module' (see also
--- 'instUnitToUnit'.
-instModuleToModule :: PackageState -> InstantiatedModule -> Module
-instModuleToModule pkgstate (Module iuid mod_name) =
- mkModule (instUnitToUnit pkgstate iuid) mod_name
-
--- | An installed unit identifier identifies a library which has
--- been installed to the package database. These strings are
--- provided to us via the @-this-unit-id@ flag. The library
--- in question may be definite or indefinite; if it is indefinite,
--- none of the holes have been filled (we never install partially
--- instantiated libraries.) Put another way, an installed unit id
--- is either fully instantiated, or not instantiated at all.
---
--- Installed unit identifiers look something like @p+af23SAj2dZ219@,
--- or maybe just @p@ if they don't use Backpack.
-newtype UnitId =
- UnitId {
- -- | The full hashed unit identifier, including the component id
- -- and the hash.
- unitIdFS :: FastString
- }
-
-instance Binary UnitId where
- put_ bh (UnitId fs) = put_ bh fs
- get bh = do fs <- get bh; return (UnitId fs)
-
-instance Eq UnitId where
- uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2
-
-instance Ord UnitId where
- u1 `compare` u2 = unitIdFS u1 `compare` unitIdFS u2
-
-instance Uniquable UnitId where
- getUnique = unitIdKey
-
-instance Outputable UnitId where
- ppr uid@(UnitId fs) =
- getPprStyle $ \sty ->
- sdocWithDynFlags $ \dflags ->
- case displayUnitId (getPackageState dflags) uid of
- Just str | not (debugStyle sty) -> text str
- _ -> ftext fs
-
-unitIdKey :: UnitId -> Unique
-unitIdKey = getUnique . unitIdFS
-
--- | Return the UnitId of the Unit. For instantiated units, return the
--- UnitId of the indefinite unit this unit is an instance of.
-toUnitId :: Unit -> UnitId
-toUnitId (RealUnit (Definite iuid)) = iuid
-toUnitId (VirtUnit indef) = indefUnit (instUnitInstanceOf indef)
-toUnitId HoleUnit = error "Hole unit"
-
-unitIdString :: UnitId -> String
-unitIdString = unpackFS . unitIdFS
-
-instance Outputable InstantiatedUnit where
- ppr uid =
- -- getPprStyle $ \sty ->
- ppr cid <>
- (if not (null insts) -- pprIf
- then
- brackets (hcat
- (punctuate comma $
- [ ppr modname <> text "=" <> ppr m
- | (modname, m) <- insts]))
- else empty)
- where
- cid = instUnitInstanceOf uid
- insts = instUnitInsts uid
-
-fsToUnitId :: FastString -> UnitId
-fsToUnitId fs = UnitId fs
-
-stringToUnitId :: String -> UnitId
-stringToUnitId = fsToUnitId . mkFastString
-
--- | Test if a 'Module' corresponds to a given 'InstalledModule',
--- modulo instantiation.
-installedModuleEq :: InstalledModule -> Module -> Bool
-installedModuleEq imod mod =
- fst (getModuleInstantiation mod) == imod
-
--- | Test if a 'Unit' corresponds to a given 'UnitId',
--- modulo instantiation.
-unitIdEq :: UnitId -> Unit -> Bool
-unitIdEq iuid uid = toUnitId uid == iuid
-
--- | A 'DefUnitId' is an 'UnitId' with the invariant that
--- it only refers to a definite library; i.e., one we have generated
--- code for.
-type DefUnitId = Definite UnitId
-
--- | A definite unit (i.e. without any free module hole)
-newtype Definite unit = Definite { unDefinite :: unit }
- deriving (Eq, Ord, Functor)
-
-instance Outputable unit => Outputable (Definite unit) where
- ppr (Definite uid) = ppr uid
-
-instance Binary unit => Binary (Definite unit) where
- put_ bh (Definite uid) = put_ bh uid
- get bh = do uid <- get bh; return (Definite uid)
-
--- | A map keyed off of 'InstalledModule'
-newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
-
-emptyInstalledModuleEnv :: InstalledModuleEnv a
-emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
-
-lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
-lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
-
-extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
-extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
-
-filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
-filterInstalledModuleEnv f (InstalledModuleEnv e) =
- InstalledModuleEnv (Map.filterWithKey f e)
-
-delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
-delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
-
--- Note [VirtUnit to RealUnit improvement]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
---
--- Over the course of instantiating VirtUnits on the fly while typechecking an
--- indefinite library, we may end up with a fully instantiated VirtUnit. I.e.
--- one that could be compiled and installed in the database. During
--- type-checking we generate a virtual UnitId for it, say "abc".
---
--- Now the question is: do we have a matching installed unit in the database?
--- Suppose we have one with UnitId "xyz" (provided by Cabal so we don't know how
--- to generate it). The trouble is that if both units end up being used in the
--- same type-checking session, their names won't match (e.g. "abc:M.X" vs
--- "xyz:M.X").
---
--- As we want them to match we just replace the virtual unit with the installed
--- one: for some reason this is called "improvement".
---
--- There is one last niggle: improvement based on the package database means
--- that we might end up developing on a package that is not transitively
--- depended upon by the packages the user specified directly via command line
--- flags. This could lead to strange and difficult to understand bugs if those
--- instantiations are out of date. The solution is to only improve a
--- unit id if the new unit id is part of the 'preloadClosure'; i.e., the
--- closure of all the packages which were explicitly specified.
-
--- | Retrieve the set of free module holes of a 'Unit'.
-unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
-unitFreeModuleHoles (VirtUnit x) = instUnitHoles x
--- Hashed unit ids are always fully instantiated
-unitFreeModuleHoles (RealUnit _) = emptyUniqDSet
-unitFreeModuleHoles HoleUnit = emptyUniqDSet
-
-instance Show Unit where
- show = unitString
-
--- | A 'Unit' is definite if it has no free holes.
-unitIsDefinite :: Unit -> Bool
-unitIsDefinite = isEmptyUniqDSet . unitFreeModuleHoles
-
--- | Generate a uniquely identifying hash (internal unit-id) for an instantiated
--- unit.
---
--- This is a one-way function. If the indefinite unit has not been instantiated at all, we return its unit-id.
---
--- This hash is completely internal to GHC and is not used for symbol names or
--- file paths. It is different from the hash Cabal would produce for the same
--- instantiated unit.
-mkGenInstantiatedUnitHash :: (unit -> FastString) -> Indefinite unit -> [(ModuleName, GenModule (GenUnit unit))] -> FastString
-mkGenInstantiatedUnitHash gunitFS cid sorted_holes =
- mkFastStringByteString
- . fingerprintUnitId (bytesFS (gunitFS (indefUnit cid)))
- $ hashInstantiations gunitFS sorted_holes
-
-mkInstantiatedUnitHash :: IndefUnitId -> Instantiations -> FastString
-mkInstantiatedUnitHash = mkGenInstantiatedUnitHash unitIdFS
-
--- | Generate a hash for a sorted module instantiation.
-hashInstantiations :: (unit -> FastString) -> [(ModuleName, GenModule (GenUnit unit))] -> Fingerprint
-hashInstantiations gunitFS sorted_holes =
- fingerprintByteString
- . BS.concat $ do
- (m, b) <- sorted_holes
- [ bytesFS (moduleNameFS m), BS.Char8.singleton ' ',
- bytesFS (genUnitFS gunitFS (moduleUnit b)), BS.Char8.singleton ':',
- bytesFS (moduleNameFS (moduleName b)), BS.Char8.singleton '\n']
-
-fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
-fingerprintUnitId prefix (Fingerprint a b)
- = BS.concat
- $ [ prefix
- , BS.Char8.singleton '-'
- , BS.Char8.pack (toBase62Padded a)
- , BS.Char8.pack (toBase62Padded b) ]
-
--- | Smart constructor for instantiated GenUnit
-mkGenVirtUnit :: (unit -> FastString) -> Indefinite unit -> [(ModuleName, GenModule (GenUnit unit))] -> GenUnit unit
-mkGenVirtUnit _gunitFS uid [] = RealUnit $ Definite (indefUnit uid) -- huh? indefinite unit without any instantiation/hole?
-mkGenVirtUnit gunitFS uid insts = VirtUnit $ mkGenInstantiatedUnit gunitFS uid insts
-
--- | Smart constructor for VirtUnit
-mkVirtUnit :: IndefUnitId -> Instantiations -> Unit
-mkVirtUnit = mkGenVirtUnit unitIdFS
-
-pprUnit :: Unit -> SDoc
-pprUnit (RealUnit uid) = ppr uid
-pprUnit (VirtUnit uid) = ppr uid
-pprUnit HoleUnit = ftext holeFS
-
-instance Eq Unit where
- uid1 == uid2 = unitKey uid1 == unitKey uid2
-
-instance Uniquable Unit where
- getUnique = unitKey
-
-instance Ord Unit where
- nm1 `compare` nm2 = stableUnitCmp nm1 nm2
-
-instance Data Unit where
- -- don't traverse?
- toConstr _ = abstractConstr "Unit"
- gunfold _ _ = error "gunfold"
- dataTypeOf _ = mkNoRepType "Unit"
-
-instance NFData Unit where
- rnf x = x `seq` ()
-
--- | Compares unit ids lexically, rather than by their 'Unique's
-stableUnitCmp :: Unit -> Unit -> Ordering
-stableUnitCmp p1 p2 = unitFS p1 `compare` unitFS p2
-
-instance Outputable Unit where
- ppr pk = pprUnit pk
-
--- Performance: would prefer to have a NameCache like thing
-instance Binary Unit where
- put_ bh (RealUnit def_uid) = do
- putByte bh 0
- put_ bh def_uid
- put_ bh (VirtUnit indef_uid) = do
- putByte bh 1
- put_ bh indef_uid
- put_ bh HoleUnit = do
- putByte bh 2
- get bh = do b <- getByte bh
- case b of
- 0 -> fmap RealUnit (get bh)
- 1 -> fmap VirtUnit (get bh)
- _ -> pure HoleUnit
-
-instance Binary unit => Binary (Indefinite unit) where
- put_ bh (Indefinite fs _) = put_ bh fs
- get bh = do { fs <- get bh; return (Indefinite fs Nothing) }
-
--- | Create a new simple unit identifier from a 'FastString'. Internally,
--- this is primarily used to specify wired-in unit identifiers.
-fsToUnit :: FastString -> Unit
-fsToUnit = RealUnit . Definite . UnitId
-
-stringToUnit :: String -> Unit
-stringToUnit = fsToUnit . mkFastString
-
-unitString :: Unit -> String
-unitString = unpackFS . unitFS
-
-{-
-************************************************************************
-* *
- Hole substitutions
-* *
-************************************************************************
--}
-
--- | Substitution on module variables, mapping module names to module
--- identifiers.
-type ShHoleSubst = ModuleNameEnv Module
-
--- | Substitutes holes in a 'Module'. NOT suitable for being called
--- directly on a 'nameModule', see Note [Representation of module/name variable].
--- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
--- similarly, @<A>@ maps to @q():A@.
-renameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module
-renameHoleModule dflags = renameHoleModule' (getUnitInfoMap dflags)
-
--- | Substitutes holes in a 'Unit', suitable for renaming when
--- an include occurs; see Note [Representation of module/name variable].
---
--- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.
-renameHoleUnit :: DynFlags -> ShHoleSubst -> Unit -> Unit
-renameHoleUnit dflags = renameHoleUnit' (getUnitInfoMap dflags)
-
--- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
--- so it can be used by "Packages".
-renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
-renameHoleModule' pkg_map env m
- | not (isHoleModule m) =
- let uid = renameHoleUnit' pkg_map env (moduleUnit m)
- in mkModule uid (moduleName m)
- | Just m' <- lookupUFM env (moduleName m) = m'
- -- NB m = <Blah>, that's what's in scope.
- | otherwise = m
-
--- | Like 'renameHoleUnit, but requires only 'UnitInfoMap'
--- so it can be used by "Packages".
-renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
-renameHoleUnit' pkg_map env uid =
- case uid of
- (VirtUnit
- InstantiatedUnit{ instUnitInstanceOf = cid
- , instUnitInsts = insts
- , instUnitHoles = fh })
- -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
- then uid
- -- Functorially apply the substitution to the instantiation,
- -- then check the 'UnitInfoMap' to see if there is
- -- a compiled version of this 'InstantiatedUnit' we can improve to.
- -- See Note [VirtUnit to RealUnit improvement]
- else improveUnit pkg_map $
- mkVirtUnit cid
- (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
- _ -> uid
-
--- | Given a possibly on-the-fly instantiated module, split it into
--- a 'Module' that we definitely can find on-disk, as well as an
--- instantiation if we need to instantiate it on the fly. If the
--- instantiation is @Nothing@ no on-the-fly renaming is needed.
-getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
-getModuleInstantiation m =
- let (uid, mb_iuid) = getUnitInstantiations (moduleUnit m)
- in (Module uid (moduleName m),
- fmap (\iuid -> Module iuid (moduleName m)) mb_iuid)
-
--- | Return the unit-id this unit is an instance of and the module instantiations (if any).
-getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
-getUnitInstantiations (VirtUnit iuid) = (indefUnit (instUnitInstanceOf iuid), Just iuid)
-getUnitInstantiations (RealUnit (Definite uid)) = (uid, Nothing)
-getUnitInstantiations HoleUnit = error "Hole unit"
-
--- | Remove instantiations of the given instantiated unit
-uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
-uninstantiateInstantiatedUnit u =
- mkInstantiatedUnit (instUnitInstanceOf u)
- (map (\(m,_) -> (m, mkHoleModule m))
- (instUnitInsts u))
-
--- | Remove instantiations of the given module instantiated unit
-uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
-uninstantiateInstantiatedModule (Module uid n) = Module (uninstantiateInstantiatedUnit uid) n
-
-parseModuleName :: ReadP ModuleName
-parseModuleName = fmap mkModuleName
- $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
-
-parseUnit :: ReadP Unit
-parseUnit = parseVirtUnitId <++ parseDefUnitId
- where
- parseVirtUnitId = do
- uid <- parseIndefUnitId
- insts <- parseModSubst
- return (mkVirtUnit uid insts)
- parseDefUnitId = do
- s <- parseUnitId
- return (RealUnit (Definite s))
-
-parseUnitId :: ReadP UnitId
-parseUnitId = do
- s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
- return (UnitId (mkFastString s))
-
-parseIndefUnitId :: ReadP IndefUnitId
-parseIndefUnitId = do
- uid <- parseUnitId
- return (Indefinite uid Nothing)
-
-parseHoleyModule :: ReadP Module
-parseHoleyModule = parseModuleVar <++ parseModule
- where
- parseModuleVar = do
- _ <- Parse.char '<'
- modname <- parseModuleName
- _ <- Parse.char '>'
- return (Module HoleUnit modname)
- parseModule = do
- uid <- parseUnit
- _ <- Parse.char ':'
- modname <- parseModuleName
- return (Module uid modname)
-
-parseModSubst :: ReadP [(ModuleName, Module)]
-parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
- . flip Parse.sepBy (Parse.char ',')
- $ do k <- parseModuleName
- _ <- Parse.char '='
- v <- parseHoleyModule
- return (k, v)
-
-
-{-
-Note [Wired-in packages]
-~~~~~~~~~~~~~~~~~~~~~~~~
-
-Certain packages are known to the compiler, in that we know about certain
-entities that reside in these packages, and the compiler needs to
-declare static Modules and Names that refer to these packages. Hence
-the wired-in packages can't include version numbers in their package UnitId,
-since we don't want to bake the version numbers of these packages into GHC.
-
-So here's the plan. Wired-in packages are still versioned as
-normal in the packages database, and you can still have multiple
-versions of them installed. To the user, everything looks normal.
-
-However, for each invocation of GHC, only a single instance of each wired-in
-package will be recognised (the desired one is selected via
-@-package@\/@-hide-package@), and GHC will internally pretend that it has the
-*unversioned* 'UnitId', including in .hi files and object file symbols.
-
-Unselected versions of wired-in packages will be ignored, as will any other
-package that depends directly or indirectly on it (much as if you
-had used @-ignore-package@).
-
-The affected packages are compiled with, e.g., @-this-unit-id base@, so that
-the symbols in the object files have the unversioned unit id in their name.
-
-Make sure you change 'Packages.findWiredInPackages' if you add an entry here.
-
-For `integer-gmp`/`integer-simple` we also change the base name to
-`integer-wired-in`, but this is fundamentally no different.
-See Note [The integer library] in GHC.Builtin.Names.
--}
-
-integerUnitId, primUnitId,
- baseUnitId, rtsUnitId,
- thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: Unit
-primUnitId = fsToUnit (fsLit "ghc-prim")
-integerUnitId = fsToUnit (fsLit "integer-wired-in")
- -- See Note [The integer library] in GHC.Builtin.Names
-baseUnitId = fsToUnit (fsLit "base")
-rtsUnitId = fsToUnit (fsLit "rts")
-thUnitId = fsToUnit (fsLit "template-haskell")
-thisGhcUnitId = fsToUnit (fsLit "ghc")
-interactiveUnitId = fsToUnit (fsLit "interactive")
-
--- | This is the package Id for the current program. It is the default
--- package Id if you don't specify a package name. We don't add this prefix
--- to symbol names, since there can be only one main package per program.
-mainUnitId = fsToUnit (fsLit "main")
-
-isInteractiveModule :: Module -> Bool
-isInteractiveModule mod = moduleUnit mod == interactiveUnitId
-
--- Note [Representation of module/name variables]
--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent
--- name holes. This could have been represented by adding some new cases
--- to the core data types, but this would have made the existing 'moduleName'
--- and 'moduleUnit' partial, which would have required a lot of modifications
--- to existing code.
---
--- Instead, we adopted the following encoding scheme:
---
--- <A> ===> hole:A
--- {A.T} ===> hole:A.T
---
--- This encoding is quite convenient, but it is also a bit dangerous too,
--- because if you have a 'hole:A' you need to know if it's actually a
--- 'Module' or just a module stored in a 'Name'; these two cases must be
--- treated differently when doing substitutions. 'renameHoleModule'
--- and 'renameHoleUnit' assume they are NOT operating on a
--- 'Name'; 'NameShape' handles name substitutions exclusively.
-
--- | Test if a Module is not instantiated
-isHoleModule :: GenModule (GenUnit u) -> Bool
-isHoleModule (Module HoleUnit _) = True
-isHoleModule _ = False
-
--- | Create a hole Module
-mkHoleModule :: ModuleName -> GenModule (GenUnit u)
-mkHoleModule = Module HoleUnit
-
-wiredInUnitIds :: [Unit]
-wiredInUnitIds = [ primUnitId,
- integerUnitId,
- baseUnitId,
- rtsUnitId,
- thUnitId,
- thisGhcUnitId ]
-
-{-
-************************************************************************
-* *
-\subsection{@ModuleEnv@s}
-* *
-************************************************************************
--}
-
--- | A map keyed off of 'Module's
-newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
-
-{-
-Note [ModuleEnv performance and determinism]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-To prevent accidental reintroduction of nondeterminism the Ord instance
-for Module was changed to not depend on Unique ordering and to use the
-lexicographic order. This is potentially expensive, but when measured
-there was no difference in performance.
-
-To be on the safe side and not pessimize ModuleEnv uses nondeterministic
-ordering on Module and normalizes by doing the lexicographic sort when
-turning the env to a list.
-See Note [Unique Determinism] for more information about the source of
-nondeterminismand and Note [Deterministic UniqFM] for explanation of why
-it matters for maps.
--}
-
-newtype NDModule = NDModule { unNDModule :: Module }
- deriving Eq
- -- A wrapper for Module with faster nondeterministic Ord.
- -- Don't export, See [ModuleEnv performance and determinism]
-
-instance Ord NDModule where
- compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
- (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
- (getUnique n1 `nonDetCmpUnique` getUnique n2)
-
-filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
-filterModuleEnv f (ModuleEnv e) =
- ModuleEnv (Map.filterWithKey (f . unNDModule) e)
-
-elemModuleEnv :: Module -> ModuleEnv a -> Bool
-elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
-
-extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
-
-extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
- -> ModuleEnv a
-extendModuleEnvWith f (ModuleEnv e) m x =
- ModuleEnv (Map.insertWith f (NDModule m) x e)
-
-extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-extendModuleEnvList (ModuleEnv e) xs =
- ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
-
-extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
- -> ModuleEnv a
-extendModuleEnvList_C f (ModuleEnv e) xs =
- ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
-
-plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
- ModuleEnv (Map.unionWith f e1 e2)
-
-delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
-delModuleEnvList (ModuleEnv e) ms =
- ModuleEnv (Map.deleteList (map NDModule ms) e)
-
-delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
-delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
-
-plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
-
-lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
-lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
-
-lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
-lookupWithDefaultModuleEnv (ModuleEnv e) x m =
- Map.findWithDefault x (NDModule m) e
-
-mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
-mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
-
-mkModuleEnv :: [(Module, a)] -> ModuleEnv a
-mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
-
-emptyModuleEnv :: ModuleEnv a
-emptyModuleEnv = ModuleEnv Map.empty
-
-moduleEnvKeys :: ModuleEnv a -> [Module]
-moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
- -- See Note [ModuleEnv performance and determinism]
-
-moduleEnvElts :: ModuleEnv a -> [a]
-moduleEnvElts e = map snd $ moduleEnvToList e
- -- See Note [ModuleEnv performance and determinism]
-
-moduleEnvToList :: ModuleEnv a -> [(Module, a)]
-moduleEnvToList (ModuleEnv e) =
- sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
- -- See Note [ModuleEnv performance and determinism]
-
-unitModuleEnv :: Module -> a -> ModuleEnv a
-unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
-
-isEmptyModuleEnv :: ModuleEnv a -> Bool
-isEmptyModuleEnv (ModuleEnv e) = Map.null e
-
--- | A set of 'Module's
-type ModuleSet = Set NDModule
-
-mkModuleSet :: [Module] -> ModuleSet
-mkModuleSet = Set.fromList . coerce
-
-extendModuleSet :: ModuleSet -> Module -> ModuleSet
-extendModuleSet s m = Set.insert (NDModule m) s
-
-extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
-extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
-
-emptyModuleSet :: ModuleSet
-emptyModuleSet = Set.empty
-
-moduleSetElts :: ModuleSet -> [Module]
-moduleSetElts = sort . coerce . Set.toList
-
-elemModuleSet :: Module -> ModuleSet -> Bool
-elemModuleSet = Set.member . coerce
-
-intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
-intersectModuleSet = coerce Set.intersection
-
-minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
-minusModuleSet = coerce Set.difference
-
-delModuleSet :: ModuleSet -> Module -> ModuleSet
-delModuleSet = coerce (flip Set.delete)
-
-unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
-unionModuleSet = coerce Set.union
-
-unitModuleSet :: Module -> ModuleSet
-unitModuleSet = coerce Set.singleton
-
-{-
-A ModuleName has a Unique, so we can build mappings of these using
-UniqFM.
--}
-
--- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
-type ModuleNameEnv elt = UniqFM elt
-
-
--- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
--- Has deterministic folds and can be deterministically converted to a list
-type DModuleNameEnv elt = UniqDFM elt
diff --git a/compiler/GHC/Types/Module.hs-boot b/compiler/GHC/Types/Module.hs-boot
deleted file mode 100644
index 7846cb795d..0000000000
--- a/compiler/GHC/Types/Module.hs-boot
+++ /dev/null
@@ -1,17 +0,0 @@
-module GHC.Types.Module where
-
-import GHC.Prelude
-
-data ModuleName
-data UnitId
-data GenModule a
-data GenUnit a
-data Indefinite unit
-
-type Unit = GenUnit UnitId
-type IndefUnitId = Indefinite UnitId
-type Module = GenModule Unit
-
-moduleName :: GenModule a -> ModuleName
-moduleUnit :: GenModule a -> a
-unitString :: Unit -> String
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index 2525d8b12b..fe316542ae 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -84,7 +84,7 @@ import GHC.Prelude
import {-# SOURCE #-} GHC.Core.TyCo.Rep( TyThing )
import GHC.Types.Name.Occurrence
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.SrcLoc
import GHC.Types.Unique
import GHC.Utils.Misc
diff --git a/compiler/GHC/Types/Name/Cache.hs b/compiler/GHC/Types/Name/Cache.hs
index 2d81e048ad..0506c5747c 100644
--- a/compiler/GHC/Types/Name/Cache.hs
+++ b/compiler/GHC/Types/Name/Cache.hs
@@ -12,7 +12,7 @@ module GHC.Types.Name.Cache
import GHC.Prelude
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Unique.Supply
import GHC.Builtin.Types
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index 274e3a90ce..5f9163bb46 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -72,7 +72,7 @@ module GHC.Types.Name.Reader (
import GHC.Prelude
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Avail
import GHC.Types.Name.Set
diff --git a/compiler/GHC/Types/Name/Shape.hs b/compiler/GHC/Types/Name/Shape.hs
index 745fe8bb77..d4ad316887 100644
--- a/compiler/GHC/Types/Name/Shape.hs
+++ b/compiler/GHC/Types/Name/Shape.hs
@@ -17,7 +17,7 @@ import GHC.Prelude
import GHC.Utils.Outputable
import GHC.Driver.Types
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Unique.FM
import GHC.Types.Avail
import GHC.Types.FieldLabel
diff --git a/compiler/GHC/Unit.hs b/compiler/GHC/Unit.hs
new file mode 100644
index 0000000000..0051aa3087
--- /dev/null
+++ b/compiler/GHC/Unit.hs
@@ -0,0 +1,257 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveFunctor #-}
+
+-- | Units are library components from Cabal packages compiled and installed in
+-- a database
+module GHC.Unit
+ ( module GHC.Unit.Types
+ , module GHC.Unit.Info
+ , module GHC.Unit.Parser
+ , module GHC.Unit.State
+ , module GHC.Unit.Subst
+ , module GHC.Unit.Module
+ )
+where
+
+import GHC.Unit.Types
+import GHC.Unit.Info
+import GHC.Unit.Parser
+import GHC.Unit.State
+import GHC.Unit.Subst
+import GHC.Unit.Module
+
+-- Note [About Units]
+-- ~~~~~~~~~~~~~~~~~~
+--
+-- Haskell users are used to manipulate Cabal packages. These packages are
+-- identified by:
+-- - a package name :: String
+-- - a package version :: Version
+-- - (a revision number, when they are registered on Hackage)
+--
+-- Cabal packages may contain several components (libraries, programs,
+-- testsuites). In GHC we are mostly interested in libraries because those are
+-- the components that can be depended upon by other components. Components in a
+-- package are identified by their component name. Historically only one library
+-- component was allowed per package, hence it didn't need a name. For this
+-- reason, component name may be empty for one library component in each
+-- package:
+-- - a component name :: Maybe String
+--
+-- UnitId
+-- ------
+--
+-- Cabal libraries can be compiled in various ways (different compiler options
+-- or Cabal flags, different dependencies, etc.), hence using package name,
+-- package version and component name isn't enough to identify a built library.
+-- We use another identifier called UnitId:
+--
+-- package name \
+-- package version | ________
+-- component name | hash of all this ==> | UnitId |
+-- Cabal flags | --------
+-- compiler options |
+-- dependencies' UnitId /
+--
+-- Fortunately GHC doesn't have to generate these UnitId: they are provided by
+-- external build tools (e.g. Cabal) with `-this-unit-id` command-line parameter.
+--
+-- UnitIds are important because they are used to generate internal names
+-- (symbols, etc.).
+--
+-- Wired-in units
+-- --------------
+--
+-- Certain libraries are known to the compiler, in that we know about certain
+-- entities that reside in these libraries. The compiler needs to declare static
+-- Modules and Names that refer to units built from these libraries.
+--
+-- Hence UnitIds of wired-in libraries are fixed. Instead of letting Cabal chose
+-- the UnitId for these libraries, their .cabal file uses the following stanza to
+-- force it to a specific value:
+--
+-- ghc-options: -this-unit-id ghc-prim -- taken from ghc-prim.cabal
+--
+-- The RTS also uses entities of wired-in units by directly referring to symbols
+-- such as "base_GHCziIOziException_heapOverflow_closure" where the prefix is
+-- the UnitId of "base" unit.
+--
+-- Unit databases
+-- --------------
+--
+-- Units are stored in databases in order to be reused by other codes:
+--
+-- UnitKey ---> UnitInfo { exposed modules, package name, package version
+-- component name, various file paths,
+-- dependencies :: [UnitKey], etc. }
+--
+-- Because of the wired-in units described above, we can't exactly use UnitIds
+-- as UnitKeys in the database: if we did this, we could only have a single unit
+-- (compiled library) in the database for each wired-in library. As we want to
+-- support databases containing several different units for the same wired-in
+-- library, we do this:
+--
+-- * for non wired-in units:
+-- * UnitId = UnitKey = Identifier (hash) computed by Cabal
+--
+-- * for wired-in units:
+-- * UnitKey = Identifier computed by Cabal (just like for non wired-in units)
+-- * UnitId = unit-id specified with -this-unit-id command-line flag
+--
+-- We can expose several units to GHC via the `package-id <UnitKey>`
+-- command-line parameter. We must use the UnitKeys of the units so that GHC can
+-- find them in the database.
+--
+-- GHC then replaces the UnitKeys with UnitIds by taking into account wired-in
+-- units: these units are detected thanks to their UnitInfo (especially their
+-- package name).
+--
+-- For example, knowing that "base", "ghc-prim" and "rts" are wired-in packages,
+-- the following dependency graph expressed with UnitKeys (as found in the
+-- database) will be transformed into a similar graph expressed with UnitIds
+-- (that are what matters for compilation):
+--
+-- UnitKeys
+-- ~~~~~~~~ ---> rts-1.0-hashABC <--
+-- | |
+-- | |
+-- foo-2.0-hash123 --> base-4.1-hashXYZ ---> ghc-prim-0.5.3-hashABC
+--
+-- UnitIds
+-- ~~~~~~~ ---> rts <--
+-- | |
+-- | |
+-- foo-2.0-hash123 --> base ---------------> ghc-prim
+--
+--
+-- Module signatures / indefinite units / instantiated units
+-- ---------------------------------------------------------
+--
+-- GHC distinguishes two kinds of units:
+--
+-- * definite: units for which every module has an associated code object
+-- (i.e. real compiled code in a .o/.a/.so/.dll/...)
+--
+-- * indefinite: units for which some modules are replaced by module
+-- signatures.
+--
+-- Module signatures are a kind of interface (similar to .hs-boot files). They
+-- are used in place of some real code. GHC allows real modules from other
+-- units to be used to fill these module holes. The process is called
+-- "unit/module instantiation".
+--
+-- You can think of this as polymorphism at the module level: module signatures
+-- give constraints on the "type" of module that can be used to fill the hole
+-- (where "type" means types of the exported module entitites, etc.).
+--
+-- Module signatures contain enough information (datatypes, abstract types, type
+-- synonyms, classes, etc.) to typecheck modules depending on them but not
+-- enough to compile them. As such, indefinite units found in databases only
+-- provide module interfaces (the .hi ones this time), not object code.
+--
+-- To distinguish between indefinite and finite unit ids at the type level, we
+-- respectively use 'IndefUnitId' and 'DefUnitId' datatypes that are basically
+-- wrappers over 'UnitId'.
+--
+-- Unit instantiation
+-- ------------------
+--
+-- Indefinite units can be instantiated with modules from other units. The
+-- instantiating units can also be instantiated themselves (if there are
+-- indefinite) and so on. The 'Unit' datatype represents a unit which may have
+-- been instantiated:
+--
+-- data Unit = RealUnit DefUnitId
+-- | VirtUnit InstantiatedUnit
+--
+-- 'InstantiatedUnit' has two interesting fields:
+--
+-- * instUnitInstanceOf :: IndefUnitId
+-- -- ^ the indefinite unit that is instantiated
+--
+-- * instUnitInsts :: [(ModuleName,(Unit,ModuleName)]
+-- -- ^ a list of instantiations, where an instantiation is:
+-- (module hole name, (instantiating unit, instantiating module name))
+--
+-- A 'Unit' may be indefinite or definite, it depends on whether some holes
+-- remain in the instantiated unit OR in the instantiating units (recursively).
+--
+-- Pretty-printing UnitId
+-- ----------------------
+--
+-- GHC mostly deals with UnitIds which are some opaque strings. We could display
+-- them when we pretty-print a module origin, a name, etc. But it wouldn't be
+-- very friendly to the user because of the hash they usually contain. E.g.
+--
+-- foo-4.18.1:thelib-XYZsomeUglyHashABC
+--
+-- Instead when we want to pretty-print a 'UnitId' we query the database to
+-- get the 'UnitInfo' and print something nicer to the user:
+--
+-- foo-4.18.1:thelib
+--
+-- We do the same for wired-in units.
+--
+-- Currently (2020-04-06), we don't thread the database into every function that
+-- pretty-prints a Name/Module/Unit. Instead querying the database is delayed
+-- until the `SDoc` is transformed into a `Doc` using the database that is
+-- active at this point in time. This is an issue because we want to be able to
+-- unload units from the database and we also want to support several
+-- independent databases loaded at the same time (see #14335). The alternatives
+-- we have are:
+--
+-- * threading the database into every function that pretty-prints a UnitId
+-- for the user (directly or indirectly).
+--
+-- * storing enough info to correctly display a UnitId into the UnitId
+-- datatype itself. This is done in the IndefUnitId wrapper (see
+-- 'UnitPprInfo' datatype) but not for every 'UnitId'. Statically defined
+-- 'UnitId' for wired-in units would have empty UnitPprInfo so we need to
+-- find some places to update them if we want to display wired-in UnitId
+-- correctly. This leads to a solution similar to the first one above.
+--
+-- Note [VirtUnit to RealUnit improvement]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Over the course of instantiating VirtUnits on the fly while typechecking an
+-- indefinite library, we may end up with a fully instantiated VirtUnit. I.e.
+-- one that could be compiled and installed in the database. During
+-- type-checking we generate a virtual UnitId for it, say "abc".
+--
+-- Now the question is: do we have a matching installed unit in the database?
+-- Suppose we have one with UnitId "xyz" (provided by Cabal so we don't know how
+-- to generate it). The trouble is that if both units end up being used in the
+-- same type-checking session, their names won't match (e.g. "abc:M.X" vs
+-- "xyz:M.X").
+--
+-- As we want them to match we just replace the virtual unit with the installed
+-- one: for some reason this is called "improvement".
+--
+-- There is one last niggle: improvement based on the package database means
+-- that we might end up developing on a package that is not transitively
+-- depended upon by the packages the user specified directly via command line
+-- flags. This could lead to strange and difficult to understand bugs if those
+-- instantiations are out of date. The solution is to only improve a
+-- unit id if the new unit id is part of the 'preloadClosure'; i.e., the
+-- closure of all the packages which were explicitly specified.
+
+-- Note [Representation of module/name variables]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- In our ICFP'16, we use <A> to represent module holes, and {A.T} to represent
+-- name holes. This could have been represented by adding some new cases
+-- to the core data types, but this would have made the existing 'moduleName'
+-- and 'moduleUnit' partial, which would have required a lot of modifications
+-- to existing code.
+--
+-- Instead, we use a fake "hole" unit:
+--
+-- <A> ===> hole:A
+-- {A.T} ===> hole:A.T
+--
+-- This encoding is quite convenient, but it is also a bit dangerous too,
+-- because if you have a 'hole:A' you need to know if it's actually a
+-- 'Module' or just a module stored in a 'Name'; these two cases must be
+-- treated differently when doing substitutions. 'renameHoleModule'
+-- and 'renameHoleUnit' assume they are NOT operating on a
+-- 'Name'; 'NameShape' handles name substitutions exclusively.
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index d0014bc3e1..917c55bca6 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -1,11 +1,6 @@
{-# LANGUAGE CPP, RecordWildCards, FlexibleInstances, MultiParamTypeClasses #-}
--- |
--- Package configuration information: essentially the interface to Cabal, with
--- some utilities
---
--- (c) The University of Glasgow, 2004
---
+-- | Info about installed units (compiled libraries)
module GHC.Unit.Info
( GenericUnitInfo (..)
, GenUnitInfo
@@ -14,6 +9,7 @@ module GHC.Unit.Info
, UnitKeyInfo
, mkUnitKeyInfo
, mapUnitInfo
+ , mkUnitPprInfo
, mkUnit
, expandedUnitInfoId
@@ -32,14 +28,15 @@ where
import GHC.Prelude
-import GHC.PackageDb
+import GHC.Unit.Database
import Data.Version
import Data.Bifunctor
import GHC.Data.FastString
import GHC.Utils.Outputable
-import GHC.Types.Module as Module
+import GHC.Unit.Module as Module
import GHC.Types.Unique
+import GHC.Unit.Ppr
-- | Information about an installed unit
--
@@ -47,8 +44,8 @@ import GHC.Types.Unique
-- * UnitKey: identifier used in the database (cf 'UnitKeyInfo')
-- * UnitId: identifier used to generate code (cf 'UnitInfo')
--
--- These two identifiers are different for wired-in packages. See Note [The
--- identifier lexicon] in GHC.Types.Module
+-- These two identifiers are different for wired-in packages. See Note [About
+-- Units] in GHC.Unit
type GenUnitInfo unit = GenericUnitInfo (Indefinite unit) PackageId PackageName unit ModuleName (GenModule (GenUnit unit))
-- | A unit key in the database
@@ -119,12 +116,12 @@ instance Outputable PackageId where
instance Outputable PackageName where
ppr (PackageName str) = ftext str
-unitPackageIdString :: UnitInfo -> String
+unitPackageIdString :: GenUnitInfo u -> String
unitPackageIdString pkg = unpackFS str
where
PackageId str = unitPackageId pkg
-unitPackageNameString :: UnitInfo -> String
+unitPackageNameString :: GenUnitInfo u -> String
unitPackageNameString pkg = unpackFS str
where
PackageName str = unitPackageName pkg
@@ -173,3 +170,10 @@ definiteUnitInfoId p =
case mkUnit p of
RealUnit def_uid -> Just def_uid
_ -> Nothing
+
+-- | Create a UnitPprInfo from a UnitInfo
+mkUnitPprInfo :: GenUnitInfo u -> UnitPprInfo
+mkUnitPprInfo i = UnitPprInfo
+ (unitPackageNameString i)
+ (unitPackageVersion i)
+ ((unpackFS . unPackageName) <$> unitComponentName i)
diff --git a/compiler/GHC/Unit/Module.hs b/compiler/GHC/Unit/Module.hs
new file mode 100644
index 0000000000..7eed456311
--- /dev/null
+++ b/compiler/GHC/Unit/Module.hs
@@ -0,0 +1,151 @@
+{-
+(c) The University of Glasgow, 2004-2006
+
+
+Module
+~~~~~~~~~~
+Simply the name of a module, represented as a FastString.
+These are Uniquable, hence we can build Maps with Modules as
+the keys.
+-}
+
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ExplicitNamespaces #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+
+module GHC.Unit.Module
+ ( module GHC.Unit.Types
+
+ -- * The ModuleName type
+ , module GHC.Unit.Module.Name
+
+ -- * The ModLocation type
+ , module GHC.Unit.Module.Location
+
+ -- * ModuleEnv
+ , module GHC.Unit.Module.Env
+
+
+ -- * Generalization
+ , getModuleInstantiation
+ , getUnitInstantiations
+ , uninstantiateInstantiatedUnit
+ , uninstantiateInstantiatedModule
+
+ -- * The Module type
+ , mkHoleModule
+ , isHoleModule
+ , stableModuleCmp
+ , moduleStableString
+ , moduleIsDefinite
+ , HasModule(..)
+ , ContainsModule(..)
+ , instModuleToModule
+ , unitIdEq
+ , installedModuleEq
+ ) where
+
+import GHC.Prelude
+
+import GHC.Types.Unique.DSet
+import GHC.Unit.Types
+import GHC.Unit.Module.Name
+import GHC.Unit.Module.Location
+import GHC.Unit.Module.Env
+import GHC.Utils.Misc
+
+import {-# SOURCE #-} GHC.Unit.State (PackageState)
+
+
+-- | A 'Module' is definite if it has no free holes.
+moduleIsDefinite :: Module -> Bool
+moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles
+
+-- | Get a string representation of a 'Module' that's unique and stable
+-- across recompilations.
+-- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
+moduleStableString :: Module -> String
+moduleStableString Module{..} =
+ "$" ++ unitString moduleUnit ++ "$" ++ moduleNameString moduleName
+
+
+-- | This gives a stable ordering, as opposed to the Ord instance which
+-- gives an ordering based on the 'Unique's of the components, which may
+-- not be stable from run to run of the compiler.
+stableModuleCmp :: Module -> Module -> Ordering
+stableModuleCmp (Module p1 n1) (Module p2 n2)
+ = (p1 `stableUnitCmp` p2) `thenCmp`
+ (n1 `stableModuleNameCmp` n2)
+
+class ContainsModule t where
+ extractModule :: t -> Module
+
+class HasModule m where
+ getModule :: m Module
+
+
+-- | Injects an 'InstantiatedModule' to 'Module' (see also
+-- 'instUnitToUnit'.
+instModuleToModule :: PackageState -> InstantiatedModule -> Module
+instModuleToModule pkgstate (Module iuid mod_name) =
+ mkModule (instUnitToUnit pkgstate iuid) mod_name
+
+-- | Test if a 'Module' corresponds to a given 'InstalledModule',
+-- modulo instantiation.
+installedModuleEq :: InstalledModule -> Module -> Bool
+installedModuleEq imod mod =
+ fst (getModuleInstantiation mod) == imod
+
+-- | Test if a 'Unit' corresponds to a given 'UnitId',
+-- modulo instantiation.
+unitIdEq :: UnitId -> Unit -> Bool
+unitIdEq iuid uid = toUnitId uid == iuid
+
+{-
+************************************************************************
+* *
+ Hole substitutions
+* *
+************************************************************************
+-}
+
+-- | Given a possibly on-the-fly instantiated module, split it into
+-- a 'Module' that we definitely can find on-disk, as well as an
+-- instantiation if we need to instantiate it on the fly. If the
+-- instantiation is @Nothing@ no on-the-fly renaming is needed.
+getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
+getModuleInstantiation m =
+ let (uid, mb_iuid) = getUnitInstantiations (moduleUnit m)
+ in (Module uid (moduleName m),
+ fmap (\iuid -> Module iuid (moduleName m)) mb_iuid)
+
+-- | Return the unit-id this unit is an instance of and the module instantiations (if any).
+getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
+getUnitInstantiations (VirtUnit iuid) = (indefUnit (instUnitInstanceOf iuid), Just iuid)
+getUnitInstantiations (RealUnit (Definite uid)) = (uid, Nothing)
+getUnitInstantiations HoleUnit = error "Hole unit"
+
+-- | Remove instantiations of the given instantiated unit
+uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
+uninstantiateInstantiatedUnit u =
+ mkInstantiatedUnit (instUnitInstanceOf u)
+ (map (\(m,_) -> (m, mkHoleModule m))
+ (instUnitInsts u))
+
+-- | Remove instantiations of the given module instantiated unit
+uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
+uninstantiateInstantiatedModule (Module uid n) = Module (uninstantiateInstantiatedUnit uid) n
+
+-- | Test if a Module is not instantiated
+isHoleModule :: GenModule (GenUnit u) -> Bool
+isHoleModule (Module HoleUnit _) = True
+isHoleModule _ = False
+
+-- | Create a hole Module
+mkHoleModule :: ModuleName -> GenModule (GenUnit u)
+mkHoleModule = Module HoleUnit
+
diff --git a/compiler/GHC/Unit/Module/Env.hs b/compiler/GHC/Unit/Module/Env.hs
new file mode 100644
index 0000000000..3d01b21c08
--- /dev/null
+++ b/compiler/GHC/Unit/Module/Env.hs
@@ -0,0 +1,224 @@
+-- | Module environment
+module GHC.Unit.Module.Env
+ ( -- * Module mappings
+ ModuleEnv
+ , elemModuleEnv, extendModuleEnv, extendModuleEnvList
+ , extendModuleEnvList_C, plusModuleEnv_C
+ , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
+ , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
+ , moduleEnvKeys, moduleEnvElts, moduleEnvToList
+ , unitModuleEnv, isEmptyModuleEnv
+ , extendModuleEnvWith, filterModuleEnv
+
+ -- * ModuleName mappings
+ , ModuleNameEnv, DModuleNameEnv
+
+ -- * Sets of Modules
+ , ModuleSet
+ , emptyModuleSet, mkModuleSet, moduleSetElts
+ , extendModuleSet, extendModuleSetList, delModuleSet
+ , elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet
+ , unitModuleSet
+
+ -- * InstalledModuleEnv
+ , InstalledModuleEnv
+ , emptyInstalledModuleEnv
+ , lookupInstalledModuleEnv
+ , extendInstalledModuleEnv
+ , filterInstalledModuleEnv
+ , delInstalledModuleEnv
+ )
+where
+
+import GHC.Prelude
+
+import GHC.Types.Unique
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import GHC.Unit.Types
+import GHC.Utils.Misc
+import Data.List (sortBy, sort)
+import Data.Ord
+
+import Data.Coerce
+import Data.Map (Map)
+import Data.Set (Set)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified GHC.Data.FiniteMap as Map
+
+-- | A map keyed off of 'Module's
+newtype ModuleEnv elt = ModuleEnv (Map NDModule elt)
+
+{-
+Note [ModuleEnv performance and determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To prevent accidental reintroduction of nondeterminism the Ord instance
+for Module was changed to not depend on Unique ordering and to use the
+lexicographic order. This is potentially expensive, but when measured
+there was no difference in performance.
+
+To be on the safe side and not pessimize ModuleEnv uses nondeterministic
+ordering on Module and normalizes by doing the lexicographic sort when
+turning the env to a list.
+See Note [Unique Determinism] for more information about the source of
+nondeterminismand and Note [Deterministic UniqFM] for explanation of why
+it matters for maps.
+-}
+
+newtype NDModule = NDModule { unNDModule :: Module }
+ deriving Eq
+ -- A wrapper for Module with faster nondeterministic Ord.
+ -- Don't export, See [ModuleEnv performance and determinism]
+
+instance Ord NDModule where
+ compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) =
+ (getUnique p1 `nonDetCmpUnique` getUnique p2) `thenCmp`
+ (getUnique n1 `nonDetCmpUnique` getUnique n2)
+
+filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
+filterModuleEnv f (ModuleEnv e) =
+ ModuleEnv (Map.filterWithKey (f . unNDModule) e)
+
+elemModuleEnv :: Module -> ModuleEnv a -> Bool
+elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e
+
+extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
+extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert (NDModule m) x e)
+
+extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
+ -> ModuleEnv a
+extendModuleEnvWith f (ModuleEnv e) m x =
+ ModuleEnv (Map.insertWith f (NDModule m) x e)
+
+extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
+extendModuleEnvList (ModuleEnv e) xs =
+ ModuleEnv (Map.insertList [(NDModule k, v) | (k,v) <- xs] e)
+
+extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
+ -> ModuleEnv a
+extendModuleEnvList_C f (ModuleEnv e) xs =
+ ModuleEnv (Map.insertListWith f [(NDModule k, v) | (k,v) <- xs] e)
+
+plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) =
+ ModuleEnv (Map.unionWith f e1 e2)
+
+delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
+delModuleEnvList (ModuleEnv e) ms =
+ ModuleEnv (Map.deleteList (map NDModule ms) e)
+
+delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
+delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete (NDModule m) e)
+
+plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
+plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
+
+lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
+lookupModuleEnv (ModuleEnv e) m = Map.lookup (NDModule m) e
+
+lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
+lookupWithDefaultModuleEnv (ModuleEnv e) x m =
+ Map.findWithDefault x (NDModule m) e
+
+mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
+mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
+
+mkModuleEnv :: [(Module, a)] -> ModuleEnv a
+mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs])
+
+emptyModuleEnv :: ModuleEnv a
+emptyModuleEnv = ModuleEnv Map.empty
+
+moduleEnvKeys :: ModuleEnv a -> [Module]
+moduleEnvKeys (ModuleEnv e) = sort $ map unNDModule $ Map.keys e
+ -- See Note [ModuleEnv performance and determinism]
+
+moduleEnvElts :: ModuleEnv a -> [a]
+moduleEnvElts e = map snd $ moduleEnvToList e
+ -- See Note [ModuleEnv performance and determinism]
+
+moduleEnvToList :: ModuleEnv a -> [(Module, a)]
+moduleEnvToList (ModuleEnv e) =
+ sortBy (comparing fst) [(m, v) | (NDModule m, v) <- Map.toList e]
+ -- See Note [ModuleEnv performance and determinism]
+
+unitModuleEnv :: Module -> a -> ModuleEnv a
+unitModuleEnv m x = ModuleEnv (Map.singleton (NDModule m) x)
+
+isEmptyModuleEnv :: ModuleEnv a -> Bool
+isEmptyModuleEnv (ModuleEnv e) = Map.null e
+
+-- | A set of 'Module's
+type ModuleSet = Set NDModule
+
+mkModuleSet :: [Module] -> ModuleSet
+mkModuleSet = Set.fromList . coerce
+
+extendModuleSet :: ModuleSet -> Module -> ModuleSet
+extendModuleSet s m = Set.insert (NDModule m) s
+
+extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
+extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms
+
+emptyModuleSet :: ModuleSet
+emptyModuleSet = Set.empty
+
+moduleSetElts :: ModuleSet -> [Module]
+moduleSetElts = sort . coerce . Set.toList
+
+elemModuleSet :: Module -> ModuleSet -> Bool
+elemModuleSet = Set.member . coerce
+
+intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
+intersectModuleSet = coerce Set.intersection
+
+minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
+minusModuleSet = coerce Set.difference
+
+delModuleSet :: ModuleSet -> Module -> ModuleSet
+delModuleSet = coerce (flip Set.delete)
+
+unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
+unionModuleSet = coerce Set.union
+
+unitModuleSet :: Module -> ModuleSet
+unitModuleSet = coerce Set.singleton
+
+{-
+A ModuleName has a Unique, so we can build mappings of these using
+UniqFM.
+-}
+
+-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
+type ModuleNameEnv elt = UniqFM elt
+
+
+-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
+-- Has deterministic folds and can be deterministically converted to a list
+type DModuleNameEnv elt = UniqDFM elt
+
+
+--------------------------------------------------------------------
+-- InstalledModuleEnv
+--------------------------------------------------------------------
+
+-- | A map keyed off of 'InstalledModule'
+newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)
+
+emptyInstalledModuleEnv :: InstalledModuleEnv a
+emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
+
+lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
+lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
+
+extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
+extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
+
+filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
+filterInstalledModuleEnv f (InstalledModuleEnv e) =
+ InstalledModuleEnv (Map.filterWithKey f e)
+
+delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
+delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
+
diff --git a/compiler/GHC/Unit/Module/Env.hs-boot b/compiler/GHC/Unit/Module/Env.hs-boot
new file mode 100644
index 0000000000..657f55490c
--- /dev/null
+++ b/compiler/GHC/Unit/Module/Env.hs-boot
@@ -0,0 +1,6 @@
+module GHC.Unit.Module.Env where
+
+import GhcPrelude ()
+import GHC.Types.Unique.FM
+
+type ModuleNameEnv elt = UniqFM elt
diff --git a/compiler/GHC/Unit/Module/Location.hs b/compiler/GHC/Unit/Module/Location.hs
new file mode 100644
index 0000000000..540f2305d2
--- /dev/null
+++ b/compiler/GHC/Unit/Module/Location.hs
@@ -0,0 +1,78 @@
+-- | Module location
+module GHC.Unit.Module.Location
+ ( ModLocation(..)
+ , addBootSuffix
+ , addBootSuffix_maybe
+ , addBootSuffixLocn
+ , addBootSuffixLocnOut
+ )
+where
+
+import GHC.Prelude
+import GHC.Utils.Outputable
+
+-- | Module Location
+--
+-- Where a module lives on the file system: the actual locations
+-- of the .hs, .hi and .o files, if we have them.
+--
+-- For a module in another package, the ml_hs_file and ml_obj_file components of
+-- ModLocation are undefined.
+--
+-- The locations specified by a ModLocation may or may not
+-- correspond to actual files yet: for example, even if the object
+-- file doesn't exist, the ModLocation still contains the path to
+-- where the object file will reside if/when it is created.
+
+data ModLocation
+ = ModLocation {
+ ml_hs_file :: Maybe FilePath,
+ -- ^ The source file, if we have one. Package modules
+ -- probably don't have source files.
+
+ ml_hi_file :: FilePath,
+ -- ^ Where the .hi file is, whether or not it exists
+ -- yet. Always of form foo.hi, even if there is an
+ -- hi-boot file (we add the -boot suffix later)
+
+ ml_obj_file :: FilePath,
+ -- ^ Where the .o file is, whether or not it exists yet.
+ -- (might not exist either because the module hasn't
+ -- been compiled yet, or because it is part of a
+ -- package with a .a file)
+
+ ml_hie_file :: FilePath
+ -- ^ Where the .hie file is, whether or not it exists
+ -- yet.
+ } deriving Show
+
+instance Outputable ModLocation where
+ ppr = text . show
+
+-- | Add the @-boot@ suffix to .hs, .hi and .o files
+addBootSuffix :: FilePath -> FilePath
+addBootSuffix path = path ++ "-boot"
+
+-- | Add the @-boot@ suffix if the @Bool@ argument is @True@
+addBootSuffix_maybe :: Bool -> FilePath -> FilePath
+addBootSuffix_maybe is_boot path
+ | is_boot = addBootSuffix path
+ | otherwise = path
+
+-- | Add the @-boot@ suffix to all file paths associated with the module
+addBootSuffixLocn :: ModLocation -> ModLocation
+addBootSuffixLocn locn
+ = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
+ , ml_hi_file = addBootSuffix (ml_hi_file locn)
+ , ml_obj_file = addBootSuffix (ml_obj_file locn)
+ , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+
+-- | Add the @-boot@ suffix to all output file paths associated with the
+-- module, not including the input file itself
+addBootSuffixLocnOut :: ModLocation -> ModLocation
+addBootSuffixLocnOut locn
+ = locn { ml_hi_file = addBootSuffix (ml_hi_file locn)
+ , ml_obj_file = addBootSuffix (ml_obj_file locn)
+ , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+
+
diff --git a/compiler/GHC/Unit/Module/Name.hs b/compiler/GHC/Unit/Module/Name.hs
new file mode 100644
index 0000000000..ad09fa7549
--- /dev/null
+++ b/compiler/GHC/Unit/Module/Name.hs
@@ -0,0 +1,98 @@
+
+-- | The ModuleName type
+module GHC.Unit.Module.Name
+ ( ModuleName
+ , pprModuleName
+ , moduleNameFS
+ , moduleNameString
+ , moduleNameSlashes, moduleNameColons
+ , mkModuleName
+ , mkModuleNameFS
+ , stableModuleNameCmp
+ , parseModuleName
+ )
+where
+
+import GHC.Prelude
+
+import GHC.Utils.Outputable
+import GHC.Types.Unique
+import GHC.Data.FastString
+import GHC.Utils.Binary
+import GHC.Utils.Misc
+
+import Control.DeepSeq
+import Data.Data
+import System.FilePath
+
+import qualified Text.ParserCombinators.ReadP as Parse
+import Text.ParserCombinators.ReadP (ReadP)
+import Data.Char (isAlphaNum)
+
+-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
+newtype ModuleName = ModuleName FastString
+
+instance Uniquable ModuleName where
+ getUnique (ModuleName nm) = getUnique nm
+
+instance Eq ModuleName where
+ nm1 == nm2 = getUnique nm1 == getUnique nm2
+
+instance Ord ModuleName where
+ nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
+
+instance Outputable ModuleName where
+ ppr = pprModuleName
+
+instance Binary ModuleName where
+ put_ bh (ModuleName fs) = put_ bh fs
+ get bh = do fs <- get bh; return (ModuleName fs)
+
+instance Data ModuleName where
+ -- don't traverse?
+ toConstr _ = abstractConstr "ModuleName"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "ModuleName"
+
+instance NFData ModuleName where
+ rnf x = x `seq` ()
+
+stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
+-- ^ Compares module names lexically, rather than by their 'Unique's
+stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
+
+pprModuleName :: ModuleName -> SDoc
+pprModuleName (ModuleName nm) =
+ getPprStyle $ \ sty ->
+ if codeStyle sty
+ then ztext (zEncodeFS nm)
+ else ftext nm
+
+moduleNameFS :: ModuleName -> FastString
+moduleNameFS (ModuleName mod) = mod
+
+moduleNameString :: ModuleName -> String
+moduleNameString (ModuleName mod) = unpackFS mod
+
+mkModuleName :: String -> ModuleName
+mkModuleName s = ModuleName (mkFastString s)
+
+mkModuleNameFS :: FastString -> ModuleName
+mkModuleNameFS s = ModuleName s
+
+-- |Returns the string version of the module name, with dots replaced by slashes.
+--
+moduleNameSlashes :: ModuleName -> String
+moduleNameSlashes = dots_to_slashes . moduleNameString
+ where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
+
+-- |Returns the string version of the module name, with dots replaced by colons.
+--
+moduleNameColons :: ModuleName -> String
+moduleNameColons = dots_to_colons . moduleNameString
+ where dots_to_colons = map (\c -> if c == '.' then ':' else c)
+
+parseModuleName :: ReadP ModuleName
+parseModuleName = fmap mkModuleName
+ $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")
+
diff --git a/compiler/GHC/Unit/Module/Name.hs-boot b/compiler/GHC/Unit/Module/Name.hs-boot
new file mode 100644
index 0000000000..7a48d807a7
--- /dev/null
+++ b/compiler/GHC/Unit/Module/Name.hs-boot
@@ -0,0 +1,6 @@
+module GHC.Unit.Module.Name where
+
+import GHC.Prelude ()
+
+data ModuleName
+
diff --git a/compiler/GHC/Unit/Parser.hs b/compiler/GHC/Unit/Parser.hs
new file mode 100644
index 0000000000..6ae38259af
--- /dev/null
+++ b/compiler/GHC/Unit/Parser.hs
@@ -0,0 +1,63 @@
+-- | Parsers for unit/module identifiers
+module GHC.Unit.Parser
+ ( parseUnit
+ , parseIndefUnitId
+ , parseHoleyModule
+ , parseModSubst
+ )
+where
+
+import GHC.Prelude
+
+import GHC.Unit.Types
+import GHC.Unit.Module.Name
+import GHC.Data.FastString
+
+import qualified Text.ParserCombinators.ReadP as Parse
+import Text.ParserCombinators.ReadP (ReadP, (<++))
+import Data.Char (isAlphaNum)
+
+parseUnit :: ReadP Unit
+parseUnit = parseVirtUnitId <++ parseDefUnitId
+ where
+ parseVirtUnitId = do
+ uid <- parseIndefUnitId
+ insts <- parseModSubst
+ return (mkVirtUnit uid insts)
+ parseDefUnitId = do
+ s <- parseUnitId
+ return (RealUnit (Definite s))
+
+parseUnitId :: ReadP UnitId
+parseUnitId = do
+ s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
+ return (UnitId (mkFastString s))
+
+parseIndefUnitId :: ReadP IndefUnitId
+parseIndefUnitId = do
+ uid <- parseUnitId
+ return (Indefinite uid Nothing)
+
+parseHoleyModule :: ReadP Module
+parseHoleyModule = parseModuleVar <++ parseModule
+ where
+ parseModuleVar = do
+ _ <- Parse.char '<'
+ modname <- parseModuleName
+ _ <- Parse.char '>'
+ return (Module HoleUnit modname)
+ parseModule = do
+ uid <- parseUnit
+ _ <- Parse.char ':'
+ modname <- parseModuleName
+ return (Module uid modname)
+
+parseModSubst :: ReadP [(ModuleName, Module)]
+parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
+ . flip Parse.sepBy (Parse.char ',')
+ $ do k <- parseModuleName
+ _ <- Parse.char '='
+ v <- parseHoleyModule
+ return (k, v)
+
+
diff --git a/compiler/GHC/Unit/Ppr.hs b/compiler/GHC/Unit/Ppr.hs
new file mode 100644
index 0000000000..6c11dae34e
--- /dev/null
+++ b/compiler/GHC/Unit/Ppr.hs
@@ -0,0 +1,31 @@
+-- | Unit identifier pretty-printing
+module GHC.Unit.Ppr
+ ( UnitPprInfo (..)
+ )
+where
+
+import GHC.Prelude
+import GHC.Utils.Outputable
+import Data.Version
+
+-- | Subset of UnitInfo: just enough to pretty-print a unit-id
+--
+-- Instead of printing the unit-id which may contain a hash, we print:
+-- package-version:componentname
+--
+data UnitPprInfo = UnitPprInfo
+ { unitPprPackageName :: String -- ^ Source package name
+ , unitPprPackageVersion :: Version -- ^ Source package version
+ , unitPprComponentName :: Maybe String -- ^ Component name
+ }
+
+instance Outputable UnitPprInfo where
+ ppr pprinfo = text $ mconcat
+ [ unitPprPackageName pprinfo
+ , case unitPprPackageVersion pprinfo of
+ Version [] [] -> ""
+ version -> "-" ++ showVersion version
+ , case unitPprComponentName pprinfo of
+ Nothing -> ""
+ Just cname -> ":" ++ cname
+ ]
diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Unit/State.hs
index c6dac71e06..50fd72f651 100644
--- a/compiler/GHC/Driver/Packages.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -3,7 +3,7 @@
{-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns, FlexibleContexts #-}
-- | Package manipulation
-module GHC.Driver.Packages (
+module GHC.Unit.State (
module GHC.Unit.Info,
-- * Reading the package config, and processing cmdline args
@@ -45,8 +45,6 @@ module GHC.Driver.Packages (
getPackageExtraCcOpts,
getPackageFrameworkPath,
getPackageFrameworks,
- getUnitInfoMap,
- getPackageState,
getPreloadPackagesAnd,
collectArchives,
@@ -70,15 +68,17 @@ where
import GHC.Prelude
-import GHC.PackageDb
+import GHC.Unit.Database
import GHC.Unit.Info
+import GHC.Unit.Types
+import GHC.Unit.Module
+import GHC.Unit.Subst
import GHC.Driver.Session
import GHC.Driver.Ways
import GHC.Types.Name ( Name, nameModule_maybe )
import GHC.Types.Unique.FM
import GHC.Types.Unique.DFM
import GHC.Types.Unique.Set
-import GHC.Types.Module
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Platform
@@ -941,9 +941,9 @@ pprTrustFlag flag = case flag of
DistrustPackage p -> text "-distrust " <> text p
-- -----------------------------------------------------------------------------
--- Wired-in packages
+-- Wired-in units
--
--- See Note [Wired-in packages] in GHC.Types.Module
+-- See Note [Wired-in units] in GHC.Unit.Module
type WiredInUnitId = String
type WiredPackagesMap = Map WiredUnitId WiredUnitId
@@ -963,7 +963,7 @@ findWiredInPackages
findWiredInPackages dflags prec_map pkgs vis_map = do
-- Now we must find our wired-in packages, and rename them to
-- their canonical names (eg. base-1.0 ==> base), as described
- -- in Note [Wired-in packages] in GHC.Types.Module
+ -- in Note [Wired-in units] in GHC.Unit.Module
let
matches :: UnitInfo -> WiredInUnitId -> Bool
pc `matches` pid
@@ -1050,7 +1050,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
, Just wiredInUnitId <- Map.lookup def_uid wiredInMap
= let fs = unitIdFS (unDefinite wiredInUnitId)
in pkg {
- unitId = fsToUnitId fs,
+ unitId = UnitId fs,
unitInstanceOf = mkIndefUnitId pkgstate fs
}
| otherwise
@@ -1068,7 +1068,7 @@ findWiredInPackages dflags prec_map pkgs vis_map = do
-- Helper functions for rewiring Module and Unit. These
-- rewrite Units of modules in wired-in packages to the form known to the
--- compiler, as described in Note [Wired-in packages] in GHC.Types.Module.
+-- compiler, as described in Note [Wired-in units] in GHC.Unit.Module.
--
-- For instance, base-4.9.0.0 will be rewritten to just base, to match
-- what appears in GHC.Builtin.Names.
@@ -2077,10 +2077,7 @@ mkIndefUnitId pkgstate raw =
let uid = UnitId raw
in case lookupInstalledPackage pkgstate uid of
Nothing -> Indefinite uid Nothing -- we didn't find the unit at all
- Just c -> Indefinite uid $ Just $ UnitPprInfo
- (unitPackageNameString c)
- (unitPackageVersion c)
- ((unpackFS . unPackageName) <$> unitComponentName c)
+ Just c -> Indefinite uid $ Just $ mkUnitPprInfo c
-- | Update component ID details from the database
updateIndefUnitId :: PackageState -> IndefUnitId -> IndefUnitId
@@ -2161,7 +2158,7 @@ fsPackageName info = fs
where
PackageName fs = unitPackageName info
--- | Given a fully instantiated 'InstnatiatedUnit', improve it into a
+-- | Given a fully instantiated 'InstantiatedUnit', improve it into a
-- 'RealUnit' if we can find it in the package database.
improveUnit :: UnitInfoMap -> Unit -> Unit
improveUnit _ uid@(RealUnit _) = uid -- short circuit
@@ -2176,13 +2173,3 @@ improveUnit pkg_map uid =
if unitId pkg `elementOfUniqSet` preloadClosure pkg_map
then mkUnit pkg
else uid
-
--- | Retrieve the 'UnitInfoMap' from 'DynFlags'; used
--- in the @hs-boot@ loop-breaker.
-getUnitInfoMap :: DynFlags -> UnitInfoMap
-getUnitInfoMap = unitInfoMap . pkgState
-
--- | Retrieve the 'PackageState' from 'DynFlags'; used
--- in the @hs-boot@ loop-breaker.
-getPackageState :: DynFlags -> PackageState
-getPackageState = pkgState
diff --git a/compiler/GHC/Driver/Packages.hs-boot b/compiler/GHC/Unit/State.hs-boot
index 368057e2d3..01309afb2f 100644
--- a/compiler/GHC/Driver/Packages.hs-boot
+++ b/compiler/GHC/Unit/State.hs-boot
@@ -1,8 +1,7 @@
-module GHC.Driver.Packages where
+module GHC.Unit.State where
import GHC.Prelude
import GHC.Data.FastString
-import {-# SOURCE #-} GHC.Driver.Session (DynFlags)
-import {-# SOURCE #-} GHC.Types.Module(IndefUnitId, Unit, UnitId)
+import {-# SOURCE #-} GHC.Unit.Types (IndefUnitId, Unit, UnitId)
data PackageState
data UnitInfoMap
data PackageDatabase unit
@@ -10,7 +9,5 @@ emptyPackageState :: PackageState
mkIndefUnitId :: PackageState -> FastString -> IndefUnitId
displayUnitId :: PackageState -> UnitId -> Maybe String
improveUnit :: UnitInfoMap -> Unit -> Unit
-getUnitInfoMap :: DynFlags -> UnitInfoMap
unitInfoMap :: PackageState -> UnitInfoMap
-getPackageState :: DynFlags -> PackageState
updateIndefUnitId :: PackageState -> IndefUnitId -> IndefUnitId
diff --git a/compiler/GHC/Unit/Subst.hs b/compiler/GHC/Unit/Subst.hs
new file mode 100644
index 0000000000..3539d5a255
--- /dev/null
+++ b/compiler/GHC/Unit/Subst.hs
@@ -0,0 +1,69 @@
+-- | Module hole substitutions
+module GHC.Unit.Subst
+ ( ShHoleSubst
+ , renameHoleUnit
+ , renameHoleModule
+ , renameHoleUnit'
+ , renameHoleModule'
+ )
+where
+
+import GHC.Prelude
+
+import {-# SOURCE #-} GHC.Unit.State
+import GHC.Unit.Types
+import GHC.Unit.Module.Env
+import GHC.Unit.Module
+import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
+import GHC.Types.Unique.DSet
+
+-- | Substitution on module variables, mapping module names to module
+-- identifiers.
+type ShHoleSubst = ModuleNameEnv Module
+
+-- | Substitutes holes in a 'Module'. NOT suitable for being called
+-- directly on a 'nameModule', see Note [Representation of module/name variable].
+-- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
+-- similarly, @<A>@ maps to @q():A@.
+renameHoleModule :: PackageState -> ShHoleSubst -> Module -> Module
+renameHoleModule state = renameHoleModule' (unitInfoMap state)
+
+-- | Substitutes holes in a 'Unit', suitable for renaming when
+-- an include occurs; see Note [Representation of module/name variable].
+--
+-- @p[A=<A>]@ maps to @p[A=<B>]@ with @A=<B>@.
+renameHoleUnit :: PackageState -> ShHoleSubst -> Unit -> Unit
+renameHoleUnit state = renameHoleUnit' (unitInfoMap state)
+
+-- | Like 'renameHoleModule', but requires only 'UnitInfoMap'
+-- so it can be used by "Packages".
+renameHoleModule' :: UnitInfoMap -> ShHoleSubst -> Module -> Module
+renameHoleModule' pkg_map env m
+ | not (isHoleModule m) =
+ let uid = renameHoleUnit' pkg_map env (moduleUnit m)
+ in mkModule uid (moduleName m)
+ | Just m' <- lookupUFM env (moduleName m) = m'
+ -- NB m = <Blah>, that's what's in scope.
+ | otherwise = m
+
+-- | Like 'renameHoleUnit, but requires only 'UnitInfoMap'
+-- so it can be used by "Packages".
+renameHoleUnit' :: UnitInfoMap -> ShHoleSubst -> Unit -> Unit
+renameHoleUnit' pkg_map env uid =
+ case uid of
+ (VirtUnit
+ InstantiatedUnit{ instUnitInstanceOf = cid
+ , instUnitInsts = insts
+ , instUnitHoles = fh })
+ -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
+ then uid
+ -- Functorially apply the substitution to the instantiation,
+ -- then check the 'UnitInfoMap' to see if there is
+ -- a compiled version of this 'InstantiatedUnit' we can improve to.
+ -- See Note [VirtUnit to RealUnit improvement]
+ else improveUnit pkg_map $
+ mkVirtUnit cid
+ (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
+ _ -> uid
+
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
new file mode 100644
index 0000000000..a42f0c0c78
--- /dev/null
+++ b/compiler/GHC/Unit/Types.hs
@@ -0,0 +1,636 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFunctor #-}
+
+-- | Unit & Module types
+--
+-- This module is used to resolve the loops between Unit and Module types
+-- (Module references a Unit and vice-versa).
+module GHC.Unit.Types
+ ( -- * Modules
+ GenModule (..)
+ , Module
+ , InstalledModule
+ , InstantiatedModule
+ , mkModule
+ , pprModule
+ , pprInstantiatedModule
+ , moduleFreeHoles
+
+ -- * Units
+ , GenUnit (..)
+ , Unit
+ , UnitId (..)
+ , GenInstantiatedUnit (..)
+ , InstantiatedUnit
+ , IndefUnitId
+ , DefUnitId
+ , Instantiations
+ , GenInstantiations
+ , mkGenInstantiatedUnit
+ , mkInstantiatedUnit
+ , mkInstantiatedUnitHash
+ , mkGenVirtUnit
+ , mkVirtUnit
+ , mapGenUnit
+ , unitFreeModuleHoles
+ , fsToUnit
+ , unitFS
+ , unitString
+ , instUnitToUnit
+ , toUnitId
+ , stringToUnit
+ , stableUnitCmp
+ , unitIsDefinite
+
+ -- * Unit Ids
+ , unitIdString
+ , stringToUnitId
+
+ -- * Utils
+ , Definite (..)
+ , Indefinite (..)
+
+ -- * Wired-in units
+ , primUnitId
+ , integerUnitId
+ , baseUnitId
+ , rtsUnitId
+ , thUnitId
+ , mainUnitId
+ , thisGhcUnitId
+ , interactiveUnitId
+ , isInteractiveModule
+ , wiredInUnitIds
+ )
+where
+
+import GHC.Prelude
+import GHC.Types.Unique
+import GHC.Types.Unique.DSet
+import GHC.Unit.Ppr
+import GHC.Unit.Module.Name
+import GHC.Utils.Binary
+import GHC.Utils.Outputable
+import GHC.Data.FastString
+import GHC.Utils.Encoding
+import GHC.Utils.Fingerprint
+import GHC.Utils.Misc
+
+import Control.DeepSeq
+import Data.Data
+import Data.List (sortBy )
+import Data.Function
+import Data.Bifunctor
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS.Char8
+
+import {-# SOURCE #-} GHC.Unit.State (improveUnit, PackageState, unitInfoMap, displayUnitId)
+import {-# SOURCE #-} GHC.Driver.Session (pkgState)
+
+---------------------------------------------------------------------
+-- MODULES
+---------------------------------------------------------------------
+
+-- | A generic module is a pair of a unit identifier and a 'ModuleName'.
+data GenModule unit = Module
+ { moduleUnit :: !unit -- ^ Unit the module belongs to
+ , moduleName :: !ModuleName -- ^ Module name (e.g. A.B.C)
+ }
+ deriving (Eq,Ord,Data,Functor)
+
+-- | A Module is a pair of a 'Unit' and a 'ModuleName'.
+type Module = GenModule Unit
+
+-- | A 'InstalledModule' is a 'Module' whose unit is identified with an
+-- 'UnitId'.
+type InstalledModule = GenModule UnitId
+
+-- | An `InstantiatedModule` is a 'Module' whose unit is identified with an `InstantiatedUnit`.
+type InstantiatedModule = GenModule InstantiatedUnit
+
+
+mkModule :: u -> ModuleName -> GenModule u
+mkModule = Module
+
+instance Uniquable Module where
+ getUnique (Module p n) = getUnique (unitFS p `appendFS` moduleNameFS n)
+
+instance Binary a => Binary (GenModule a) where
+ put_ bh (Module p n) = put_ bh p >> put_ bh n
+ get bh = do p <- get bh; n <- get bh; return (Module p n)
+
+instance NFData (GenModule a) where
+ rnf (Module unit name) = unit `seq` name `seq` ()
+
+instance Outputable Module where
+ ppr = pprModule
+
+instance Outputable InstalledModule where
+ ppr (Module p n) =
+ ppr p <> char ':' <> pprModuleName n
+
+instance Outputable InstantiatedModule where
+ ppr = pprInstantiatedModule
+
+instance Outputable InstantiatedUnit where
+ ppr uid =
+ -- getPprStyle $ \sty ->
+ ppr cid <>
+ (if not (null insts) -- pprIf
+ then
+ brackets (hcat
+ (punctuate comma $
+ [ ppr modname <> text "=" <> pprModule m
+ | (modname, m) <- insts]))
+ else empty)
+ where
+ cid = instUnitInstanceOf uid
+ insts = instUnitInsts uid
+
+
+pprModule :: Module -> SDoc
+pprModule mod@(Module p n) = getPprStyle doc
+ where
+ doc sty
+ | codeStyle sty =
+ (if p == mainUnitId
+ then empty -- never qualify the main package in code
+ else ztext (zEncodeFS (unitFS p)) <> char '_')
+ <> pprModuleName n
+ | qualModule sty mod =
+ case p of
+ HoleUnit -> angleBrackets (pprModuleName n)
+ _ -> ppr (moduleUnit mod) <> char ':' <> pprModuleName n
+ | otherwise =
+ pprModuleName n
+
+
+pprInstantiatedModule :: InstantiatedModule -> SDoc
+pprInstantiatedModule (Module uid m) =
+ ppr uid <> char ':' <> ppr m
+
+---------------------------------------------------------------------
+-- UNITS
+---------------------------------------------------------------------
+
+-- | A unit identifier identifies a (possibly partially) instantiated library.
+-- It is primarily used as part of 'Module', which in turn is used in 'Name',
+-- which is used to give names to entities when typechecking.
+--
+-- There are two possible forms for a 'Unit':
+--
+-- 1) It can be a 'RealUnit', in which case we just have a 'DefUnitId' that
+-- uniquely identifies some fully compiled, installed library we have on disk.
+--
+-- 2) It can be an 'VirtUnit'. When we are typechecking a library with missing
+-- holes, we may need to instantiate a library on the fly (in which case we
+-- don't have any on-disk representation.) In that case, you have an
+-- 'InstantiatedUnit', which explicitly records the instantiation, so that we
+-- can substitute over it.
+data GenUnit uid
+ = RealUnit !(Definite uid)
+ -- ^ Installed definite unit (either a fully instantiated unit or a closed unit)
+
+ | VirtUnit {-# UNPACK #-} !(GenInstantiatedUnit uid)
+ -- ^ Virtual unit instantiated on-the-fly. It may be definite if all the
+ -- holes are instantiated but we don't have code objects for it.
+
+ | HoleUnit
+ -- ^ Fake hole unit
+
+-- | An instantiated unit.
+--
+-- It identifies an indefinite library (with holes) that has been instantiated.
+--
+-- This unit may be indefinite or not (i.e. with remaining holes or not). If it
+-- is definite, we don't know if it has already been compiled and installed in a
+-- database. Nevertheless, we have a mechanism called "improvement" to try to
+-- match a fully instantiated unit with existing compiled and installed units:
+-- see Note [VirtUnit to RealUnit improvement].
+--
+-- An indefinite unit identifier pretty-prints to something like
+-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'IndefUnitId', and the
+-- brackets enclose the module substitution).
+data GenInstantiatedUnit unit
+ = InstantiatedUnit {
+ -- | A private, uniquely identifying representation of
+ -- an InstantiatedUnit. This string is completely private to GHC
+ -- and is just used to get a unique.
+ instUnitFS :: !FastString,
+ -- | Cached unique of 'unitFS'.
+ instUnitKey :: !Unique,
+ -- | The indefinite unit being instantiated.
+ instUnitInstanceOf :: !(Indefinite unit),
+ -- | The sorted (by 'ModuleName') instantiations of this unit.
+ instUnitInsts :: !(GenInstantiations unit),
+ -- | A cache of the free module holes of 'instUnitInsts'.
+ -- This lets us efficiently tell if a 'InstantiatedUnit' has been
+ -- fully instantiated (empty set of free module holes)
+ -- and whether or not a substitution can have any effect.
+ instUnitHoles :: UniqDSet ModuleName
+ }
+
+type Unit = GenUnit UnitId
+type InstantiatedUnit = GenInstantiatedUnit UnitId
+
+type GenInstantiations unit = [(ModuleName,GenModule (GenUnit unit))]
+type Instantiations = GenInstantiations UnitId
+
+holeUnique :: Unique
+holeUnique = getUnique holeFS
+
+holeFS :: FastString
+holeFS = fsLit "<hole>"
+
+
+instance Eq (GenInstantiatedUnit unit) where
+ u1 == u2 = instUnitKey u1 == instUnitKey u2
+
+instance Ord (GenInstantiatedUnit unit) where
+ u1 `compare` u2 = instUnitFS u1 `compare` instUnitFS u2
+
+instance Binary InstantiatedUnit where
+ put_ bh indef = do
+ put_ bh (instUnitInstanceOf indef)
+ put_ bh (instUnitInsts indef)
+ get bh = do
+ cid <- get bh
+ insts <- get bh
+ let fs = mkInstantiatedUnitHash cid insts
+ return InstantiatedUnit {
+ instUnitInstanceOf = cid,
+ instUnitInsts = insts,
+ instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
+ instUnitFS = fs,
+ instUnitKey = getUnique fs
+ }
+
+instance Eq Unit where
+ uid1 == uid2 = unitUnique uid1 == unitUnique uid2
+
+instance Uniquable Unit where
+ getUnique = unitUnique
+
+instance Ord Unit where
+ nm1 `compare` nm2 = stableUnitCmp nm1 nm2
+
+instance Data Unit where
+ -- don't traverse?
+ toConstr _ = abstractConstr "Unit"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "Unit"
+
+instance NFData Unit where
+ rnf x = x `seq` ()
+
+-- | Compares unit ids lexically, rather than by their 'Unique's
+stableUnitCmp :: Unit -> Unit -> Ordering
+stableUnitCmp p1 p2 = unitFS p1 `compare` unitFS p2
+
+instance Outputable Unit where
+ ppr pk = pprUnit pk
+
+pprUnit :: Unit -> SDoc
+pprUnit (RealUnit uid) = ppr uid
+pprUnit (VirtUnit uid) = ppr uid
+pprUnit HoleUnit = ftext holeFS
+
+instance Show Unit where
+ show = unitString
+
+-- Performance: would prefer to have a NameCache like thing
+instance Binary Unit where
+ put_ bh (RealUnit def_uid) = do
+ putByte bh 0
+ put_ bh def_uid
+ put_ bh (VirtUnit indef_uid) = do
+ putByte bh 1
+ put_ bh indef_uid
+ put_ bh HoleUnit = do
+ putByte bh 2
+ get bh = do b <- getByte bh
+ case b of
+ 0 -> fmap RealUnit (get bh)
+ 1 -> fmap VirtUnit (get bh)
+ _ -> pure HoleUnit
+
+instance Binary unit => Binary (Indefinite unit) where
+ put_ bh (Indefinite fs _) = put_ bh fs
+ get bh = do { fs <- get bh; return (Indefinite fs Nothing) }
+
+
+
+-- | Retrieve the set of free module holes of a 'Unit'.
+unitFreeModuleHoles :: GenUnit u -> UniqDSet ModuleName
+unitFreeModuleHoles (VirtUnit x) = instUnitHoles x
+unitFreeModuleHoles (RealUnit _) = emptyUniqDSet
+unitFreeModuleHoles HoleUnit = emptyUniqDSet
+
+-- | Calculate the free holes of a 'Module'. If this set is non-empty,
+-- this module was defined in an indefinite library that had required
+-- signatures.
+--
+-- If a module has free holes, that means that substitutions can operate on it;
+-- if it has no free holes, substituting over a module has no effect.
+moduleFreeHoles :: GenModule (GenUnit u) -> UniqDSet ModuleName
+moduleFreeHoles (Module HoleUnit name) = unitUniqDSet name
+moduleFreeHoles (Module u _ ) = unitFreeModuleHoles u
+
+
+-- | Create a new 'GenInstantiatedUnit' given an explicit module substitution.
+mkGenInstantiatedUnit :: (unit -> FastString) -> Indefinite unit -> GenInstantiations unit -> GenInstantiatedUnit unit
+mkGenInstantiatedUnit gunitFS cid insts =
+ InstantiatedUnit {
+ instUnitInstanceOf = cid,
+ instUnitInsts = sorted_insts,
+ instUnitHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
+ instUnitFS = fs,
+ instUnitKey = getUnique fs
+ }
+ where
+ fs = mkGenInstantiatedUnitHash gunitFS cid sorted_insts
+ sorted_insts = sortBy (stableModuleNameCmp `on` fst) insts
+
+-- | Create a new 'InstantiatedUnit' given an explicit module substitution.
+mkInstantiatedUnit :: IndefUnitId -> Instantiations -> InstantiatedUnit
+mkInstantiatedUnit = mkGenInstantiatedUnit unitIdFS
+
+
+-- | Smart constructor for instantiated GenUnit
+mkGenVirtUnit :: (unit -> FastString) -> Indefinite unit -> [(ModuleName, GenModule (GenUnit unit))] -> GenUnit unit
+mkGenVirtUnit _gunitFS uid [] = RealUnit $ Definite (indefUnit uid) -- huh? indefinite unit without any instantiation/hole?
+mkGenVirtUnit gunitFS uid insts = VirtUnit $ mkGenInstantiatedUnit gunitFS uid insts
+
+-- | Smart constructor for VirtUnit
+mkVirtUnit :: IndefUnitId -> Instantiations -> Unit
+mkVirtUnit = mkGenVirtUnit unitIdFS
+
+-- | Generate a uniquely identifying hash (internal unit-id) for an instantiated
+-- unit.
+--
+-- This is a one-way function. If the indefinite unit has not been instantiated at all, we return its unit-id.
+--
+-- This hash is completely internal to GHC and is not used for symbol names or
+-- file paths. It is different from the hash Cabal would produce for the same
+-- instantiated unit.
+mkGenInstantiatedUnitHash :: (unit -> FastString) -> Indefinite unit -> [(ModuleName, GenModule (GenUnit unit))] -> FastString
+mkGenInstantiatedUnitHash gunitFS cid sorted_holes =
+ mkFastStringByteString
+ . fingerprintUnitId (bytesFS (gunitFS (indefUnit cid)))
+ $ hashInstantiations gunitFS sorted_holes
+
+mkInstantiatedUnitHash :: IndefUnitId -> Instantiations -> FastString
+mkInstantiatedUnitHash = mkGenInstantiatedUnitHash unitIdFS
+
+-- | Generate a hash for a sorted module instantiation.
+hashInstantiations :: (unit -> FastString) -> [(ModuleName, GenModule (GenUnit unit))] -> Fingerprint
+hashInstantiations gunitFS sorted_holes =
+ fingerprintByteString
+ . BS.concat $ do
+ (m, b) <- sorted_holes
+ [ bytesFS (moduleNameFS m), BS.Char8.singleton ' ',
+ bytesFS (genUnitFS gunitFS (moduleUnit b)), BS.Char8.singleton ':',
+ bytesFS (moduleNameFS (moduleName b)), BS.Char8.singleton '\n']
+
+fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
+fingerprintUnitId prefix (Fingerprint a b)
+ = BS.concat
+ $ [ prefix
+ , BS.Char8.singleton '-'
+ , BS.Char8.pack (toBase62Padded a)
+ , BS.Char8.pack (toBase62Padded b) ]
+
+unitUnique :: Unit -> Unique
+unitUnique (VirtUnit x) = instUnitKey x
+unitUnique (RealUnit (Definite x)) = getUnique x
+unitUnique HoleUnit = holeUnique
+
+unitFS :: Unit -> FastString
+unitFS = genUnitFS unitIdFS
+
+genUnitFS :: (unit -> FastString) -> GenUnit unit -> FastString
+genUnitFS _gunitFS (VirtUnit x) = instUnitFS x
+genUnitFS gunitFS (RealUnit (Definite x)) = gunitFS x
+genUnitFS _gunitFS HoleUnit = holeFS
+
+-- | Create a new simple unit identifier from a 'FastString'. Internally,
+-- this is primarily used to specify wired-in unit identifiers.
+fsToUnit :: FastString -> Unit
+fsToUnit = RealUnit . Definite . UnitId
+
+unitString :: Unit -> String
+unitString = unpackFS . unitFS
+
+stringToUnit :: String -> Unit
+stringToUnit = fsToUnit . mkFastString
+
+-- | Map over the unit type of a 'GenUnit'
+mapGenUnit :: (u -> v) -> (v -> FastString) -> GenUnit u -> GenUnit v
+mapGenUnit f gunitFS = go
+ where
+ go gu = case gu of
+ HoleUnit -> HoleUnit
+ RealUnit d -> RealUnit (fmap f d)
+ VirtUnit i ->
+ VirtUnit $ mkGenInstantiatedUnit gunitFS
+ (fmap f (instUnitInstanceOf i))
+ (fmap (second (fmap go)) (instUnitInsts i))
+
+
+-- | Check the database to see if we already have an installed unit that
+-- corresponds to the given 'InstantiatedUnit'.
+--
+-- Return a `UnitId` which either wraps the `InstantiatedUnit` unchanged or
+-- references a matching installed unit.
+--
+-- See Note [VirtUnit to RealUnit improvement]
+instUnitToUnit :: PackageState -> InstantiatedUnit -> Unit
+instUnitToUnit pkgstate iuid =
+ -- NB: suppose that we want to compare the indefinite
+ -- unit id p[H=impl:H] against p+abcd (where p+abcd
+ -- happens to be the existing, installed version of
+ -- p[H=impl:H]. If we *only* wrap in p[H=impl:H]
+ -- VirtUnit, they won't compare equal; only
+ -- after improvement will the equality hold.
+ improveUnit (unitInfoMap pkgstate) $
+ VirtUnit iuid
+
+-- | Return the UnitId of the Unit. For instantiated units, return the
+-- UnitId of the indefinite unit this unit is an instance of.
+toUnitId :: Unit -> UnitId
+toUnitId (RealUnit (Definite iuid)) = iuid
+toUnitId (VirtUnit indef) = indefUnit (instUnitInstanceOf indef)
+toUnitId HoleUnit = error "Hole unit"
+
+-- | A 'Unit' is definite if it has no free holes.
+unitIsDefinite :: Unit -> Bool
+unitIsDefinite = isEmptyUniqDSet . unitFreeModuleHoles
+
+---------------------------------------------------------------------
+-- UNIT IDs
+---------------------------------------------------------------------
+
+-- | A UnitId identifies a built library in a database and is used to generate
+-- unique symbols, etc. It's usually of the form:
+--
+-- pkgname-1.2:libname+hash
+--
+-- These UnitId are provided to us via the @-this-unit-id@ flag.
+--
+-- The library in question may be definite or indefinite; if it is indefinite,
+-- none of the holes have been filled (we never install partially instantiated
+-- libraries as we can cheaply instantiate them on-the-fly, cf VirtUnit). Put
+-- another way, an installed unit id is either fully instantiated, or not
+-- instantiated at all.
+newtype UnitId =
+ UnitId {
+ -- | The full hashed unit identifier, including the component id
+ -- and the hash.
+ unitIdFS :: FastString
+ }
+
+instance Binary UnitId where
+ put_ bh (UnitId fs) = put_ bh fs
+ get bh = do fs <- get bh; return (UnitId fs)
+
+instance Eq UnitId where
+ uid1 == uid2 = getUnique uid1 == getUnique uid2
+
+instance Ord UnitId where
+ u1 `compare` u2 = unitIdFS u1 `compare` unitIdFS u2
+
+instance Uniquable UnitId where
+ getUnique = getUnique . unitIdFS
+
+instance Outputable UnitId where
+ ppr uid@(UnitId fs) =
+ getPprStyle $ \sty ->
+ sdocWithDynFlags $ \dflags ->
+ case displayUnitId (pkgState dflags) uid of
+ Just str | not (debugStyle sty) -> text str
+ _ -> ftext fs
+
+-- | A 'DefUnitId' is an 'UnitId' with the invariant that
+-- it only refers to a definite library; i.e., one we have generated
+-- code for.
+type DefUnitId = Definite UnitId
+
+unitIdString :: UnitId -> String
+unitIdString = unpackFS . unitIdFS
+
+stringToUnitId :: String -> UnitId
+stringToUnitId = UnitId . mkFastString
+
+---------------------------------------------------------------------
+-- UTILS
+---------------------------------------------------------------------
+
+-- | A definite unit (i.e. without any free module hole)
+newtype Definite unit = Definite { unDefinite :: unit }
+ deriving (Eq, Ord, Functor)
+
+instance Outputable unit => Outputable (Definite unit) where
+ ppr (Definite uid) = ppr uid
+
+instance Binary unit => Binary (Definite unit) where
+ put_ bh (Definite uid) = put_ bh uid
+ get bh = do uid <- get bh; return (Definite uid)
+
+
+-- | An 'IndefUnitId' is an 'UnitId' with the invariant that it only
+-- refers to an indefinite library; i.e., one that can be instantiated.
+type IndefUnitId = Indefinite UnitId
+
+data Indefinite unit = Indefinite
+ { indefUnit :: !unit -- ^ Unit identifier
+ , indefUnitPprInfo :: Maybe UnitPprInfo -- ^ Cache for some unit info retrieved from the DB
+ }
+ deriving (Functor)
+
+instance Eq unit => Eq (Indefinite unit) where
+ a == b = indefUnit a == indefUnit b
+
+instance Ord unit => Ord (Indefinite unit) where
+ compare a b = compare (indefUnit a) (indefUnit b)
+
+
+instance Uniquable unit => Uniquable (Indefinite unit) where
+ getUnique (Indefinite n _) = getUnique n
+
+instance Outputable unit => Outputable (Indefinite unit) where
+ ppr (Indefinite uid Nothing) = ppr uid
+ ppr (Indefinite uid (Just pprinfo)) =
+ getPprStyle $ \sty ->
+ if debugStyle sty
+ then ppr uid
+ else ppr pprinfo
+
+
+---------------------------------------------------------------------
+-- WIRED-IN UNITS
+---------------------------------------------------------------------
+
+{-
+Note [Wired-in units]
+~~~~~~~~~~~~~~~~~~~~~
+
+Certain packages are known to the compiler, in that we know about certain
+entities that reside in these packages, and the compiler needs to
+declare static Modules and Names that refer to these packages. Hence
+the wired-in packages can't include version numbers in their package UnitId,
+since we don't want to bake the version numbers of these packages into GHC.
+
+So here's the plan. Wired-in units are still versioned as
+normal in the packages database, and you can still have multiple
+versions of them installed. To the user, everything looks normal.
+
+However, for each invocation of GHC, only a single instance of each wired-in
+package will be recognised (the desired one is selected via
+@-package@\/@-hide-package@), and GHC will internally pretend that it has the
+*unversioned* 'UnitId', including in .hi files and object file symbols.
+
+Unselected versions of wired-in packages will be ignored, as will any other
+package that depends directly or indirectly on it (much as if you
+had used @-ignore-package@).
+
+The affected packages are compiled with, e.g., @-this-unit-id base@, so that
+the symbols in the object files have the unversioned unit id in their name.
+
+Make sure you change 'GHC.Unit.State.findWiredInPackages' if you add an entry here.
+
+For `integer-gmp`/`integer-simple` we also change the base name to
+`integer-wired-in`, but this is fundamentally no different.
+See Note [The integer library] in PrelNames.
+-}
+
+integerUnitId, primUnitId,
+ baseUnitId, rtsUnitId,
+ thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId :: Unit
+primUnitId = fsToUnit (fsLit "ghc-prim")
+integerUnitId = fsToUnit (fsLit "integer-wired-in")
+ -- See Note [The integer library] in PrelNames
+baseUnitId = fsToUnit (fsLit "base")
+rtsUnitId = fsToUnit (fsLit "rts")
+thUnitId = fsToUnit (fsLit "template-haskell")
+thisGhcUnitId = fsToUnit (fsLit "ghc")
+interactiveUnitId = fsToUnit (fsLit "interactive")
+
+-- | This is the package Id for the current program. It is the default
+-- package Id if you don't specify a package name. We don't add this prefix
+-- to symbol names, since there can be only one main package per program.
+mainUnitId = fsToUnit (fsLit "main")
+
+isInteractiveModule :: Module -> Bool
+isInteractiveModule mod = moduleUnit mod == interactiveUnitId
+
+wiredInUnitIds :: [Unit]
+wiredInUnitIds =
+ [ primUnitId
+ , integerUnitId
+ , baseUnitId
+ , rtsUnitId
+ , thUnitId
+ , thisGhcUnitId
+ ]
diff --git a/compiler/GHC/Unit/Types.hs-boot b/compiler/GHC/Unit/Types.hs-boot
new file mode 100644
index 0000000000..f8ad571935
--- /dev/null
+++ b/compiler/GHC/Unit/Types.hs-boot
@@ -0,0 +1,18 @@
+module GHC.Unit.Types where
+
+import GHC.Prelude ()
+import {-# SOURCE #-} GHC.Utils.Outputable
+import {-# SOURCE #-} GHC.Unit.Module.Name
+
+data UnitId
+data GenModule unit
+data GenUnit uid
+data Indefinite unit
+
+type Module = GenModule Unit
+type Unit = GenUnit UnitId
+type IndefUnitId = Indefinite UnitId
+
+moduleName :: GenModule a -> ModuleName
+moduleUnit :: GenModule a -> a
+pprModule :: Module -> SDoc
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index bcea799bd8..1f046d2354 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -99,7 +99,8 @@ import {-# SOURCE #-} GHC.Driver.Session
, pprUserLength
, unsafeGlobalDynFlags, initSDocContext
)
-import {-# SOURCE #-} GHC.Types.Module( Unit, Module, ModuleName, moduleName )
+import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName )
+import {-# SOURCE #-} GHC.Unit.Module.Name( ModuleName )
import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
import GHC.Utils.BufHandle (BufHandle)