HscTypes.hs 118 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(..), FoundHs(..), FindExactResult(..),
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 32 33
        -- (re-exported from DriverPhases)
        HscSource(..), isHsBootOrSig, hscSourceString,

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,
Mateusz Kowalczyk's avatar
Mateusz Kowalczyk committed
70
        emptyIfaceWarnCache,
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,
Gergő Érdi's avatar
Gergő Érdi committed
84
        extendTypeEnv, extendTypeEnvList,
Mateusz Kowalczyk's avatar
Mateusz Kowalczyk committed
85
        extendTypeEnvWithIds,
Gergő Érdi's avatar
Gergő Érdi 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,
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
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
151
import IdInfo           ( IdDetails(..) )
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
Gergő Érdi's avatar
Gergő Érdi committed
159
import ConLike
160
import DataCon
Gergő Érdi's avatar
Gergő Érdi 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 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
    | 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
    pure = return
    (<*>) = ap

instance Monad Hsc where
    return a    = Hsc $ \_ w -> return (a, w)
    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
Ian Lynagh's avatar
Ian Lynagh committed
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.
Ian Lynagh's avatar
Ian Lynagh committed
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" package key 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 681 682 683 684 685 686 687 688 689 690 691 692 693
type FinderCache = ModuleEnv FindExactResult

-- | The result of search for an exact 'Module'.
data FindExactResult
    = FoundExact ModLocation Module
        -- ^ The module/signature was found
    | NoPackageExact PackageKey
    | NotFoundExact
        { fer_paths     :: [FilePath]
        , fer_pkg       :: Maybe PackageKey
        }

-- | A found module or signature; e.g. anything with an interface file
data FoundHs = FoundHs { fr_loc :: ModLocation
                       , fr_mod :: Module
                       -- , fr_origin :: ModuleOrigin
                       }
Simon Marlow's avatar
Simon Marlow committed
694 695 696

-- | The result of searching for an imported module.
data FindResult
697
  = FoundModule FoundHs
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
698
        -- ^ The module was found
699 700
  | FoundSigs [FoundHs] Module
        -- ^ Signatures were found, with some backing implementation
701
  | NoPackage PackageKey
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
702
        -- ^ The requested package was not found
703
  | FoundMultiple [(Module, ModuleOrigin)]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
704
        -- ^ _Error_: both in multiple packages
dterei's avatar
dterei committed
705

dterei's avatar
dterei committed
706 707
        -- | Not found
  | NotFound
708 709
      { fr_paths       :: [FilePath]       -- Places where I looked

710
      , fr_pkg         :: Maybe PackageKey  -- Just p => module is in this package's
711 712 713
                                           --           manifest, but couldn't find
                                           --           the .hi file

714
      , fr_mods_hidden :: [PackageKey]      -- Module is in these packages,
715 716
                                           --   but the *module* is hidden

717
      , fr_pkgs_hidden :: [PackageKey]      -- Module is in these packages,
718 719
                                           --   but the *package* is hidden

720
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
721
      }
Simon Marlow's avatar
Simon Marlow committed
722

Austin Seipp's avatar
Austin Seipp committed
723 724 725
{-
************************************************************************
*                                                                      *
726
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
727 728 729
*                                                                      *
************************************************************************
-}
730

dterei's avatar
dterei committed
731
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
732
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
dterei's avatar
dterei committed
733
-- and can be written out to an interface file. The 'ModDetails is after
734
-- linking and can be completely recovered from just the 'ModIface'.
dterei's avatar
dterei committed
735
--
736 737 738 739
-- 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
740
data ModIface
dterei's avatar
dterei committed
741 742
  = ModIface {
        mi_module     :: !Module,             -- ^ Name of the module we are for
743
        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?
dterei's avatar
dterei committed
744 745
        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface
        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only
746 747
        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags
                                              -- used when compiling this module
748

dterei's avatar
dterei committed
749 750 751
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts     :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
        mi_boot       :: !IsBootInterface,    -- ^ Read from an hi-boot file?
752

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
753 754 755 756
        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
757

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

765
        mi_exports  :: ![IfaceExport],
dterei's avatar
dterei committed
766 767 768
                -- ^ Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
                -- Records the modules that are the declaration points for things
769
                -- exported by this module, and the 'OccName's of those things
dterei's avatar
dterei committed
770

dterei's avatar
dterei committed
771 772
        mi_exp_hash :: !Fingerprint,
                -- ^ Hash of export list
773

dterei's avatar
dterei committed
774 775 776
        mi_used_th  :: !Bool,
                -- ^ Module required TH splices when it was compiled.
                -- This disables recompilation avoidance (see #481).
777

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

dterei's avatar
dterei committed
782
        mi_warns    :: Warnings,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
783 784
                -- ^ Warnings
                -- NOT STRICT!  we read this field lazily from the interface file
785

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

dterei's avatar
dterei committed
790 791 792

        mi_decls    :: [(Fingerprint,IfaceDecl)],
                -- ^ Type, class and variable declarations
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
793 794
                -- The hash of an Id changes if its fixity or deprecations change
                --      (as well as its type of course)
dterei's avatar