1 files changed, 117 insertions, 0 deletions
diff --git a/compiler/GHC/Unit/Home/ModInfo.hs b/compiler/GHC/Unit/Home/ModInfo.hs
new file mode 100644
index 0000000000..9732955521
--- /dev/null
+++ b/compiler/GHC/Unit/Home/ModInfo.hs
@@ -0,0 +1,117 @@
+-- | Info about modules in the "home" unit
+module GHC.Unit.Home.ModInfo
+   ( HomeModInfo (..)
+   , HomePackageTable
+   , emptyHomePackageTable
+   , lookupHpt
+   , eltsHpt
+   , filterHpt
+   , allHpt
+   , mapHpt
+   , delFromHpt
+   , addToHpt
+   , addListToHpt
+   , lookupHptDirectly
+   , lookupHptByModule
+   , listToHpt
+   , pprHPT
+   )
+where
+
+import GHC.Prelude
+
+import GHC.Unit.Module.ModIface
+import GHC.Unit.Module.ModDetails
+import GHC.Unit.Module
+
+import GHC.Runtime.Linker.Types ( Linkable(..) )
+
+import GHC.Types.Unique
+import GHC.Types.Unique.DFM
+
+import GHC.Utils.Outputable
+
+-- | Information about modules in the package being compiled
+data HomeModInfo = HomeModInfo
+   { hm_iface    :: !ModIface
+        -- ^ The basic loaded interface file: every loaded module has one of
+        -- these, even if it is imported from another package
+
+   , hm_details  :: !ModDetails
+        -- ^ Extra information that has been created from the 'ModIface' for
+        -- the module, typically during typechecking
+
+   , hm_linkable :: !(Maybe Linkable)
+        -- ^ The actual artifact we would like to link to access things in
+        -- this module.
+        --
+        -- 'hm_linkable' might be Nothing:
+        --
+        --   1. If this is an .hs-boot module
+        --
+        --   2. Temporarily during compilation if we pruned away
+        --      the old linkable because it was out of date.
+        --
+        -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
+        -- in the 'HomePackageTable' will be @Just@.
+        --
+        -- When re-linking a module ('GHC.Driver.Main.HscNoRecomp'), we construct the
+        -- 'HomeModInfo' by building a new 'ModDetails' from the old
+        -- 'ModIface' (only).
+   }
+
+-- | Helps us find information about modules in the home package
+type HomePackageTable = DModuleNameEnv HomeModInfo
+   -- Domain = modules in the home unit that have been fully compiled
+   -- "home" unit id cached (implicit) here for convenience
+
+-- | Constructs an empty HomePackageTable
+emptyHomePackageTable :: HomePackageTable
+emptyHomePackageTable  = emptyUDFM
+
+lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
+lookupHpt = lookupUDFM
+
+lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
+lookupHptDirectly = lookupUDFM_Directly
+
+eltsHpt :: HomePackageTable -> [HomeModInfo]
+eltsHpt = eltsUDFM
+
+filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
+filterHpt = filterUDFM
+
+allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
+allHpt = allUDFM
+
+mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
+mapHpt = mapUDFM
+
+delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
+delFromHpt = delFromUDFM
+
+addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
+addToHpt = addToUDFM
+
+addListToHpt
+  :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
+addListToHpt = addListToUDFM
+
+listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
+listToHpt = listToUDFM
+
+lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
+-- The HPT is indexed by ModuleName, not Module,
+-- we must check for a hit on the right Module
+lookupHptByModule hpt mod
+  = case lookupHpt hpt (moduleName mod) of
+      Just hm | mi_module (hm_iface hm) == mod -> Just hm
+      _otherwise                               -> Nothing
+
+pprHPT :: HomePackageTable -> SDoc
+-- A bit arbitrary for now
+pprHPT hpt = pprUDFM hpt $ \hms ->
+    vcat [ hang (ppr (mi_module (hm_iface hm)))
+              2 (ppr (md_types (hm_details hm)))
+         | hm <- hms ]
+