Module.hs 48.2 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3
{-
(c) The University of Glasgow, 2004-2006

sof's avatar
sof committed
4

5
Module
6
~~~~~~~~~~
7
Simply the name of a module, represented as a FastString.
8
These are Uniquable, hence we can build Maps with Modules as
9
the keys.
Austin Seipp's avatar
Austin Seipp committed
10
-}
sof's avatar
sof committed
11

niteria's avatar
niteria committed
12
{-# LANGUAGE RecordWildCards #-}
13
{-# LANGUAGE MultiParamTypeClasses #-}
dterei's avatar
dterei committed
14 15

module Module
sof's avatar
sof committed
16
    (
17 18 19 20 21 22
        -- * The ModuleName type
        ModuleName,
        pprModuleName,
        moduleNameFS,
        moduleNameString,
        moduleNameSlashes, moduleNameColons,
niteria's avatar
niteria committed
23
        moduleStableString,
Edward Z. Yang's avatar
Edward Z. Yang committed
24 25
        moduleFreeHoles,
        moduleIsDefinite,
26 27 28
        mkModuleName,
        mkModuleNameFS,
        stableModuleNameCmp,
Simon Marlow's avatar
Simon Marlow committed
29

30
        -- * The UnitId type
Edward Z. Yang's avatar
Edward Z. Yang committed
31 32
        ComponentId(..),
        UnitId(..),
33
        unitIdFS,
Edward Z. Yang's avatar
Edward Z. Yang committed
34 35
        unitIdKey,
        IndefUnitId(..),
36
        IndefModule(..),
37 38
        indefUnitIdToUnitId,
        indefModuleToModule,
39 40
        InstalledUnitId(..),
        toInstalledUnitId,
Edward Z. Yang's avatar
Edward Z. Yang committed
41 42 43
        ShHoleSubst,

        unitIdIsDefinite,
44
        unitIdString,
Edward Z. Yang's avatar
Edward Z. Yang committed
45 46 47 48 49 50 51 52
        unitIdFreeHoles,

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

Edward Z. Yang's avatar
Edward Z. Yang committed
55 56 57 58 59 60 61 62 63 64
        -- * HOLE renaming
        renameHoleUnitId,
        renameHoleModule,
        renameHoleUnitId',
        renameHoleModule',

        -- * Generalization
        splitModuleInsts,
        splitUnitIdInsts,
        generalizeIndefUnitId,
65
        generalizeIndefModule,
Edward Z. Yang's avatar
Edward Z. Yang committed
66 67 68 69 70 71 72 73

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

74
        -- * Wired-in UnitIds
dterei's avatar
dterei committed
75
        -- $wired_in_packages
76 77 78 79 80 81 82
        primUnitId,
        integerUnitId,
        baseUnitId,
        rtsUnitId,
        thUnitId,
        mainUnitId,
        thisGhcUnitId,
Edward Z. Yang's avatar
Edward Z. Yang committed
83
        isHoleModule,
84 85
        interactiveUnitId, isInteractiveModule,
        wiredInUnitIds,
dterei's avatar
dterei committed
86 87

        -- * The Module type
Joel Burget's avatar
Joel Burget committed
88
        Module(Module),
89
        moduleUnitId, moduleName,
dterei's avatar
dterei committed
90 91
        pprModule,
        mkModule,
Edward Z. Yang's avatar
Edward Z. Yang committed
92
        mkHoleModule,
93
        stableModuleCmp,
94 95
        HasModule(..),
        ContainsModule(..),
Simon Marlow's avatar
Simon Marlow committed
96

97 98 99 100 101 102 103
        -- * Installed unit ids and modules
        InstalledModule(..),
        InstalledModuleEnv,
        installedModuleEq,
        installedUnitIdEq,
        installedUnitIdString,
        fsToInstalledUnitId,
104
        componentIdToInstalledUnitId,
105 106 107 108 109 110 111
        stringToInstalledUnitId,
        emptyInstalledModuleEnv,
        lookupInstalledModuleEnv,
        extendInstalledModuleEnv,
        filterInstalledModuleEnv,
        delInstalledModuleEnv,
        DefUnitId(..),
Edward Z. Yang's avatar
Edward Z. Yang committed
112

dterei's avatar
dterei committed
113 114
        -- * The ModuleLocation type
        ModLocation(..),
Alec Theriault's avatar
Alec Theriault committed
115 116
        addBootSuffix, addBootSuffix_maybe,
        addBootSuffixLocn, addBootSuffixLocnOut,
dterei's avatar
dterei committed
117 118 119 120 121 122 123 124

        -- * Module mappings
        ModuleEnv,
        elemModuleEnv, extendModuleEnv, extendModuleEnvList,
        extendModuleEnvList_C, plusModuleEnv_C,
        delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
        lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
        moduleEnvKeys, moduleEnvElts, moduleEnvToList,
125
        unitModuleEnv, isEmptyModuleEnv,
niteria's avatar
niteria committed
126
        extendModuleEnvWith, filterModuleEnv,
Simon Marlow's avatar
Simon Marlow committed
127

dterei's avatar
dterei committed
128
        -- * ModuleName mappings
niteria's avatar
niteria committed
129
        ModuleNameEnv, DModuleNameEnv,
Simon Marlow's avatar
Simon Marlow committed
130

dterei's avatar
dterei committed
131
        -- * Sets of Modules
Austin Seipp's avatar
Austin Seipp committed
132
        ModuleSet,
133
        emptyModuleSet, mkModuleSet, moduleSetElts,
134
        extendModuleSet, extendModuleSetList, delModuleSet,
135 136
        elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet,
        unitModuleSet
sof's avatar
sof committed
137 138
    ) where

139 140
import GhcPrelude

sof's avatar
sof committed
141
import Outputable
Simon Marlow's avatar
Simon Marlow committed
142
import Unique
143
import UniqFM
niteria's avatar
niteria committed
144
import UniqDFM
Edward Z. Yang's avatar
Edward Z. Yang committed
145
import UniqDSet
146
import FastString
Simon Marlow's avatar
Simon Marlow committed
147
import Binary
148
import Util
149 150
import Data.List
import Data.Ord
Edward Z. Yang's avatar
Edward Z. Yang committed
151
import GHC.PackageDb (BinaryStringRep(..), DbUnitIdModuleRep(..), DbModule(..), DbUnitId(..))
152
import Fingerprint
Edward Z. Yang's avatar
Edward Z. Yang committed
153 154 155 156 157 158 159 160

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)
161
import Control.DeepSeq
162
import Data.Coerce
163
import Data.Data
Edward Z. Yang's avatar
Edward Z. Yang committed
164
import Data.Function
165
import Data.Map (Map)
166
import Data.Set (Set)
167
import qualified Data.Map as Map
168
import qualified Data.Set as Set
169
import qualified FiniteMap as Map
170
import System.FilePath
sof's avatar
sof committed
171

Edward Z. Yang's avatar
Edward Z. Yang committed
172
import {-# SOURCE #-} DynFlags (DynFlags)
173
import {-# SOURCE #-} Packages (componentIdString, improveUnitId, PackageConfigMap, getPackageConfigMap, displayInstalledUnitId)
Edward Z. Yang's avatar
Edward Z. Yang committed
174

Edward Z. Yang's avatar
Edward Z. Yang committed
175 176
-- Note [The identifier lexicon]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Edward Z. Yang's avatar
Edward Z. Yang committed
177
-- Unit IDs, installed package IDs, ABI hashes, package names,
Edward Z. Yang's avatar
Edward Z. Yang committed
178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193
-- 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
--
194
-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names
Gabor Greif's avatar
Gabor Greif committed
195
-- (ModuleName) to Modules.  This is how the compiler identifies instantiated
196
-- components, and also is the main identifier by which GHC identifies things.
Edward Z. Yang's avatar
Edward Z. Yang committed
197 198 199 200 201 202 203 204 205
--      - 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
206 207 208 209
--      - 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.)
Edward Z. Yang's avatar
Edward Z. Yang committed
210
--
211 212
-- Module/InstalledModule: A UnitId/InstalledUnitId + ModuleName. This is how
-- the compiler identifies modules (e.g. a Name is a Module + OccName)
Edward Z. Yang's avatar
Edward Z. Yang committed
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
--      - 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).

Austin Seipp's avatar
Austin Seipp committed
248 249 250
{-
************************************************************************
*                                                                      *
251
\subsection{Module locations}
Austin Seipp's avatar
Austin Seipp committed
252 253 254
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
255

256 257 258
-- | Module Location
--
-- Where a module lives on the file system: the actual locations
batterseapower's avatar
batterseapower committed
259
-- of the .hs, .hi and .o files, if we have them
260 261 262
data ModLocation
   = ModLocation {
        ml_hs_file   :: Maybe FilePath,
dterei's avatar
dterei committed
263 264
                -- The source file, if we have one.  Package modules
                -- probably don't have source files.
265 266

        ml_hi_file   :: FilePath,
dterei's avatar
dterei committed
267 268 269
                -- 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)
270

Alec Theriault's avatar
Alec Theriault committed
271
        ml_obj_file  :: FilePath,
dterei's avatar
dterei committed
272 273 274 275
                -- 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)
Alec Theriault's avatar
Alec Theriault committed
276
        ml_hie_file  :: FilePath
277
  } deriving Show
278 279 280

instance Outputable ModLocation where
   ppr = text . show
sof's avatar
sof committed
281

Austin Seipp's avatar
Austin Seipp committed
282
{-
283
For a module in another package, the hs_file and obj_file
dterei's avatar
dterei committed
284
components of ModLocation are undefined.
285 286 287 288 289

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.
Austin Seipp's avatar
Austin Seipp committed
290
-}
291

292
addBootSuffix :: FilePath -> FilePath
batterseapower's avatar
batterseapower committed
293
-- ^ Add the @-boot@ suffix to .hs, .hi and .o files
294 295 296
addBootSuffix path = path ++ "-boot"

addBootSuffix_maybe :: Bool -> FilePath -> FilePath
batterseapower's avatar
batterseapower committed
297
-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
298 299 300 301 302
addBootSuffix_maybe is_boot path
 | is_boot   = addBootSuffix path
 | otherwise = path

addBootSuffixLocn :: ModLocation -> ModLocation
batterseapower's avatar
batterseapower committed
303
-- ^ Add the @-boot@ suffix to all file paths associated with the module
304 305
addBootSuffixLocn locn
  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
dterei's avatar
dterei committed
306
         , ml_hi_file  = addBootSuffix (ml_hi_file locn)
Alec Theriault's avatar
Alec Theriault committed
307 308 309 310 311 312 313 314 315 316
         , ml_obj_file = addBootSuffix (ml_obj_file locn)
         , ml_hie_file = addBootSuffix (ml_hie_file locn) }

addBootSuffixLocnOut :: ModLocation -> ModLocation
-- ^ Add the @-boot@ suffix to all output file paths associated with the
-- module, not including the input file itself
addBootSuffixLocnOut locn
  = locn { ml_hi_file  = addBootSuffix (ml_hi_file locn)
         , ml_obj_file = addBootSuffix (ml_obj_file locn)
         , ml_hie_file = addBootSuffix (ml_hie_file locn) }
sof's avatar
sof committed
317

Austin Seipp's avatar
Austin Seipp committed
318 319 320
{-
************************************************************************
*                                                                      *
sof's avatar
sof committed
321
\subsection{The name of a module}
Austin Seipp's avatar
Austin Seipp committed
322 323 324
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
325

batterseapower's avatar
batterseapower committed
326
-- | A ModuleName is essentially a simple string, e.g. @Data.List@.
Simon Marlow's avatar
Simon Marlow committed
327
newtype ModuleName = ModuleName FastString
328

Simon Marlow's avatar
Simon Marlow committed
329 330
instance Uniquable ModuleName where
  getUnique (ModuleName nm) = getUnique nm
331

Simon Marlow's avatar
Simon Marlow committed
332
instance Eq ModuleName where
333 334
  nm1 == nm2 = getUnique nm1 == getUnique nm2

Simon Marlow's avatar
Simon Marlow committed
335
instance Ord ModuleName where
336
  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
337

Simon Marlow's avatar
Simon Marlow committed
338 339
instance Outputable ModuleName where
  ppr = pprModuleName
sof's avatar
sof committed
340

Simon Marlow's avatar
Simon Marlow committed
341 342 343 344
instance Binary ModuleName where
  put_ bh (ModuleName fs) = put_ bh fs
  get bh = do fs <- get bh; return (ModuleName fs)

345 346 347 348
instance BinaryStringRep ModuleName where
  fromStringRep = mkModuleNameFS . mkFastStringByteString
  toStringRep   = fastStringToByteString . moduleNameFS

349 350 351 352 353 354
instance Data ModuleName where
  -- don't traverse?
  toConstr _   = abstractConstr "ModuleName"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "ModuleName"

355 356 357
instance NFData ModuleName where
  rnf x = x `seq` ()

358
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
batterseapower's avatar
batterseapower committed
359
-- ^ Compares module names lexically, rather than by their 'Unique's
360 361
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2

Simon Marlow's avatar
Simon Marlow committed
362
pprModuleName :: ModuleName -> SDoc
dterei's avatar
dterei committed
363
pprModuleName (ModuleName nm) =
364
    getPprStyle $ \ sty ->
dterei's avatar
dterei committed
365
    if codeStyle sty
Ian Lynagh's avatar
Ian Lynagh committed
366
        then ztext (zEncodeFS nm)
dterei's avatar
dterei committed
367
        else ftext nm
368

Simon Marlow's avatar
Simon Marlow committed
369 370
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName mod) = mod
371

Simon Marlow's avatar
Simon Marlow committed
372 373
moduleNameString :: ModuleName -> String
moduleNameString (ModuleName mod) = unpackFS mod
374

niteria's avatar
niteria committed
375 376 377 378 379
-- | 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{..} =
380
  "$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName
niteria's avatar
niteria committed
381

Simon Marlow's avatar
Simon Marlow committed
382 383
mkModuleName :: String -> ModuleName
mkModuleName s = ModuleName (mkFastString s)
384

Simon Marlow's avatar
Simon Marlow committed
385 386
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS s = ModuleName s
387

388 389
-- |Returns the string version of the module name, with dots replaced by slashes.
--
390 391
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
392
  where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
393

Edward Z. Yang's avatar
Edward Z. Yang committed
394
-- |Returns the string version of the module name, with dots replaced by colons.
395 396 397 398
--
moduleNameColons :: ModuleName -> String
moduleNameColons = dots_to_colons . moduleNameString
  where dots_to_colons = map (\c -> if c == '.' then ':' else c)
Simon Marlow's avatar
Simon Marlow committed
399

Austin Seipp's avatar
Austin Seipp committed
400 401 402
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
403
\subsection{A fully qualified module}
Austin Seipp's avatar
Austin Seipp committed
404 405 406
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
407

408
-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
Edward Z. Yang's avatar
Edward Z. Yang committed
409 410 411 412 413 414
--
-- 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.)
--
Simon Marlow's avatar
Simon Marlow committed
415
data Module = Module {
416
   moduleUnitId :: !UnitId,  -- pkg-1.0
417
   moduleName :: !ModuleName  -- A.B.C
Simon Marlow's avatar
Simon Marlow committed
418
  }
419
  deriving (Eq, Ord)
Simon Marlow's avatar
Simon Marlow committed
420

Edward Z. Yang's avatar
Edward Z. Yang committed
421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440
-- | 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 m
    | isHoleModule m = unitUniqDSet (moduleName m)
    | otherwise = unitIdFreeHoles (moduleUnitId m)

-- | A 'Module' is definite if it has no free holes.
moduleIsDefinite :: Module -> Bool
moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles

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

batterseapower's avatar
batterseapower committed
441
instance Uniquable Module where
442
  getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)
batterseapower's avatar
batterseapower committed
443

Simon Marlow's avatar
Simon Marlow committed
444 445 446 447 448 449 450
instance Outputable Module where
  ppr = pprModule

instance Binary Module where
  put_ bh (Module p n) = put_ bh p >> put_ bh n
  get bh = do p <- get bh; n <- get bh; return (Module p n)

451 452 453 454 455 456
instance Data Module where
  -- don't traverse?
  toConstr _   = abstractConstr "Module"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "Module"

457 458 459
instance NFData Module where
  rnf x = x `seq` ()

batterseapower's avatar
batterseapower committed
460 461
-- | 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
462 463
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
dterei's avatar
dterei committed
464
stableModuleCmp (Module p1 n1) (Module p2 n2)
465
   = (p1 `stableUnitIdCmp`  p2) `thenCmp`
466
     (n1 `stableModuleNameCmp` n2)
467

468
mkModule :: UnitId -> ModuleName -> Module
Simon Marlow's avatar
Simon Marlow committed
469 470 471
mkModule = Module

pprModule :: Module -> SDoc
Edward Z. Yang's avatar
Edward Z. Yang committed
472
pprModule mod@(Module p n)  = getPprStyle doc
Simon Marlow's avatar
Simon Marlow committed
473
 where
Edward Z. Yang's avatar
Edward Z. Yang committed
474 475 476
  doc sty
    | codeStyle sty =
        (if p == mainUnitId
Simon Marlow's avatar
Simon Marlow committed
477
                then empty -- never qualify the main package in code
Edward Z. Yang's avatar
Edward Z. Yang committed
478 479 480 481 482 483 484 485
                else ztext (zEncodeFS (unitIdFS p)) <> char '_')
            <> pprModuleName n
    | qualModule sty mod =
        if isHoleModule mod
            then angleBrackets (pprModuleName n)
            else ppr (moduleUnitId mod) <> char ':' <> pprModuleName n
    | otherwise =
        pprModuleName n
486 487 488 489 490 491

class ContainsModule t where
    extractModule :: t -> Module

class HasModule m where
    getModule :: m Module
492

493 494 495 496 497
instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where
  fromDbModule (DbModule uid mod_name)  = mkModule uid mod_name
  fromDbModule (DbModuleVar mod_name)   = mkHoleModule mod_name
  fromDbUnitId (DbUnitId cid insts)     = newUnitId cid insts
  fromDbUnitId (DbInstalledUnitId iuid) = DefiniteUnitId (DefUnitId iuid)
Edward Z. Yang's avatar
Edward Z. Yang committed
498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533
  -- GHC never writes to the database, so it's not needed
  toDbModule = error "toDbModule: not implemented"
  toDbUnitId = 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 (Eq, Ord)

instance BinaryStringRep ComponentId where
  fromStringRep = ComponentId . mkFastStringByteString
  toStringRep (ComponentId s) = fastStringToByteString s

instance Uniquable ComponentId where
  getUnique (ComponentId n) = getUnique n

instance Outputable ComponentId where
  ppr cid@(ComponentId fs) =
    getPprStyle $ \sty ->
    sdocWithDynFlags $ \dflags ->
      case componentIdString dflags cid of
        Just str | not (debugStyle sty) -> text str
        _ -> ftext fs
534

Austin Seipp's avatar
Austin Seipp committed
535 536 537
{-
************************************************************************
*                                                                      *
538
\subsection{UnitId}
Austin Seipp's avatar
Austin Seipp committed
539 540 541
*                                                                      *
************************************************************************
-}
542

543 544 545 546 547 548 549 550 551 552 553 554 555
-- | 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.
Edward Z. Yang's avatar
Edward Z. Yang committed
556
data UnitId
557 558
    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId
Edward Z. Yang's avatar
Edward Z. Yang committed
559 560

unitIdFS :: UnitId -> FastString
561 562
unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x
Edward Z. Yang's avatar
Edward Z. Yang committed
563 564

unitIdKey :: UnitId -> Unique
565 566
unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x
unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x
Edward Z. Yang's avatar
Edward Z. Yang committed
567

568 569 570 571 572
-- | 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.
Edward Z. Yang's avatar
Edward Z. Yang committed
573
--
574
-- An indefinite unit identifier pretty-prints to something like
Edward Z. Yang's avatar
Edward Z. Yang committed
575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595
-- @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).
        indefUnitIdFS :: FastString,
        -- | Cached unique of 'unitIdFS'.
        indefUnitIdKey :: Unique,
        -- | The component identity of the indefinite library that
        -- is being instantiated.
        indefUnitIdComponentId :: !ComponentId,
        -- | The sorted (by 'ModuleName') instantiations of this library.
        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.
        indefUnitIdFreeHoles :: UniqDSet ModuleName
Ryan Scott's avatar
Ryan Scott committed
596
    }
Edward Z. Yang's avatar
Edward Z. Yang committed
597

598 599 600 601 602 603
instance Eq IndefUnitId where
  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2

instance Ord IndefUnitId where
  u1 `compare` u2 = indefUnitIdFS u1 `compare` indefUnitIdFS u2

604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633
instance Binary IndefUnitId where
  put_ bh indef = do
    put_ bh (indefUnitIdComponentId indef)
    put_ bh (indefUnitIdInsts indef)
  get bh = do
    cid   <- get bh
    insts <- get bh
    let fs = hashUnitId cid insts
    return IndefUnitId {
            indefUnitIdComponentId = cid,
            indefUnitIdInsts = insts,
            indefUnitIdFreeHoles = unionManyUniqDSets (map (moduleFreeHoles.snd) insts),
            indefUnitIdFS = fs,
            indefUnitIdKey = getUnique fs
           }

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

634 635 636 637 638 639 640 641 642 643 644 645 646 647
-- | 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 dflags 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.
    improveUnitId (getPackageConfigMap dflags) $
        IndefiniteUnitId iuid

648 649 650
data IndefModule = IndefModule {
        indefModuleUnitId :: IndefUnitId,
        indefModuleName   :: ModuleName
Ryan Scott's avatar
Ryan Scott committed
651
    } deriving (Eq, Ord)
652 653 654 655 656

instance Outputable IndefModule where
  ppr (IndefModule uid m) =
    ppr uid <> char ':' <> ppr m

657 658 659 660 661 662
-- | Injects an 'IndefModule' to 'Module' (see also
-- 'indefUnitIdToUnitId'.
indefModuleToModule :: DynFlags -> IndefModule -> Module
indefModuleToModule dflags (IndefModule iuid mod_name) =
    mkModule (indefUnitIdToUnitId dflags iuid) mod_name

663 664 665 666 667 668 669
-- | 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.
Edward Z. Yang's avatar
Edward Z. Yang committed
670
--
671 672
-- Installed unit identifiers look something like @p+af23SAj2dZ219@,
-- or maybe just @p@ if they don't use Backpack.
673
newtype InstalledUnitId =
674
    InstalledUnitId {
Edward Z. Yang's avatar
Edward Z. Yang committed
675 676
      -- | The full hashed unit identifier, including the component id
      -- and the hash.
677
      installedUnitIdFS :: FastString
Edward Z. Yang's avatar
Edward Z. Yang committed
678 679
    }

680
instance Binary InstalledUnitId where
681 682
  put_ bh (InstalledUnitId fs) = put_ bh fs
  get bh = do fs <- get bh; return (InstalledUnitId fs)
Edward Z. Yang's avatar
Edward Z. Yang committed
683

684
instance BinaryStringRep InstalledUnitId where
685
  fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)
686 687 688 689 690 691 692 693 694 695 696 697 698
  -- GHC doesn't write to database
  toStringRep   = error "BinaryStringRep InstalledUnitId: not implemented"

instance Eq InstalledUnitId where
    uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2

instance Ord InstalledUnitId where
    u1 `compare` u2 = installedUnitIdFS u1 `compare` installedUnitIdFS u2

instance Uniquable InstalledUnitId where
    getUnique = installedUnitIdKey

instance Outputable InstalledUnitId where
699 700 701 702 703 704 705 706 707
    ppr uid@(InstalledUnitId fs) =
        getPprStyle $ \sty ->
        sdocWithDynFlags $ \dflags ->
          case displayInstalledUnitId dflags uid of
            Just str | not (debugStyle sty) -> text str
            _ -> ftext fs

installedUnitIdKey :: InstalledUnitId -> Unique
installedUnitIdKey = getUnique . installedUnitIdFS
708 709 710 711 712

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

installedUnitIdString :: InstalledUnitId -> String
installedUnitIdString = unpackFS . installedUnitIdFS
Edward Z. Yang's avatar
Edward Z. Yang committed
717 718 719 720 721 722 723

instance Outputable IndefUnitId where
    ppr uid =
      -- getPprStyle $ \sty ->
      ppr cid <>
        (if not (null insts) -- pprIf
          then
724
            brackets (hcat
Edward Z. Yang's avatar
Edward Z. Yang committed
725 726
                (punctuate comma $
                    [ ppr modname <> text "=" <> ppr m
727
                    | (modname, m) <- insts]))
Edward Z. Yang's avatar
Edward Z. Yang committed
728 729 730 731 732
          else empty)
     where
      cid   = indefUnitIdComponentId uid
      insts = indefUnitIdInsts uid

733 734 735 736 737 738
-- | A 'InstalledModule' is a 'Module' which contains a 'InstalledUnitId'.
data InstalledModule = InstalledModule {
   installedModuleUnitId :: !InstalledUnitId,
   installedModuleName :: !ModuleName
  }
  deriving (Eq, Ord)
Edward Z. Yang's avatar
Edward Z. Yang committed
739

740 741 742 743 744
instance Outputable InstalledModule where
  ppr (InstalledModule p n) =
    ppr p <> char ':' <> pprModuleName n

fsToInstalledUnitId :: FastString -> InstalledUnitId
745 746 747 748
fsToInstalledUnitId fs = InstalledUnitId fs

componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs
749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764

stringToInstalledUnitId :: String -> InstalledUnitId
stringToInstalledUnitId = fsToInstalledUnitId . mkFastString

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

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

765 766 767 768
-- | 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 { unDefUnitId :: InstalledUnitId }
Ryan Scott's avatar
Ryan Scott committed
769
    deriving (Eq, Ord)
770 771 772 773 774 775 776 777

instance Outputable DefUnitId where
    ppr (DefUnitId uid) = ppr uid

instance Binary DefUnitId where
    put_ bh (DefUnitId uid) = put_ bh uid
    get bh = do uid <- get bh; return (DefUnitId uid)

778 779 780 781 782
-- | A map keyed off of 'InstalledModule'
newtype InstalledModuleEnv elt = InstalledModuleEnv (Map InstalledModule elt)

emptyInstalledModuleEnv :: InstalledModuleEnv a
emptyInstalledModuleEnv = InstalledModuleEnv Map.empty
Edward Z. Yang's avatar
Edward Z. Yang committed
783

784 785
lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
Edward Z. Yang's avatar
Edward Z. Yang committed
786

787 788
extendInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> a -> InstalledModuleEnv a
extendInstalledModuleEnv (InstalledModuleEnv e) m x = InstalledModuleEnv (Map.insert m x e)
Edward Z. Yang's avatar
Edward Z. Yang committed
789

790 791 792 793 794 795
filterInstalledModuleEnv :: (InstalledModule -> a -> Bool) -> InstalledModuleEnv a -> InstalledModuleEnv a
filterInstalledModuleEnv f (InstalledModuleEnv e) =
  InstalledModuleEnv (Map.filterWithKey f e)

delInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> InstalledModuleEnv a
delInstalledModuleEnv (InstalledModuleEnv e) m = InstalledModuleEnv (Map.delete m e)
Edward Z. Yang's avatar
Edward Z. Yang committed
796

797
-- Note [UnitId to InstalledUnitId improvement]
Edward Z. Yang's avatar
Edward Z. Yang committed
798 799
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Just because a UnitId is definite (has no holes) doesn't
800
-- mean it's necessarily a InstalledUnitId; it could just be
Edward Z. Yang's avatar
Edward Z. Yang committed
801 802 803 804 805 806 807 808 809 810 811 812
-- 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).
--
813 814 815 816 817 818 819
-- 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.
Edward Z. Yang's avatar
Edward Z. Yang committed
820 821 822

-- | Retrieve the set of free holes of a 'UnitId'.
unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
823
unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x
Edward Z. Yang's avatar
Edward Z. Yang committed
824
-- Hashed unit ids are always fully instantiated
825
unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet
Edward Z. Yang's avatar
Edward Z. Yang committed
826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844

instance Show UnitId where
    show = unitIdString

-- | A 'UnitId' is definite if it has no free holes.
unitIdIsDefinite :: UnitId -> Bool
unitIdIsDefinite = isEmptyUniqDSet . 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 cid sorted_holes =
    mkFastStringByteString
  . fingerprintUnitId (toStringRep cid)
  $ rawHashUnitId sorted_holes

845
-- | Generate a hash for a sorted module substitution.
Edward Z. Yang's avatar
Edward Z. Yang committed
846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865
rawHashUnitId :: [(ModuleName, Module)] -> Fingerprint
rawHashUnitId sorted_holes =
    fingerprintByteString
  . BS.concat $ do
        (m, b) <- sorted_holes
        [ toStringRep m,                BS.Char8.singleton ' ',
          fastStringToByteString (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
          toStringRep (moduleName b),   BS.Char8.singleton '\n']

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

-- | Create a new, un-hashed unit identifier.
newUnitId :: ComponentId -> [(ModuleName, Module)] -> UnitId
newUnitId cid [] = newSimpleUnitId cid -- TODO: this indicates some latent bug...
866
newUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts
Edward Z. Yang's avatar
Edward Z. Yang committed
867 868

pprUnitId :: UnitId -> SDoc
869 870
pprUnitId (DefiniteUnitId uid) = ppr uid
pprUnitId (IndefiniteUnitId uid) = ppr uid
Edward Z. Yang's avatar
Edward Z. Yang committed
871 872 873

instance Eq UnitId where
  uid1 == uid2 = unitIdKey uid1 == unitIdKey uid2
874

875
instance Uniquable UnitId where
Edward Z. Yang's avatar
Edward Z. Yang committed
876
  getUnique = unitIdKey
877

878
instance Ord UnitId where
879
  nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2
880

881
instance Data UnitId where
882
  -- don't traverse?
883
  toConstr _   = abstractConstr "UnitId"
884
  gunfold _ _  = error "gunfold"
885
  dataTypeOf _ = mkNoRepType "UnitId"
886

887 888 889
instance NFData UnitId where
  rnf x = x `seq` ()

890
stableUnitIdCmp :: UnitId -> UnitId -> Ordering
batterseapower's avatar
batterseapower committed
891
-- ^ Compares package ids lexically, rather than by their 'Unique's
892
stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2
893

894
instance Outputable UnitId where
Edward Z. Yang's avatar
Edward Z. Yang committed
895
   ppr pk = pprUnitId pk
896

Edward Z. Yang's avatar
Edward Z. Yang committed
897
-- Performance: would prefer to have a NameCache like thing
898
instance Binary UnitId where
899 900 901 902
  put_ bh (DefiniteUnitId def_uid) = do
    putByte bh 0
    put_ bh def_uid
  put_ bh (IndefiniteUnitId indef_uid) = do
Edward Z. Yang's avatar
Edward Z. Yang committed
903
    putByte bh 1
904
    put_ bh indef_uid
Edward Z. Yang's avatar
Edward Z. Yang committed
905 906
  get bh = do b <- getByte bh
              case b of
907 908
                0 -> fmap DefiniteUnitId   (get bh)
                _ -> fmap IndefiniteUnitId (get bh)
909

Edward Z. Yang's avatar
Edward Z. Yang committed
910 911 912
instance Binary ComponentId where
  put_ bh (ComponentId fs) = put_ bh fs
  get bh = do { fs <- get bh; return (ComponentId fs) }
913

Edward Z. Yang's avatar
Edward Z. Yang committed
914 915 916 917 918 919 920
-- | Create a new simple unit identifier (no holes) from a 'ComponentId'.
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId (ComponentId fs) = fsToUnitId fs

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

923 924
stringToUnitId :: String -> UnitId
stringToUnitId = fsToUnitId . mkFastString
925

926 927
unitIdString :: UnitId -> String
unitIdString = unpackFS . unitIdFS
928

Edward Z. Yang's avatar
Edward Z. Yang committed
929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970
{-
************************************************************************
*                                                                      *
                        Hole substitutions
*                                                                      *
************************************************************************
-}

-- | Substitution on module variables, mapping module names to module
-- identifiers.
type ShHoleSubst = ModuleNameEnv Module

-- | Substitutes holes in a 'Module'.  NOT suitable for being called
-- directly on a 'nameModule', see Note [Representation of module/name variable].
-- @p[A=<A>]:B@ maps to @p[A=q():A]:B@ with @A=q():A@;
-- similarly, @<A>@ maps to @q():A@.
renameHoleModule :: DynFlags -> ShHoleSubst -> Module -> Module
renameHoleModule dflags = renameHoleModule' (getPackageConfigMap 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 dflags = renameHoleUnitId' (getPackageConfigMap dflags)

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

-- | Like 'renameHoleUnitId, but requires only 'PackageConfigMap'
-- so it can be used by "Packages".
renameHoleUnitId' :: PackageConfigMap -> ShHoleSubst -> UnitId -> UnitId
renameHoleUnitId' pkg_map env uid =
    case uid of
971
      (IndefiniteUnitId
Edward Z. Yang's avatar
Edward Z. Yang committed
972 973 974
        IndefUnitId{ indefUnitIdComponentId = cid
                   , indefUnitIdInsts       = insts
                   , indefUnitIdFreeHoles   = fh })
Sebastian Graf's avatar
Sebastian Graf committed
975
          -> if isNullUFM (intersectUFM_C const (udfmToUfm (getUniqDSet fh)) env)
Edward Z. Yang's avatar
Edward Z. Yang committed
976 977 978 979
                then 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.
980
                -- See Note [UnitId to InstalledUnitId] improvement
Edward Z. Yang's avatar
Edward Z. Yang committed
981 982 983 984 985 986 987 988 989
                else improveUnitId pkg_map $
                        newUnitId cid
                            (map (\(k,v) -> (k, renameHoleModule' pkg_map env v)) insts)
      _ -> uid

-- | Given a possibly on-the-fly instantiated module, split it into
-- a 'Module' that we definitely can find on-disk, as well as an
-- instantiation if we need to instantiate it on the fly.  If the
-- instantiation is @Nothing@ no on-the-fly renaming is needed.
990
splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)
Edward Z. Yang's avatar
Edward Z. Yang committed
991
splitModuleInsts m =
992 993 994
    let (uid, mb_iuid) = splitUnitIdInsts (moduleUnitId m)
    in (InstalledModule uid (moduleName m),
        fmap (\iuid -> IndefModule iuid (moduleName m)) mb_iuid)
Edward Z. Yang's avatar
Edward Z. Yang committed
995 996

-- | See 'splitModuleInsts'.
997
splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)
998
splitUnitIdInsts (IndefiniteUnitId iuid) =
Edward Z. Yang's avatar