HscTypes.hs 121 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, 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(..), InstalledFindResult(..),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
14 15
        Target(..), TargetId(..), pprTarget, pprTargetId,
        ModuleGraph, emptyMG,
16
        HscStatus(..),
17
        IServ(..),
18 19 20

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

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

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

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

dterei's avatar
dterei committed
35

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
36 37
        -- * State relating to modules in this package
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
niteria's avatar
niteria committed
38 39
        lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
        addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
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,
Edward Z. Yang's avatar
Edward Z. Yang committed
74 75 76
        mi_semantic_module,
        mi_free_holes,
        renameFreeHoles,
77

78
        -- * Fixity
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
79
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
80

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
88
        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
89
        typeEnvFromEntities, mkTypeEnvWithImplicits,
cactus's avatar
cactus committed
90
        extendTypeEnv, extendTypeEnvList,
niteria's avatar
niteria committed
91
        extendTypeEnvWithIds, plusTypeEnv,
cactus's avatar
cactus committed
92 93
        lookupTypeEnv,
        typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
94
        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
95

96 97 98 99
        -- * MonadThings
        MonadThings(..),

        -- * Information on imports and exports
dterei's avatar
dterei committed
100
        WhetherHasOrphans, IsBootInterface, Usage(..),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
101
        Dependencies(..), noDependencies,
102
        updNameCacheIO,
103
        IfaceExport,
104

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
105 106
        -- * Warnings
        Warnings(..), WarningTxt(..), plusWarns,
107

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

113
        -- * Program coverage
114
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
115

116
        -- * Breakpoints
117
        ModBreaks (..), emptyModBreaks,
118

119
        -- * Vectorisation information
dterei's avatar
dterei committed
120
        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo,
121
        noIfaceVectInfo, isNoIfaceVectInfo,
122

123 124
        -- * Safe Haskell information
        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
125
        trustInfoToNum, numToTrustInfo, IsSafeImport,
126

127 128 129
        -- * result of the parser
        HsParsedModule(..),

130 131 132 133
        -- * Compilation errors and warnings
        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
        throwOneError, handleSourceError,
        handleFlagWarnings, printOrThrowWarnings,
134
    ) where
135 136 137

#include "HsVersions.h"

138
import ByteCodeTypes
139
import InteractiveEvalTypes ( Resume )
140
import GHCi.Message         ( Pipe )
141
import GHCi.RemoteTypes
142

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

Alan Zimmerman's avatar
Alan Zimmerman committed
161
import ApiAnnotation    ( ApiAnns )
162
import Annotations      ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
163
import Class
164
import TyCon
165
import CoAxiom
cactus's avatar
cactus committed
166
import ConLike
167
import DataCon
cactus's avatar
cactus committed
168
import PatSyn
169 170 171
import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule
                        , eqTyConName )
import TysWiredIn
dterei's avatar
dterei committed
172
import Packages hiding  ( Version(..) )
173
import DynFlags
174
import DriverPhases     ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
175
import BasicTypes
176
import IfaceSyn
177
import Maybes
178
import Outputable
Ian Lynagh's avatar
Ian Lynagh committed
179
import SrcLoc
niteria's avatar
niteria committed
180 181
import Unique
import UniqDFM
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 NameCache
190
import Platform
191
import Util
Edward Z. Yang's avatar
Edward Z. Yang committed
192
import UniqDSet
193
import GHC.Serialized   ( Serialized )
Simon Marlow's avatar
Simon Marlow committed
194

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

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

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

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

253 254
-- -----------------------------------------------------------------------------
-- Source Errors
255

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

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

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

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

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

271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286
-- | 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.
287
newtype SourceError = SourceError ErrorMessages
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
305 306

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

instance Exception GhcApiError

311 312 313 314
-- | 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
315 316
  | anyBag (isWarnMsgFatal dflags) warns
  = throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
317
  | otherwise
318
  = printBagOfErrors dflags warns
319

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

328
      printOrThrowWarnings dflags bag
329

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

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

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

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

395
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
396
                -- ^ Used for one-shot compilation only, to initialise
dterei's avatar
dterei committed
397
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
398
                -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]
399 400 401 402

        , hsc_iserv :: MVar (Maybe IServ)
                -- ^ interactive server process.  Created the first
                -- time it is needed.
403
 }
404

405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447
-- Note [hsc_type_env_var hack]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- hsc_type_env_var is used to initialize tcg_type_env_var, and
-- eventually it is the mutable variable that is queried from
-- if_rec_types to get a TypeEnv.  So, clearly, it's something
-- related to knot-tying (see Note [Tying the knot]).
-- hsc_type_env_var is used in two places: initTcRn (where
-- it initializes tcg_type_env_var) and initIfaceCheck
-- (where it initializes if_rec_types).
--
-- But why do we need a way to feed a mutable variable in?  Why
-- can't we just initialize tcg_type_env_var when we start
-- typechecking?  The problem is we need to knot-tie the
-- EPS, and we may start adding things to the EPS before type
-- checking starts.
--
-- Here is a concrete example. Suppose we are running
-- "ghc -c A.hs", and we have this file system state:
--
--  A.hs-boot   A.hi-boot **up to date**
--  B.hs        B.hi      **up to date**
--  A.hs        A.hi      **stale**
--
-- The first thing we do is run checkOldIface on A.hi.
-- checkOldIface will call loadInterface on B.hi so it can
-- get its hands on the fingerprints, to find out if A.hi
-- needs recompilation.  But loadInterface also populates
-- the EPS!  And so if compilation turns out to be necessary,
-- as it is in this case, the thunks we put into the EPS for
-- B.hi need to have the correct if_rec_types mutable variable
-- to query.
--
-- If the mutable variable is only allocated WHEN we start
-- typechecking, then that's too late: we can't get the
-- information to the thunks.  So we need to pre-commit
-- to a type variable in 'hscIncrementalCompile' BEFORE we
-- check the old interface.
--
-- This is all a massive hack because arguably checkOldIface
-- should not populate the EPS. But that's a refactor for
-- another day.


448 449 450 451 452 453 454
data IServ = IServ
  { iservPipe :: Pipe
  , iservProcess :: ProcessHandle
  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
  , iservPendingFrees :: [HValueRef]
  }

dterei's avatar
dterei committed
455
-- | Retrieve the ExternalPackageState cache.
456 457
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
458

459 460 461 462 463 464
-- | 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
465 466 467 468
data Target
  = Target {
      targetId           :: TargetId, -- ^ module or filename
      targetAllowObjCode :: Bool,     -- ^ object code allowed?
469
      targetContents     :: Maybe (StringBuffer,UTCTime)
470
                                        -- ^ in-memory text buffer?
dterei's avatar
dterei committed
471
    }
472 473

data TargetId
Simon Marlow's avatar
Simon Marlow committed
474
  = TargetModule ModuleName
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
475
        -- ^ A module name: search for the file
476
  | TargetFile FilePath (Maybe Phase)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
477 478 479 480
        -- ^ 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.
481
  deriving Eq
482 483

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

Ian Lynagh's avatar
Ian Lynagh committed
487 488 489
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
490
pprTargetId :: TargetId -> SDoc
491
pprTargetId (TargetModule m) = ppr m
492
pprTargetId (TargetFile f _) = text f
493

Ian Lynagh's avatar
Ian Lynagh committed
494 495 496
instance Outputable TargetId where
    ppr = pprTargetId

Austin Seipp's avatar
Austin Seipp committed
497 498 499
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
500
\subsection{Package and Module Tables}
Austin Seipp's avatar
Austin Seipp committed
501 502 503
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
504

505
-- | Helps us find information about modules in the home package
niteria's avatar
niteria committed
506
type HomePackageTable  = DModuleNameEnv HomeModInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
507
        -- Domain = modules in the home package that have been fully compiled
508
        -- "home" unit id cached here for convenience
509 510

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

dterei's avatar
dterei committed
514
-- | Constructs an empty HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
515
emptyHomePackageTable :: HomePackageTable
niteria's avatar
niteria committed
516
emptyHomePackageTable  = emptyUDFM
Simon Marlow's avatar
Simon Marlow committed
517

dterei's avatar
dterei committed
518
-- | Constructs an empty PackageIfaceTable
Simon Marlow's avatar
Simon Marlow committed
519
emptyPackageIfaceTable :: PackageIfaceTable
520 521
emptyPackageIfaceTable = emptyModuleEnv

522
pprHPT :: HomePackageTable -> SDoc
523
-- A bit arbitrary for now
niteria's avatar
niteria committed
524
pprHPT hpt = pprUDFM hpt $ \hms ->
525
    vcat [ hang (ppr (mi_module (hm_iface hm)))
526
              2 (ppr (md_types (hm_details hm)))
527
         | hm <- hms ]
528

niteria's avatar
niteria committed
529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559
lookupHpt :: HomePackageTable -> ModuleName -> Maybe HomeModInfo
lookupHpt = lookupUDFM

lookupHptDirectly :: HomePackageTable -> Unique -> Maybe HomeModInfo
lookupHptDirectly = lookupUDFM_Directly

eltsHpt :: HomePackageTable -> [HomeModInfo]
eltsHpt = eltsUDFM

filterHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> HomePackageTable
filterHpt = filterUDFM

allHpt :: (HomeModInfo -> Bool) -> HomePackageTable -> Bool
allHpt = allUDFM

mapHpt :: (HomeModInfo -> HomeModInfo) -> HomePackageTable -> HomePackageTable
mapHpt = mapUDFM

delFromHpt :: HomePackageTable -> ModuleName -> HomePackageTable
delFromHpt = delFromUDFM

addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
addToHpt = addToUDFM

addListToHpt
  :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable
addListToHpt = addListToUDFM

listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable
listToHpt = listToUDFM

560 561 562 563
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
niteria's avatar
niteria committed
564
  = case lookupHpt hpt (moduleName mod) of
565 566 567
      Just hm | mi_module (hm_iface hm) == mod -> Just hm
      _otherwise                               -> Nothing

568
-- | Information about modules in the package being compiled
dterei's avatar
dterei committed
569
data HomeModInfo
570 571 572 573 574 575
  = 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
576
        -- the module, typically during typechecking
577 578
      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
579 580 581 582 583 584 585 586 587 588 589 590 591 592 593
        -- 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).
594
    }
595

596 597
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
Simon Marlow's avatar
Simon Marlow committed
598
lookupIfaceByModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
599 600 601 602 603
        :: DynFlags
        -> HomePackageTable
        -> PackageIfaceTable
        -> Module
        -> Maybe ModIface
604 605 606 607
lookupIfaceByModule _dflags hpt pit mod
  = case lookupHptByModule hpt mod of
       Just hm -> Just (hm_iface hm)
       Nothing -> lookupModuleEnv pit mod
608 609 610 611 612

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

616

617 618 619 620
-- | 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.
621
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
622
hptInstances hsc_env want_this_module
623 624 625 626 627 628
  = 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
629
-- | Get the combined VectInfo of all modules in the home package table. In
630
-- contrast to instances and rules, we don't care whether the modules are
dterei's avatar
dterei committed
631
-- "below" us in the dependency sense. The VectInfo of those modules not "below"
632
-- us does not affect the compilation of the current module.
dterei's avatar
dterei committed
633
hptVectInfo :: HscEnv -> VectInfo
634
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
635

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

640

dterei's avatar
dterei committed
641
-- | Get annotations from modules "below" this one (in the dependency sense)
642 643 644 645
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

646
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
niteria's avatar
niteria committed
647
hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
648

dterei's avatar
dterei committed
649
-- | Get things from modules "below" this one (in the dependency sense)
650
-- C.f Inst.hptInstances
dterei's avatar
dterei committed
651
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
652
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
dterei's avatar
dterei committed
653 654
  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []

655
  | otherwise
dterei's avatar
dterei committed
656
  = let hpt = hsc_HPT hsc_env
657
    in
658
    [ thing
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
659
    |   -- Find each non-hi-boot module below me
660 661
      (mod, is_boot_mod) <- deps
    , include_hi_boot || not is_boot_mod
662

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
669
        -- Look it up in the HPT
niteria's avatar
niteria committed
670
    , let things = case lookupHpt hpt mod of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
671
                    Just info -> extract info
dterei's avatar
dterei committed
672
                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
673 674
          msg = vcat [text "missing module" <+> ppr mod,
                      text "Probable cause: out-of-date interface files"]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
675
                        -- This really shouldn't happen, but see Trac #962
676

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
677
        -- And get its dfuns
678
    , thing <- things ]
679 680

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

Luite Stegeman's avatar
Luite Stegeman committed
683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723
{-
************************************************************************
*                                                                      *
\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
724 725 726
{-
************************************************************************
*                                                                      *
727
\subsection{Dealing with Annotations}
Austin Seipp's avatar
Austin Seipp committed
728 729 730
*                                                                      *
************************************************************************
-}
731

dterei's avatar
dterei committed
732
-- | Deal with gathering annotations in from all possible places
733
--   and combining them into a single 'AnnEnv'
dterei's avatar
dterei committed
734 735 736 737 738
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
739 740 741
        -- 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
742 743
        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
744 745
        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
                                                         Just home_pkg_anns,
dterei's avatar
dterei committed
746 747
                                                         Just other_pkg_anns]
    return ann_env
748

Austin Seipp's avatar
Austin Seipp committed
749 750 751
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
752
\subsection{The Finder cache}
Austin Seipp's avatar
Austin Seipp committed
753 754 755
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
756

757
-- | The 'FinderCache' maps modules to the result of
dterei's avatar
dterei committed
758 759
-- 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
760 761
-- contents of this cache.
--
762 763 764 765 766 767
type FinderCache = InstalledModuleEnv InstalledFindResult

data InstalledFindResult
  = InstalledFound ModLocation InstalledModule
  | InstalledNoPackage InstalledUnitId
  | InstalledNotFound [FilePath] (Maybe InstalledUnitId)
Simon Marlow's avatar
Simon Marlow committed
768 769

-- | The result of searching for an imported module.
Edward Z. Yang's avatar
Edward Z. Yang committed
770 771 772
--
-- NB: FindResult manages both user source-import lookups
-- (which can result in 'Module') as well as direct imports
773
-- for interfaces (which always result in 'InstalledModule').
Simon Marlow's avatar
Simon Marlow committed
774
data FindResult
775
  = Found ModLocation Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
776
        -- ^ The module was found
777
  | NoPackage UnitId
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
778
        -- ^ The requested package was not found
779
  | FoundMultiple [(Module, ModuleOrigin)]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
780
        -- ^ _Error_: both in multiple packages
dterei's avatar
dterei committed
781

dterei's avatar
dterei committed
782 783
        -- | Not found
  | NotFound
784 785
      { fr_paths       :: [FilePath]       -- Places where I looked

786
      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's
787 788 789
                                           --           manifest, but couldn't find
                                           --           the .hi file

790
      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,
791 792
                                           --   but the *module* is hidden

793
      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,
794 795
                                           --   but the *package* is hidden

796
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
797
      }
Simon Marlow's avatar
Simon Marlow committed
798

Austin Seipp's avatar
Austin Seipp committed
799 800 801
{-
************************************************************************
*                                                                      *
802
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
803 804 805
*                                                                      *
************************************************************************
-}
806

dterei's avatar
dterei committed
807
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
808
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
dterei's avatar
dterei committed
809
-- and can be written out to an interface file. The 'ModDetails is after
810
-- linking and can be completely recovered from just the 'ModIface'.
dterei's avatar
dterei committed
811
--
812 813 814 815
-- 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
816
data ModIface
dterei's avatar
dterei committed
817 818
  = ModIface {
        mi_module     :: !Module,             -- ^ Name of the module we are for
819
        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?
dterei's avatar
dterei committed
820 821
        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface
        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only
822 823
        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags
                                              -- used when compiling this module
824

dterei's avatar
dterei committed
825 826
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts     :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
827
        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?
828

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
829 830 831 832
        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
833

834 835
        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
836 837 838 839
                -- 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
840

841
        mi_exports  :: ![IfaceExport],
dterei's avatar
dterei committed
842 843 844
                -- ^ Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
                -- Records the modules that are the declaration points for things
845
                -- exported by this module, and the 'OccName's of those things
dterei's avatar
dterei committed
846

dterei's avatar
dterei committed
847 848
        mi_exp_hash :: !Fingerprint,
                -- ^ Hash of export list
849

dterei's avatar
dterei committed
850 851 852
        mi_used_th  :: !Bool,
                -- ^ Module required TH splices when it was compiled.
                -- This disables recompilation avoidance (see #481).
853

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

dterei's avatar
dterei committed
858
        mi_warns    :: Warnings,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
859 860
                -- ^ Warnings
                -- NOT STRICT!  we read this field lazily from the interface file
861

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

dterei's avatar
dterei committed
866 867 868

        mi_decls    :: [(Fingerprint,IfaceDecl)],
                -- ^ Type, class and variable declarations
chak@cse.unsw.edu.au.'s avatar