Unit: split and rename modules

Introduce GHC.Unit.* hierarchy for everything concerning units, packages
and modules.

Update Haddock submodule

5 files changed, 412 insertions, 0 deletions

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
+