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
        HscStatus(..),
17
18
19
#ifdef GHCI
        IServ(..),
#endif
20
21
22

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

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

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

33
        -- * Information about the module being compiled
34
        -- (re-exported from DriverPhases)
35
        HscSource(..), isHsBootOrSig, hscSourceString,
36

dterei's avatar
dterei committed
37

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

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

48
        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
49

50
        mkSOName, mkHsSOName, soExt,
51

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

58
59
60
        -- * Annotations
        prepareAnnotations,

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
71
72
        -- * Interfaces
        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
73
        emptyIfaceWarnCache, mi_boot, mi_fix,
74

75
        -- * Fixity
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
76
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
77

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
85
        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
86
        typeEnvFromEntities, mkTypeEnvWithImplicits,
Gergő Érdi's avatar
Gergő Érdi committed
87
        extendTypeEnv, extendTypeEnvList,
Mateusz Kowalczyk's avatar
Mateusz Kowalczyk committed
88
        extendTypeEnvWithIds,
Gergő Érdi's avatar
Gergő Érdi committed
89
90
        lookupTypeEnv,
        typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
91
        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
92

93
94
95
96
        -- * MonadThings
        MonadThings(..),

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
102
103
        -- * Warnings
        Warnings(..), WarningTxt(..), plusWarns,
104

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

110
        -- * Program coverage
111
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
112

113
        -- * Breakpoints
114
        ModBreaks (..), emptyModBreaks,
115

116
        -- * Vectorisation information
dterei's avatar
dterei committed
117
        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
118
        noIfaceVectInfo, isNoIfaceVectInfo,
119

120
121
        -- * Safe Haskell information
        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
122
        trustInfoToNum, numToTrustInfo, IsSafeImport,
123

124
125
126
        -- * result of the parser
        HsParsedModule(..),

127
128
129
130
        -- * Compilation errors and warnings
        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
        throwOneError, handleSourceError,
        handleFlagWarnings, printOrThrowWarnings,
131
    ) where
132
133
134

#include "HsVersions.h"

135
#ifdef GHCI
136
import ByteCodeTypes
137
import InteractiveEvalTypes ( Resume )
138
import GHCi.Message         ( Pipe )
139
import GHCi.RemoteTypes
140
141
#endif

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

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

193
import Foreign
194
import Control.Monad    ( guard, liftM, when, ap )
195
import Control.Concurrent
dterei's avatar
dterei committed
196
import Data.IORef
197
import Data.Time
198
import Data.Typeable    ( Typeable )
dterei's avatar
dterei committed
199
200
import Exception
import System.FilePath
201
import System.Process   ( ProcessHandle )
202

203
204
205
206
207
208
209
210
211
-- -----------------------------------------------------------------------------
-- Compilation state
-- -----------------------------------------------------------------------------

-- | Status of a compilation to hard-code
data HscStatus
    = HscNotGeneratingCode
    | HscUpToDate
    | HscUpdateBoot
212
    | HscUpdateSig
213
214
215
216
217
218
219
220
221
222
223
    | 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
224
    pure a = Hsc $ \_ w -> return (a, w)
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
    (<*>) = ap

instance Monad Hsc where
    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

244
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
245
246
-- A variant of runHsc that switches in the DynFlags from the
-- InteractiveContext before running the Hsc computation.
247
248
249
250
runInteractiveHsc hsc_env
  = runHsc (hsc_env { hsc_dflags = interactive_dflags })
  where
    interactive_dflags = ic_dflags (hsc_IC hsc_env)
251

252
253
-- -----------------------------------------------------------------------------
-- Source Errors
254

255
256
-- When the compiler (HscMain) discovers errors, it throws an
-- exception in the IO monad.
257
258

mkSrcErr :: ErrorMessages -> SourceError
dterei's avatar
dterei committed
259
260
mkSrcErr = SourceError

261
srcErrorMessages :: SourceError -> ErrorMessages
dterei's avatar
dterei committed
262
263
srcErrorMessages (SourceError msgs) = msgs

264
mkApiErr :: DynFlags -> SDoc -> GhcApiError
Ian Lynagh's avatar
Ian Lynagh committed
265
mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
266

267
268
269
throwOneError :: MonadIO m => ErrMsg -> m ab
throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err

270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
-- | 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.
286
287
newtype SourceError = SourceError ErrorMessages
  deriving Typeable
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

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
303
-- | An error thrown if the GHC API is used in an incorrect fashion.
304
newtype GhcApiError = GhcApiError String
dterei's avatar
dterei committed
305
  deriving Typeable
306
307

instance Show GhcApiError where
308
  show (GhcApiError msg) = msg
309
310
311

instance Exception GhcApiError

312
313
314
315
-- | 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
316
  | gopt Opt_WarnIsError dflags
317
  = when (not (isEmptyBag warns)) $ do
Ian Lynagh's avatar
Ian Lynagh committed
318
      throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
319
  | otherwise
320
  = printBagOfErrors dflags warns
321

322
handleFlagWarnings :: DynFlags -> [Located String] -> IO ()
323
handleFlagWarnings dflags warns
324
 = when (wopt Opt_WarnDeprecatedFlags dflags) $ do
325
        -- It would be nicer if warns :: [Located MsgDoc], but that
326
        -- has circular import problems.
Ian Lynagh's avatar
Ian Lynagh committed
327
      let bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
328
                          | L loc warn <- warns ]
329

330
      printOrThrowWarnings dflags bag
331

Austin Seipp's avatar
Austin Seipp committed
332
333
334
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
335
\subsection{HscEnv}
Austin Seipp's avatar
Austin Seipp committed
336
337
338
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
339

340
-- | HscEnv is like 'Session', except that some of the fields are immutable.
341
342
343
344
345
346
347
348
349
-- 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
350
351
data HscEnv
  = HscEnv {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
352
353
354
355
356
357
358
359
360
361
362
363
364
365
        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
366
                -- home-package modules, /excluding/ the module we
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
367
368
                -- are compiling right now.
                -- (In one-shot mode the current module is the only
dterei's avatar
dterei committed
369
370
371
372
                -- 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
373
                --
dterei's avatar
dterei committed
374
375
                -- '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
376
                -- loaded, module by module, by the compilation manager.
dterei's avatar
dterei committed
377
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
378
379
380
                -- 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
381
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
382
                -- (This changes a previous invariant: changed Jan 05.)
dterei's avatar
dterei committed
383

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
384
385
386
387
        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
388

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
389
390
391
392
393
394
395
        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
396

397
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
398
                -- ^ Used for one-shot compilation only, to initialise
dterei's avatar
dterei committed
399
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
400
                -- 'TcRunTypes.TcGblEnv'
401
402
403
404
405
406

#ifdef GHCI
        , hsc_iserv :: MVar (Maybe IServ)
                -- ^ interactive server process.  Created the first
                -- time it is needed.
#endif
407
 }
408

409
410
411
412
instance ContainsDynFlags HscEnv where
    extractDynFlags env = hsc_dflags env
    replaceDynFlags env dflags = env {hsc_dflags = dflags}

413
414
415
416
417
418
419
420
421
#ifdef GHCI
data IServ = IServ
  { iservPipe :: Pipe
  , iservProcess :: ProcessHandle
  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
  , iservPendingFrees :: [HValueRef]
  }
#endif

dterei's avatar
dterei committed
422
-- | Retrieve the ExternalPackageState cache.
423
424
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
425

426
427
428
429
430
431
-- | 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
432
433
434
435
data Target
  = Target {
      targetId           :: TargetId, -- ^ module or filename
      targetAllowObjCode :: Bool,     -- ^ object code allowed?
436
      targetContents     :: Maybe (StringBuffer,UTCTime)
437
                                        -- ^ in-memory text buffer?
dterei's avatar
dterei committed
438
    }
439
440

data TargetId
Simon Marlow's avatar
Simon Marlow committed
441
  = TargetModule ModuleName
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
442
        -- ^ A module name: search for the file
443
  | TargetFile FilePath (Maybe Phase)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
444
445
446
447
        -- ^ 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.
448
  deriving Eq
449
450

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

Ian Lynagh's avatar
Ian Lynagh committed
454
455
456
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
457
pprTargetId :: TargetId -> SDoc
458
pprTargetId (TargetModule m) = ppr m
459
pprTargetId (TargetFile f _) = text f
460

Ian Lynagh's avatar
Ian Lynagh committed
461
462
463
instance Outputable TargetId where
    ppr = pprTargetId

Austin Seipp's avatar
Austin Seipp committed
464
465
466
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
467
\subsection{Package and Module Tables}
Austin Seipp's avatar
Austin Seipp committed
468
469
470
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
471

472
-- | Helps us find information about modules in the home package
Simon Marlow's avatar
Simon Marlow committed
473
type HomePackageTable  = ModuleNameEnv HomeModInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
474
        -- Domain = modules in the home package that have been fully compiled
475
        -- "home" unit id cached here for convenience
476
477

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

dterei's avatar
dterei committed
481
-- | Constructs an empty HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
482
emptyHomePackageTable :: HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
483
emptyHomePackageTable  = emptyUFM
Simon Marlow's avatar
Simon Marlow committed
484

dterei's avatar
dterei committed
485
-- | Constructs an empty PackageIfaceTable
Simon Marlow's avatar
Simon Marlow committed
486
emptyPackageIfaceTable :: PackageIfaceTable
487
488
emptyPackageIfaceTable = emptyModuleEnv

489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
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

504
-- | Information about modules in the package being compiled
dterei's avatar
dterei committed
505
data HomeModInfo
506
507
508
509
510
511
  = 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
512
        -- the module, typically during typechecking
513
514
      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
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
        -- 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).
530
    }
531

532
533
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
Simon Marlow's avatar
Simon Marlow committed
534
lookupIfaceByModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
535
536
537
538
539
        :: DynFlags
        -> HomePackageTable
        -> PackageIfaceTable
        -> Module
        -> Maybe ModIface
540
541
542
543
lookupIfaceByModule _dflags hpt pit mod
  = case lookupHptByModule hpt mod of
       Just hm -> Just (hm_iface hm)
       Nothing -> lookupModuleEnv pit mod
544
545
546
547
548

-- 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.
549
-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
550
-- of its own, but it doesn't seem worth the bother.
551

552

553
554
555
556
-- | 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.
557
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
558
hptInstances hsc_env want_this_module
559
560
561
562
563
564
  = 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
565
-- | Get the combined VectInfo of all modules in the home package table. In
566
-- contrast to instances and rules, we don't care whether the modules are
dterei's avatar
dterei committed
567
-- "below" us in the dependency sense. The VectInfo of those modules not "below"
568
-- us does not affect the compilation of the current module.
dterei's avatar
dterei committed
569
hptVectInfo :: HscEnv -> VectInfo
570
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
571

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

576

dterei's avatar
dterei committed
577
-- | Get annotations from modules "below" this one (in the dependency sense)
578
579
580
581
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

582
583
584
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))

dterei's avatar
dterei committed
585
-- | Get things from modules "below" this one (in the dependency sense)
586
-- C.f Inst.hptInstances
dterei's avatar
dterei committed
587
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
588
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
dterei's avatar
dterei committed
589
590
  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []

591
  | otherwise
dterei's avatar
dterei committed
592
  = let hpt = hsc_HPT hsc_env
593
    in
594
    [ thing
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
595
    |   -- Find each non-hi-boot module below me
596
597
      (mod, is_boot_mod) <- deps
    , include_hi_boot || not is_boot_mod
598

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
599
        -- unsavoury: when compiling the base package with --make, we
dterei's avatar
dterei committed
600
        -- 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
601
        -- be in the HPT, because we never compile it; it's in the EPT
dterei's avatar
dterei committed
602
        -- instead. ToDo: clean up, and remove this slightly bogus filter:
Simon Marlow's avatar
Simon Marlow committed
603
    , mod /= moduleName gHC_PRIM
604

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
605
        -- Look it up in the HPT
606
    , let things = case lookupUFM hpt mod of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
607
                    Just info -> extract info
dterei's avatar
dterei committed
608
                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
609
610
611
          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
612

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
613
        -- And get its dfuns
614
    , thing <- things ]
615
616
617

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
618

Luite Stegeman's avatar
Luite Stegeman committed
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
{-
************************************************************************
*                                                                      *
\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
660
661
662
{-
************************************************************************
*                                                                      *
663
\subsection{Dealing with Annotations}
Austin Seipp's avatar
Austin Seipp committed
664
665
666
*                                                                      *
************************************************************************
-}
667

dterei's avatar
dterei committed
668
-- | Deal with gathering annotations in from all possible places
669
--   and combining them into a single 'AnnEnv'
dterei's avatar
dterei committed
670
671
672
673
674
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
675
676
677
        -- 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
678
679
        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
680
681
        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
                                                         Just home_pkg_anns,
dterei's avatar
dterei committed
682
683
                                                         Just other_pkg_anns]
    return ann_env
684

Austin Seipp's avatar
Austin Seipp committed
685
686
687
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
688
\subsection{The Finder cache}
Austin Seipp's avatar
Austin Seipp committed
689
690
691
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
692

693
-- | The 'FinderCache' maps modules to the result of
dterei's avatar
dterei committed
694
695
-- 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
696
697
-- contents of this cache.
--
698
699
700
701
-- 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
702
703
704

-- | The result of searching for an imported module.
data FindResult
705
  = Found ModLocation Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
706
        -- ^ The module was found
707
  | NoPackage UnitId
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
708
        -- ^ The requested package was not found
709
  | FoundMultiple [(Module, ModuleOrigin)]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
710
        -- ^ _Error_: both in multiple packages
dterei's avatar
dterei committed
711

dterei's avatar
dterei committed
712
713
        -- | Not found
  | NotFound
714
715
      { fr_paths       :: [FilePath]       -- Places where I looked

716
      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's
717
718
719
                                           --           manifest, but couldn't find
                                           --           the .hi file

720
      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,
721
722
                                           --   but the *module* is hidden

723
      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,
724
725
                                           --   but the *package* is hidden

726
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
727
      }
Simon Marlow's avatar
Simon Marlow committed
728

Austin Seipp's avatar
Austin Seipp committed
729
730
731
{-
************************************************************************
*                                                                      *
732
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
733
734
735
*                                                                      *
************************************************************************
-}
736

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

dterei's avatar
dterei committed
755
756
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts     :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
757
        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?
758

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
759
760
761
762
        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
763

764
765
        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
766
767
768
769
                -- 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
770

771
        mi_exports  :: ![IfaceExport],
dterei's avatar
dterei committed
772
773
774
                -- ^ Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
                -- Records the modules that are the declaration points for things
775
                -- exported by this module, and the 'OccName's of those things
dterei's avatar
dterei committed
776

dterei's avatar
dterei committed
777
778
        mi_exp_hash :: !Fingerprint,
                -- ^ Hash of export list
779

dterei's avatar
dterei committed
780
781
782
        mi_used_th  :: !Bool,
                -- ^ Module required TH splices when it was compiled.
                -- This disables recompilation avoidance (see #481).
783

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

dterei's avatar
dterei committed
788
        mi_warns    :: Warnings,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
789
790
                -- ^ Warnings
                -- NOT STRICT!  we read this field lazily from the interface file
791

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

dterei's avatar
dterei committed
796
797
798

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

804
        mi_globals  :: !(Maybe GlobalRdrEnv),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
                -- ^ 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
820
        mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance
dterei's avatar
dterei committed
821
822
        mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances
        mi_rules       :: [IfaceRule],     -- ^ Sorted rules
823
824
        mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules, class and family
                                           -- instances, and vectorise pragmas combined
825

dterei's avatar
dterei committed
826
        mi_vect_info :: !IfaceVectInfo,    -- ^ Vectorisation information
827

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
828
829
830
                -- Cached environments for easy lookup
                -- These are computed (lazily) from other fields
                -- and are not put into the interface file
831
832
        mi_warn_fn   :: OccName -> Maybe WarningTxt,
                -- ^ Cached lookup for 'mi_warns'
833
        mi_fix_fn    :: OccName -> Maybe Fixity,
834
                -- ^ Cached lookup for 'mi_fixities'
dterei's avatar
dterei committed
835
836
837
838
839
840
841
842
        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
843
                -- ^ True if this program uses Hpc at any point in the program.
dterei's avatar
dterei committed
844
845

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
848
849
850
851
852
853
        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).
854
                -- See Note [RnNames . Trust Own Package]
855
     }
856

857
858
859
860
861
-- | 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

862
863
864
865
866
-- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be
-- found, 'defaultFixity' is returned instead.
mi_fix :: ModIface -> OccName -> Fixity
mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity

867
868
869
instance Binary ModIface where
   put_ bh (ModIface {
                 mi_module    = mod,
870
                 mi_sig_of    = sig_of,
871
                 mi_hsc_src   = hsc_src,
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
                 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
895
        put_ bh hsc_src
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
        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