Module.hs 46.3 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
        InstalledUnitId(..),
        toInstalledUnitId,
Edward Z. Yang's avatar
Edward Z. Yang committed
39 40 41
        ShHoleSubst,

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

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

Edward Z. Yang's avatar
Edward Z. Yang committed
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
        -- * HOLE renaming
        renameHoleUnitId,
        renameHoleModule,
        renameHoleUnitId',
        renameHoleModule',

        -- * Generalization
        splitModuleInsts,
        splitUnitIdInsts,
        generalizeIndefUnitId,

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

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

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

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

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

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

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

dterei's avatar
dterei committed
129
        -- * Sets of Modules
Austin Seipp's avatar
Austin Seipp committed
130
        ModuleSet,
dterei's avatar
dterei committed
131
        emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
sof's avatar
sof committed
132 133
    ) where

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

import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Char8 as BS.Char8
import System.IO.Unsafe
import Foreign.Ptr (castPtr)
import GHC.Fingerprint
import Encoding

import qualified Text.ParserCombinators.ReadP as Parse
import Text.ParserCombinators.ReadP (ReadP, (<++))
import Data.Char (isAlphaNum)
158
import Control.DeepSeq
159
import Data.Coerce
160
import Data.Data
Edward Z. Yang's avatar
Edward Z. Yang committed
161
import Data.Function
162
import Data.Map (Map)
163
import Data.Set (Set)
164
import qualified Data.Map as Map
165
import qualified Data.Set as Set
166
import qualified FiniteMap as Map
167
import System.FilePath
sof's avatar
sof committed
168

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

Edward Z. Yang's avatar
Edward Z. Yang committed
172 173
-- Note [The identifier lexicon]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Edward Z. Yang's avatar
Edward Z. Yang committed
174
-- Unit IDs, installed package IDs, ABI hashes, package names,
Edward Z. Yang's avatar
Edward Z. Yang committed
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
-- 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
--
191
-- UnitId/InstalledUnitId: A ComponentId + a mapping from hole names
Gabor Greif's avatar
Gabor Greif committed
192
-- (ModuleName) to Modules.  This is how the compiler identifies instantiated
193
-- components, and also is the main identifier by which GHC identifies things.
Edward Z. Yang's avatar
Edward Z. Yang committed
194 195 196 197 198 199 200 201 202
--      - 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
203 204 205 206
--      - 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
207
--
208 209
-- 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
210 211 212 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
--      - 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
245 246 247
{-
************************************************************************
*                                                                      *
248
\subsection{Module locations}
Austin Seipp's avatar
Austin Seipp committed
249 250 251
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
252

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

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

        ml_obj_file  :: FilePath
dterei's avatar
dterei committed
269 270 271 272
                -- 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)
273
  } deriving Show
274 275 276

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

Austin Seipp's avatar
Austin Seipp committed
278
{-
279
For a module in another package, the hs_file and obj_file
dterei's avatar
dterei committed
280
components of ModLocation are undefined.
281 282 283 284 285

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
286
-}
287

288
addBootSuffix :: FilePath -> FilePath
batterseapower's avatar
batterseapower committed
289
-- ^ Add the @-boot@ suffix to .hs, .hi and .o files
290 291 292
addBootSuffix path = path ++ "-boot"

addBootSuffix_maybe :: Bool -> FilePath -> FilePath
batterseapower's avatar
batterseapower committed
293
-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
294 295 296 297 298
addBootSuffix_maybe is_boot path
 | is_boot   = addBootSuffix path
 | otherwise = path

addBootSuffixLocn :: ModLocation -> ModLocation
batterseapower's avatar
batterseapower committed
299
-- ^ Add the @-boot@ suffix to all file paths associated with the module
300 301
addBootSuffixLocn locn
  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
dterei's avatar
dterei committed
302 303
         , ml_hi_file  = addBootSuffix (ml_hi_file locn)
         , ml_obj_file = addBootSuffix (ml_obj_file locn) }
sof's avatar
sof committed
304

Austin Seipp's avatar
Austin Seipp committed
305 306 307
{-
************************************************************************
*                                                                      *
sof's avatar
sof committed
308
\subsection{The name of a module}
Austin Seipp's avatar
Austin Seipp committed
309 310 311
*                                                                      *
************************************************************************
-}
sof's avatar
sof committed
312

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

Simon Marlow's avatar
Simon Marlow committed
316 317
instance Uniquable ModuleName where
  getUnique (ModuleName nm) = getUnique nm
318

Simon Marlow's avatar
Simon Marlow committed
319
instance Eq ModuleName where
320 321
  nm1 == nm2 = getUnique nm1 == getUnique nm2

Simon Marlow's avatar
Simon Marlow committed
322
instance Ord ModuleName where
323
  nm1 `compare` nm2 = stableModuleNameCmp nm1 nm2
324

Simon Marlow's avatar
Simon Marlow committed
325 326
instance Outputable ModuleName where
  ppr = pprModuleName
sof's avatar
sof committed
327

Simon Marlow's avatar
Simon Marlow committed
328 329 330 331
instance Binary ModuleName where
  put_ bh (ModuleName fs) = put_ bh fs
  get bh = do fs <- get bh; return (ModuleName fs)

332 333 334 335
instance BinaryStringRep ModuleName where
  fromStringRep = mkModuleNameFS . mkFastStringByteString
  toStringRep   = fastStringToByteString . moduleNameFS

336 337 338 339 340 341
instance Data ModuleName where
  -- don't traverse?
  toConstr _   = abstractConstr "ModuleName"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "ModuleName"

342 343 344
instance NFData ModuleName where
  rnf x = x `seq` ()

345
stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
batterseapower's avatar
batterseapower committed
346
-- ^ Compares module names lexically, rather than by their 'Unique's
347 348
stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2

Simon Marlow's avatar
Simon Marlow committed
349
pprModuleName :: ModuleName -> SDoc
dterei's avatar
dterei committed
350
pprModuleName (ModuleName nm) =
351
    getPprStyle $ \ sty ->
dterei's avatar
dterei committed
352
    if codeStyle sty
Ian Lynagh's avatar
Ian Lynagh committed
353
        then ztext (zEncodeFS nm)
dterei's avatar
dterei committed
354
        else ftext nm
355

Simon Marlow's avatar
Simon Marlow committed
356 357
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName mod) = mod
358

Simon Marlow's avatar
Simon Marlow committed
359 360
moduleNameString :: ModuleName -> String
moduleNameString (ModuleName mod) = unpackFS mod
361

niteria's avatar
niteria committed
362 363 364 365 366
-- | 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{..} =
367
  "$" ++ unitIdString moduleUnitId ++ "$" ++ moduleNameString moduleName
niteria's avatar
niteria committed
368

Simon Marlow's avatar
Simon Marlow committed
369 370
mkModuleName :: String -> ModuleName
mkModuleName s = ModuleName (mkFastString s)
371

Simon Marlow's avatar
Simon Marlow committed
372 373
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS s = ModuleName s
374

375 376
-- |Returns the string version of the module name, with dots replaced by slashes.
--
377 378
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
379
  where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
380

Edward Z. Yang's avatar
Edward Z. Yang committed
381
-- |Returns the string version of the module name, with dots replaced by colons.
382 383 384 385
--
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
386

Austin Seipp's avatar
Austin Seipp committed
387 388 389
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
390
\subsection{A fully qualified module}
Austin Seipp's avatar
Austin Seipp committed
391 392 393
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
394

395
-- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
Edward Z. Yang's avatar
Edward Z. Yang committed
396 397 398 399 400 401
--
-- 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
402
data Module = Module {
403
   moduleUnitId :: !UnitId,  -- pkg-1.0
404
   moduleName :: !ModuleName  -- A.B.C
Simon Marlow's avatar
Simon Marlow committed
405
  }
406
  deriving (Eq, Ord)
Simon Marlow's avatar
Simon Marlow committed
407

Edward Z. Yang's avatar
Edward Z. Yang committed
408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
-- | 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
428
instance Uniquable Module where
429
  getUnique (Module p n) = getUnique (unitIdFS p `appendFS` moduleNameFS n)
batterseapower's avatar
batterseapower committed
430

Simon Marlow's avatar
Simon Marlow committed
431 432 433 434 435 436 437
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)

438 439 440 441 442 443
instance Data Module where
  -- don't traverse?
  toConstr _   = abstractConstr "Module"
  gunfold _ _  = error "gunfold"
  dataTypeOf _ = mkNoRepType "Module"

444 445 446
instance NFData Module where
  rnf x = x `seq` ()

batterseapower's avatar
batterseapower committed
447 448
-- | 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
449 450
-- not be stable from run to run of the compiler.
stableModuleCmp :: Module -> Module -> Ordering
dterei's avatar
dterei committed
451
stableModuleCmp (Module p1 n1) (Module p2 n2)
452
   = (p1 `stableUnitIdCmp`  p2) `thenCmp`
453
     (n1 `stableModuleNameCmp` n2)
454

455
mkModule :: UnitId -> ModuleName -> Module
Simon Marlow's avatar
Simon Marlow committed
456 457 458
mkModule = Module

pprModule :: Module -> SDoc
Edward Z. Yang's avatar
Edward Z. Yang committed
459
pprModule mod@(Module p n)  = getPprStyle doc
Simon Marlow's avatar
Simon Marlow committed
460
 where
Edward Z. Yang's avatar
Edward Z. Yang committed
461 462 463
  doc sty
    | codeStyle sty =
        (if p == mainUnitId
Simon Marlow's avatar
Simon Marlow committed
464
                then empty -- never qualify the main package in code
Edward Z. Yang's avatar
Edward Z. Yang committed
465 466 467 468 469 470 471 472
                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
473 474 475 476 477 478

class ContainsModule t where
    extractModule :: t -> Module

class HasModule m where
    getModule :: m Module
479

480 481 482 483 484
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
485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520
  -- 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
521

Austin Seipp's avatar
Austin Seipp committed
522 523 524
{-
************************************************************************
*                                                                      *
525
\subsection{UnitId}
Austin Seipp's avatar
Austin Seipp committed
526 527 528
*                                                                      *
************************************************************************
-}
529

530 531 532 533 534 535 536 537 538 539 540 541 542
-- | 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
543
data UnitId
544 545
    = IndefiniteUnitId {-# UNPACK #-} !IndefUnitId
    |   DefiniteUnitId {-# UNPACK #-} !DefUnitId
Edward Z. Yang's avatar
Edward Z. Yang committed
546 547 548
    deriving (Typeable)

unitIdFS :: UnitId -> FastString
549 550
unitIdFS (IndefiniteUnitId x) = indefUnitIdFS x
unitIdFS (DefiniteUnitId (DefUnitId x)) = installedUnitIdFS x
Edward Z. Yang's avatar
Edward Z. Yang committed
551 552

unitIdKey :: UnitId -> Unique
553 554
unitIdKey (IndefiniteUnitId x) = indefUnitIdKey x
unitIdKey (DefiniteUnitId (DefUnitId x)) = installedUnitIdKey x
Edward Z. Yang's avatar
Edward Z. Yang committed
555

556 557 558 559 560
-- | 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
561
--
562
-- An indefinite unit identifier pretty-prints to something like
Edward Z. Yang's avatar
Edward Z. Yang committed
563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585
-- @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
    } deriving (Typeable)

586 587 588 589 590 591
instance Eq IndefUnitId where
  u1 == u2 = indefUnitIdKey u1 == indefUnitIdKey u2

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

592 593 594 595 596 597 598 599 600 601 602 603 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
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

data IndefModule = IndefModule {
        indefModuleUnitId :: IndefUnitId,
        indefModuleName   :: ModuleName
    } deriving (Typeable, Eq, Ord)

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

631 632 633 634 635 636 637
-- | 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
638
--
639 640
-- Installed unit identifiers look something like @p+af23SAj2dZ219@,
-- or maybe just @p@ if they don't use Backpack.
641
newtype InstalledUnitId =
642
    InstalledUnitId {
Edward Z. Yang's avatar
Edward Z. Yang committed
643 644
      -- | The full hashed unit identifier, including the component id
      -- and the hash.
645
      installedUnitIdFS :: FastString
Edward Z. Yang's avatar
Edward Z. Yang committed
646 647 648
    }
   deriving (Typeable)

649
instance Binary InstalledUnitId where
650 651
  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
652

653
instance BinaryStringRep InstalledUnitId where
654
  fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)
655 656 657 658 659 660 661 662 663 664 665 666 667
  -- 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
668 669 670 671 672 673 674 675 676
    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
677 678 679 680 681

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

installedUnitIdString :: InstalledUnitId -> String
installedUnitIdString = unpackFS . installedUnitIdFS
Edward Z. Yang's avatar
Edward Z. Yang committed
686 687 688 689 690 691 692

instance Outputable IndefUnitId where
    ppr uid =
      -- getPprStyle $ \sty ->
      ppr cid <>
        (if not (null insts) -- pprIf
          then
693
            brackets (hcat
Edward Z. Yang's avatar
Edward Z. Yang committed
694 695
                (punctuate comma $
                    [ ppr modname <> text "=" <> ppr m
696
                    | (modname, m) <- insts]))
Edward Z. Yang's avatar
Edward Z. Yang committed
697 698 699 700 701
          else empty)
     where
      cid   = indefUnitIdComponentId uid
      insts = indefUnitIdInsts uid

702 703 704 705 706 707
-- | 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
708

709 710 711 712 713
instance Outputable InstalledModule where
  ppr (InstalledModule p n) =
    ppr p <> char ':' <> pprModuleName n

fsToInstalledUnitId :: FastString -> InstalledUnitId
714 715 716 717
fsToInstalledUnitId fs = InstalledUnitId fs

componentIdToInstalledUnitId :: ComponentId -> InstalledUnitId
componentIdToInstalledUnitId (ComponentId fs) = fsToInstalledUnitId fs
718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733

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

734 735 736 737 738 739 740 741 742 743 744 745 746
-- | 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 }
    deriving (Eq, Ord, Typeable)

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)

747 748 749 750 751
-- | 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
752

753 754
lookupInstalledModuleEnv :: InstalledModuleEnv a -> InstalledModule -> Maybe a
lookupInstalledModuleEnv (InstalledModuleEnv e) m = Map.lookup m e
Edward Z. Yang's avatar
Edward Z. Yang committed
755

756 757
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
758

759 760 761 762 763 764
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
765

766
-- Note [UnitId to InstalledUnitId improvement]
Edward Z. Yang's avatar
Edward Z. Yang committed
767 768
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Just because a UnitId is definite (has no holes) doesn't
769
-- mean it's necessarily a InstalledUnitId; it could just be
Edward Z. Yang's avatar
Edward Z. Yang committed
770 771 772 773 774 775 776 777 778 779 780 781
-- 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).
--
782 783 784 785 786 787 788
-- 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
789 790 791

-- | Retrieve the set of free holes of a 'UnitId'.
unitIdFreeHoles :: UnitId -> UniqDSet ModuleName
792
unitIdFreeHoles (IndefiniteUnitId x) = indefUnitIdFreeHoles x
Edward Z. Yang's avatar
Edward Z. Yang committed
793
-- Hashed unit ids are always fully instantiated
794
unitIdFreeHoles (DefiniteUnitId _) = emptyUniqDSet
Edward Z. Yang's avatar
Edward Z. Yang committed
795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813

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

814
-- | Generate a hash for a sorted module substitution.
Edward Z. Yang's avatar
Edward Z. Yang committed
815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839
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']

fingerprintByteString :: BS.ByteString -> Fingerprint
fingerprintByteString bs = unsafePerformIO
                         . BS.unsafeUseAsCStringLen bs
                         $ \(p,l) -> fingerprintData (castPtr p) l

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...
840
newUnitId cid insts = IndefiniteUnitId $ newIndefUnitId cid insts
Edward Z. Yang's avatar
Edward Z. Yang committed
841 842

pprUnitId :: UnitId -> SDoc
843 844
pprUnitId (DefiniteUnitId uid) = ppr uid
pprUnitId (IndefiniteUnitId uid) = ppr uid
Edward Z. Yang's avatar
Edward Z. Yang committed
845 846 847

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

849
instance Uniquable UnitId where
Edward Z. Yang's avatar
Edward Z. Yang committed
850
  getUnique = unitIdKey
851

852
instance Ord UnitId where
853
  nm1 `compare` nm2 = stableUnitIdCmp nm1 nm2
854

855
instance Data UnitId where
856
  -- don't traverse?
857
  toConstr _   = abstractConstr "UnitId"
858
  gunfold _ _  = error "gunfold"
859
  dataTypeOf _ = mkNoRepType "UnitId"
860

861 862 863
instance NFData UnitId where
  rnf x = x `seq` ()

864
stableUnitIdCmp :: UnitId -> UnitId -> Ordering
batterseapower's avatar
batterseapower committed
865
-- ^ Compares package ids lexically, rather than by their 'Unique's
866
stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2
867

868
instance Outputable UnitId where
Edward Z. Yang's avatar
Edward Z. Yang committed
869
   ppr pk = pprUnitId pk
870

Edward Z. Yang's avatar
Edward Z. Yang committed
871
-- Performance: would prefer to have a NameCache like thing
872
instance Binary UnitId where
873 874 875 876
  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
877
    putByte bh 1
878
    put_ bh indef_uid
Edward Z. Yang's avatar
Edward Z. Yang committed
879 880
  get bh = do b <- getByte bh
              case b of
881 882
                0 -> fmap DefiniteUnitId   (get bh)
                _ -> fmap IndefiniteUnitId (get bh)
883

Edward Z. Yang's avatar
Edward Z. Yang committed
884 885 886
instance Binary ComponentId where
  put_ bh (ComponentId fs) = put_ bh fs
  get bh = do { fs <- get bh; return (ComponentId fs) }
887

Edward Z. Yang's avatar
Edward Z. Yang committed
888 889 890 891 892 893 894
-- | 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
895
fsToUnitId = DefiniteUnitId . DefUnitId . InstalledUnitId
896

897 898
stringToUnitId :: String -> UnitId
stringToUnitId = fsToUnitId . mkFastString
899

900 901
unitIdString :: UnitId -> String
unitIdString = unpackFS . unitIdFS
902

Edward Z. Yang's avatar
Edward Z. Yang committed
903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944
{-
************************************************************************
*                                                                      *
                        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
945
      (IndefiniteUnitId
Edward Z. Yang's avatar
Edward Z. Yang committed
946 947 948 949 950 951 952 953
        IndefUnitId{ indefUnitIdComponentId = cid
                   , indefUnitIdInsts       = insts
                   , indefUnitIdFreeHoles   = fh })
          -> if isNullUFM (intersectUFM_C const (udfmToUfm fh) env)
                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.
954
                -- See Note [UnitId to InstalledUnitId] improvement
Edward Z. Yang's avatar
Edward Z. Yang committed
955 956 957 958 959 960 961 962 963
                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.
964
splitModuleInsts :: Module -> (InstalledModule, Maybe IndefModule)
Edward Z. Yang's avatar
Edward Z. Yang committed
965
splitModuleInsts m =
966 967 968
    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
969 970

-- | See 'splitModuleInsts'.
971
splitUnitIdInsts :: UnitId -> (InstalledUnitId, Maybe IndefUnitId)
972
splitUnitIdInsts (IndefiniteUnitId iuid) =
973
    (componentIdToInstalledUnitId (indefUnitIdComponentId iuid), Just iuid)
974
splitUnitIdInsts (DefiniteUnitId (DefUnitId uid)) = (uid, Nothing)
Edward Z. Yang's avatar
Edward Z. Yang committed
975 976 977 978 979 980 981 982 983 984 985

generalizeIndefUnitId :: IndefUnitId -> IndefUnitId
generalizeIndefUnitId IndefUnitId{ indefUnitIdComponentId = cid
                                 , indefUnitIdInsts = insts } =
    newIndefUnitId cid (map (\(m,_) -> (m, mkHoleModule m)) insts)

parseModuleName :: ReadP ModuleName
parseModuleName = fmap mkModuleName
                $ Parse.munch1 (\c -> isAlphaNum c || c `elem` "_.")

parseUnitId :: ReadP UnitId
986
parseUnitId = parseFullUnitId <++ parseDefiniteUnitId <++ parseSimpleUnitId
Edward Z. Yang's avatar
Edward Z. Yang committed
987
  where
988 989 990 991 992
    parseFullUnitId = do
        cid <- parseComponentId
        insts <- parseModSubst
        return (newUnitId cid insts)
    parseDefiniteUnitId = do
993 994
        s <- Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
        return (stringToUnitId s)
995 996 997
    parseSimpleUnitId = do
        cid <- parseComponentId
        return (newSimpleUnitId cid)
Edward Z. Yang's avatar
Edward Z. Yang committed
998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024

parseComponentId :: ReadP ComponentId
parseComponentId = (ComponentId . mkFastString)  `fmap` Parse.munch1 abi_char
   where abi_char c = isAlphaNum c || c `elem` "-_."

parseModuleId :: ReadP Module
parseModuleId = parseModuleVar <++ parseModule
    where
      parseModuleVar = do
        _ <- Parse.char '<'
        modname <- parseModuleName
        _ <- Parse.char '>'
        return (mkHoleModule modname)
      parseModule = do
        uid <- parseUnitId
        _ <- Parse.char ':'
        modname <- parseModuleName
        return (mkModule uid modname)

parseModSubst :: ReadP [(ModuleName, Module)]
parseModSubst = Parse.between (Parse.char '[') (Parse.char ']')
      . flip Parse.sepBy (Parse.char ',')
      $ do k <- parseModuleName
           _ <- Parse.char '='
           v <- parseModuleId
           return (k, v)

1025 1026

-- -----------------------------------------------------------------------------
batterseapower's avatar
batterseapower committed
1027 1028
-- $wired_in_packages
-- Certain packages are known to the compiler, in that we know about certain
dterei's avatar
dterei committed
1029
-- entities that reside in these packages, and the compiler needs to
1030 1031 1032 1033 1034 1035 1036 1037
-- declare static Modules and Names that refer to these packages.  Hence
-- the wired-in packages can't include version numbers, 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.  However, for each invocation of GHC,
-- only a single instance of each wired-in package will be recognised
Ian Lynagh's avatar
Ian Lynagh committed
1038
-- (the desired one is selected via @-package@\/@-hide-package@), and GHC
Edward Z. Yang's avatar