diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-04-11 17:03:18 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-04-30 01:56:56 -0400 |
| commit | 8bfb0219587b969d5c8f723c46d433e9493958b4 (patch) | |
| tree | 7ed243039324e5a85905985589d7defd91543625 | |
| parent | 10d15f1ec4bab4dd6152d87fc66e61658a705eb3 (diff) | |
| download | haskell-8bfb0219587b969d5c8f723c46d433e9493958b4.tar.gz | |
Unit: split and rename modules
Introduce GHC.Unit.* hierarchy for everything concerning units, packages
and modules.
Update Haddock submodule
192 files changed, 1987 insertions, 1977 deletions
diff --git a/compiler/GHC.hs b/compiler/GHC.hs index d6878ad63d..088e121690 100644 --- a/compiler/GHC.hs +++ b/compiler/GHC.hs @@ -312,7 +312,7 @@ import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceTcRn ) import GHC.Iface.Load ( loadSysInterface ) import GHC.Tc.Types import GHC.Core.Predicate -import GHC.Driver.Packages +import GHC.Unit.State import GHC.Types.Name.Set import GHC.Types.Name.Reader import GHC.Hs @@ -341,7 +341,7 @@ import GHC.Driver.Ways import GHC.SysTools import GHC.SysTools.BaseDir import GHC.Types.Annotations -import GHC.Types.Module +import GHC.Unit.Module import GHC.Utils.Panic import GHC.Platform import GHC.Data.Bag ( listToBag ) 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) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 5cc0b3af31..be85522ad4 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -210,7 +210,15 @@ Library GHC.CmmToLlvm.Regs GHC.CmmToLlvm.Mangler GHC.Types.Id.Make - GHC.Types.Module + GHC.Unit + GHC.Unit.Parser + GHC.Unit.Ppr + GHC.Unit.Subst + GHC.Unit.Types + GHC.Unit.Module + GHC.Unit.Module.Name + GHC.Unit.Module.Location + GHC.Unit.Module.Env GHC.Types.Name GHC.Types.Name.Env GHC.Types.Name.Set @@ -372,7 +380,7 @@ Library GHC.Runtime.Eval.Types GHC.Runtime.Loader GHC.Unit.Info - GHC.Driver.Packages + GHC.Unit.State GHC.Driver.Plugins GHC.Tc.Plugin GHC.Core.Ppr.TyThing diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 3006af68c1..4eafcbd1d1 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -55,9 +55,9 @@ import GHC.Hs import GHC.Driver.Types ( tyThingParent_maybe, handleFlagWarnings, getSafeMode, hsc_IC, setInteractivePrintName, hsc_dflags, msObjFilePath, runInteractiveHsc, hsc_dynLinker, hsc_interp ) -import GHC.Types.Module +import GHC.Unit.Module import GHC.Types.Name -import GHC.Driver.Packages ( unitIsTrusted, unsafeGetUnitInfo, getInstalledPackageDetails, +import GHC.Unit.State ( unitIsTrusted, unsafeGetUnitInfo, getInstalledPackageDetails, listVisibleModuleNames, pprFlag ) import GHC.Iface.Syntax ( showToHeader ) import GHC.Core.Ppr.TyThing @@ -3150,7 +3150,7 @@ If we don't filter the bindings returned by the function GHC.getBindings, then the :show bindings command will also show unwanted bound names, internally generated by GHC, eg: $tcFoo :: GHC.Types.TyCon = _ - $trModule :: GHC.Types.Module = _ . + $trModule :: GHC.Unit.Module = _ . The filter was introduced as a fix for #12525 [1]. Comment:1 [2] to this ticket contains an analysis of the situation and suggests the solution diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs index fb6d673fff..fe8b9380de 100644 --- a/ghc/GHCi/UI/Monad.hs +++ b/ghc/GHCi/UI/Monad.hs @@ -45,7 +45,7 @@ import GHC.Driver.Session import GHC.Data.FastString import GHC.Driver.Types import GHC.Types.SrcLoc -import GHC.Types.Module +import GHC.Unit import GHC.Types.Name.Reader as RdrName (mkOrig) import GHC.Builtin.Names (gHC_GHCI_HELPERS) import GHC.Runtime.Interpreter diff --git a/ghc/Main.hs b/ghc/Main.hs index a4cd897ab4..5e194369ca 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -39,7 +39,7 @@ import GHC.Driver.Plugins #if defined(HAVE_INTERNAL_INTERPRETER) import GHC.Runtime.Loader ( initializePlugins ) #endif -import GHC.Types.Module ( ModuleName, mkModuleName ) +import GHC.Unit.Module ( ModuleName, mkModuleName ) -- Various other random stuff that we need @@ -49,7 +49,7 @@ import GHC.Platform.Host import Config import GHC.Settings.Constants import GHC.Driver.Types -import GHC.Driver.Packages ( pprPackages, pprPackagesSimple ) +import GHC.Unit.State ( pprPackages, pprPackagesSimple ) import GHC.Driver.Phases import GHC.Types.Basic ( failed ) import GHC.Driver.Session hiding (WarnReason(..)) diff --git a/libraries/ghc-boot/GHC/PackageDb.hs b/libraries/ghc-boot/GHC/Unit/Database.hs index 650234927c..8ed139adf3 100644 --- a/libraries/ghc-boot/GHC/PackageDb.hs +++ b/libraries/ghc-boot/GHC/Unit/Database.hs @@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- -- | --- Module : GHC.PackageDb +-- Module : GHC.Unit.Database -- Copyright : (c) The University of Glasgow 2009, Duncan Coutts 2014 -- -- Maintainer : ghc-devs@haskell.org @@ -47,7 +47,7 @@ -- is kept in the file but here we treat it as an opaque blob of data. That way -- this library avoids depending on Cabal. -- -module GHC.PackageDb +module GHC.Unit.Database ( GenericUnitInfo(..) , type DbUnitInfo , DbModule (..) @@ -495,7 +495,7 @@ decodeFromFile file mode decoder = case mode of where err = mkIOError InappropriateType loc Nothing (Just file) `ioeSetErrorString` msg - loc = "GHC.PackageDb.readPackageDb" + loc = "GHC.Unit.Database.readPackageDb" -- Copied from Cabal's Distribution.Simple.Utils. writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO () diff --git a/libraries/ghc-boot/ghc-boot.cabal.in b/libraries/ghc-boot/ghc-boot.cabal.in index c8ac491c59..6866f65011 100644 --- a/libraries/ghc-boot/ghc-boot.cabal.in +++ b/libraries/ghc-boot/ghc-boot.cabal.in @@ -13,7 +13,7 @@ synopsis: Shared functionality between GHC and its boot libraries description: This library is shared between GHC, ghc-pkg, and other boot libraries. . - A note about "GHC.PackageDb": it only deals with the subset of + A note about "GHC.Unit.Database": it only deals with the subset of the package database that the compiler cares about: modules paths etc and not package metadata like description, authors etc. It is thus not a library interface to ghc-pkg and is *not* @@ -39,7 +39,7 @@ Library exposed-modules: GHC.BaseDir GHC.LanguageExtensions - GHC.PackageDb + GHC.Unit.Database GHC.Serialized GHC.ForeignSrcLang GHC.HandleEncoding diff --git a/testsuite/tests/ghc-api/T8628.hs b/testsuite/tests/ghc-api/T8628.hs index 9e8fd84fcb..fa23bc5218 100644 --- a/testsuite/tests/ghc-api/T8628.hs +++ b/testsuite/tests/ghc-api/T8628.hs @@ -4,7 +4,7 @@ import System.IO import GHC.Driver.Session import GHC import GHC.Utils.Exception -import GHC.Types.Module +import GHC.Unit.Module import GHC.Data.FastString import GHC.Utils.Monad import GHC.Utils.Outputable diff --git a/testsuite/tests/ghc-api/T9595.hs b/testsuite/tests/ghc-api/T9595.hs index 0080ae9bc5..3910a20115 100644 --- a/testsuite/tests/ghc-api/T9595.hs +++ b/testsuite/tests/ghc-api/T9595.hs @@ -1,12 +1,12 @@ module Main where import GHC -import GHC.Driver.Packages +import GHC.Unit.State import GHC.Driver.Monad import GHC.Utils.Outputable import System.Environment import GHC.Driver.Session -import GHC.Types.Module +import GHC.Unit.Module main = do [libdir] <- getArgs diff --git a/testsuite/tests/ghci/linking/dyn/all.T b/testsuite/tests/ghci/linking/dyn/all.T index 9a54670732..127c9707a7 100644 --- a/testsuite/tests/ghci/linking/dyn/all.T +++ b/testsuite/tests/ghci/linking/dyn/all.T @@ -52,6 +52,6 @@ test('T3372', unless(config.have_RTS_linker, skip), # Concurrent GHC sessions is fragile on Windows since we must lock the # package database even for read-only access. - # See Note [Locking package database on Windows] in GHC.PackageDb + # See Note [Locking package database on Windows] in GHC.Unit.Database when(opsys('mingw32'), fragile(16773))], compile_and_run, ['-package ghc']) diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs index ced0cde750..fdc44fe09c 100644 --- a/testsuite/tests/parser/should_run/CountParserDeps.hs +++ b/testsuite/tests/parser/should_run/CountParserDeps.hs @@ -11,7 +11,7 @@ module Main(main) where -- need exists to produce ASTs and nothing more. import GHC.Driver.Types -import GHC.Types.Module +import GHC.Unit.Module import GHC.Driver.Session import GHC.Driver.Main import GHC @@ -30,7 +30,7 @@ main = do let num = sizeUniqSet modules -- print num -- print (map moduleNameString $ nonDetEltsUniqSet modules) - unless (num < 190) $ exitWith (ExitFailure num) + unless (num < 195) $ exitWith (ExitFailure num) parserDeps :: FilePath -> IO (UniqSet ModuleName) parserDeps libdir = diff --git a/testsuite/tests/regalloc/regalloc_unit_tests.hs b/testsuite/tests/regalloc/regalloc_unit_tests.hs index 4c34a065ca..b4495f5d34 100644 --- a/testsuite/tests/regalloc/regalloc_unit_tests.hs +++ b/testsuite/tests/regalloc/regalloc_unit_tests.hs @@ -33,7 +33,7 @@ import GHC.Cmm.Pipeline import GHC.Cmm.Parser import GHC.Cmm.Info import GHC.Cmm -import GHC.Types.Module +import GHC.Unit.Module import GHC.Cmm.DebugBlock import GHC import GHC.Driver.Monad diff --git a/testsuite/tests/roles/should_compile/Roles1.stderr b/testsuite/tests/roles/should_compile/Roles1.stderr index defc6e8c3a..e4f1683ee9 100644 --- a/testsuite/tests/roles/should_compile/Roles1.stderr +++ b/testsuite/tests/roles/should_compile/Roles1.stderr @@ -20,122 +20,66 @@ DATA CONSTRUCTORS K2 :: forall a. a -> T2 a K1 :: forall a. a -> T1 a Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] ==================== Typechecker ==================== Roles1.$tcT7 = GHC.Types.TyCon - 178606230775360129## - 14564382578551945561## - Roles1.$trModule - (GHC.Types.TrNameS "T7"#) - 1 - $krep + 178606230775360129## 14564382578551945561## Roles1.$trModule + (GHC.Types.TrNameS "T7"#) 1 $krep Roles1.$tc'K7 = GHC.Types.TyCon - 15901479081375327280## - 4842873210599704617## - Roles1.$trModule - (GHC.Types.TrNameS "'K7"#) - 3 - $krep + 15901479081375327280## 4842873210599704617## Roles1.$trModule + (GHC.Types.TrNameS "'K7"#) 3 $krep Roles1.$tcT6 = GHC.Types.TyCon - 7244893995195634045## - 6882827069359931041## - Roles1.$trModule - (GHC.Types.TrNameS "T6"#) - 1 - $krep + 7244893995195634045## 6882827069359931041## Roles1.$trModule + (GHC.Types.TrNameS "T6"#) 1 $krep Roles1.$tc'K6 = GHC.Types.TyCon - 13928703131159360198## - 9274401506945696896## - Roles1.$trModule - (GHC.Types.TrNameS "'K6"#) - 2 - $krep + 13928703131159360198## 9274401506945696896## Roles1.$trModule + (GHC.Types.TrNameS "'K6"#) 2 $krep Roles1.$tcT5 = GHC.Types.TyCon - 12033401645911719002## - 6369139038321702301## - Roles1.$trModule - (GHC.Types.TrNameS "T5"#) - 0 - GHC.Types.krep$*Arr* + 12033401645911719002## 6369139038321702301## Roles1.$trModule + (GHC.Types.TrNameS "T5"#) 0 GHC.Types.krep$*Arr* Roles1.$tc'K5 = GHC.Types.TyCon - 5548842497263642061## - 18349261927117571882## - Roles1.$trModule - (GHC.Types.TrNameS "'K5"#) - 1 - $krep + 5548842497263642061## 18349261927117571882## Roles1.$trModule + (GHC.Types.TrNameS "'K5"#) 1 $krep Roles1.$tcT4 = GHC.Types.TyCon - 15834077582937152787## - 17059037094835388922## - Roles1.$trModule - (GHC.Types.TrNameS "T4"#) - 0 - $krep + 15834077582937152787## 17059037094835388922## Roles1.$trModule + (GHC.Types.TrNameS "T4"#) 0 $krep Roles1.$tc'K4 = GHC.Types.TyCon - 10188453925450404995## - 4762093850599364042## - Roles1.$trModule - (GHC.Types.TrNameS "'K4"#) - 2 - $krep + 10188453925450404995## 4762093850599364042## Roles1.$trModule + (GHC.Types.TrNameS "'K4"#) 2 $krep Roles1.$tcT3 = GHC.Types.TyCon - 13341737262627465733## - 14527452670364737316## - Roles1.$trModule - (GHC.Types.TrNameS "T3"#) - 1 - $krep + 13341737262627465733## 14527452670364737316## Roles1.$trModule + (GHC.Types.TrNameS "T3"#) 1 $krep Roles1.$tc'K3 = GHC.Types.TyCon - 14534968069054730342## - 6860808298964464185## - Roles1.$trModule - (GHC.Types.TrNameS "'K3"#) - 2 - $krep + 14534968069054730342## 6860808298964464185## Roles1.$trModule + (GHC.Types.TrNameS "'K3"#) 2 $krep Roles1.$tcT2 = GHC.Types.TyCon - 12900773996789723956## - 9313087549503346504## - Roles1.$trModule - (GHC.Types.TrNameS "T2"#) - 0 - GHC.Types.krep$*Arr* + 12900773996789723956## 9313087549503346504## Roles1.$trModule + (GHC.Types.TrNameS "T2"#) 0 GHC.Types.krep$*Arr* Roles1.$tc'K2 = GHC.Types.TyCon - 11054915488163123841## - 10799789256744079155## - Roles1.$trModule - (GHC.Types.TrNameS "'K2"#) - 1 - $krep + 11054915488163123841## 10799789256744079155## Roles1.$trModule + (GHC.Types.TrNameS "'K2"#) 1 $krep Roles1.$tcT1 = GHC.Types.TyCon - 13228660854624297872## - 14494320157476678712## - Roles1.$trModule - (GHC.Types.TrNameS "T1"#) - 0 - GHC.Types.krep$*Arr* + 13228660854624297872## 14494320157476678712## Roles1.$trModule + (GHC.Types.TrNameS "T1"#) 0 GHC.Types.krep$*Arr* Roles1.$tc'K1 = GHC.Types.TyCon - 1265606750138351672## - 7033043930969109074## - Roles1.$trModule - (GHC.Types.TrNameS "'K1"#) - 1 - $krep + 1265606750138351672## 7033043930969109074## Roles1.$trModule + (GHC.Types.TrNameS "'K1"#) 1 $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 1 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 @@ -172,3 +116,4 @@ Roles1.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles1"#) + diff --git a/testsuite/tests/roles/should_compile/Roles14.stderr b/testsuite/tests/roles/should_compile/Roles14.stderr index a55e57f080..54e01992be 100644 --- a/testsuite/tests/roles/should_compile/Roles14.stderr +++ b/testsuite/tests/roles/should_compile/Roles14.stderr @@ -6,26 +6,18 @@ TYPE CONSTRUCTORS COERCION AXIOMS axiom Roles12.N:C2 :: C2 a = a -> a Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] ==================== Typechecker ==================== Roles12.$tcC2 = GHC.Types.TyCon - 7996680154108933333## - 9454227235464419996## - Roles12.$trModule - (GHC.Types.TrNameS "C2"#) - 0 - $krep + 7996680154108933333## 9454227235464419996## Roles12.$trModule + (GHC.Types.TrNameS "C2"#) 0 $krep Roles12.$tc'C:C2 = GHC.Types.TyCon - 7087988437584478859## - 11477953550142401435## - Roles12.$trModule - (GHC.Types.TrNameS "'C:C2"#) - 1 - $krep + 7087988437584478859## 11477953550142401435## Roles12.$trModule + (GHC.Types.TrNameS "'C:C2"#) 1 $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep @@ -39,3 +31,4 @@ Roles12.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles12"#) + diff --git a/testsuite/tests/roles/should_compile/Roles2.stderr b/testsuite/tests/roles/should_compile/Roles2.stderr index c1d6cc3870..7d721f2c12 100644 --- a/testsuite/tests/roles/should_compile/Roles2.stderr +++ b/testsuite/tests/roles/should_compile/Roles2.stderr @@ -6,42 +6,26 @@ DATA CONSTRUCTORS K2 :: forall a. FunPtr a -> T2 a K1 :: forall a. IO a -> T1 a Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] ==================== Typechecker ==================== Roles2.$tcT2 = GHC.Types.TyCon - 9065817229114433861## - 13399581642971864140## - Roles2.$trModule - (GHC.Types.TrNameS "T2"#) - 0 - GHC.Types.krep$*Arr* + 9065817229114433861## 13399581642971864140## Roles2.$trModule + (GHC.Types.TrNameS "T2"#) 0 GHC.Types.krep$*Arr* Roles2.$tc'K2 = GHC.Types.TyCon - 17395957229042313563## - 12263882107019815181## - Roles2.$trModule - (GHC.Types.TrNameS "'K2"#) - 1 - $krep + 17395957229042313563## 12263882107019815181## Roles2.$trModule + (GHC.Types.TrNameS "'K2"#) 1 $krep Roles2.$tcT1 = GHC.Types.TyCon - 10310640733256438505## - 9162099558816022096## - Roles2.$trModule - (GHC.Types.TrNameS "T1"#) - 0 - GHC.Types.krep$*Arr* + 10310640733256438505## 9162099558816022096## Roles2.$trModule + (GHC.Types.TrNameS "T1"#) 0 GHC.Types.krep$*Arr* Roles2.$tc'K1 = GHC.Types.TyCon - 16530009231990968394## - 11761390951471299534## - Roles2.$trModule - (GHC.Types.TrNameS "'K1"#) - 1 - $krep + 16530009231990968394## 11761390951471299534## Roles2.$trModule + (GHC.Types.TrNameS "'K1"#) 1 $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep @@ -57,3 +41,4 @@ Roles2.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles2"#) + diff --git a/testsuite/tests/roles/should_compile/Roles3.stderr b/testsuite/tests/roles/should_compile/Roles3.stderr index 255f2ed773..a7fb7a06c9 100644 --- a/testsuite/tests/roles/should_compile/Roles3.stderr +++ b/testsuite/tests/roles/should_compile/Roles3.stderr @@ -21,58 +21,34 @@ COERCION AXIOMS axiom Roles3.N:C3 :: C3 a b = a -> F3 b -> F3 b axiom Roles3.N:C4 :: C4 a b = a -> F4 b -> F4 b Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] ==================== Typechecker ==================== Roles3.$tcC4 = GHC.Types.TyCon - 6800596812149592130## - 15513203864133461281## - Roles3.$trModule - (GHC.Types.TrNameS "C4"#) - 0 - $krep + 6800596812149592130## 15513203864133461281## Roles3.$trModule + (GHC.Types.TrNameS "C4"#) 0 $krep Roles3.$tcC3 = GHC.Types.TyCon - 5076086601454991970## - 10299714674904836194## - Roles3.$trModule - (GHC.Types.TrNameS "C3"#) - 0 - $krep + 5076086601454991970## 10299714674904836194## Roles3.$trModule + (GHC.Types.TrNameS "C3"#) 0 $krep Roles3.$tcC2 = GHC.Types.TyCon - 7902873224172523979## - 11840994447152209031## - Roles3.$trModule - (GHC.Types.TrNameS "C2"#) - 0 - $krep + 7902873224172523979## 11840994447152209031## Roles3.$trModule + (GHC.Types.TrNameS "C2"#) 0 $krep Roles3.$tc'C:C2 = GHC.Types.TyCon - 11218882737915989529## - 9454910899374397367## - Roles3.$trModule - (GHC.Types.TrNameS "'C:C2"#) - 2 - $krep + 11218882737915989529## 9454910899374397367## Roles3.$trModule + (GHC.Types.TrNameS "'C:C2"#) 2 $krep Roles3.$tcC1 = GHC.Types.TyCon - 11013585501375994163## - 16371608655219610659## - Roles3.$trModule - (GHC.Types.TrNameS "C1"#) - 0 - $krep + 11013585501375994163## 16371608655219610659## Roles3.$trModule + (GHC.Types.TrNameS "C1"#) 0 $krep Roles3.$tc'C:C1 = GHC.Types.TyCon - 4508088879886988796## - 13962145553903222779## - Roles3.$trModule - (GHC.Types.TrNameS "'C:C1"#) - 1 - $krep + 4508088879886988796## 13962145553903222779## Roles3.$trModule + (GHC.Types.TrNameS "'C:C1"#) 1 $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 1 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep @@ -97,3 +73,4 @@ Roles3.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles3"#) + diff --git a/testsuite/tests/roles/should_compile/Roles4.stderr b/testsuite/tests/roles/should_compile/Roles4.stderr index 8a8851a0a2..8f1d58183b 100644 --- a/testsuite/tests/roles/should_compile/Roles4.stderr +++ b/testsuite/tests/roles/should_compile/Roles4.stderr @@ -9,42 +9,26 @@ COERCION AXIOMS axiom Roles4.N:C1 :: C1 a = a -> a axiom Roles4.N:C3 :: C3 a = a -> Syn1 a Dependent modules: [] -Dependent packages: [base-4.13.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] +Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, + integer-gmp-1.0.3.0] ==================== Typechecker ==================== Roles4.$tcC3 = GHC.Types.TyCon - 7508642517340826358## - 16938219270597865136## - Roles4.$trModule - (GHC.Types.TrNameS "C3"#) - 0 - $krep + 7508642517340826358## 16938219270597865136## Roles4.$trModule + (GHC.Types.TrNameS "C3"#) 0 $krep Roles4.$tc'C:C3 = GHC.Types.TyCon - 3133378316178104365## - 15809386433947157376## - Roles4.$trModule - (GHC.Types.TrNameS "'C:C3"#) - 1 - $krep + 3133378316178104365## 15809386433947157376## Roles4.$trModule + (GHC.Types.TrNameS "'C:C3"#) 1 $krep Roles4.$tcC1 = GHC.Types.TyCon - 13392243382482428602## - 1780037961948725012## - Roles4.$trModule - (GHC.Types.TrNameS "C1"#) - 0 - $krep + 13392243382482428602## 1780037961948725012## Roles4.$trModule + (GHC.Types.TrNameS "C1"#) 0 $krep Roles4.$tc'C:C1 = GHC.Types.TyCon - 3870707671502302648## - 10631907186261837450## - Roles4.$trModule - (GHC.Types.TrNameS "'C:C1"#) - 1 - $krep + 3870707671502302648## 10631907186261837450## Roles4.$trModule + (GHC.Types.TrNameS "'C:C1"#) 1 $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep $krep @@ -64,3 +48,4 @@ Roles4.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "Roles4"#) + diff --git a/testsuite/tests/roles/should_compile/T8958.stderr b/testsuite/tests/roles/should_compile/T8958.stderr index f498b9b009..07d0496799 100644 --- a/testsuite/tests/roles/should_compile/T8958.stderr +++ b/testsuite/tests/roles/should_compile/T8958.stderr @@ -17,7 +17,7 @@ CLASS INSTANCES instance [incoherent] Nominal a -- Defined at T8958.hs:7:10 Dependent modules: [] Dependent packages: [base-4.14.0.0, ghc-prim-0.6.1, - integer-gmp-1.0.2.0] + integer-gmp-1.0.3.0] ==================== Typechecker ==================== T8958.$tcMap diff --git a/testsuite/tests/simplCore/should_compile/T14137.stderr b/testsuite/tests/simplCore/should_compile/T14137.stderr index 602a74072d..71fee02df4 100644 --- a/testsuite/tests/simplCore/should_compile/T14137.stderr +++ b/testsuite/tests/simplCore/should_compile/T14137.stderr @@ -55,9 +55,9 @@ $trModule4 :: GHC.Types.TrName $trModule4 = GHC.Types.TrNameS $trModule3 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T14137.$trModule :: GHC.Types.Module +T14137.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs] -T14137.$trModule = GHC.Types.Module $trModule2 $trModule4 +T14137.$trModule = GHC.Unit.Module $trModule2 $trModule4 diff --git a/testsuite/tests/simplCore/should_compile/T14152.stderr b/testsuite/tests/simplCore/should_compile/T14152.stderr index c782d84fc3..cc025625b9 100644 --- a/testsuite/tests/simplCore/should_compile/T14152.stderr +++ b/testsuite/tests/simplCore/should_compile/T14152.stderr @@ -116,14 +116,14 @@ T14152.$trModule1 :: GHC.Types.TrName T14152.$trModule1 = GHC.Types.TrNameS T14152.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T14152.$trModule :: GHC.Types.Module +T14152.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T14152.$trModule - = GHC.Types.Module T14152.$trModule3 T14152.$trModule1 + = GHC.Unit.Module T14152.$trModule3 T14152.$trModule1 diff --git a/testsuite/tests/simplCore/should_compile/T14152a.stderr b/testsuite/tests/simplCore/should_compile/T14152a.stderr index d4b2ed39b8..0196c3695d 100644 --- a/testsuite/tests/simplCore/should_compile/T14152a.stderr +++ b/testsuite/tests/simplCore/should_compile/T14152a.stderr @@ -209,14 +209,14 @@ T14152.$trModule1 :: GHC.Types.TrName T14152.$trModule1 = GHC.Types.TrNameS T14152.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T14152.$trModule :: GHC.Types.Module +T14152.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T14152.$trModule - = GHC.Types.Module T14152.$trModule3 T14152.$trModule1 + = GHC.Unit.Module T14152.$trModule3 T14152.$trModule1 diff --git a/testsuite/tests/simplCore/should_compile/T14186.stderr b/testsuite/tests/simplCore/should_compile/T14186.stderr index 17ccc2c07d..41701fd4d9 100644 --- a/testsuite/tests/simplCore/should_compile/T14186.stderr +++ b/testsuite/tests/simplCore/should_compile/T14186.stderr @@ -106,14 +106,14 @@ T14186.$trModule1 :: GHC.Types.TrName T14186.$trModule1 = GHC.Types.TrNameS T14186.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T14186.$trModule :: GHC.Types.Module +T14186.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T14186.$trModule - = GHC.Types.Module T14186.$trModule3 T14186.$trModule1 + = GHC.Unit.Module T14186.$trModule3 T14186.$trModule1 diff --git a/testsuite/tests/simplCore/should_compile/spec004.stderr b/testsuite/tests/simplCore/should_compile/spec004.stderr index 8d53785b68..f140da9977 100644 --- a/testsuite/tests/simplCore/should_compile/spec004.stderr +++ b/testsuite/tests/simplCore/should_compile/spec004.stderr @@ -67,11 +67,11 @@ $trModule :: GHC.Types.TrName $trModule = GHC.Types.TrNameS $trModule -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -ShouldCompile.$trModule :: GHC.Types.Module +ShouldCompile.$trModule :: GHC.Unit.Module [LclIdX, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -ShouldCompile.$trModule = GHC.Types.Module $trModule $trModule +ShouldCompile.$trModule = GHC.Unit.Module $trModule $trModule -- RHS size: {terms: 5, types: 1, coercions: 0, joins: 0/0} bar :: String diff --git a/testsuite/tests/simplStg/should_compile/T13588.stderr b/testsuite/tests/simplStg/should_compile/T13588.stderr index 15075cd3fc..4c9c6dd006 100644 --- a/testsuite/tests/simplStg/should_compile/T13588.stderr +++ b/testsuite/tests/simplStg/should_compile/T13588.stderr @@ -40,9 +40,9 @@ T13588.$trModule1 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] = NO_CCS GHC.Types.TrNameS! [T13588.$trModule2]; -T13588.$trModule :: GHC.Types.Module +T13588.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] = - NO_CCS GHC.Types.Module! [T13588.$trModule3 T13588.$trModule1]; + NO_CCS GHC.Unit.Module! [T13588.$trModule3 T13588.$trModule1]; $krep_rWb :: GHC.Types.KindRep [GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] = @@ -137,9 +137,9 @@ T13588.$trModule1 :: GHC.Types.TrName [GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] = NO_CCS GHC.Types.TrNameS! [T13588.$trModule2]; -T13588.$trModule :: GHC.Types.Module +T13588.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] = - NO_CCS GHC.Types.Module! [T13588.$trModule3 T13588.$trModule1]; + NO_CCS GHC.Unit.Module! [T13588.$trModule3 T13588.$trModule1]; $krep_rWb :: GHC.Types.KindRep [GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] = diff --git a/testsuite/tests/stranal/should_compile/T10482.stderr b/testsuite/tests/stranal/should_compile/T10482.stderr index af81b81bab..2c2f7ca067 100644 --- a/testsuite/tests/stranal/should_compile/T10482.stderr +++ b/testsuite/tests/stranal/should_compile/T10482.stderr @@ -48,11 +48,11 @@ T10482.$trModule1 :: GHC.Types.TrName T10482.$trModule1 = GHC.Types.TrNameS T10482.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T10482.$trModule :: GHC.Types.Module +T10482.$trModule :: GHC.Unit.Module [GblId, Cpr=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -T10482.$trModule = GHC.Types.Module T10482.$trModule3 T10482.$trModule1 +T10482.$trModule = GHC.Unit.Module T10482.$trModule3 T10482.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep_r1Gw :: GHC.Types.KindRep diff --git a/testsuite/tests/stranal/should_compile/T10482a.stderr b/testsuite/tests/stranal/should_compile/T10482a.stderr index 8d6fd7d877..369694a870 100644 --- a/testsuite/tests/stranal/should_compile/T10482a.stderr +++ b/testsuite/tests/stranal/should_compile/T10482a.stderr @@ -57,11 +57,11 @@ Foo.$trModule1 :: GHC.Types.TrName Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -Foo.$trModule :: GHC.Types.Module +Foo.$trModule :: GHC.Unit.Module [GblId, Cpr=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1 +Foo.$trModule = GHC.Unit.Module Foo.$trModule3 Foo.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep_r1x7 :: GHC.Types.KindRep diff --git a/testsuite/tests/stranal/should_compile/T10694.stderr b/testsuite/tests/stranal/should_compile/T10694.stderr index 5eb2c186ad..66a337ab24 100644 --- a/testsuite/tests/stranal/should_compile/T10694.stderr +++ b/testsuite/tests/stranal/should_compile/T10694.stderr @@ -75,11 +75,11 @@ T10694.$trModule1 :: GHC.Types.TrName T10694.$trModule1 = GHC.Types.TrNameS T10694.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -T10694.$trModule :: GHC.Types.Module +T10694.$trModule :: GHC.Unit.Module [GblId, Cpr=m1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -T10694.$trModule = GHC.Types.Module T10694.$trModule3 T10694.$trModule1 +T10694.$trModule = GHC.Unit.Module T10694.$trModule3 T10694.$trModule1 diff --git a/testsuite/tests/stranal/should_compile/T11770.stderr b/testsuite/tests/stranal/should_compile/T11770.stderr index 82f6a9d1f9..2c9c149d7d 100644 --- a/testsuite/tests/stranal/should_compile/T11770.stderr +++ b/testsuite/tests/stranal/should_compile/T11770.stderr @@ -21,14 +21,14 @@ T11770.$trModule1 :: GHC.Types.TrName T11770.$trModule1 = GHC.Types.TrNameS "T11770"# -- RHS size: {terms: 3, types: 0, coercions: 0} -T11770.$trModule :: GHC.Types.Module +T11770.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] T11770.$trModule = - GHC.Types.Module T11770.$trModule2 T11770.$trModule1 + GHC.Unit.Module T11770.$trModule2 T11770.$trModule1 Rec { -- RHS size: {terms: 32, types: 11, coercions: 0} diff --git a/testsuite/tests/stranal/should_compile/T15627.stderr b/testsuite/tests/stranal/should_compile/T15627.stderr index 91f51b4ba8..38c054da17 100644 --- a/testsuite/tests/stranal/should_compile/T15627.stderr +++ b/testsuite/tests/stranal/should_compile/T15627.stderr @@ -34,12 +34,12 @@ Unlifted.$trModule1 :: GHC.Types.TrName Unlifted.$trModule1 = GHC.Types.TrNameS Unlifted.$trModule2 -- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0} -Unlifted.$trModule :: GHC.Types.Module +Unlifted.$trModule :: GHC.Unit.Module [GblId, Caf=NoCafRefs, Str=m, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}] -Unlifted.$trModule = GHC.Types.Module Unlifted.$trModule3 Unlifted.$trModule1 +Unlifted.$trModule = GHC.Unit.Module Unlifted.$trModule3 Unlifted.$trModule1 -- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0} $krep_r2Xd :: GHC.Types.KindRep diff --git a/testsuite/tests/th/TH_Roles2.stderr b/testsuite/tests/th/TH_Roles2.stderr index 81866fdf6f..a536e4b62c 100644 --- a/testsuite/tests/th/TH_Roles2.stderr +++ b/testsuite/tests/th/TH_Roles2.stderr @@ -2,19 +2,15 @@ TYPE CONSTRUCTORS data type T{2} :: forall k. k -> * roles nominal representational Dependent modules: [] -Dependent packages: [array-0.5.2.0, base-4.12.0.0, deepseq-1.4.4.0, - ghc-boot-th-8.7, ghc-prim-0.6.1, integer-gmp-1.0.2.0, +Dependent packages: [array-0.5.4.0, base-4.14.0.0, deepseq-1.4.4.0, + ghc-boot-th-8.11.0.20200416, ghc-prim-0.6.1, integer-gmp-1.0.3.0, pretty-1.1.3.6, template-haskell-2.16.0.0] ==================== Typechecker ==================== TH_Roles2.$tcT = GHC.Types.TyCon - 11651627537942629178## - 11503899791410937231## - TH_Roles2.$trModule - (GHC.Types.TrNameS "T"#) - 1 - $krep + 11651627537942629178## 11503899791410937231## TH_Roles2.$trModule + (GHC.Types.TrNameS "T"#) 1 $krep $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepVar 0 $krep [InlPrag=NOUSERINLINE[~]] = GHC.Types.KindRepFun $krep GHC.Types.krep$* @@ -22,3 +18,4 @@ TH_Roles2.$trModule = GHC.Types.Module (GHC.Types.TrNameS "main"#) (GHC.Types.TrNameS "TH_Roles2"#) + diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index c822c31c4e..b8fe8c11f9 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -30,8 +30,8 @@ module Main (main) where -import qualified GHC.PackageDb as GhcPkg -import GHC.PackageDb +import qualified GHC.Unit.Database as GhcPkg +import GHC.Unit.Database import GHC.HandleEncoding import GHC.BaseDir (getBaseDir) import GHC.Settings.Platform (getTargetPlatform) @@ -976,7 +976,7 @@ mungePackageDBPaths top_dir db@PackageDB { packages = pkgs } = mungePackagePaths :: FilePath -> FilePath -> InstalledPackageInfo -> InstalledPackageInfo mungePackagePaths top_dir pkgroot pkg = - -- TODO: similar code is duplicated in GHC.PackageDb + -- TODO: similar code is duplicated in GHC.Unit.Database pkg { importDirs = munge_paths (importDirs pkg), includeDirs = munge_paths (includeDirs pkg), diff --git a/utils/haddock b/utils/haddock -Subproject 75b9b6ebbe8326f3a2b099ab7f130960b456761 +Subproject a61dbdb0a7420e15e978bce6c09de1ce99290f4 |