{-
(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, 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
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://ghc.haskell.org/trac/ghc/wiki/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://ghc.haskell.org/trac/ghc/ticket/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://ghc.haskell.org/trac/ghc/ticket/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 path :: FilePath
path = FilePath
path FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ "-boot"

addBootSuffix_maybe :: Bool -> FilePath -> FilePath
-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
addBootSuffix_maybe :: Bool -> ShowS
addBootSuffix_maybe is_boot :: Bool
is_boot path :: 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 locn :: 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 locn :: 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 nm :: FastString
nm) = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique FastString
nm

instance Eq ModuleName where
  nm1 :: ModuleName
nm1 == :: ModuleName -> ModuleName -> Bool
== nm2 :: 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
  nm1 :: ModuleName
nm1 compare :: ModuleName -> ModuleName -> Ordering
`compare` nm2 :: 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_ bh :: BinHandle
bh (ModuleName fs :: FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO ModuleName
get bh :: 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
fastStringToByteString (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 _   = FilePath -> Constr
abstractConstr "ModuleName"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModuleName
gunfold _ _  = FilePath -> Constr -> c ModuleName
forall a. HasCallStack => FilePath -> a
error "gunfold"
  dataTypeOf :: ModuleName -> DataType
dataTypeOf _ = FilePath -> DataType
mkNoRepType "ModuleName"

instance NFData ModuleName where
  rnf :: ModuleName -> ()
rnf x :: ModuleName
x = ModuleName
x ModuleName -> () -> ()
forall a b. a -> b -> b
`seq` ()

stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
-- ^ Compares module names lexically, rather than by their 'Unique's
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
stableModuleNameCmp n1 :: ModuleName
n1 n2 :: 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 nm :: FastString
nm) =
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ sty :: 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 mod :: FastString
mod) = FastString
mod

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

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

mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS s :: 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 (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' 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 (\c :: Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' then ':' 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 m :: 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 p :: UnitId
p n :: 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_ bh :: BinHandle
bh (Module p :: UnitId
p n :: 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 bh :: 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 _   = FilePath -> Constr
abstractConstr "Module"
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Module
gunfold _ _  = FilePath -> Constr -> c Module
forall a. HasCallStack => FilePath -> a
error "gunfold"
  dataTypeOf :: Module -> DataType
dataTypeOf _ = FilePath -> DataType
mkNoRepType "Module"

instance NFData Module where
  rnf :: Module -> ()
rnf x :: Module
x = Module
x Module -> () -> ()
forall a b. a -> b -> b
`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 p1 :: UnitId
p1 n1 :: ModuleName
n1) (Module p2 :: UnitId
p2 n2 :: 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 p :: UnitId
p n :: ModuleName
n)  = (PprStyle -> SDoc) -> SDoc
getPprStyle PprStyle -> SDoc
doc
 where
  doc :: PprStyle -> SDoc
doc sty :: 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 '_')
            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 ':' 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 uid :: UnitId
uid mod_name :: ModuleName
mod_name)  = UnitId -> ModuleName -> Module
mkModule UnitId
uid ModuleName
mod_name
  fromDbModule (DbModuleVar mod_name :: ModuleName
mod_name)   = ModuleName -> Module
mkHoleModule ModuleName
mod_name
  fromDbUnitId :: DbUnitId InstalledUnitId ComponentId UnitId ModuleName Module
-> UnitId
fromDbUnitId (DbUnitId cid :: ComponentId
cid insts :: [(ModuleName, Module)]
insts)     = ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId ComponentId
cid [(ModuleName, Module)]
insts
  fromDbUnitId (DbInstalledUnitId iuid :: 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 "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 "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 s :: FastString
s) = FastString -> ByteString
fastStringToByteString FastString
s

instance Uniquable ComponentId where
  getUnique :: ComponentId -> Unique
getUnique (ComponentId n :: 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 fs :: FastString
fs) =
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \sty :: PprStyle
sty ->
    (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
      case DynFlags -> ComponentId -> Maybe FilePath
componentIdString DynFlags
dflags ComponentId
cid of
        Just str :: FilePath
str | Bool -> Bool
not (PprStyle -> Bool
debugStyle PprStyle
sty) -> FilePath -> SDoc
text FilePath
str
        _ -> 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 x :: IndefUnitId
x) = IndefUnitId -> FastString
indefUnitIdFS IndefUnitId
x
unitIdFS (DefiniteUnitId (DefUnitId x :: InstalledUnitId
x)) = InstalledUnitId -> FastString
installedUnitIdFS InstalledUnitId
x

unitIdKey :: UnitId -> Unique
unitIdKey :: UnitId -> Unique
unitIdKey (IndefiniteUnitId x :: IndefUnitId
x) = IndefUnitId -> Unique
indefUnitIdKey IndefUnitId
x
unitIdKey (DefiniteUnitId (DefUnitId x :: 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
  u1 :: IndefUnitId
u1 == :: IndefUnitId -> IndefUnitId -> Bool
== u2 :: 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
  u1 :: IndefUnitId
u1 compare :: IndefUnitId -> IndefUnitId -> Ordering
`compare` u2 :: 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_ bh :: BinHandle
bh indef :: 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 bh :: 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 $WIndefUnitId :: 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 cid :: ComponentId
cid insts :: [(ModuleName, Module)]
insts =
    $WIndefUnitId :: 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 dflags :: DynFlags
dflags iuid :: 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 uid :: IndefUnitId
uid m :: ModuleName
m) =
    IndefUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr IndefUnitId
uid SDoc -> SDoc -> SDoc
<> Char -> SDoc
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 dflags :: DynFlags
dflags (IndefModule iuid :: IndefUnitId
iuid mod_name :: 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_ bh :: BinHandle
bh (InstalledUnitId fs :: FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO InstalledUnitId
get bh :: 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 bs :: 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 "BinaryStringRep InstalledUnitId: not implemented"

instance Eq InstalledUnitId where
    uid1 :: InstalledUnitId
uid1 == :: InstalledUnitId -> InstalledUnitId -> Bool
== uid2 :: 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
    u1 :: InstalledUnitId
u1 compare :: InstalledUnitId -> InstalledUnitId -> Ordering
`compare` u2 :: 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 fs :: FastString
fs) =
        (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \sty :: PprStyle
sty ->
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
          case DynFlags -> InstalledUnitId -> Maybe FilePath
displayInstalledUnitId DynFlags
dflags InstalledUnitId
uid of
            Just str :: FilePath
str | Bool -> Bool
not (PprStyle -> Bool
debugStyle PprStyle
sty) -> FilePath -> SDoc
text FilePath
str
            _ -> 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 iuid :: InstalledUnitId
iuid)) = InstalledUnitId
iuid
toInstalledUnitId (IndefiniteUnitId indef :: 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 uid :: 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 "=" SDoc -> SDoc -> SDoc
<> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m
                    | (modname :: ModuleName
modname, m :: 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 p :: InstalledUnitId
p n :: ModuleName
n) =
    InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledUnitId
p SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':' SDoc -> SDoc -> SDoc
<> ModuleName -> SDoc
pprModuleName ModuleName
n

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

componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (ComponentId fs :: 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 imod :: InstalledModule
imod mod :: 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 iuid :: InstalledUnitId
iuid uid :: 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 uid :: InstalledUnitId
uid) = InstalledUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr InstalledUnitId
uid

instance Binary DefUnitId where
    put_ :: BinHandle -> DefUnitId -> IO ()
put_ bh :: BinHandle
bh (DefUnitId uid :: InstalledUnitId
uid) = BinHandle -> InstalledUnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh InstalledUnitId
uid
    get :: BinHandle -> IO DefUnitId
get bh :: 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 e :: Map InstalledModule a
e) m :: 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 e :: Map InstalledModule a
e) m :: InstalledModule
m x :: 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 f :: InstalledModule -> a -> Bool
f (InstalledModuleEnv e :: 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 e :: Map InstalledModule a
e) m :: 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 x :: IndefUnitId
x) = IndefUnitId -> UniqDSet ModuleName
indefUnitIdFreeHoles IndefUnitId
x
-- Hashed unit ids are always fully instantiated
unitIdFreeHoles (DefiniteUnitId _) = 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 cid :: ComponentId
cid sorted_holes :: [(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 sorted_holes :: [(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
        (m :: ModuleName
m, b :: Module
b) <- [(ModuleName, Module)]
sorted_holes
        [ ModuleName -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep ModuleName
m,                Char -> ByteString
BS.Char8.singleton ' ',
          FastString -> ByteString
fastStringToByteString (UnitId -> FastString
unitIdFS (Module -> UnitId
moduleUnitId Module
b)), Char -> ByteString
BS.Char8.singleton ':',
          ModuleName -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep (Module -> ModuleName
moduleName Module
b),   Char -> ByteString
BS.Char8.singleton '\n']

fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
fingerprintUnitId :: ByteString -> Fingerprint -> ByteString
fingerprintUnitId prefix :: ByteString
prefix (Fingerprint a :: Word64
a b :: Word64
b)
    = [ByteString] -> ByteString
BS.concat
    ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ ByteString
prefix
      , Char -> ByteString
BS.Char8.singleton '-'
      , 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 cid :: ComponentId
cid [] = ComponentId -> UnitId
newSimpleUnitId ComponentId
cid -- TODO: this indicates some latent bug...
newUnitId cid :: ComponentId
cid insts :: [(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 uid :: DefUnitId
uid) = DefUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr DefUnitId
uid
pprUnitId (IndefiniteUnitId uid :: IndefUnitId
uid) = IndefUnitId -> SDoc
forall a. Outputable a => a -> SDoc
ppr IndefUnitId
uid

instance Eq UnitId where
  uid1 :: UnitId
uid1 == :: UnitId -> UnitId -> Bool
== uid2 :: 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
  nm1 :: UnitId
nm1 compare :: UnitId -> UnitId -> Ordering
`compare` nm2 :: UnitId
nm2 = UnitId -> UnitId -> Ordering
stableUnitIdCmp UnitId
nm1 UnitId
nm2

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

instance NFData UnitId where
  rnf :: UnitId -> ()
rnf x :: UnitId
x = UnitId
x UnitId -> () -> ()
forall a b. a -> b -> b
`seq` ()

stableUnitIdCmp :: UnitId -> UnitId -> Ordering
-- ^ Compares package ids lexically, rather than by their 'Unique's
stableUnitIdCmp :: UnitId -> UnitId -> Ordering
stableUnitIdCmp p1 :: UnitId
p1 p2 :: 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 pk :: 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_ bh :: BinHandle
bh (DefiniteUnitId def_uid :: DefUnitId
def_uid) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    BinHandle -> DefUnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh DefUnitId
def_uid
  put_ bh :: BinHandle
bh (IndefiniteUnitId indef_uid :: IndefUnitId
indef_uid) = do
    BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
    BinHandle -> IndefUnitId -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IndefUnitId
indef_uid
  get :: BinHandle -> IO UnitId
get bh :: BinHandle
bh = do Word8
b <- BinHandle -> IO Word8
getByte BinHandle
bh
              case Word8
b of
                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)
                _ -> (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_ bh :: BinHandle
bh (ComponentId fs :: FastString
fs) = BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
fs
  get :: BinHandle -> IO ComponentId
get bh :: 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 fs :: 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 dflags :: 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 dflags :: 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' pkg_map :: PackageConfigMap
pkg_map env :: ShHoleSubst
env m :: 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 m' :: 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' pkg_map :: PackageConfigMap
pkg_map env :: ShHoleSubst
env uid :: 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 (\(k :: ModuleName
k,v :: Module
v) -> (ModuleName
k, PackageConfigMap -> ShHoleSubst -> Module -> Module
renameHoleModule' PackageConfigMap
pkg_map ShHoleSubst
env Module
v)) [(ModuleName, Module)]
insts)
      _ -> 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 m :: Module
m =
    let (uid :: InstalledUnitId
uid, mb_iuid :: 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 (\iuid :: 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 iuid :: IndefUnitId
iuid) =
    (ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (IndefUnitId -> ComponentId
indefUnitIdComponentId IndefUnitId
iuid), IndefUnitId -> Maybe IndefUnitId
forall a. a -> Maybe a
Just IndefUnitId
iuid)
splitUnitIdInsts (DefiniteUnitId (DefUnitId uid :: 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 (\(m :: ModuleName
m,_) -> (ModuleName
m, ModuleName -> Module
mkHoleModule ModuleName
m)) [(ModuleName, Module)]
insts)

generalizeIndefModule :: IndefModule -> IndefModule
generalizeIndefModule :: IndefModule -> IndefModule
generalizeIndefModule (IndefModule uid :: IndefUnitId
uid n :: 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 (\c :: 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` "_.")

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 (\c :: 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` "-_.+")
        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 c :: 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` "-_."

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 '<'
        ModuleName
modname <- ReadP ModuleName
parseModuleName
        Char
_ <- Char -> ReadP Char
Parse.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 ':'
        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 -> ReadP Char
Parse.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 ',')
      (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 '='
           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 "ghc-prim")
integerUnitId :: UnitId
integerUnitId     = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "integer-wired-in")
   -- See Note [The integer library] in PrelNames
baseUnitId :: UnitId
baseUnitId        = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "base")
rtsUnitId :: UnitId
rtsUnitId         = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "rts")
thUnitId :: UnitId
thUnitId          = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "template-haskell")
thisGhcUnitId :: UnitId
thisGhcUnitId     = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "ghc")
interactiveUnitId :: UnitId
interactiveUnitId = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "interactive")

-- | This is the package Id for the current program.  It is the default
-- package Id if you don't specify a package name.  We don't add this prefix
-- to symbol names, since there can be only one main package per program.
mainUnitId :: UnitId
mainUnitId      = FastString -> UnitId
fsToUnitId (FilePath -> FastString
fsLit "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 "hole")

isInteractiveModule :: Module -> Bool
isInteractiveModule :: Module -> Bool
isInteractiveModule mod :: 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 mod :: 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 p1 :: UnitId
p1 n1 :: ModuleName
n1)) (NDModule (Module p2 :: UnitId
p2 n2 :: 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 f :: Module -> a -> Bool
f (ModuleEnv e :: 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 m :: Module
m (ModuleEnv e :: 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 e :: Map NDModule a
e) m :: Module
m x :: 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 f :: a -> a -> a
f (ModuleEnv e :: Map NDModule a
e) m :: Module
m x :: 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 e :: Map NDModule a
e) xs :: [(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) | (k :: Module
k,v :: 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 f :: a -> a -> a
f (ModuleEnv e :: Map NDModule a
e) xs :: [(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) | (k :: Module
k,v :: 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 f :: a -> a -> a
f (ModuleEnv e1 :: Map NDModule a
e1) (ModuleEnv e2 :: 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 e :: Map NDModule a
e) ms :: [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 e :: Map NDModule a
e) m :: 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 e1 :: Map NDModule a
e1) (ModuleEnv e2 :: 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 e :: Map NDModule a
e) m :: 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 e :: Map NDModule a
e) x :: a
x m :: 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 f :: a -> b
f (ModuleEnv e :: 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 (\_ v :: a
v -> a -> b
f a
v) Map NDModule a
e)

mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv :: [(Module, a)] -> ModuleEnv a
mkModuleEnv xs :: [(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) | (k :: Module
k,v :: 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 e :: 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 e :: 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 e :: 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 m :: Module
m, v :: 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 m :: Module
m x :: 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 e :: 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]
forall a b. Coercible a b => a -> b
coerce

extendModuleSet :: ModuleSet -> Module -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
extendModuleSet s :: ModuleSet
s m :: 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 s :: ModuleSet
s ms :: [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
forall a b. Coercible a b => a -> b
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]
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
coerce

intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
intersectModuleSet :: ModuleSet -> ModuleSet -> ModuleSet
intersectModuleSet = (ModuleSet -> ModuleSet -> ModuleSet)
-> ModuleSet -> ModuleSet -> ModuleSet
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
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
forall a b. Coercible a b => a -> b
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