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

4
\section[HscTypes]{Types for the per-module compiler}
Austin Seipp's avatar
Austin Seipp committed
5
-}
6

7
{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables #-}
8

9
-- | Types for the per-module compiler
dterei's avatar
dterei committed
10
module HscTypes (
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
11
        -- * compilation state
12
        HscEnv(..), hscEPS,
13
        FinderCache, FindResult(..),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
14 15
        Target(..), TargetId(..), pprTarget, pprTargetId,
        ModuleGraph, emptyMG,
16 17 18 19
        HscStatus(..),

        -- * Hsc monad
        Hsc(..), runHsc, runInteractiveHsc,
20

21
        -- * Information about modules
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
22
        ModDetails(..), emptyModDetails,
23
        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
24
        ImportedMods, ImportedModsVal(..),
25

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
26 27
        ModSummary(..), ms_imps, ms_mod_name, showModMsg, isBootSummary,
        msHsFilePath, msHiFilePath, msObjFilePath,
28
        SourceModified(..),
29

30
        -- * Information about the module being compiled
31
        -- (re-exported from DriverPhases)
32
        HscSource(..), isHsBootOrSig, hscSourceString,
33

dterei's avatar
dterei committed
34

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
35 36
        -- * State relating to modules in this package
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
37
        hptInstances, hptRules, hptVectInfo, pprHPT,
38 39
        hptObjs,

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
40 41 42
        -- * State relating to known packages
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
43
        lookupIfaceByModule, emptyModIface, lookupHptByModule,
dterei's avatar
dterei committed
44

45
        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
46

47
        mkSOName, mkHsSOName, soExt,
48

Luite Stegeman's avatar
Luite Stegeman committed
49 50 51 52 53 54
        -- * Metaprogramming
        MetaRequest(..),
        MetaResult, -- data constructors not exported to ensure correct response type
        metaRequestE, metaRequestP, metaRequestT, metaRequestD, metaRequestAW,
        MetaHook,

55 56 57
        -- * Annotations
        prepareAnnotations,

58
        -- * Interactive context
dterei's avatar
dterei committed
59
        InteractiveContext(..), emptyInteractiveContext,
60
        icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,
61 62
        extendInteractiveContext, extendInteractiveContextWithIds,
        substInteractiveContext,
63 64
        setInteractivePrintName, icInteractiveModule,
        InteractiveImport(..), setInteractivePackage,
65
        mkPrintUnqualified, pprModulePrefix,
66
        mkQualPackage, mkQualModule, pkgQual,
67

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
68 69
        -- * Interfaces
        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
70
        emptyIfaceWarnCache, mi_boot,
71

72
        -- * Fixity
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
73
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
74

75
        -- * TyThings and type environments
76
        TyThing(..),  tyThingAvailInfo,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
77
        tyThingTyCon, tyThingDataCon,
78 79 80
        tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyVars,
        implicitTyThings, implicitTyConThings, implicitClassThings,
        isImplicitTyThing,
dterei's avatar
dterei committed
81

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
82
        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
83
        typeEnvFromEntities, mkTypeEnvWithImplicits,
cactus's avatar
cactus committed
84
        extendTypeEnv, extendTypeEnvList,
Mateusz Kowalczyk's avatar
Mateusz Kowalczyk committed
85
        extendTypeEnvWithIds,
cactus's avatar
cactus committed
86 87
        lookupTypeEnv,
        typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
88
        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
89

90 91 92 93
        -- * MonadThings
        MonadThings(..),

        -- * Information on imports and exports
dterei's avatar
dterei committed
94
        WhetherHasOrphans, IsBootInterface, Usage(..),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
95
        Dependencies(..), noDependencies,
96
        NameCache(..), OrigNameCache, updNameCacheIO,
97
        IfaceExport,
98

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
99 100
        -- * Warnings
        Warnings(..), WarningTxt(..), plusWarns,
101

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
102
        -- * Linker stuff
103
        Linkable(..), isObjectLinkable, linkableObjs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
104 105
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
dterei's avatar
dterei committed
106

107
        -- * Program coverage
108
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
109

110
        -- * Breakpoints
111 112
        ModBreaks (..), BreakIndex, emptyModBreaks,

113
        -- * Vectorisation information
dterei's avatar
dterei committed
114
        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
115
        noIfaceVectInfo, isNoIfaceVectInfo,
116

117 118
        -- * Safe Haskell information
        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
119
        trustInfoToNum, numToTrustInfo, IsSafeImport,
120

121 122 123
        -- * result of the parser
        HsParsedModule(..),

124 125 126 127
        -- * Compilation errors and warnings
        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
        throwOneError, handleSourceError,
        handleFlagWarnings, printOrThrowWarnings,
128
    ) where
129 130 131

#include "HsVersions.h"

132
#ifdef GHCI
133
import ByteCodeAsm      ( CompiledByteCode )
134
import InteractiveEvalTypes ( Resume )
135 136
#endif

137
import HsSyn
138
import RdrName
139
import Avail
140
import Module
141
import InstEnv          ( InstEnv, ClsInst, identicalClsInstHead )
142
import FamInstEnv
143
import CoreSyn          ( CoreProgram, RuleBase )
dterei's avatar
dterei committed
144 145
import Name
import NameEnv
dterei's avatar
dterei committed
146
import NameSet
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
147
import VarEnv
148
import VarSet
149
import Var
150
import Id
Matthew Pickering's avatar
Matthew Pickering committed
151
import IdInfo           ( IdDetails(..), RecSelParent(..))
dterei's avatar
dterei committed
152
import Type
153

Alan Zimmerman's avatar
Alan Zimmerman committed
154
import ApiAnnotation    ( ApiAnns )
155
import Annotations      ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
156
import Class
157
import TyCon
158
import CoAxiom
cactus's avatar
cactus committed
159
import ConLike
160
import DataCon
cactus's avatar
cactus committed
161
import PatSyn
162
import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule )
dterei's avatar
dterei committed
163
import Packages hiding  ( Version(..) )
164
import DynFlags
165
import DriverPhases     ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
166
import BasicTypes
167
import IfaceSyn
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
168
import CoreSyn          ( CoreRule, CoreVect )
169
import Maybes
170
import Outputable
171
import BreakArray
Ian Lynagh's avatar
Ian Lynagh committed
172
import SrcLoc
173
-- import Unique
174 175
import UniqFM
import UniqSupply
176
import FastString
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
177
import StringBuffer     ( StringBuffer )
178
import Fingerprint
179
import MonadUtils
180
import Bag
181
import Binary
182
import ErrUtils
183
import Platform
184
import Util
Luite Stegeman's avatar
Luite Stegeman committed
185
import Serialized       ( Serialized )
Simon Marlow's avatar
Simon Marlow committed
186

187
import Control.Monad    ( guard, liftM, when, ap )
188
import Data.Array       ( Array, array )
dterei's avatar
dterei committed
189
import Data.IORef
190
import Data.Time
191
import Data.Word
192
import Data.Typeable    ( Typeable )
dterei's avatar
dterei committed
193 194
import Exception
import System.FilePath
195

196 197 198 199 200 201 202 203 204
-- -----------------------------------------------------------------------------
-- Compilation state
-- -----------------------------------------------------------------------------

-- | Status of a compilation to hard-code
data HscStatus
    = HscNotGeneratingCode
    | HscUpToDate
    | HscUpdateBoot
205
    | HscUpdateSig
206 207 208 209 210 211 212 213 214 215 216
    | HscRecomp CgGuts ModSummary

-- -----------------------------------------------------------------------------
-- The Hsc monad: Passing an environment and warning state

newtype Hsc a = Hsc (HscEnv -> WarningMessages -> IO (a, WarningMessages))

instance Functor Hsc where
    fmap = liftM

instance Applicative Hsc where
217
    pure a = Hsc $ \_ w -> return (a, w)
218 219 220
    (<*>) = ap

instance Monad Hsc where
221
    return = pure
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
    Hsc m >>= k = Hsc $ \e w -> do (a, w1) <- m e w
                                   case k a of
                                       Hsc k' -> k' e w1

instance MonadIO Hsc where
    liftIO io = Hsc $ \_ w -> do a <- io; return (a, w)

instance HasDynFlags Hsc where
    getDynFlags = Hsc $ \e w -> return (hsc_dflags e, w)

runHsc :: HscEnv -> Hsc a -> IO a
runHsc hsc_env (Hsc hsc) = do
    (a, w) <- hsc hsc_env emptyBag
    printOrThrowWarnings (hsc_dflags hsc_env) w
    return a

238
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
239 240
-- A variant of runHsc that switches in the DynFlags from the
-- InteractiveContext before running the Hsc computation.
241 242 243 244
runInteractiveHsc hsc_env
  = runHsc (hsc_env { hsc_dflags = interactive_dflags })
  where
    interactive_dflags = ic_dflags (hsc_IC hsc_env)
245

246 247
-- -----------------------------------------------------------------------------
-- Source Errors
248

249 250
-- When the compiler (HscMain) discovers errors, it throws an
-- exception in the IO monad.
251 252

mkSrcErr :: ErrorMessages -> SourceError
dterei's avatar
dterei committed
253 254
mkSrcErr = SourceError

255
srcErrorMessages :: SourceError -> ErrorMessages
dterei's avatar
dterei committed
256 257
srcErrorMessages (SourceError msgs) = msgs

258
mkApiErr :: DynFlags -> SDoc -> GhcApiError
Ian Lynagh's avatar
Ian Lynagh committed
259
mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
260

261 262 263
throwOneError :: MonadIO m => ErrMsg -> m ab
throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err

264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279
-- | A source error is an error that is caused by one or more errors in the
-- source code.  A 'SourceError' is thrown by many functions in the
-- compilation pipeline.  Inside GHC these errors are merely printed via
-- 'log_action', but API clients may treat them differently, for example,
-- insert them into a list box.  If you want the default behaviour, use the
-- idiom:
--
-- > handleSourceError printExceptionAndWarnings $ do
-- >   ... api calls that may fail ...
--
-- The 'SourceError's error messages can be accessed via 'srcErrorMessages'.
-- This list may be empty if the compiler failed due to @-Werror@
-- ('Opt_WarnIsError').
--
-- See 'printExceptionAndWarnings' for more information on what to take care
-- of when writing a custom error handler.
280 281
newtype SourceError = SourceError ErrorMessages
  deriving Typeable
282 283 284 285 286 287 288 289 290 291 292 293 294 295 296

instance Show SourceError where
  show (SourceError msgs) = unlines . map show . bagToList $ msgs

instance Exception SourceError

-- | Perform the given action and call the exception handler if the action
-- throws a 'SourceError'.  See 'SourceError' for more information.
handleSourceError :: (ExceptionMonad m) =>
                     (SourceError -> m a) -- ^ exception handler
                  -> m a -- ^ action to perform
                  -> m a
handleSourceError handler act =
  gcatch act (\(e :: SourceError) -> handler e)

dterei's avatar
dterei committed
297
-- | An error thrown if the GHC API is used in an incorrect fashion.
298
newtype GhcApiError = GhcApiError String
dterei's avatar
dterei committed
299
  deriving Typeable
300 301

instance Show GhcApiError where
302
  show (GhcApiError msg) = msg
303 304 305

instance Exception GhcApiError

306 307 308 309
-- | Given a bag of warnings, turn them into an exception if
-- -Werror is enabled, or print them out otherwise.
printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
printOrThrowWarnings dflags warns
ian@well-typed.com's avatar
ian@well-typed.com committed
310
  | gopt Opt_WarnIsError dflags
311
  = when (not (isEmptyBag warns)) $ do
312
      throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
313
  | otherwise
314
  = printBagOfErrors dflags warns
315

316
handleFlagWarnings :: DynFlags -> [Located String] -> IO ()
317
handleFlagWarnings dflags warns
318
 = when (wopt Opt_WarnDeprecatedFlags dflags) $ do
319
        -- It would be nicer if warns :: [Located MsgDoc], but that
320
        -- has circular import problems.
321
      let bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
322
                          | L loc warn <- warns ]
323

324
      printOrThrowWarnings dflags bag
325

Austin Seipp's avatar
Austin Seipp committed
326 327 328
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
329
\subsection{HscEnv}
Austin Seipp's avatar
Austin Seipp committed
330 331 332
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
333

334
-- | Hscenv is like 'Session', except that some of the fields are immutable.
335 336 337 338 339 340 341 342 343
-- An HscEnv is used to compile a single module from plain Haskell source
-- code (after preprocessing) to either C, assembly or C--.  Things like
-- the module graph don't change during a single compilation.
--
-- Historical note: \"hsc\" used to be the name of the compiler binary,
-- when there was a separate driver and compiler.  To compile a single
-- module, the driver would invoke hsc on the source code... so nowadays
-- we think of hsc as the layer of the compiler that deals with compiling
-- a single module.
dterei's avatar
dterei committed
344 345
data HscEnv
  = HscEnv {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
346 347 348 349 350 351 352 353 354 355 356 357 358 359
        hsc_dflags :: DynFlags,
                -- ^ The dynamic flag settings

        hsc_targets :: [Target],
                -- ^ The targets (or roots) of the current session

        hsc_mod_graph :: ModuleGraph,
                -- ^ The module graph of the current session

        hsc_IC :: InteractiveContext,
                -- ^ The context for evaluating interactive statements

        hsc_HPT    :: HomePackageTable,
                -- ^ The home package table describes already-compiled
dterei's avatar
dterei committed
360
                -- home-package modules, /excluding/ the module we
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
361 362
                -- are compiling right now.
                -- (In one-shot mode the current module is the only
dterei's avatar
dterei committed
363 364 365 366
                -- home-package module, so hsc_HPT is empty.  All other
                -- modules count as \"external-package\" modules.
                -- However, even in GHCi mode, hi-boot interfaces are
                -- demand-loaded into the external-package table.)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
367
                --
dterei's avatar
dterei committed
368 369
                -- 'hsc_HPT' is not mutable because we only demand-load
                -- external packages; the home package is eagerly
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
370
                -- loaded, module by module, by the compilation manager.
dterei's avatar
dterei committed
371
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
372 373 374
                -- The HPT may contain modules compiled earlier by @--make@
                -- but not actually below the current module in the dependency
                -- graph.
dterei's avatar
dterei committed
375
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
376
                -- (This changes a previous invariant: changed Jan 05.)
dterei's avatar
dterei committed
377

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
378 379 380 381
        hsc_EPS :: {-# UNPACK #-} !(IORef ExternalPackageState),
                -- ^ Information about the currently loaded external packages.
                -- This is mutable because packages will be demand-loaded during
                -- a compilation run as required.
dterei's avatar
dterei committed
382

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
383 384 385 386 387 388 389
        hsc_NC  :: {-# UNPACK #-} !(IORef NameCache),
                -- ^ As with 'hsc_EPS', this is side-effected by compiling to
                -- reflect sucking in interface files.  They cache the state of
                -- external interface files, in effect.

        hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),
                -- ^ The cached result of performing finding in the file system
Simon Marlow's avatar
Simon Marlow committed
390

391
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
392
                -- ^ Used for one-shot compilation only, to initialise
dterei's avatar
dterei committed
393
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
394
                -- 'TcRunTypes.TcGblEnv'
395
 }
396

397 398 399 400
instance ContainsDynFlags HscEnv where
    extractDynFlags env = hsc_dflags env
    replaceDynFlags env dflags = env {hsc_dflags = dflags}

dterei's avatar
dterei committed
401
-- | Retrieve the ExternalPackageState cache.
402 403
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
404

405 406 407 408 409 410
-- | A compilation target.
--
-- A target may be supplied with the actual text of the
-- module.  If so, use this instead of the file contents (this
-- is for use in an IDE where the file hasn't been saved by
-- the user yet).
dterei's avatar
dterei committed
411 412 413 414
data Target
  = Target {
      targetId           :: TargetId, -- ^ module or filename
      targetAllowObjCode :: Bool,     -- ^ object code allowed?
415
      targetContents     :: Maybe (StringBuffer,UTCTime)
416
                                        -- ^ in-memory text buffer?
dterei's avatar
dterei committed
417
    }
418 419

data TargetId
Simon Marlow's avatar
Simon Marlow committed
420
  = TargetModule ModuleName
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
421
        -- ^ A module name: search for the file
422
  | TargetFile FilePath (Maybe Phase)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
423 424 425 426
        -- ^ A filename: preprocess & parse it to find the module name.
        -- If specified, the Phase indicates how to compile this file
        -- (which phase to start from).  Nothing indicates the starting phase
        -- should be determined from the suffix of the filename.
427
  deriving Eq
428 429

pprTarget :: Target -> SDoc
dterei's avatar
dterei committed
430
pprTarget (Target id obj _) =
dterei's avatar
dterei committed
431
    (if obj then char '*' else empty) <> pprTargetId id
432

Ian Lynagh's avatar
Ian Lynagh committed
433 434 435
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
436
pprTargetId :: TargetId -> SDoc
437
pprTargetId (TargetModule m) = ppr m
438
pprTargetId (TargetFile f _) = text f
439

Ian Lynagh's avatar
Ian Lynagh committed
440 441 442
instance Outputable TargetId where
    ppr = pprTargetId

Austin Seipp's avatar
Austin Seipp committed
443 444 445
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
446
\subsection{Package and Module Tables}
Austin Seipp's avatar
Austin Seipp committed
447 448 449
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
450

451
-- | Helps us find information about modules in the home package
Simon Marlow's avatar
Simon Marlow committed
452
type HomePackageTable  = ModuleNameEnv HomeModInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
453
        -- Domain = modules in the home package that have been fully compiled
454
        -- "home" unit id cached here for convenience
455 456

-- | Helps us find information about modules in the imported packages
457
type PackageIfaceTable = ModuleEnv ModIface
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
458
        -- Domain = modules in the imported packages
459

dterei's avatar
dterei committed
460
-- | Constructs an empty HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
461
emptyHomePackageTable :: HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
462
emptyHomePackageTable  = emptyUFM
Simon Marlow's avatar
Simon Marlow committed
463

dterei's avatar
dterei committed
464
-- | Constructs an empty PackageIfaceTable
Simon Marlow's avatar
Simon Marlow committed
465
emptyPackageIfaceTable :: PackageIfaceTable
466 467
emptyPackageIfaceTable = emptyModuleEnv

468 469 470 471 472 473 474 475 476 477 478 479 480 481 482
pprHPT :: HomePackageTable -> SDoc
-- A bit aribitrary for now
pprHPT hpt
  = vcat [ hang (ppr (mi_module (hm_iface hm)))
              2 (ppr (md_types (hm_details hm)))
         | hm <- eltsUFM hpt ]

lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo
-- The HPT is indexed by ModuleName, not Module,
-- we must check for a hit on the right Module
lookupHptByModule hpt mod
  = case lookupUFM hpt (moduleName mod) of
      Just hm | mi_module (hm_iface hm) == mod -> Just hm
      _otherwise                               -> Nothing

483
-- | Information about modules in the package being compiled
dterei's avatar
dterei committed
484
data HomeModInfo
485 486 487 488 489 490
  = HomeModInfo {
      hm_iface    :: !ModIface,
        -- ^ The basic loaded interface file: every loaded module has one of
        -- these, even if it is imported from another package
      hm_details  :: !ModDetails,
        -- ^ Extra information that has been created from the 'ModIface' for
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
491
        -- the module, typically during typechecking
492 493
      hm_linkable :: !(Maybe Linkable)
        -- ^ The actual artifact we would like to link to access things in
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
494 495 496 497 498 499 500 501 502 503 504 505 506 507 508
        -- this module.
        --
        -- 'hm_linkable' might be Nothing:
        --
        --   1. If this is an .hs-boot module
        --
        --   2. Temporarily during compilation if we pruned away
        --      the old linkable because it was out of date.
        --
        -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
        -- in the 'HomePackageTable' will be @Just@.
        --
        -- When re-linking a module ('HscMain.HscNoRecomp'), we construct the
        -- 'HomeModInfo' by building a new 'ModDetails' from the old
        -- 'ModIface' (only).
509
    }
510

511 512
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
Simon Marlow's avatar
Simon Marlow committed
513
lookupIfaceByModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
514 515 516 517 518
        :: DynFlags
        -> HomePackageTable
        -> PackageIfaceTable
        -> Module
        -> Maybe ModIface
519 520 521 522
lookupIfaceByModule _dflags hpt pit mod
  = case lookupHptByModule hpt mod of
       Just hm -> Just (hm_iface hm)
       Nothing -> lookupModuleEnv pit mod
523 524 525 526 527

-- If the module does come from the home package, why do we look in the PIT as well?
-- (a) In OneShot mode, even home-package modules accumulate in the PIT
-- (b) Even in Batch (--make) mode, there is *one* case where a home-package
--     module is in the PIT, namely GHC.Prim when compiling the base package.
528
-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
529
-- of its own, but it doesn't seem worth the bother.
530

531

532 533 534 535
-- | Find all the instance declarations (of classes and families) from
-- the Home Package Table filtered by the provided predicate function.
-- Used in @tcRnImports@, to select the instances that are in the
-- transitive closure of imports from the currently compiled module.
536
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
537
hptInstances hsc_env want_this_module
538 539 540 541 542 543
  = let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
                guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
                let details = hm_details mod_info
                return (md_insts details, md_fam_insts details)
    in (concat insts, concat famInsts)

dterei's avatar
dterei committed
544
-- | Get the combined VectInfo of all modules in the home package table. In
545
-- contrast to instances and rules, we don't care whether the modules are
dterei's avatar
dterei committed
546
-- "below" us in the dependency sense. The VectInfo of those modules not "below"
547
-- us does not affect the compilation of the current module.
dterei's avatar
dterei committed
548
hptVectInfo :: HscEnv -> VectInfo
549
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
550

dterei's avatar
dterei committed
551
-- | Get rules from modules "below" this one (in the dependency sense)
Simon Marlow's avatar
Simon Marlow committed
552
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
553 554
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False

555

dterei's avatar
dterei committed
556
-- | Get annotations from modules "below" this one (in the dependency sense)
557 558 559 560
hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]
hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps
hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env

561 562 563
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))

dterei's avatar
dterei committed
564
-- | Get things from modules "below" this one (in the dependency sense)
565
-- C.f Inst.hptInstances
dterei's avatar
dterei committed
566
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
567
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
dterei's avatar
dterei committed
568 569
  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []

570
  | otherwise
dterei's avatar
dterei committed
571
  = let hpt = hsc_HPT hsc_env
572
    in
573
    [ thing
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
574
    |   -- Find each non-hi-boot module below me
575 576
      (mod, is_boot_mod) <- deps
    , include_hi_boot || not is_boot_mod
577

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
578
        -- unsavoury: when compiling the base package with --make, we
dterei's avatar
dterei committed
579
        -- sometimes try to look up RULES etc for GHC.Prim. GHC.Prim won't
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
580
        -- be in the HPT, because we never compile it; it's in the EPT
dterei's avatar
dterei committed
581
        -- instead. ToDo: clean up, and remove this slightly bogus filter:
Simon Marlow's avatar
Simon Marlow committed
582
    , mod /= moduleName gHC_PRIM
583

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
584
        -- Look it up in the HPT
585
    , let things = case lookupUFM hpt mod of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
586
                    Just info -> extract info
dterei's avatar
dterei committed
587
                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
588 589 590
          msg = vcat [ptext (sLit "missing module") <+> ppr mod,
                      ptext (sLit "Probable cause: out-of-date interface files")]
                        -- This really shouldn't happen, but see Trac #962
591

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
592
        -- And get its dfuns
593
    , thing <- things ]
594 595 596

hptObjs :: HomePackageTable -> [FilePath]
hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
597

Luite Stegeman's avatar
Luite Stegeman committed
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 631 632 633 634 635 636 637 638
{-
************************************************************************
*                                                                      *
\subsection{Metaprogramming}
*                                                                      *
************************************************************************
-}

-- | The supported metaprogramming result types
data MetaRequest
  = MetaE  (LHsExpr RdrName   -> MetaResult)
  | MetaP  (LPat RdrName      -> MetaResult)
  | MetaT  (LHsType RdrName   -> MetaResult)
  | MetaD  ([LHsDecl RdrName] -> MetaResult)
  | MetaAW (Serialized        -> MetaResult)

-- | data constructors not exported to ensure correct result type
data MetaResult
  = MetaResE  { unMetaResE  :: LHsExpr RdrName   }
  | MetaResP  { unMetaResP  :: LPat RdrName      }
  | MetaResT  { unMetaResT  :: LHsType RdrName   }
  | MetaResD  { unMetaResD  :: [LHsDecl RdrName] }
  | MetaResAW { unMetaResAW :: Serialized        }

type MetaHook f = MetaRequest -> LHsExpr Id -> f MetaResult

metaRequestE :: Functor f => MetaHook f -> LHsExpr Id -> f (LHsExpr RdrName)
metaRequestE h = fmap unMetaResE . h (MetaE MetaResE)

metaRequestP :: Functor f => MetaHook f -> LHsExpr Id -> f (LPat RdrName)
metaRequestP h = fmap unMetaResP . h (MetaP MetaResP)

metaRequestT :: Functor f => MetaHook f -> LHsExpr Id -> f (LHsType RdrName)
metaRequestT h = fmap unMetaResT . h (MetaT MetaResT)

metaRequestD :: Functor f => MetaHook f -> LHsExpr Id -> f [LHsDecl RdrName]
metaRequestD h = fmap unMetaResD . h (MetaD MetaResD)

metaRequestAW :: Functor f => MetaHook f -> LHsExpr Id -> f Serialized
metaRequestAW h = fmap unMetaResAW . h (MetaAW MetaResAW)

Austin Seipp's avatar
Austin Seipp committed
639 640 641
{-
************************************************************************
*                                                                      *
642
\subsection{Dealing with Annotations}
Austin Seipp's avatar
Austin Seipp committed
643 644 645
*                                                                      *
************************************************************************
-}
646

dterei's avatar
dterei committed
647
-- | Deal with gathering annotations in from all possible places
648
--   and combining them into a single 'AnnEnv'
dterei's avatar
dterei committed
649 650 651 652 653
prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
prepareAnnotations hsc_env mb_guts = do
    eps <- hscEPS hsc_env
    let -- Extract annotations from the module being compiled if supplied one
        mb_this_module_anns = fmap (mkAnnEnv . mg_anns) mb_guts
654 655 656
        -- Extract dependencies of the module if we are supplied one,
        -- otherwise load annotations from all home package table
        -- entries regardless of dependency ordering.
dterei's avatar
dterei committed
657 658
        home_pkg_anns  = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
        other_pkg_anns = eps_ann_env eps
dterei's avatar
dterei committed
659 660
        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
                                                         Just home_pkg_anns,
dterei's avatar
dterei committed
661 662
                                                         Just other_pkg_anns]
    return ann_env
663

Austin Seipp's avatar
Austin Seipp committed
664 665 666
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
667
\subsection{The Finder cache}
Austin Seipp's avatar
Austin Seipp committed
668 669 670
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
671

672
-- | The 'FinderCache' maps modules to the result of
dterei's avatar
dterei committed
673 674
-- searching for that module. It records the results of searching for
-- modules along the search path. On @:load@, we flush the entire
Simon Marlow's avatar
Simon Marlow committed
675 676
-- contents of this cache.
--
677 678 679 680
-- Although the @FinderCache@ range is 'FindResult' for convenience,
-- in fact it will only ever contain 'Found' or 'NotFound' entries.
--
type FinderCache = ModuleEnv FindResult
Simon Marlow's avatar
Simon Marlow committed
681 682 683

-- | The result of searching for an imported module.
data FindResult
684
  = Found ModLocation Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
685
        -- ^ The module was found
686
  | NoPackage UnitId
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
687
        -- ^ The requested package was not found
688
  | FoundMultiple [(Module, ModuleOrigin)]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
689
        -- ^ _Error_: both in multiple packages
dterei's avatar
dterei committed
690

dterei's avatar
dterei committed
691 692
        -- | Not found
  | NotFound
693 694
      { fr_paths       :: [FilePath]       -- Places where I looked

695
      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's
696 697 698
                                           --           manifest, but couldn't find
                                           --           the .hi file

699
      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,
700 701
                                           --   but the *module* is hidden

702
      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,
703 704
                                           --   but the *package* is hidden

705
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
706
      }
Simon Marlow's avatar
Simon Marlow committed
707

Austin Seipp's avatar
Austin Seipp committed
708 709 710
{-
************************************************************************
*                                                                      *
711
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
712 713 714
*                                                                      *
************************************************************************
-}
715

dterei's avatar
dterei committed
716
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
717
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
dterei's avatar
dterei committed
718
-- and can be written out to an interface file. The 'ModDetails is after
719
-- linking and can be completely recovered from just the 'ModIface'.
dterei's avatar
dterei committed
720
--
721 722 723 724
-- When we read an interface file, we also construct a 'ModIface' from it,
-- except that we explicitly make the 'mi_decls' and a few other fields empty;
-- as when reading we consolidate the declarations etc. into a number of indexed
-- maps and environments in the 'ExternalPackageState'.
dterei's avatar
dterei committed
725
data ModIface
dterei's avatar
dterei committed
726 727
  = ModIface {
        mi_module     :: !Module,             -- ^ Name of the module we are for
728
        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?
dterei's avatar
dterei committed
729 730
        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface
        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only
731 732
        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags
                                              -- used when compiling this module
733

dterei's avatar
dterei committed
734 735
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts     :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
736
        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?
737

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
738 739 740 741
        mi_deps     :: Dependencies,
                -- ^ The dependencies of the module.  This is
                -- consulted for directly-imported modules, but not
                -- for anything else (hence lazy)
Simon Marlow's avatar
Simon Marlow committed
742

743 744
        mi_usages   :: [Usage],
                -- ^ Usages; kept sorted so that it's easy to decide
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
745 746 747 748
                -- whether to write a new iface file (changing usages
                -- doesn't affect the hash of this module)
                -- NOT STRICT!  we read this field lazily from the interface file
                -- It is *only* consulted by the recompilation checker
749

750
        mi_exports  :: ![IfaceExport],
dterei's avatar
dterei committed
751 752 753
                -- ^ Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
                -- Records the modules that are the declaration points for things
754
                -- exported by this module, and the 'OccName's of those things
dterei's avatar
dterei committed
755

dterei's avatar
dterei committed
756 757
        mi_exp_hash :: !Fingerprint,
                -- ^ Hash of export list
758

dterei's avatar
dterei committed
759 760 761
        mi_used_th  :: !Bool,
                -- ^ Module required TH splices when it was compiled.
                -- This disables recompilation avoidance (see #481).
762

763
        mi_fixities :: [(OccName,Fixity)],
764
                -- ^ Fixities
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
765
                -- NOT STRICT!  we read this field lazily from the interface file
766

dterei's avatar
dterei committed
767
        mi_warns    :: Warnings,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
768 769
                -- ^ Warnings
                -- NOT STRICT!  we read this field lazily from the interface file
770

dterei's avatar
dterei committed
771
        mi_anns     :: [IfaceAnnotation],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
772 773
                -- ^ Annotations
                -- NOT STRICT!  we read this field lazily from the interface file
774

dterei's avatar
dterei committed
775 776 777

        mi_decls    :: [(Fingerprint,IfaceDecl)],
                -- ^ Type, class and variable declarations
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
778 779
                -- The hash of an Id changes if its fixity or deprecations change
                --      (as well as its type of course)
dterei's avatar
dterei committed
780
                -- Ditto data constructors, class operations, except that
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
781
                -- the hash of the parent class/tycon changes
782

783
        mi_globals  :: !(Maybe GlobalRdrEnv),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
784 785 786 787 788 789 790 791 792 793 794 795 796 797 798
                -- ^ Binds all the things defined at the top level in
                -- the /original source/ code for this module. which
                -- is NOT the same as mi_exports, nor mi_decls (which
                -- may contains declarations for things not actually
                -- defined by the user).  Used for GHCi and for inspecting
                -- the contents of modules via the GHC API only.
                --
                -- (We need the source file to figure out the
                -- top-level environment, if we didn't compile this module
                -- from source then this field contains @Nothing@).
                --
                -- Strictly speaking this field should live in the
                -- 'HomeModInfo', but that leads to more plumbing.

                -- Instance declarations and rules
799
        mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance
dterei's avatar
dterei committed
800 801
        mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances
        mi_rules       :: [IfaceRule],     -- ^ Sorted rules
802 803
        mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules, class and family
                                           -- instances, and vectorise pragmas combined
804

dterei's avatar
dterei committed
805
        mi_vect_info :: !IfaceVectInfo,    -- ^ Vectorisation information
806

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
807 808 809
                -- Cached environments for easy lookup
                -- These are computed (lazily) from other fields
                -- and are not put into the interface file
dterei's avatar
dterei committed
810
        mi_warn_fn   :: Name -> Maybe WarningTxt,        -- ^ Cached lookup for 'mi_warns'
811
        mi_fix_fn    :: OccName -> Fixity,               -- ^ Cached lookup for 'mi_fixities'
dterei's avatar
dterei committed
812 813 814 815 816 817 818 819
        mi_hash_fn   :: OccName -> Maybe (OccName, Fingerprint),
                -- ^ Cached lookup for 'mi_decls'.
                -- The @Nothing@ in 'mi_hash_fn' means that the thing
                -- isn't in decls. It's useful to know that when
                -- seeing if we are up to date wrt. the old interface.
                -- The 'OccName' is the parent of the name, if it has one.

        mi_hpc       :: !AnyHpcUsage,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
820
                -- ^ True if this program uses Hpc at any point in the program.
dterei's avatar
dterei committed
821 822

        mi_trust     :: !IfaceTrustInfo,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
823
                -- ^ Safe Haskell Trust information for this module.
dterei's avatar
dterei committed
824

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
825 826 827 828 829 830
        mi_trust_pkg :: !Bool
                -- ^ Do we require the package this module resides in be trusted
                -- to trust this module? This is used for the situation where a
                -- module is Safe (so doesn't require the package be trusted
                -- itself) but imports some trustworthy modules from its own
                -- package (which does require its own package be trusted).
831
                -- See Note [RnNames . Trust Own Package]
832
     }
833

834 835 836 837 838
-- | Old-style accessor for whether or not the ModIface came from an hs-boot
-- file.
mi_boot :: ModIface -> Bool
mi_boot iface = mi_hsc_src iface == HsBootFile

839 840 841
instance Binary ModIface where
   put_ bh (ModIface {
                 mi_module    = mod,
842
                 mi_sig_of    = sig_of,
843
                 mi_hsc_src   = hsc_src,
844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866
                 mi_iface_hash= iface_hash,
                 mi_mod_hash  = mod_hash,
                 mi_flag_hash = flag_hash,
                 mi_orphan    = orphan,
                 mi_finsts    = hasFamInsts,
                 mi_deps      = deps,
                 mi_usages    = usages,
                 mi_exports   = exports,
                 mi_exp_hash  = exp_hash,
                 mi_used_th   = used_th,
                 mi_fixities  = fixities,
                 mi_warns     = warns,
                 mi_anns      = anns,
                 mi_decls     = decls,
                 mi_insts     = insts,
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,
                 mi_orphan_hash = orphan_hash,
                 mi_vect_info = vect_info,
                 mi_hpc       = hpc_info,
                 mi_trust     = trust,
                 mi_trust_pkg = trust_pkg }) = do
        put_ bh mod
867
        put_ bh hsc_src
868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889
        put_ bh iface_hash
        put_ bh mod_hash
        put_ bh flag_hash
        put_ bh orphan
        put_ bh hasFamInsts
        lazyPut bh deps
        lazyPut bh usages
        put_ bh exports
        put_ bh exp_hash
        put_ bh used_th
        put_ bh fixities
        lazyPut bh warns
        lazyPut bh anns
        put_ bh decls
        put_ bh insts
        put_ bh fam_insts
        lazyPut bh rules
        put_ bh orphan_hash
        put_ bh vect_info
        put_ bh hpc_info
        put_ bh trust
        put_ bh trust_pkg
890
        put_ bh sig_of
891 892 893

   get bh = do
        mod_name    <- get bh
894
        hsc_src     <- get bh
895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916
        iface_hash  <- get bh
        mod_hash    <- get bh
        flag_hash   <- get bh
        orphan      <- get bh
        hasFamInsts <- get bh
        deps        <- lazyGet bh
        usages      <- {-# SCC "bin_usages" #-} lazyGet bh
        exports     <- {-# SCC "bin_exports" #-} get bh
        exp_hash    <- get bh
        used_th     <- get bh
        fixities    <- {-# SCC "bin_fixities" #-} get bh
        warns       <- {-# SCC "bin_warns" #-} lazyGet bh
        anns        <- {-# SCC "bin_anns" #-} lazyGet bh
        decls       <- {-# SCC "bin_tycldecls" #-} get bh
        insts       <- {-# SCC "bin_insts" #-} get bh
        fam_insts   <- {-# SCC "bin_fam_insts" #-} get bh
        rules       <- {-# SCC "bin_rules" #-} lazyGet bh
        orphan_hash <- get bh
        vect_info   <- get bh
        hpc_info    <- get bh
        trust       <- get bh
        trust_pkg   <- get bh
917
        sig_of      <- get bh
918 919
        return (ModIface {
                 mi_module      = mod_name,
920
                 mi_sig_of      = sig_of,
921
                 mi_hsc_src     = hsc_src,
922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949
                 mi_iface_hash  = iface_hash,
                 mi_mod_hash    = mod_hash,
                 mi_flag_hash   = flag_hash,
                 mi_orphan      = orphan,
                 mi_finsts      = hasFamInsts,
                 mi_deps        = deps,
                 mi_usages      = usages,
                 mi_exports     = exports,
                 mi_exp_hash    = exp_hash,
                 mi_used_th     = used_th,
                 mi_anns        = anns,
                 mi_fixities    = fixities,
                 mi_warns       = warns,
                 mi_decls       = decls,
                 mi_globals     = Nothing,
                 mi_insts       = insts,
                 mi_fam_insts   = fam_insts,
                 mi_rules       = rules,
                 mi_orphan_hash = orphan_hash,
                 mi_vect_info   = vect_info,
                 mi_hpc         = hpc_info,
                 mi_trust       = trust,
                 mi_trust_pkg   = trust_pkg,
                        -- And build the cached values
                 mi_warn_fn     = mkIfaceWarnCache warns,
                 mi_fix_fn      = mkIfaceFixCache fixities,
                 mi_hash_fn     = mkIfaceHashCache decls })

950 951 952
-- | The original names declared of a certain module that are exported
type IfaceExport = AvailInfo

dterei's avatar
dterei committed
953 954 955 956
-- | Constructs an empty ModIface
emptyModIface :: Module -> ModIface
emptyModIface mod
  = ModIface { mi_module      = mod,
957
               mi_sig_of      = Nothing,
dterei's avatar
dterei committed
958 959
               mi_iface_hash  = fingerprint0,
               mi_mod_hash    = fingerprint0,
960
               mi_flag_hash   = fingerprint0,
dterei's avatar
dterei committed
961 962
               mi_orphan      = False,
               mi_finsts      = False,
963
               mi_hsc_src     = HsSrcFile,
dterei's avatar
dterei committed
964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983
               mi_deps        = noDependencies,
               mi_usages      = [],
               mi_exports     = [],
               mi_exp_hash    = fingerprint0,
               mi_used_th     = False,
               mi_fixities    = [],
               mi_warns       = NoWarnings,
               mi_anns        = [],
               mi_insts       = [],
               mi_fam_insts   = [],
               mi_rules       = [],
               mi_decls       = [],
               mi_globals     = Nothing,
               mi_orphan_hash = fingerprint0,
               mi_vect_info   = noIfaceVectInfo,
               mi_warn_fn     = emptyIfaceWarnCache,
               mi_fix_fn      = emptyIfaceFixCache,
               mi_hash_fn     = emptyIfaceHashCache,
               mi_hpc         = False,
               mi_trust       = noIfaceTrustInfo,
dterei's avatar
dterei committed
984
               mi_trust_pkg   = False }
dterei's avatar
dterei committed
985

986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001

-- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface'
mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]
                 -> (OccName -> Maybe (OccName, Fingerprint))
mkIfaceHashCache pairs
  = \occ -> lookupOccEnv env occ
  where
    env = foldr add_decl emptyOccEnv pairs
    add_decl (v,d) env0 = foldr add env0 (ifaceDeclFingerprints v d)
      where
        add (occ,hash) env0 = extendOccEnv env0 occ (occ,hash)

emptyIfaceHashCache :: OccName -> Maybe (OccName, Fingerprint)
emptyIfaceHashCache _occ = Nothing


1002 1003 1004
-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
-- for home modules only. Information relating to packages will be loaded into
-- global environments in 'ExternalPackageState'.
1005
data ModDetails
dterei's avatar
dterei committed
1006
  = ModDetails {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
1007 1008
        -- The next two fields are created by the typechecker
        md_exports   :: [AvailInfo],
1009
        md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module
Simon Peyton Jones's avatar