{-
(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 #-}

module Module
    (
        -- * The ModuleName type
        ModuleName,
        pprModuleName,
        moduleNameFS,
        moduleNameString,
        moduleNameSlashes, moduleNameColons,
        moduleStableString,
        moduleFreeHoles,
        moduleIsDefinite,
        mkModuleName,
        mkModuleNameFS,
        stableModuleNameCmp,

        -- * The UnitId type
        ComponentId(..),
        UnitId(..),
        unitIdFS,
        unitIdKey,
        IndefUnitId(..),
        IndefModule(..),
        indefUnitIdToUnitId,
        indefModuleToModule,
        InstalledUnitId(..),
        toInstalledUnitId,
        ShHoleSubst,

        unitIdIsDefinite,
        unitIdString,
        unitIdFreeHoles,

        newUnitId,
        newIndefUnitId,
        newSimpleUnitId,
        hashUnitId,
        fsToUnitId,
        stringToUnitId,
        stableUnitIdCmp,

        -- * HOLE renaming
        renameHoleUnitId,
        renameHoleModule,
        renameHoleUnitId',
        renameHoleModule',

        -- * Generalization
        splitModuleInsts,
        splitUnitIdInsts,
        generalizeIndefUnitId,
        generalizeIndefModule,

        -- * Parsers
        parseModuleName,
        parseUnitId,
        parseComponentId,
        parseModuleId,
        parseModSubst,

        -- * Wired-in UnitIds
        -- $wired_in_packages
        primUnitId,
        integerUnitId,
        baseUnitId,
        rtsUnitId,
        thUnitId,
        mainUnitId,
        thisGhcUnitId,
        isHoleModule,
        interactiveUnitId, isInteractiveModule,
        wiredInUnitIds,

        -- * The Module type
        Module(Module),
        moduleUnitId, moduleName,
        pprModule,
        mkModule,
        mkHoleModule,
        stableModuleCmp,
        HasModule(..),
        ContainsModule(..),

        -- * Installed unit ids and modules
        InstalledModule(..),
        InstalledModuleEnv,
        installedModuleEq,
        installedUnitIdEq,
        installedUnitIdString,
        fsToInstalledUnitId,
        componentIdToInstalledUnitId,
        stringToInstalledUnitId,
        emptyInstalledModuleEnv,
        lookupInstalledModuleEnv,
        extendInstalledModuleEnv,
        filterInstalledModuleEnv,
        delInstalledModuleEnv,
        DefUnitId(..),

        -- * The ModuleLocation type
        ModLocation(..),
        addBootSuffix, removeBootSuffix, 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 GhcPrelude

import Outputable
import Unique
import UniqFM
import UniqDFM
import UniqDSet
import FastString
import Binary
import Util
import Data.List (sortBy, sort)
import Data.Ord
import GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..))
import Fingerprint

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS.Char8
import 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.Map (Map)
import Data.Set (Set)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified FiniteMap as Map
import System.FilePath

import {-# SOURCE #-} DynFlags (DynFlags)
import {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigMap, getPackageConfigMap, displayInstalledUnitId)

-- Note [The identifier lexicon]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Unit IDs, installed package IDs, ABI hashes, package names,
-- versions, there are a *lot* of different identifiers for closely
-- related things.  What do they all mean? Here's what.  (See also
-- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/packages/concepts )
--
-- THE IMPORTANT ONES
--
-- ComponentId: An opaque identifier provided by Cabal, which should
-- uniquely identify such things as the package name, the package
-- version, the name of the component, the hash of the source code
-- tarball, the selected Cabal flags, GHC flags, direct dependencies of
-- the component.  These are very similar to InstalledPackageId, but
-- an 'InstalledPackageId' implies that it identifies a package, while
-- a package may install multiple components with different
-- 'ComponentId's.
--      - Same as Distribution.Package.ComponentId
--
-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names
-- (ModuleName) to Modules.  This is how the compiler identifies instantiated
-- components, and also is the main identifier by which GHC identifies things.
--      - When Backpack is not being used, UnitId = ComponentId.
--        this means a useful fiction for end-users is that there are
--        only ever ComponentIds, and some ComponentIds happen to have
--        more information (UnitIds).
--      - Same as Language.Haskell.TH.Syntax:PkgName, see
--          https://gitlab.haskell.org/ghc/ghc/issues/10279
--      - The same as PackageKey in GHC 7.10 (we renamed it because
--        they don't necessarily identify packages anymore.)
--      - Same as -this-package-key/-package-name flags
--      - An InstalledUnitId corresponds to an actual package which
--        we have installed on disk.  It could be definite or indefinite,
--        but if it's indefinite, it has nothing instantiated (we
--        never install partially instantiated units.)
--
-- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how
-- the compiler identifies modules (e.g. a Name is a Module + OccName)
--      - Same as Language.Haskell.TH.Syntax:Module
--
-- THE LESS IMPORTANT ONES
--
-- PackageName: The "name" field in a Cabal file, something like "lens".
--      - Same as Distribution.Package.PackageName
--      - DIFFERENT FROM Language.Haskell.TH.Syntax:PkgName, see
--          https://gitlab.haskell.org/ghc/ghc/issues/10279
--      - DIFFERENT FROM -package-name flag
--      - DIFFERENT FROM the 'name' field in an installed package
--        information.  This field could more accurately be described
--        as a munged package name: when it's for the main library
--        it is the same as the package name, but if it's an internal
--        library it's a munged combination of the package name and
--        the component name.
--
-- LEGACY ONES
--
-- InstalledPackageId: This is what we used to call ComponentId.
-- It's a still pretty useful concept for packages that have only
-- one library; in that case the logical InstalledPackageId =
-- ComponentId.  Also, the Cabal nix-local-build continues to
-- compute an InstalledPackageId which is then forcibly used
-- for all components in a package.  This means that if a dependency
-- from one component in a package changes, the InstalledPackageId
-- changes: you don't get as fine-grained dependency tracking,
-- but it means your builds are hermetic.  Eventually, Cabal will
-- deal completely in components and we can get rid of this.
--
-- PackageKey: This is what we used to call UnitId.  We ditched
-- "Package" from the name when we realized that you might want to
-- assign different "PackageKeys" to components from the same package.
-- (For a brief, non-released period of time, we also called these
-- UnitKeys).

{-
************************************************************************
*                                                                      *
\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 {
        ModLocation -> Maybe FilePath
ml_hs_file   :: Maybe FilePath,
                -- The source file, if we have one.  Package modules
                -- probably don't have source files.

        ModLocation -> FilePath
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)

        ModLocation -> FilePath
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)
        ModLocation -> FilePath
ml_hie_file  :: FilePath
  } deriving Int -> ModLocation -> ShowS
[ModLocation] -> ShowS
ModLocation -> FilePath
(Int -> ModLocation -> ShowS)
-> (ModLocation -> FilePath)
-> ([ModLocation] -> ShowS)
-> Show ModLocation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ModLocation] -> ShowS
$cshowList :: [ModLocation] -> ShowS
show :: ModLocation -> FilePath
$cshow :: ModLocation -> FilePath
showsPrec :: Int -> ModLocation -> ShowS
$cshowsPrec :: Int -> ModLocation -> ShowS
Show

instance Outputable ModLocation where
   ppr :: ModLocation -> SDoc
ppr = FilePath -> SDoc
text (FilePath -> SDoc)
-> (ModLocation -> FilePath) -> ModLocation -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModLocation -> FilePath
forall a. Show a => a -> FilePath
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 :: ShowS
addBootSuffix FilePath
path = FilePath
path FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"-boot"

-- | Remove the @-boot@ suffix to .hs, .hi and .o files
removeBootSuffix :: FilePath -> FilePath
removeBootSuffix :: ShowS
removeBootSuffix FilePath
"-boot" = []
removeBootSuffix (Char
x:FilePath
xs)  = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
removeBootSuffix FilePath
xs
removeBootSuffix []      = ShowS
forall a. HasCallStack => FilePath -> a
error FilePath
"removeBootSuffix: no -boot suffix"

addBootSuffix_maybe :: Bool -> FilePath -> FilePath
-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
addBootSuffix_maybe :: Bool -> ShowS
addBootSuffix_maybe Bool
is_boot FilePath
path
 | Bool
is_boot   = ShowS
addBootSuffix FilePath
path
 | Bool
otherwise = FilePath
path

addBootSuffixLocn :: ModLocation -> ModLocation
-- ^ Add the @-boot@ suffix to all file paths associated with the module
addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn ModLocation
locn
  = ModLocation
locn { ml_hs_file :: Maybe FilePath
ml_hs_file  = ShowS -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
addBootSuffix (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
locn)
         , ml_hi_file :: FilePath
ml_hi_file  = ShowS
addBootSuffix (ModLocation -> FilePath
ml_hi_file ModLocation
locn)
         , ml_obj_file :: FilePath
ml_obj_file = ShowS
addBootSuffix (ModLocation -> FilePath
ml_obj_file ModLocation
locn)
         , ml_hie_file :: FilePath
ml_hie_file = ShowS
addBootSuffix (ModLocation -> FilePath
ml_hie_file ModLocation
locn) }

addBootSuffixLocnOut :: ModLocation -> ModLocation
-- ^ Add the @-boot@ suffix to all output file paths associated with the
-- module, not including the input file itself
addBootSuffixLocnOut :: ModLocation -> ModLocation
addBootSuffixLocnOut ModLocation
locn
  = ModLocation
locn { ml_hi_file :: FilePath
ml_hi_file  = ShowS
addBootSuffix (ModLocation -> FilePath
ml_hi_file ModLocation
locn)
         , ml_obj_file :: FilePath
ml_obj_file = ShowS
addBootSuffix (ModLocation -> FilePath
ml_obj_file ModLocation
locn)
         , ml_hie_file :: FilePath
ml_hie_file = ShowS
addBootSuffix (ModLocation -> FilePath
ml_hie_file ModLocation
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 -> Unique
getUnique (ModuleName FastString
nm) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
nm

instance Eq ModuleName where
  ModuleName
nm1 == :: ModuleName -> ModuleName -> Bool
== ModuleName
nm2 = ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique ModuleName
nm1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique ModuleName
nm2

instance Ord ModuleName where
  ModuleName
nm1 compare :: ModuleName -> ModuleName -> Ordering
`compare` ModuleName
nm2 = ModuleName -> ModuleName -> Ordering
stableModuleNameCmp ModuleName
nm1 ModuleName
nm2

instance Outputable ModuleName where
  ppr :: ModuleName -> SDoc
ppr = ModuleName -> SDoc
pprModuleName

instance Binary ModuleName where
  put_ :: BinHandle -> ModuleName -> IO ()
put_ BinHandle
bh (ModuleName FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO ModuleName
get BinHandle
bh = do FastString
fs <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; ModuleName -> IO ModuleName
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> ModuleName
ModuleName FastString
fs)

instance BinaryStringRep ModuleName where
  fromStringRep :: ByteString -> ModuleName
fromStringRep = FastString -> ModuleName
mkModuleNameFS (FastString -> ModuleName)
-> (ByteString -> FastString) -> ByteString -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
  toStringRep :: ModuleName -> ByteString
toStringRep   = FastString -> ByteString
bytesFS (FastString -> ByteString)
-> (ModuleName -> FastString) -> ModuleName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FastString
moduleNameFS

instance Data ModuleName where
  -- don't traverse?
  toConstr :: ModuleName -> Constr
toConstr ModuleName
_   = FilePath -> Constr
abstractConstr FilePath
"ModuleName"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = FilePath -> Constr -> c ModuleName
forall a. HasCallStack => FilePath -> a
error FilePath
"gunfold"
  dataTypeOf :: ModuleName -> DataType
dataTypeOf ModuleName
_ = FilePath -> DataType
mkNoRepType FilePath
"ModuleName"

instance NFData ModuleName where
  rnf :: ModuleName -> ()
rnf ModuleName
x = ModuleName
x ModuleName -> () -> ()
`seq` ()

stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
-- ^ Compares module names lexically, rather than by their 'Unique's
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
stableModuleNameCmp ModuleName
n1 ModuleName
n2 = ModuleName -> FastString
moduleNameFS ModuleName
n1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ModuleName -> FastString
moduleNameFS ModuleName
n2

pprModuleName :: ModuleName -> SDoc
pprModuleName :: ModuleName -> SDoc
pprModuleName (ModuleName FastString
nm) =
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
    if PprStyle -> Bool
codeStyle PprStyle
sty
        then FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS FastString
nm)
        else FastString -> SDoc
ftext FastString
nm

moduleNameFS :: ModuleName -> FastString
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName FastString
mod) = FastString
mod

moduleNameString :: ModuleName -> String
moduleNameString :: ModuleName -> FilePath
moduleNameString (ModuleName FastString
mod) = FastString -> FilePath
unpackFS FastString
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 -> FilePath
moduleStableString Module{UnitId
ModuleName
moduleName :: ModuleName
moduleUnitId :: UnitId
moduleName :: Module -> ModuleName
moduleUnitId :: Module -> UnitId
..} =
  FilePath
"$" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ UnitId -> FilePath
unitIdString UnitId
moduleUnitId FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"$" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
moduleNameString ModuleName
moduleName

mkModuleName :: String -> ModuleName
mkModuleName :: FilePath -> ModuleName
mkModuleName FilePath
s = FastString -> ModuleName
ModuleName (FilePath -> FastString
mkFastString FilePath
s)

mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS FastString
s = FastString -> ModuleName
ModuleName FastString
s

-- |Returns the string version of the module name, with dots replaced by slashes.
--
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes :: ModuleName -> FilePath
moduleNameSlashes = ShowS
dots_to_slashes ShowS -> (ModuleName -> FilePath) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
moduleNameString
  where dots_to_slashes :: ShowS
dots_to_slashes = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
pathSeparator else Char
c)

-- |Returns the string version of the module name, with dots replaced by colons.
--
moduleNameColons :: ModuleName -> String
moduleNameColons :: ModuleName -> FilePath
moduleNameColons = ShowS
dots_to_colons ShowS -> (ModuleName -> FilePath) -> ModuleName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
moduleNameString
  where dots_to_colons :: ShowS
dots_to_colons = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
':' else Char
c)

{-
************************************************************************
*                                                                      *
\subsection{A fully qualified module}
*                                                                      *
************************************************************************
-}

-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
--
-- Module variables (i.e. @<H>@) which can be instantiated to a
-- specific module at some later point in time are represented
-- with 'moduleUnitId' set to 'holeUnitId' (this allows us to
-- avoid having to make 'moduleUnitId' a partial operation.)
--
data Module = Module {
   Module -> UnitId
moduleUnitId :: !UnitId,  -- pkg-1.0
   Module -> ModuleName
moduleName :: !ModuleName  -- A.B.C
  }
  deriving (Module -> Module -> Bool
(Module -> Module -> Bool)
-> (Module -> Module -> Bool) -> Eq Module
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq, Eq Module
Eq Module
-> (Module -> Module -> Ordering)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Bool)
-> (Module -> Module -> Module)
-> (Module -> Module -> Module)
-> Ord Module
Module -> Module -> Bool
Module -> Module -> Ordering
Module -> Module -> Module
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Module -> Module -> Module
$cmin :: Module -> Module -> Module
max :: Module -> Module -> Module
$cmax :: Module -> Module -> Module
>= :: Module -> Module -> Bool
$c>= :: Module -> Module -> Bool
> :: Module -> Module -> Bool
$c> :: Module -> Module -> Bool
<= :: Module -> Module -> Bool
$c<= :: Module -> Module -> Bool
< :: Module -> Module -> Bool
$c< :: Module -> Module -> Bool
compare :: Module -> Module -> Ordering
$ccompare :: Module -> Module -> Ordering
$cp1Ord :: Eq Module
Ord)

-- | 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 :: Module -> UniqDSet ModuleName
moduleFreeHoles :: Module -> UniqDSet ModuleName
moduleFreeHoles Module
m
    | Module -> Bool
isHoleModule Module
m = ModuleName -> UniqDSet ModuleName
forall a. Uniquable a => a -> UniqDSet a
unitUniqDSet (Module -> ModuleName
moduleName Module
m)
    | Bool
otherwise = UnitId -> UniqDSet ModuleName
unitIdFreeHoles (Module -> UnitId
moduleUnitId Module
m)

-- | A 'Module' is definite if it has no free holes.
moduleIsDefinite :: Module -> Bool
moduleIsDefinite :: Module -> Bool
moduleIsDefinite = UniqDSet ModuleName -> Bool
forall a. UniqDSet a -> Bool
isEmptyUniqDSet (UniqDSet ModuleName -> Bool)
-> (Module -> UniqDSet ModuleName) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UniqDSet ModuleName
moduleFreeHoles

-- | Create a module variable at some 'ModuleName'.
-- See Note [Representation of module/name variables]
mkHoleModule :: ModuleName -> Module
mkHoleModule :: ModuleName -> Module
mkHoleModule = UnitId -> ModuleName -> Module
mkModule UnitId
holeUnitId

instance Uniquable Module where
  getUnique :: Module -> Unique
getUnique (Module UnitId
p ModuleName
n) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (UnitId -> FastString
unitIdFS UnitId
p FastString -> FastString -> FastString
`appendFS` ModuleName -> FastString
moduleNameFS ModuleName
n)

instance Outputable Module where
  ppr :: Module -> SDoc
ppr = Module -> SDoc
pprModule

instance Binary Module where
  put_ :: BinHandle -> Module -> IO ()
put_ BinHandle
bh (Module UnitId
p ModuleName
n) = BinHandle -> UnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh UnitId
p IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ModuleName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ModuleName
n
  get :: BinHandle -> IO Module
get BinHandle
bh = do UnitId
p <- BinHandle -> IO UnitId
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; ModuleName
n <- BinHandle -> IO ModuleName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; Module -> IO Module
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> ModuleName -> Module
Module UnitId
p ModuleName
n)

instance Data Module where
  -- don't traverse?
  toConstr :: Module -> Constr
toConstr Module
_   = FilePath -> Constr
abstractConstr FilePath
"Module"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = FilePath -> Constr -> c Module
forall a. HasCallStack => FilePath -> a
error FilePath
"gunfold"
  dataTypeOf :: Module -> DataType
dataTypeOf Module
_ = FilePath -> DataType
mkNoRepType FilePath
"Module"

instance NFData Module where
  rnf :: Module -> ()
rnf Module
x = Module
x Module -> () -> ()
`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 -> Module -> Ordering
stableModuleCmp (Module UnitId
p1 ModuleName
n1) (Module UnitId
p2 ModuleName
n2)
   = (UnitId
p1 UnitId -> UnitId -> Ordering
`stableUnitIdCmp`  UnitId
p2) Ordering -> Ordering -> Ordering
`thenCmp`
     (ModuleName
n1 ModuleName -> ModuleName -> Ordering
`stableModuleNameCmp` ModuleName
n2)

mkModule :: UnitId -> ModuleName -> Module
mkModule :: UnitId -> ModuleName -> Module
mkModule = UnitId -> ModuleName -> Module
Module

pprModule :: Module -> SDoc
pprModule :: Module -> SDoc
pprModule mod :: Module
mod@(Module UnitId
p ModuleName
n)  = (PprStyle -> SDoc) -> SDoc
getPprStyle PprStyle -> SDoc
doc
 where
  doc :: PprStyle -> SDoc
doc PprStyle
sty
    | PprStyle -> Bool
codeStyle PprStyle
sty =
        (if UnitId
p UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
mainUnitId
                then SDoc
empty -- never qualify the main package in code
                else FastZString -> SDoc
ztext (FastString -> FastZString
zEncodeFS (UnitId -> FastString
unitIdFS UnitId
p)) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'_')
            SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n
    | PprStyle -> Module -> Bool
qualModule PprStyle
sty Module
mod =
        if Module -> Bool
isHoleModule Module
mod
            then SDoc -> SDoc
angleBrackets (ModuleName -> SDoc
pprModuleName ModuleName
n)
            else UnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Module -> UnitId
moduleUnitId Module
mod) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n
    | Bool
otherwise =
        ModuleName -> SDoc
pprModuleName ModuleName
n

class ContainsModule t where
    extractModule :: t -> Module

class HasModule m where
    getModule :: m Module

instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where
  fromDbModule :: DbModule InstalledUnitId ComponentId UnitId ModuleName Module
-> Module
fromDbModule (DbModule UnitId
uid ModuleName
mod_name)  = UnitId -> ModuleName -> Module
mkModule UnitId
uid ModuleName
mod_name
  fromDbModule (DbModuleVar ModuleName
mod_name)   = ModuleName -> Module
mkHoleModule ModuleName
mod_name
  fromDbUnitId :: DbUnitId InstalledUnitId ComponentId UnitId ModuleName Module
-> UnitId
fromDbUnitId (DbUnitId ComponentId
cid [(ModuleName, Module)]
insts)     = ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId ComponentId
cid [(ModuleName, Module)]
insts
  fromDbUnitId (DbInstalledUnitId InstalledUnitId
iuid) = DefUnitId -> UnitId
DefiniteUnitId (InstalledUnitId -> DefUnitId
DefUnitId InstalledUnitId
iuid)
  -- GHC never writes to the database, so it's not needed
  toDbModule :: Module
-> DbModule InstalledUnitId ComponentId UnitId ModuleName Module
toDbModule = FilePath
-> Module
-> DbModule InstalledUnitId ComponentId UnitId ModuleName Module
forall a. HasCallStack => FilePath -> a
error FilePath
"toDbModule: not implemented"
  toDbUnitId :: UnitId
-> DbUnitId InstalledUnitId ComponentId UnitId ModuleName Module
toDbUnitId = FilePath
-> UnitId
-> DbUnitId InstalledUnitId ComponentId UnitId ModuleName Module
forall a. HasCallStack => FilePath -> a
error FilePath
"toDbUnitId: not implemented"

{-
************************************************************************
*                                                                      *
\subsection{ComponentId}
*                                                                      *
************************************************************************
-}

-- | A 'ComponentId' consists of the package name, package version, component
-- ID, the transitive dependencies of the component, and other information to
-- uniquely identify the source code and build configuration of a component.
--
-- This used to be known as an 'InstalledPackageId', but a package can contain
-- multiple components and a 'ComponentId' uniquely identifies a component
-- within a package.  When a package only has one component, the 'ComponentId'
-- coincides with the 'InstalledPackageId'
newtype ComponentId        = ComponentId        FastString deriving (ComponentId -> ComponentId -> Bool
(ComponentId -> ComponentId -> Bool)
-> (ComponentId -> ComponentId -> Bool) -> Eq ComponentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentId -> ComponentId -> Bool
$c/= :: ComponentId -> ComponentId -> Bool
== :: ComponentId -> ComponentId -> Bool
$c== :: ComponentId -> ComponentId -> Bool
Eq, Eq ComponentId
Eq ComponentId
-> (ComponentId -> ComponentId -> Ordering)
-> (ComponentId -> ComponentId -> Bool)
-> (ComponentId -> ComponentId -> Bool)
-> (ComponentId -> ComponentId -> Bool)
-> (ComponentId -> ComponentId -> Bool)
-> (ComponentId -> ComponentId -> ComponentId)
-> (ComponentId -> ComponentId -> ComponentId)
-> Ord ComponentId
ComponentId -> ComponentId -> Bool
ComponentId -> ComponentId -> Ordering
ComponentId -> ComponentId -> ComponentId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentId -> ComponentId -> ComponentId
$cmin :: ComponentId -> ComponentId -> ComponentId
max :: ComponentId -> ComponentId -> ComponentId
$cmax :: ComponentId -> ComponentId -> ComponentId
>= :: ComponentId -> ComponentId -> Bool
$c>= :: ComponentId -> ComponentId -> Bool
> :: ComponentId -> ComponentId -> Bool
$c> :: ComponentId -> ComponentId -> Bool
<= :: ComponentId -> ComponentId -> Bool
$c<= :: ComponentId -> ComponentId -> Bool
< :: ComponentId -> ComponentId -> Bool
$c< :: ComponentId -> ComponentId -> Bool
compare :: ComponentId -> ComponentId -> Ordering
$ccompare :: ComponentId -> ComponentId -> Ordering
$cp1Ord :: Eq ComponentId
Ord)

instance BinaryStringRep ComponentId where
  fromStringRep :: ByteString -> ComponentId
fromStringRep = FastString -> ComponentId
ComponentId (FastString -> ComponentId)
-> (ByteString -> FastString) -> ByteString -> ComponentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FastString
mkFastStringByteString
  toStringRep :: ComponentId -> ByteString
toStringRep (ComponentId FastString
s) = FastString -> ByteString
bytesFS FastString
s

instance Uniquable ComponentId where
  getUnique :: ComponentId -> Unique
getUnique (ComponentId FastString
n) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
n

instance Outputable ComponentId where
  ppr :: ComponentId -> SDoc
ppr cid :: ComponentId
cid@(ComponentId FastString
fs) =
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
    (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
      case DynFlags -> ComponentId -> Maybe FilePath
componentIdString DynFlags
dflags ComponentId
cid of
        Just FilePath
str | Bool -> Bool
not (PprStyle -> Bool
debugStyle PprStyle
sty) -> FilePath -> SDoc
text FilePath
str
        Maybe FilePath
_ -> FastString -> SDoc
ftext FastString
fs

{-
************************************************************************
*                                                                      *
\subsection{UnitId}
*                                                                      *
************************************************************************
-}

-- | 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 'UnitId'.  It can be a
-- 'DefiniteUnitId', in which case we just have a string that uniquely
-- identifies some fully compiled, installed library we have on disk.
-- However, 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 'IndefiniteUnitId', which explicitly records the
-- instantiation, so that we can substitute over it.
data UnitId
    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId

unitIdFS :: UnitId -> FastString
unitIdFS :: UnitId -> FastString
unitIdFS (IndefiniteUnitId IndefUnitId
x) = IndefUnitId -> FastString
indefUnitIdFS IndefUnitId
x
unitIdFS (DefiniteUnitId (DefUnitId InstalledUnitId
x)) = InstalledUnitId -> FastString
installedUnitIdFS InstalledUnitId
x

unitIdKey :: UnitId -> Unique
unitIdKey :: UnitId -> Unique
unitIdKey (IndefiniteUnitId IndefUnitId
x) = IndefUnitId -> Unique
indefUnitIdKey IndefUnitId
x
unitIdKey (DefiniteUnitId (DefUnitId InstalledUnitId
x)) = InstalledUnitId -> Unique
installedUnitIdKey InstalledUnitId
x

-- | A unit identifier which identifies an indefinite
-- library (with holes) that has been *on-the-fly* instantiated
-- with a substitution 'indefUnitIdInsts'.  In fact, an indefinite
-- unit identifier could have no holes, but we haven't gotten
-- around to compiling the actual library yet.
--
-- An indefinite unit identifier pretty-prints to something like
-- @p[H=<H>,A=aimpl:A>]@ (@p@ is the 'ComponentId', and the
-- brackets enclose the module substitution).
data IndefUnitId
    = IndefUnitId {
        -- | A private, uniquely identifying representation of
        -- a UnitId.  This string is completely private to GHC
        -- and is just used to get a unique; in particular, we don't use it for
        -- symbols (indefinite libraries are not compiled).
        IndefUnitId -> FastString
indefUnitIdFS :: FastString,
        -- | Cached unique of 'unitIdFS'.
        IndefUnitId -> Unique
indefUnitIdKey :: Unique,
        -- | The component identity of the indefinite library that
        -- is being instantiated.
        IndefUnitId -> ComponentId
indefUnitIdComponentId :: !ComponentId,
        -- | The sorted (by 'ModuleName') instantiations of this library.
        IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts :: ![(ModuleName, Module)],
        -- | A cache of the free module variables of 'unitIdInsts'.
        -- This lets us efficiently tell if a 'UnitId' has been
        -- fully instantiated (free module variables are empty)
        -- and whether or not a substitution can have any effect.
        IndefUnitId -> UniqDSet ModuleName
indefUnitIdFreeHoles :: UniqDSet ModuleName
    }

instance Eq IndefUnitId where
  IndefUnitId
u1 == :: IndefUnitId -> IndefUnitId -> Bool
== IndefUnitId
u2 = IndefUnitId -> Unique
indefUnitIdKey IndefUnitId
u1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== IndefUnitId -> Unique
indefUnitIdKey IndefUnitId
u2

instance Ord IndefUnitId where
  IndefUnitId
u1 compare :: IndefUnitId -> IndefUnitId -> Ordering
`compare` IndefUnitId
u2 = IndefUnitId -> FastString
indefUnitIdFS IndefUnitId
u1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` IndefUnitId -> FastString
indefUnitIdFS IndefUnitId
u2

instance Binary IndefUnitId where
  put_ :: BinHandle -> IndefUnitId -> IO ()
put_ BinHandle
bh IndefUnitId
indef = do
    BinHandle -> ComponentId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (IndefUnitId -> ComponentId
indefUnitIdComponentId IndefUnitId
indef)
    BinHandle -> [(ModuleName, Module)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
indef)
  get :: BinHandle -> IO IndefUnitId
get BinHandle
bh = do
    ComponentId
cid   <- BinHandle -> IO ComponentId
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [(ModuleName, Module)]
insts <- BinHandle -> IO [(ModuleName, Module)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    let fs :: FastString
fs = ComponentId -> [(ModuleName, Module)] -> FastString
hashUnitId ComponentId
cid [(ModuleName, Module)]
insts
    IndefUnitId -> IO IndefUnitId
forall (m :: * -> *) a. Monad m => a -> m a
return IndefUnitId :: FastString
-> Unique
-> ComponentId
-> [(ModuleName, Module)]
-> UniqDSet ModuleName
-> IndefUnitId
IndefUnitId {
            indefUnitIdComponentId :: ComponentId
indefUnitIdComponentId = ComponentId
cid,
            indefUnitIdInsts :: [(ModuleName, Module)]
indefUnitIdInsts = [(ModuleName, Module)]
insts,
            indefUnitIdFreeHoles :: UniqDSet ModuleName
indefUnitIdFreeHoles = [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (((ModuleName, Module) -> UniqDSet ModuleName)
-> [(ModuleName, Module)] -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UniqDSet ModuleName
moduleFreeHoles(Module -> UniqDSet ModuleName)
-> ((ModuleName, Module) -> Module)
-> (ModuleName, Module)
-> UniqDSet ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModuleName, Module) -> Module
forall a b. (a, b) -> b
snd) [(ModuleName, Module)]
insts),
            indefUnitIdFS :: FastString
indefUnitIdFS = FastString
fs,
            indefUnitIdKey :: Unique
indefUnitIdKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
fs
           }

-- | Create a new 'IndefUnitId' given an explicit module substitution.
newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId
newIndefUnitId :: ComponentId -> [(ModuleName, Module)] -> IndefUnitId
newIndefUnitId ComponentId
cid [(ModuleName, Module)]
insts =
    IndefUnitId :: FastString
-> Unique
-> ComponentId
-> [(ModuleName, Module)]
-> UniqDSet ModuleName
-> IndefUnitId
IndefUnitId {
        indefUnitIdComponentId :: ComponentId
indefUnitIdComponentId = ComponentId
cid,
        indefUnitIdInsts :: [(ModuleName, Module)]
indefUnitIdInsts = [(ModuleName, Module)]
sorted_insts,
        indefUnitIdFreeHoles :: UniqDSet ModuleName
indefUnitIdFreeHoles = [UniqDSet ModuleName] -> UniqDSet ModuleName
forall a. [UniqDSet a] -> UniqDSet a
unionManyUniqDSets (((ModuleName, Module) -> UniqDSet ModuleName)
-> [(ModuleName, Module)] -> [UniqDSet ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> UniqDSet ModuleName
moduleFreeHoles(Module -> UniqDSet ModuleName)
-> ((ModuleName, Module) -> Module)
-> (ModuleName, Module)
-> UniqDSet ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ModuleName, Module) -> Module
forall a b. (a, b) -> b
snd) [(ModuleName, Module)]
insts),
        indefUnitIdFS :: FastString
indefUnitIdFS = FastString
fs,
        indefUnitIdKey :: Unique
indefUnitIdKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
fs
    }
  where
     fs :: FastString
fs = ComponentId -> [(ModuleName, Module)] -> FastString
hashUnitId ComponentId
cid [(ModuleName, Module)]
sorted_insts
     sorted_insts :: [(ModuleName, Module)]
sorted_insts = ((ModuleName, Module) -> (ModuleName, Module) -> Ordering)
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ModuleName -> ModuleName -> Ordering
stableModuleNameCmp (ModuleName -> ModuleName -> Ordering)
-> ((ModuleName, Module) -> ModuleName)
-> (ModuleName, Module)
-> (ModuleName, Module)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ModuleName, Module) -> ModuleName
forall a b. (a, b) -> a
fst) [(ModuleName, Module)]
insts

-- | Injects an 'IndefUnitId' (indefinite library which
-- was on-the-fly instantiated) to a 'UnitId' (either
-- an indefinite or definite library).
indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId
indefUnitIdToUnitId :: DynFlags -> IndefUnitId -> UnitId
indefUnitIdToUnitId DynFlags
dflags IndefUnitId
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]
    -- IndefiniteUnitId, they won't compare equal; only
    -- after improvement will the equality hold.
    PackageConfigMap -> UnitId -> UnitId
improveUnitId (DynFlags -> PackageConfigMap
getPackageConfigMap DynFlags
dflags) (UnitId -> UnitId) -> UnitId -> UnitId
forall a b. (a -> b) -> a -> b
$
        IndefUnitId -> UnitId
IndefiniteUnitId IndefUnitId
iuid

data IndefModule = IndefModule {
        IndefModule -> IndefUnitId
indefModuleUnitId :: IndefUnitId,
        IndefModule -> ModuleName
indefModuleName   :: ModuleName
    } deriving (IndefModule -> IndefModule -> Bool
(IndefModule -> IndefModule -> Bool)
-> (IndefModule -> IndefModule -> Bool) -> Eq IndefModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndefModule -> IndefModule -> Bool
$c/= :: IndefModule -> IndefModule -> Bool
== :: IndefModule -> IndefModule -> Bool
$c== :: IndefModule -> IndefModule -> Bool
Eq, Eq IndefModule
Eq IndefModule
-> (IndefModule -> IndefModule -> Ordering)
-> (IndefModule -> IndefModule -> Bool)
-> (IndefModule -> IndefModule -> Bool)
-> (IndefModule -> IndefModule -> Bool)
-> (IndefModule -> IndefModule -> Bool)
-> (IndefModule -> IndefModule -> IndefModule)
-> (IndefModule -> IndefModule -> IndefModule)
-> Ord IndefModule
IndefModule -> IndefModule -> Bool
IndefModule -> IndefModule -> Ordering
IndefModule -> IndefModule -> IndefModule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IndefModule -> IndefModule -> IndefModule
$cmin :: IndefModule -> IndefModule -> IndefModule
max :: IndefModule -> IndefModule -> IndefModule
$cmax :: IndefModule -> IndefModule -> IndefModule
>= :: IndefModule -> IndefModule -> Bool
$c>= :: IndefModule -> IndefModule -> Bool
> :: IndefModule -> IndefModule -> Bool
$c> :: IndefModule -> IndefModule -> Bool
<= :: IndefModule -> IndefModule -> Bool
$c<= :: IndefModule -> IndefModule -> Bool
< :: IndefModule -> IndefModule -> Bool
$c< :: IndefModule -> IndefModule -> Bool
compare :: IndefModule -> IndefModule -> Ordering
$ccompare :: IndefModule -> IndefModule -> Ordering
$cp1Ord :: Eq IndefModule
Ord)

instance Outputable IndefModule where
  ppr :: IndefModule -> SDoc
ppr (IndefModule IndefUnitId
uid ModuleName
m) =
    IndefUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr IndefUnitId
uid SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
m

-- | Injects an 'IndefModule' to 'Module' (see also
-- 'indefUnitIdToUnitId'.
indefModuleToModule :: DynFlags -> IndefModule -> Module
indefModuleToModule :: DynFlags -> IndefModule -> Module
indefModuleToModule DynFlags
dflags (IndefModule IndefUnitId
iuid ModuleName
mod_name) =
    UnitId -> ModuleName -> Module
mkModule (DynFlags -> IndefUnitId -> UnitId
indefUnitIdToUnitId DynFlags
dflags IndefUnitId
iuid) ModuleName
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 InstalledUnitId =
    InstalledUnitId {
      -- | The full hashed unit identifier, including the component id
      -- and the hash.
      InstalledUnitId -> FastString
installedUnitIdFS :: FastString
    }

instance Binary InstalledUnitId where
  put_ :: BinHandle -> InstalledUnitId -> IO ()
put_ BinHandle
bh (InstalledUnitId FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO InstalledUnitId
get BinHandle
bh = do FastString
fs <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; InstalledUnitId -> IO InstalledUnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> InstalledUnitId
InstalledUnitId FastString
fs)

instance BinaryStringRep InstalledUnitId where
  fromStringRep :: ByteString -> InstalledUnitId
fromStringRep ByteString
bs = FastString -> InstalledUnitId
InstalledUnitId (ByteString -> FastString
mkFastStringByteString ByteString
bs)
  -- GHC doesn't write to database
  toStringRep :: InstalledUnitId -> ByteString
toStringRep   = FilePath -> InstalledUnitId -> ByteString
forall a. HasCallStack => FilePath -> a
error FilePath
"BinaryStringRep InstalledUnitId: not implemented"

instance Eq InstalledUnitId where
    InstalledUnitId
uid1 == :: InstalledUnitId -> InstalledUnitId -> Bool
== InstalledUnitId
uid2 = InstalledUnitId -> Unique
installedUnitIdKey InstalledUnitId
uid1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== InstalledUnitId -> Unique
installedUnitIdKey InstalledUnitId
uid2

instance Ord InstalledUnitId where
    InstalledUnitId
u1 compare :: InstalledUnitId -> InstalledUnitId -> Ordering
`compare` InstalledUnitId
u2 = InstalledUnitId -> FastString
installedUnitIdFS InstalledUnitId
u1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` InstalledUnitId -> FastString
installedUnitIdFS InstalledUnitId
u2

instance Uniquable InstalledUnitId where
    getUnique :: InstalledUnitId -> Unique
getUnique = InstalledUnitId -> Unique
installedUnitIdKey

instance Outputable InstalledUnitId where
    ppr :: InstalledUnitId -> SDoc
ppr uid :: InstalledUnitId
uid@(InstalledUnitId FastString
fs) =
        (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
          case DynFlags -> InstalledUnitId -> Maybe FilePath
displayInstalledUnitId DynFlags
dflags InstalledUnitId
uid of
            Just FilePath
str | Bool -> Bool
not (PprStyle -> Bool
debugStyle PprStyle
sty) -> FilePath -> SDoc
text FilePath
str
            Maybe FilePath
_ -> FastString -> SDoc
ftext FastString
fs

installedUnitIdKey :: InstalledUnitId -> Unique
installedUnitIdKey :: InstalledUnitId -> Unique
installedUnitIdKey = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (FastString -> Unique)
-> (InstalledUnitId -> FastString) -> InstalledUnitId -> Unique
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledUnitId -> FastString
installedUnitIdFS

-- | Lossy conversion to the on-disk 'InstalledUnitId' for a component.
toInstalledUnitId :: UnitId -> InstalledUnitId
toInstalledUnitId :: UnitId -> InstalledUnitId
toInstalledUnitId (DefiniteUnitId (DefUnitId InstalledUnitId
iuid)) = InstalledUnitId
iuid
toInstalledUnitId (IndefiniteUnitId IndefUnitId
indef) =
    ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (IndefUnitId -> ComponentId
indefUnitIdComponentId IndefUnitId
indef)

installedUnitIdString :: InstalledUnitId -> String
installedUnitIdString :: InstalledUnitId -> FilePath
installedUnitIdString = FastString -> FilePath
unpackFS (FastString -> FilePath)
-> (InstalledUnitId -> FastString) -> InstalledUnitId -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledUnitId -> FastString
installedUnitIdFS

instance Outputable IndefUnitId where
    ppr :: IndefUnitId -> SDoc
ppr IndefUnitId
uid =
      -- getPprStyle $ \sty ->
      ComponentId -> SDoc
forall a. Outputable a => a -> SDoc
ppr ComponentId
cid SDoc -> SDoc -> SDoc
<>
        (if Bool -> Bool
not ([(ModuleName, Module)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, Module)]
insts) -- pprIf
          then
            SDoc -> SDoc
brackets ([SDoc] -> SDoc
hcat
                (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
                    [ ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr ModuleName
modname SDoc -> SDoc -> SDoc
<> FilePath -> SDoc
text FilePath
"=" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m
                    | (ModuleName
modname, Module
m) <- [(ModuleName, Module)]
insts]))
          else SDoc
empty)
     where
      cid :: ComponentId
cid   = IndefUnitId -> ComponentId
indefUnitIdComponentId IndefUnitId
uid
      insts :: [(ModuleName, Module)]
insts = IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts IndefUnitId
uid

-- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.
data InstalledModule = InstalledModule {
   InstalledModule -> InstalledUnitId
installedModuleUnitId :: !InstalledUnitId,
   InstalledModule -> ModuleName
installedModuleName :: !ModuleName
  }
  deriving (InstalledModule -> InstalledModule -> Bool
(InstalledModule -> InstalledModule -> Bool)
-> (InstalledModule -> InstalledModule -> Bool)
-> Eq InstalledModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstalledModule -> InstalledModule -> Bool
$c/= :: InstalledModule -> InstalledModule -> Bool
== :: InstalledModule -> InstalledModule -> Bool
$c== :: InstalledModule -> InstalledModule -> Bool
Eq, Eq InstalledModule
Eq InstalledModule
-> (InstalledModule -> InstalledModule -> Ordering)
-> (InstalledModule -> InstalledModule -> Bool)
-> (InstalledModule -> InstalledModule -> Bool)
-> (InstalledModule -> InstalledModule -> Bool)
-> (InstalledModule -> InstalledModule -> Bool)
-> (InstalledModule -> InstalledModule -> InstalledModule)
-> (InstalledModule -> InstalledModule -> InstalledModule)
-> Ord InstalledModule
InstalledModule -> InstalledModule -> Bool
InstalledModule -> InstalledModule -> Ordering
InstalledModule -> InstalledModule -> InstalledModule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InstalledModule -> InstalledModule -> InstalledModule
$cmin :: InstalledModule -> InstalledModule -> InstalledModule
max :: InstalledModule -> InstalledModule -> InstalledModule
$cmax :: InstalledModule -> InstalledModule -> InstalledModule
>= :: InstalledModule -> InstalledModule -> Bool
$c>= :: InstalledModule -> InstalledModule -> Bool
> :: InstalledModule -> InstalledModule -> Bool
$c> :: InstalledModule -> InstalledModule -> Bool
<= :: InstalledModule -> InstalledModule -> Bool
$c<= :: InstalledModule -> InstalledModule -> Bool
< :: InstalledModule -> InstalledModule -> Bool
$c< :: InstalledModule -> InstalledModule -> Bool
compare :: InstalledModule -> InstalledModule -> Ordering
$ccompare :: InstalledModule -> InstalledModule -> Ordering
$cp1Ord :: Eq InstalledModule
Ord)

instance Outputable InstalledModule where
  ppr :: InstalledModule -> SDoc
ppr (InstalledModule InstalledUnitId
p ModuleName
n) =
    InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledUnitId
p SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n

fsToInstalledUnitId :: FastString -> InstalledUnitId
fsToInstalledUnitId :: FastString -> InstalledUnitId
fsToInstalledUnitId FastString
fs = FastString -> InstalledUnitId
InstalledUnitId FastString
fs

componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (ComponentId FastString
fs) = FastString -> InstalledUnitId
fsToInstalledUnitId FastString
fs

stringToInstalledUnitId :: String -> InstalledUnitId
stringToInstalledUnitId :: FilePath -> InstalledUnitId
stringToInstalledUnitId = FastString -> InstalledUnitId
fsToInstalledUnitId (FastString -> InstalledUnitId)
-> (FilePath -> FastString) -> FilePath -> InstalledUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FastString
mkFastString

-- | Test if a 'Module' corresponds to a given 'InstalledModule',
-- modulo instantiation.
installedModuleEq :: InstalledModule -> Module -> Bool
installedModuleEq :: InstalledModule -> Module -> Bool
installedModuleEq InstalledModule
imod Module
mod =
    (InstalledModule, Maybe IndefModule) -> InstalledModule
forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts Module
mod) InstalledModule -> InstalledModule -> Bool
forall a. Eq a => a -> a -> Bool
== InstalledModule
imod

-- | Test if a 'UnitId' corresponds to a given 'InstalledUnitId',
-- modulo instantiation.
installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool
installedUnitIdEq :: InstalledUnitId -> UnitId -> Bool
installedUnitIdEq InstalledUnitId
iuid UnitId
uid =
    (InstalledUnitId, Maybe IndefUnitId) -> InstalledUnitId
forall a b. (a, b) -> a
fst (UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts UnitId
uid) InstalledUnitId -> InstalledUnitId -> Bool
forall a. Eq a => a -> a -> Bool
== InstalledUnitId
iuid

-- | A 'DefUnitId' is an 'InstalledUnitId' with the invariant that
-- it only refers to a definite library; i.e., one we have generated
-- code for.
newtype DefUnitId = DefUnitId { DefUnitId -> InstalledUnitId
unDefUnitId :: InstalledUnitId }
    deriving (DefUnitId -> DefUnitId -> Bool
(DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool) -> Eq DefUnitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefUnitId -> DefUnitId -> Bool
$c/= :: DefUnitId -> DefUnitId -> Bool
== :: DefUnitId -> DefUnitId -> Bool
$c== :: DefUnitId -> DefUnitId -> Bool
Eq, Eq DefUnitId
Eq DefUnitId
-> (DefUnitId -> DefUnitId -> Ordering)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> Bool)
-> (DefUnitId -> DefUnitId -> DefUnitId)
-> (DefUnitId -> DefUnitId -> DefUnitId)
-> Ord DefUnitId
DefUnitId -> DefUnitId -> Bool
DefUnitId -> DefUnitId -> Ordering
DefUnitId -> DefUnitId -> DefUnitId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DefUnitId -> DefUnitId -> DefUnitId
$cmin :: DefUnitId -> DefUnitId -> DefUnitId
max :: DefUnitId -> DefUnitId -> DefUnitId
$cmax :: DefUnitId -> DefUnitId -> DefUnitId
>= :: DefUnitId -> DefUnitId -> Bool
$c>= :: DefUnitId -> DefUnitId -> Bool
> :: DefUnitId -> DefUnitId -> Bool
$c> :: DefUnitId -> DefUnitId -> Bool
<= :: DefUnitId -> DefUnitId -> Bool
$c<= :: DefUnitId -> DefUnitId -> Bool
< :: DefUnitId -> DefUnitId -> Bool
$c< :: DefUnitId -> DefUnitId -> Bool
compare :: DefUnitId -> DefUnitId -> Ordering
$ccompare :: DefUnitId -> DefUnitId -> Ordering
$cp1Ord :: Eq DefUnitId
Ord)

instance Outputable DefUnitId where
    ppr :: DefUnitId -> SDoc
ppr (DefUnitId InstalledUnitId
uid) = InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledUnitId
uid

instance Binary DefUnitId where
    put_ :: BinHandle -> DefUnitId -> IO ()
put_ BinHandle
bh (DefUnitId InstalledUnitId
uid) = BinHandle -> InstalledUnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh InstalledUnitId
uid
    get :: BinHandle -> IO DefUnitId
get BinHandle
bh = do InstalledUnitId
uid <- BinHandle -> IO InstalledUnitId
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; DefUnitId -> IO DefUnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (InstalledUnitId -> DefUnitId
DefUnitId InstalledUnitId
uid)

-- | A map keyed off of 'InstalledModule'
newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)

emptyInstalledModuleEnv :: InstalledModuleEnv a
emptyInstalledModuleEnv :: InstalledModuleEnv a
emptyInstalledModuleEnv = Map InstalledModule a -> InstalledModuleEnv a
forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv Map InstalledModule a
forall k a. Map k a
Map.empty

lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (InstalledModuleEnv Map InstalledModule a
e) InstalledModule
m = InstalledModule -> Map InstalledModule a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup InstalledModule
m Map InstalledModule a
e

extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv :: InstalledModuleEnv a
-> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (InstalledModuleEnv Map InstalledModule a
e) InstalledModule
m a
x = Map InstalledModule a -> InstalledModuleEnv a
forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv (InstalledModule
-> a -> Map InstalledModule a -> Map InstalledModule a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert InstalledModule
m a
x Map InstalledModule a
e)

filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv :: (InstalledModule -> a -> Bool)
-> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv InstalledModule -> a -> Bool
f (InstalledModuleEnv Map InstalledModule a
e) =
  Map InstalledModule a -> InstalledModuleEnv a
forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv ((InstalledModule -> a -> Bool)
-> Map InstalledModule a -> Map InstalledModule a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey InstalledModule -> a -> Bool
f Map InstalledModule a
e)

delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv (InstalledModuleEnv Map InstalledModule a
e) InstalledModule
m = Map InstalledModule a -> InstalledModuleEnv a
forall elt. Map InstalledModule elt -> InstalledModuleEnv elt
InstalledModuleEnv (InstalledModule -> Map InstalledModule a -> Map InstalledModule a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete InstalledModule
m Map InstalledModule a
e)

-- Note [UnitId to InstalledUnitId improvement]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Just because a UnitId is definite (has no holes) doesn't
-- mean it's necessarily a InstalledUnitId; it could just be
-- that over the course of renaming UnitIds on the fly
-- while typechecking an indefinite library, we
-- ended up with a fully instantiated unit id with no hash,
-- since we haven't built it yet.  This is fine.
--
-- However, if there is a hashed unit id for this instantiation
-- in the package database, we *better use it*, because
-- that hashed unit id may be lurking in another interface,
-- and chaos will ensue if we attempt to compare the two
-- (the unitIdFS for a UnitId never corresponds to a Cabal-provided
-- hash of a compiled instantiated library).
--
-- 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 holes of a 'UnitId'.
unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
unitIdFreeHoles (IndefiniteUnitId IndefUnitId
x) = IndefUnitId -> UniqDSet ModuleName
indefUnitIdFreeHoles IndefUnitId
x
-- Hashed unit ids are always fully instantiated
unitIdFreeHoles (DefiniteUnitId DefUnitId
_) = UniqDSet ModuleName
forall a. UniqDSet a
emptyUniqDSet

instance Show UnitId where
    show :: UnitId -> FilePath
show = UnitId -> FilePath
unitIdString

-- | A 'UnitId' is definite if it has no free holes.
unitIdIsDefinite :: UnitId -> Bool
unitIdIsDefinite :: UnitId -> Bool
unitIdIsDefinite = UniqDSet ModuleName -> Bool
forall a. UniqDSet a -> Bool
isEmptyUniqDSet (UniqDSet ModuleName -> Bool)
-> (UnitId -> UniqDSet ModuleName) -> UnitId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> UniqDSet ModuleName
unitIdFreeHoles

-- | Generate a uniquely identifying 'FastString' for a unit
-- identifier.  This is a one-way function.  You can rely on one special
-- property: if a unit identifier is in most general form, its 'FastString'
-- coincides with its 'ComponentId'.  This hash is completely internal
-- to GHC and is not used for symbol names or file paths.
hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
hashUnitId ComponentId
cid [(ModuleName, Module)]
sorted_holes =
    ByteString -> FastString
mkFastStringByteString
  (ByteString -> FastString)
-> (Fingerprint -> ByteString) -> Fingerprint -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Fingerprint -> ByteString
fingerprintUnitId (ComponentId -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep ComponentId
cid)
  (Fingerprint -> FastString) -> Fingerprint -> FastString
forall a b. (a -> b) -> a -> b
$ [(ModuleName, Module)] -> Fingerprint
rawHashUnitId [(ModuleName, Module)]
sorted_holes

-- | Generate a hash for a sorted module substitution.
rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
rawHashUnitId [(ModuleName, Module)]
sorted_holes =
    ByteString -> Fingerprint
fingerprintByteString
  (ByteString -> Fingerprint)
-> ([ByteString] -> ByteString) -> [ByteString] -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BS.concat ([ByteString] -> Fingerprint) -> [ByteString] -> Fingerprint
forall a b. (a -> b) -> a -> b
$ do
        (ModuleName
m, Module
b) <- [(ModuleName, Module)]
sorted_holes
        [ ModuleName -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep ModuleName
m,                Char -> ByteString
BS.Char8.singleton Char
' ',
          FastString -> ByteString
bytesFS (UnitId -> FastString
unitIdFS (Module -> UnitId
moduleUnitId Module
b)), Char -> ByteString
BS.Char8.singleton Char
':',
          ModuleName -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep (Module -> ModuleName
moduleName Module
b),   Char -> ByteString
BS.Char8.singleton Char
'\n']

fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
fingerprintUnitId :: ByteString -> Fingerprint -> ByteString
fingerprintUnitId ByteString
prefix (Fingerprint Word64
a Word64
b)
    = [ByteString] -> ByteString
BS.concat
    ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ ByteString
prefix
      , Char -> ByteString
BS.Char8.singleton Char
'-'
      , FilePath -> ByteString
BS.Char8.pack (Word64 -> FilePath
toBase62Padded Word64
a)
      , FilePath -> ByteString
BS.Char8.pack (Word64 -> FilePath
toBase62Padded Word64
b) ]

-- | Create a new, un-hashed unit identifier.
newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId ComponentId
cid [] = ComponentId -> UnitId
newSimpleUnitId ComponentId
cid -- TODO: this indicates some latent bug...
newUnitId ComponentId
cid [(ModuleName, Module)]
insts = IndefUnitId -> UnitId
IndefiniteUnitId (IndefUnitId -> UnitId) -> IndefUnitId -> UnitId
forall a b. (a -> b) -> a -> b
$ ComponentId -> [(ModuleName, Module)] -> IndefUnitId
newIndefUnitId ComponentId
cid [(ModuleName, Module)]
insts

pprUnitId :: UnitId -> SDoc
pprUnitId :: UnitId -> SDoc
pprUnitId (DefiniteUnitId DefUnitId
uid) = DefUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr DefUnitId
uid
pprUnitId (IndefiniteUnitId IndefUnitId
uid) = IndefUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr IndefUnitId
uid

instance Eq UnitId where
  UnitId
uid1 == :: UnitId -> UnitId -> Bool
== UnitId
uid2 = UnitId -> Unique
unitIdKey UnitId
uid1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId -> Unique
unitIdKey UnitId
uid2

instance Uniquable UnitId where
  getUnique :: UnitId -> Unique
getUnique = UnitId -> Unique
unitIdKey

instance Ord UnitId where
  UnitId
nm1 compare :: UnitId -> UnitId -> Ordering
`compare` UnitId
nm2 = UnitId -> UnitId -> Ordering
stableUnitIdCmp UnitId
nm1 UnitId
nm2

instance Data UnitId where
  -- don't traverse?
  toConstr :: UnitId -> Constr
toConstr UnitId
_   = FilePath -> Constr
abstractConstr FilePath
"UnitId"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UnitId
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = FilePath -> Constr -> c UnitId
forall a. HasCallStack => FilePath -> a
error FilePath
"gunfold"
  dataTypeOf :: UnitId -> DataType
dataTypeOf UnitId
_ = FilePath -> DataType
mkNoRepType FilePath
"UnitId"

instance NFData UnitId where
  rnf :: UnitId -> ()
rnf UnitId
x = UnitId
x UnitId -> () -> ()
`seq` ()

stableUnitIdCmp :: UnitId -> UnitId -> Ordering
-- ^ Compares package ids lexically, rather than by their 'Unique's
stableUnitIdCmp :: UnitId -> UnitId -> Ordering
stableUnitIdCmp UnitId
p1 UnitId
p2 = UnitId -> FastString
unitIdFS UnitId
p1 FastString -> FastString -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` UnitId -> FastString
unitIdFS UnitId
p2

instance Outputable UnitId where
   ppr :: UnitId -> SDoc
ppr UnitId
pk = UnitId -> SDoc
pprUnitId UnitId
pk

-- Performance: would prefer to have a NameCache like thing
instance Binary UnitId where
  put_ :: BinHandle -> UnitId -> IO ()
put_ BinHandle
bh (DefiniteUnitId DefUnitId
def_uid) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    BinHandle -> DefUnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh DefUnitId
def_uid
  put_ BinHandle
bh (IndefiniteUnitId IndefUnitId
indef_uid) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    BinHandle -> IndefUnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IndefUnitId
indef_uid
  get :: BinHandle -> IO UnitId
get BinHandle
bh = do Word8
b <- BinHandle -> IO Word8
getByte BinHandle
bh
              case Word8
b of
                Word8
0 -> (DefUnitId -> UnitId) -> IO DefUnitId -> IO UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DefUnitId -> UnitId
DefiniteUnitId   (BinHandle -> IO DefUnitId
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
                Word8
_ -> (IndefUnitId -> UnitId) -> IO IndefUnitId -> IO UnitId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IndefUnitId -> UnitId
IndefiniteUnitId (BinHandle -> IO IndefUnitId
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)

instance Binary ComponentId where
  put_ :: BinHandle -> ComponentId -> IO ()
put_ BinHandle
bh (ComponentId FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO ComponentId
get BinHandle
bh = do { FastString
fs <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; ComponentId -> IO ComponentId
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> ComponentId
ComponentId FastString
fs) }

-- | Create a new simple unit identifier (no holes) from a 'ComponentId'.
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId (ComponentId FastString
fs) = FastString -> UnitId
fsToUnitId FastString
fs

-- | Create a new simple unit identifier from a 'FastString'.  Internally,
-- this is primarily used to specify wired-in unit identifiers.
fsToUnitId :: FastString -> UnitId
fsToUnitId :: FastString -> UnitId
fsToUnitId = DefUnitId -> UnitId
DefiniteUnitId (DefUnitId -> UnitId)
-> (FastString -> DefUnitId) -> FastString -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledUnitId -> DefUnitId
DefUnitId (InstalledUnitId -> DefUnitId)
-> (FastString -> InstalledUnitId) -> FastString -> DefUnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FastString -> InstalledUnitId
InstalledUnitId

stringToUnitId :: String -> UnitId
stringToUnitId :: FilePath -> UnitId
stringToUnitId = FastString -> UnitId
fsToUnitId (FastString -> UnitId)
-> (FilePath -> FastString) -> FilePath -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FastString
mkFastString

unitIdString :: UnitId -> String
unitIdString :: UnitId -> FilePath
unitIdString = FastString -> FilePath
unpackFS (FastString -> FilePath)
-> (UnitId -> FastString) -> UnitId -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FastString
unitIdFS

{-
************************************************************************
*                                                                      *
                        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 :: DynFlags -> ShHoleSubst -> Module -> Module
renameHoleModule DynFlags
dflags = PackageConfigMap -> ShHoleSubst -> Module -> Module
renameHoleModule' (DynFlags -> PackageConfigMap
getPackageConfigMap DynFlags
dflags)

-- | Substitutes holes in a 'UnitId', 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>@.
renameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId :: DynFlags -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId DynFlags
dflags = PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId' (DynFlags -> PackageConfigMap
getPackageConfigMap DynFlags
dflags)

-- | Like 'renameHoleModule', but requires only 'PackageConfigMap'
-- so it can be used by "Packages".
renameHoleModule' :: PackageConfigMap -> ShHoleSubst -> Module -> Module
renameHoleModule' :: PackageConfigMap -> ShHoleSubst -> Module -> Module
renameHoleModule' PackageConfigMap
pkg_map ShHoleSubst
env Module
m
  | Bool -> Bool
not (Module -> Bool
isHoleModule Module
m) =
        let uid :: UnitId
uid = PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId' PackageConfigMap
pkg_map ShHoleSubst
env (Module -> UnitId
moduleUnitId Module
m)
        in UnitId -> ModuleName -> Module
mkModule UnitId
uid (Module -> ModuleName
moduleName Module
m)
  | Just Module
m' <- ShHoleSubst -> ModuleName -> Maybe Module
forall key elt. Uniquable key => UniqFM elt -> key -> Maybe elt
lookupUFM ShHoleSubst
env (Module -> ModuleName
moduleName Module
m) = Module
m'
  -- NB m = <Blah>, that's what's in scope.
  | Bool
otherwise = Module
m

-- | Like 'renameHoleUnitId, but requires only 'PackageConfigMap'
-- so it can be used by "Packages".
renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId' PackageConfigMap
pkg_map ShHoleSubst
env UnitId
uid =
    case UnitId
uid of
      (IndefiniteUnitId
        IndefUnitId{ indefUnitIdComponentId :: IndefUnitId -> ComponentId
indefUnitIdComponentId = ComponentId
cid
                   , indefUnitIdInsts :: IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts       = [(ModuleName, Module)]
insts
                   , indefUnitIdFreeHoles :: IndefUnitId -> UniqDSet ModuleName
indefUnitIdFreeHoles   = UniqDSet ModuleName
fh })
          -> if UniqFM ModuleName -> Bool
forall elt. UniqFM elt -> Bool
isNullUFM ((ModuleName -> Module -> ModuleName)
-> UniqFM ModuleName -> ShHoleSubst -> UniqFM ModuleName
forall elt1 elt2 elt3.
(elt1 -> elt2 -> elt3) -> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
intersectUFM_C ModuleName -> Module -> ModuleName
forall a b. a -> b -> a
const (UniqDFM ModuleName -> UniqFM ModuleName
forall elt. UniqDFM elt -> UniqFM elt
udfmToUfm (UniqDSet ModuleName -> UniqDFM ModuleName
forall a. UniqDSet a -> UniqDFM a
getUniqDSet UniqDSet ModuleName
fh)) ShHoleSubst
env)
                then UnitId
uid
                -- Functorially apply the substitution to the instantiation,
                -- then check the 'PackageConfigMap' to see if there is
                -- a compiled version of this 'UnitId' we can improve to.
                -- See Note [UnitId to InstalledUnitId] improvement
                else PackageConfigMap -> UnitId -> UnitId
improveUnitId PackageConfigMap
pkg_map (UnitId -> UnitId) -> UnitId -> UnitId
forall a b. (a -> b) -> a -> b
$
                        ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId ComponentId
cid
                            (((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
k,Module
v) -> (ModuleName
k, PackageConfigMap -> ShHoleSubst -> Module -> Module
renameHoleModule' PackageConfigMap
pkg_map ShHoleSubst
env Module
v)) [(ModuleName, Module)]
insts)
      UnitId
_ -> UnitId
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.
splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)
splitModuleInsts Module
m =
    let (InstalledUnitId
uid, Maybe IndefUnitId
mb_iuid) = UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts (Module -> UnitId
moduleUnitId Module
m)
    in (InstalledUnitId -> ModuleName -> InstalledModule
InstalledModule InstalledUnitId
uid (Module -> ModuleName
moduleName Module
m),
        (IndefUnitId -> IndefModule)
-> Maybe IndefUnitId -> Maybe IndefModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\IndefUnitId
iuid -> IndefUnitId -> ModuleName -> IndefModule
IndefModule IndefUnitId
iuid (Module -> ModuleName
moduleName Module
m)) Maybe IndefUnitId
mb_iuid)

-- | See 'splitModuleInsts'.
splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)
splitUnitIdInsts (IndefiniteUnitId IndefUnitId
iuid) =
    (ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (IndefUnitId -> ComponentId
indefUnitIdComponentId IndefUnitId
iuid), IndefUnitId -> Maybe IndefUnitId
forall a. a -> Maybe a
Just IndefUnitId
iuid)
splitUnitIdInsts (DefiniteUnitId (DefUnitId InstalledUnitId
uid)) = (InstalledUnitId
uid, Maybe IndefUnitId
forall a. Maybe a
Nothing)

generalizeIndefUnitId :: IndefUnitId -> IndefUnitId
generalizeIndefUnitId :: IndefUnitId -> IndefUnitId
generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId :: IndefUnitId -> ComponentId
indefUnitIdComponentId = ComponentId
cid
                                 , indefUnitIdInsts :: IndefUnitId -> [(ModuleName, Module)]
indefUnitIdInsts = [(ModuleName, Module)]
insts } =
    ComponentId -> [(ModuleName, Module)] -> IndefUnitId
newIndefUnitId ComponentId
cid (((ModuleName, Module) -> (ModuleName, Module))
-> [(ModuleName, Module)] -> [(ModuleName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
m,Module
_) -> (ModuleName
m, ModuleName -> Module
mkHoleModule ModuleName
m)) [(ModuleName, Module)]
insts)

generalizeIndefModule :: IndefModule -> IndefModule
generalizeIndefModule :: IndefModule -> IndefModule
generalizeIndefModule (IndefModule IndefUnitId
uid ModuleName
n) = IndefUnitId -> ModuleName -> IndefModule
IndefModule (IndefUnitId -> IndefUnitId
generalizeIndefUnitId IndefUnitId
uid) ModuleName
n

parseModuleName :: ReadP ModuleName
parseModuleName :: ReadP ModuleName
parseModuleName = (FilePath -> ModuleName) -> ReadP FilePath -> ReadP ModuleName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> ModuleName
mkModuleName
                (ReadP FilePath -> ReadP ModuleName)
-> ReadP FilePath -> ReadP ModuleName
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ReadP FilePath
Parse.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
"_.")

parseUnitId :: ReadP UnitId
parseUnitId :: ReadP UnitId
parseUnitId = ReadP UnitId
parseFullUnitId ReadP UnitId -> ReadP UnitId -> ReadP UnitId
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP UnitId
parseDefiniteUnitId ReadP UnitId -> ReadP UnitId -> ReadP UnitId
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP UnitId
parseSimpleUnitId
  where
    parseFullUnitId :: ReadP UnitId
parseFullUnitId = do
        ComponentId
cid <- ReadP ComponentId
parseComponentId
        [(ModuleName, Module)]
insts <- ReadP [(ModuleName, Module)]
parseModSubst
        UnitId -> ReadP UnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId ComponentId
cid [(ModuleName, Module)]
insts)
    parseDefiniteUnitId :: ReadP UnitId
parseDefiniteUnitId = do
        FilePath
s <- (Char -> Bool) -> ReadP FilePath
Parse.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
"-_.+")
        UnitId -> ReadP UnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> UnitId
stringToUnitId FilePath
s)
    parseSimpleUnitId :: ReadP UnitId
parseSimpleUnitId = do
        ComponentId
cid <- ReadP ComponentId
parseComponentId
        UnitId -> ReadP UnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentId -> UnitId
newSimpleUnitId ComponentId
cid)

parseComponentId :: ReadP ComponentId
parseComponentId :: ReadP ComponentId
parseComponentId = (FastString -> ComponentId
ComponentId (FastString -> ComponentId)
-> (FilePath -> FastString) -> FilePath -> ComponentId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FastString
mkFastString)  (FilePath -> ComponentId) -> ReadP FilePath -> ReadP ComponentId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Char -> Bool) -> ReadP FilePath
Parse.munch1 Char -> Bool
abi_char
   where abi_char :: Char -> Bool
abi_char Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
"-_."

parseModuleId :: ReadP Module
parseModuleId :: ReadP Module
parseModuleId = ReadP Module
parseModuleVar ReadP Module -> ReadP Module -> ReadP Module
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP Module
parseModule
    where
      parseModuleVar :: ReadP Module
parseModuleVar = do
        Char
_ <- Char -> ReadP Char
Parse.char Char
'<'
        ModuleName
modname <- ReadP ModuleName
parseModuleName
        Char
_ <- Char -> ReadP Char
Parse.char Char
'>'
        Module -> ReadP Module
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName -> Module
mkHoleModule ModuleName
modname)
      parseModule :: ReadP Module
parseModule = do
        UnitId
uid <- ReadP UnitId
parseUnitId
        Char
_ <- Char -> ReadP Char
Parse.char Char
':'
        ModuleName
modname <- ReadP ModuleName
parseModuleName
        Module -> ReadP Module
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> ModuleName -> Module
mkModule UnitId
uid ModuleName
modname)

parseModSubst :: ReadP [(ModuleName, Module)]
parseModSubst :: ReadP [(ModuleName, Module)]
parseModSubst = ReadP Char
-> ReadP Char
-> ReadP [(ModuleName, Module)]
-> ReadP [(ModuleName, Module)]
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
Parse.between (Char -> ReadP Char
Parse.char Char
'[') (Char -> ReadP Char
Parse.char Char
']')
      (ReadP [(ModuleName, Module)] -> ReadP [(ModuleName, Module)])
-> (ReadP (ModuleName, Module) -> ReadP [(ModuleName, Module)])
-> ReadP (ModuleName, Module)
-> ReadP [(ModuleName, Module)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadP (ModuleName, Module)
 -> ReadP Char -> ReadP [(ModuleName, Module)])
-> ReadP Char
-> ReadP (ModuleName, Module)
-> ReadP [(ModuleName, Module)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReadP (ModuleName, Module)
-> ReadP Char -> ReadP [(ModuleName, Module)]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
Parse.sepBy (Char -> ReadP Char
Parse.char Char
',')
      (ReadP (ModuleName, Module) -> ReadP [(ModuleName, Module)])
-> ReadP (ModuleName, Module) -> ReadP [(ModuleName, Module)]
forall a b. (a -> b) -> a -> b
$ do ModuleName
k <- ReadP ModuleName
parseModuleName
           Char
_ <- Char -> ReadP Char
Parse.char Char
'='
           Module
v <- ReadP Module
parseModuleId
           (ModuleName, Module) -> ReadP (ModuleName, Module)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
k, Module
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 internall 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 PrelNames.
-}

integerUnitId, primUnitId,
  baseUnitId, rtsUnitId,
  thUnitId, mainUnitId, thisGhcUnitId, interactiveUnitId  :: UnitId
primUnitId :: UnitId
primUnitId        = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"ghc-prim")
integerUnitId :: UnitId
integerUnitId     = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"integer-wired-in")
   -- See Note [The integer library] in PrelNames
baseUnitId :: UnitId
baseUnitId        = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"base")
rtsUnitId :: UnitId
rtsUnitId         = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"rts")
thUnitId :: UnitId
thUnitId          = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"template-haskell")
thisGhcUnitId :: UnitId
thisGhcUnitId     = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"ghc")
interactiveUnitId :: UnitId
interactiveUnitId = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"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 :: UnitId
mainUnitId      = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"main")

-- | This is a fake package id used to provide identities to any un-implemented
-- signatures.  The set of hole identities is global over an entire compilation.
-- Don't use this directly: use 'mkHoleModule' or 'isHoleModule' instead.
-- See Note [Representation of module/name variables]
holeUnitId :: UnitId
holeUnitId :: UnitId
holeUnitId      = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit FilePath
"hole")

isInteractiveModule :: Module -> Bool
isInteractiveModule :: Module -> Bool
isInteractiveModule Module
mod = Module -> UnitId
moduleUnitId Module
mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
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 'nameModule'
-- and 'moduleUnitId' 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 'renameHoleUnitId' assume they are NOT operating on a
-- 'Name'; 'NameShape' handles name substitutions exclusively.

isHoleModule :: Module -> Bool
isHoleModule :: Module -> Bool
isHoleModule Module
mod = Module -> UnitId
moduleUnitId Module
mod UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
holeUnitId

wiredInUnitIds :: [UnitId]
wiredInUnitIds :: [UnitId]
wiredInUnitIds = [ UnitId
primUnitId,
                       UnitId
integerUnitId,
                       UnitId
baseUnitId,
                       UnitId
rtsUnitId,
                       UnitId
thUnitId,
                       UnitId
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 { NDModule -> Module
unNDModule :: Module }
  deriving NDModule -> NDModule -> Bool
(NDModule -> NDModule -> Bool)
-> (NDModule -> NDModule -> Bool) -> Eq NDModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NDModule -> NDModule -> Bool
$c/= :: NDModule -> NDModule -> Bool
== :: NDModule -> NDModule -> Bool
$c== :: NDModule -> NDModule -> Bool
Eq
  -- A wrapper for Module with faster nondeterministic Ord.
  -- Don't export, See [ModuleEnv performance and determinism]

instance Ord NDModule where
  compare :: NDModule -> NDModule -> Ordering
compare (NDModule (Module UnitId
p1 ModuleName
n1)) (NDModule (Module UnitId
p2 ModuleName
n2)) =
    (UnitId -> Unique
forall a. Uniquable a => a -> Unique
getUnique UnitId
p1 Unique -> Unique -> Ordering
`nonDetCmpUnique` UnitId -> Unique
forall a. Uniquable a => a -> Unique
getUnique UnitId
p2) Ordering -> Ordering -> Ordering
`thenCmp`
    (ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique ModuleName
n1 Unique -> Unique -> Ordering
`nonDetCmpUnique` ModuleName -> Unique
forall a. Uniquable a => a -> Unique
getUnique ModuleName
n2)

filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
filterModuleEnv Module -> a -> Bool
f (ModuleEnv Map NDModule a
e) =
  Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ((NDModule -> a -> Bool) -> Map NDModule a -> Map NDModule a
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Module -> a -> Bool
f (Module -> a -> Bool)
-> (NDModule -> Module) -> NDModule -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NDModule -> Module
unNDModule) Map NDModule a
e)

elemModuleEnv :: Module -> ModuleEnv a -> Bool
elemModuleEnv :: Module -> ModuleEnv a -> Bool
elemModuleEnv Module
m (ModuleEnv Map NDModule a
e) = NDModule -> Map NDModule a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (Module -> NDModule
NDModule Module
m) Map NDModule a
e

extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnv (ModuleEnv Map NDModule a
e) Module
m a
x = Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (NDModule -> a -> Map NDModule a -> Map NDModule a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Module -> NDModule
NDModule Module
m) a
x Map NDModule a
e)

extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a
                    -> ModuleEnv a
extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
extendModuleEnvWith a -> a -> a
f (ModuleEnv Map NDModule a
e) Module
m a
x =
  Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ((a -> a -> a) -> NDModule -> a -> Map NDModule a -> Map NDModule a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith a -> a -> a
f (Module -> NDModule
NDModule Module
m) a
x Map NDModule a
e)

extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList (ModuleEnv Map NDModule a
e) [(Module, a)]
xs =
  Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ([(NDModule, a)] -> Map NDModule a -> Map NDModule a
forall key elt.
Ord key =>
[(key, elt)] -> Map key elt -> Map key elt
Map.insertList [(Module -> NDModule
NDModule Module
k, a
v) | (Module
k,a
v) <- [(Module, a)]
xs] Map NDModule a
e)

extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
                      -> ModuleEnv a
extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)] -> ModuleEnv a
extendModuleEnvList_C a -> a -> a
f (ModuleEnv Map NDModule a
e) [(Module, a)]
xs =
  Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ((a -> a -> a)
-> [(NDModule, a)] -> Map NDModule a -> Map NDModule a
forall key elt.
Ord key =>
(elt -> elt -> elt) -> [(key, elt)] -> Map key elt -> Map key elt
Map.insertListWith a -> a -> a
f [(Module -> NDModule
NDModule Module
k, a
v) | (Module
k,a
v) <- [(Module, a)]
xs] Map NDModule a
e)

plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv_C a -> a -> a
f (ModuleEnv Map NDModule a
e1) (ModuleEnv Map NDModule a
e2) =
  Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ((a -> a -> a) -> Map NDModule a -> Map NDModule a -> Map NDModule a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith a -> a -> a
f Map NDModule a
e1 Map NDModule a
e2)

delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnvList (ModuleEnv Map NDModule a
e) [Module]
ms =
  Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ([NDModule] -> Map NDModule a -> Map NDModule a
forall key elt. Ord key => [key] -> Map key elt -> Map key elt
Map.deleteList ((Module -> NDModule) -> [Module] -> [NDModule]
forall a b. (a -> b) -> [a] -> [b]
map Module -> NDModule
NDModule [Module]
ms) Map NDModule a
e)

delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
delModuleEnv (ModuleEnv Map NDModule a
e) Module
m = Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (NDModule -> Map NDModule a -> Map NDModule a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Module -> NDModule
NDModule Module
m) Map NDModule a
e)

plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
plusModuleEnv (ModuleEnv Map NDModule a
e1) (ModuleEnv Map NDModule a
e2) = Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (Map NDModule a -> Map NDModule a -> Map NDModule a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map NDModule a
e1 Map NDModule a
e2)

lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
lookupModuleEnv (ModuleEnv Map NDModule a
e) Module
m = NDModule -> Map NDModule a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Module -> NDModule
NDModule Module
m) Map NDModule a
e

lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
lookupWithDefaultModuleEnv (ModuleEnv Map NDModule a
e) a
x Module
m =
  a -> NDModule -> Map NDModule a -> a
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault a
x (Module -> NDModule
NDModule Module
m) Map NDModule a
e

mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
mapModuleEnv a -> b
f (ModuleEnv Map NDModule a
e) = Map NDModule b -> ModuleEnv b
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ((NDModule -> a -> b) -> Map NDModule a -> Map NDModule b
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\NDModule
_ a
v -> a -> b
f a
v) Map NDModule a
e)

mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv [(Module, a)]
xs = Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv ([(NDModule, a)] -> Map NDModule a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Module -> NDModule
NDModule Module
k, a
v) | (Module
k,a
v) <- [(Module, a)]
xs])

emptyModuleEnv :: ModuleEnv a
emptyModuleEnv :: ModuleEnv a
emptyModuleEnv = Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv Map NDModule a
forall k a. Map k a
Map.empty

moduleEnvKeys :: ModuleEnv a -> [Module]
moduleEnvKeys :: ModuleEnv a -> [Module]
moduleEnvKeys (ModuleEnv Map NDModule a
e) = [Module] -> [Module]
forall a. Ord a => [a] -> [a]
sort ([Module] -> [Module]) -> [Module] -> [Module]
forall a b. (a -> b) -> a -> b
$ (NDModule -> Module) -> [NDModule] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map NDModule -> Module
unNDModule ([NDModule] -> [Module]) -> [NDModule] -> [Module]
forall a b. (a -> b) -> a -> b
$ Map NDModule a -> [NDModule]
forall k a. Map k a -> [k]
Map.keys Map NDModule a
e
  -- See Note [ModuleEnv performance and determinism]

moduleEnvElts :: ModuleEnv a -> [a]
moduleEnvElts :: ModuleEnv a -> [a]
moduleEnvElts ModuleEnv a
e = ((Module, a) -> a) -> [(Module, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Module, a) -> a
forall a b. (a, b) -> b
snd ([(Module, a)] -> [a]) -> [(Module, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ ModuleEnv a -> [(Module, a)]
forall a. ModuleEnv a -> [(Module, a)]
moduleEnvToList ModuleEnv a
e
  -- See Note [ModuleEnv performance and determinism]

moduleEnvToList :: ModuleEnv a -> [(Module, a)]
moduleEnvToList :: ModuleEnv a -> [(Module, a)]
moduleEnvToList (ModuleEnv Map NDModule a
e) =
  ((Module, a) -> (Module, a) -> Ordering)
-> [(Module, a)] -> [(Module, a)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Module, a) -> Module) -> (Module, a) -> (Module, a) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Module, a) -> Module
forall a b. (a, b) -> a
fst) [(Module
m, a
v) | (NDModule Module
m, a
v) <- Map NDModule a -> [(NDModule, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map NDModule a
e]
  -- See Note [ModuleEnv performance and determinism]

unitModuleEnv :: Module -> a -> ModuleEnv a
unitModuleEnv :: Module -> a -> ModuleEnv a
unitModuleEnv Module
m a
x = Map NDModule a -> ModuleEnv a
forall elt. Map NDModule elt -> ModuleEnv elt
ModuleEnv (NDModule -> a -> Map NDModule a
forall k a. k -> a -> Map k a
Map.singleton (Module -> NDModule
NDModule Module
m) a
x)

isEmptyModuleEnv :: ModuleEnv a -> Bool
isEmptyModuleEnv :: ModuleEnv a -> Bool
isEmptyModuleEnv (ModuleEnv Map NDModule a
e) = Map NDModule a -> Bool
forall k a. Map k a -> Bool
Map.null Map NDModule a
e

-- | A set of 'Module's
type ModuleSet = Set NDModule

mkModuleSet :: [Module] -> ModuleSet
mkModuleSet :: [Module] -> ModuleSet
mkModuleSet = [NDModule] -> ModuleSet
forall a. Ord a => [a] -> Set a
Set.fromList ([NDModule] -> ModuleSet)
-> ([Module] -> [NDModule]) -> [Module] -> ModuleSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Module] -> [NDModule]
coerce

extendModuleSet :: ModuleSet -> Module -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
extendModuleSet ModuleSet
s Module
m = NDModule -> ModuleSet -> ModuleSet
forall a. Ord a => a -> Set a -> Set a
Set.insert (Module -> NDModule
NDModule Module
m) ModuleSet
s

extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
extendModuleSetList :: ModuleSet -> [Module] -> ModuleSet
extendModuleSetList ModuleSet
s [Module]
ms = (ModuleSet -> Module -> ModuleSet)
-> ModuleSet -> [Module] -> ModuleSet
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((NDModule -> ModuleSet) -> Module -> ModuleSet
coerce ((NDModule -> ModuleSet) -> Module -> ModuleSet)
-> (ModuleSet -> NDModule -> ModuleSet)
-> ModuleSet
-> Module
-> ModuleSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NDModule -> ModuleSet -> ModuleSet)
-> ModuleSet -> NDModule -> ModuleSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip NDModule -> ModuleSet -> ModuleSet
forall a. Ord a => a -> Set a -> Set a
Set.insert) ModuleSet
s [Module]
ms

emptyModuleSet :: ModuleSet
emptyModuleSet :: ModuleSet
emptyModuleSet = ModuleSet
forall a. Set a
Set.empty

moduleSetElts :: ModuleSet -> [Module]
moduleSetElts :: ModuleSet -> [Module]
moduleSetElts = [Module] -> [Module]
forall a. Ord a => [a] -> [a]
sort ([Module] -> [Module])
-> (ModuleSet -> [Module]) -> ModuleSet -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NDModule] -> [Module]
coerce ([NDModule] -> [Module])
-> (ModuleSet -> [NDModule]) -> ModuleSet -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleSet -> [NDModule]
forall a. Set a -> [a]
Set.toList

elemModuleSet :: Module -> ModuleSet -> Bool
elemModuleSet :: Module -> ModuleSet -> Bool
elemModuleSet = NDModule -> ModuleSet -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (NDModule -> ModuleSet -> Bool)
-> (Module -> NDModule) -> Module -> ModuleSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> NDModule
coerce

intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
intersectModuleSet = (ModuleSet -> ModuleSet -> ModuleSet)
-> ModuleSet -> ModuleSet -> ModuleSet
coerce ModuleSet -> ModuleSet -> ModuleSet
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection

minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
minusModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
minusModuleSet = (ModuleSet -> ModuleSet -> ModuleSet)
-> ModuleSet -> ModuleSet -> ModuleSet
coerce ModuleSet -> ModuleSet -> ModuleSet
forall a. Ord a => Set a -> Set a -> Set a
Set.difference

delModuleSet :: ModuleSet -> Module -> ModuleSet
delModuleSet :: ModuleSet -> Module -> ModuleSet
delModuleSet = (ModuleSet -> NDModule -> ModuleSet)
-> ModuleSet -> Module -> ModuleSet
coerce ((NDModule -> ModuleSet -> ModuleSet)
-> ModuleSet -> NDModule -> ModuleSet
forall a b c. (a -> b -> c) -> b -> a -> c
flip NDModule -> ModuleSet -> ModuleSet
forall a. Ord a => a -> Set a -> Set a
Set.delete)

unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
unionModuleSet = (ModuleSet -> ModuleSet -> ModuleSet)
-> ModuleSet -> ModuleSet -> ModuleSet
coerce ModuleSet -> ModuleSet -> ModuleSet
forall a. Ord a => Set a -> Set a -> Set a
Set.union

unitModuleSet :: Module -> ModuleSet
unitModuleSet :: Module -> ModuleSet
unitModuleSet = (NDModule -> ModuleSet) -> Module -> ModuleSet
coerce NDModule -> ModuleSet
forall a. a -> Set a
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