HscTypes.hs 122 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 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

29
        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
30
        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,
niteria's avatar
niteria committed
40 41
        lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
        addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
42
        hptInstances, hptRules, hptVectInfo, pprHPT,
43 44
        hptObjs,

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

50
        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
51

52
        mkSOName, mkHsSOName, soExt,
53

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

60 61 62
        -- * Annotations
        prepareAnnotations,

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
73 74
        -- * Interfaces
        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
75
        emptyIfaceWarnCache, mi_boot, mi_fix,
Edward Z. Yang's avatar
Edward Z. Yang committed
76 77 78
        mi_semantic_module,
        mi_free_holes,
        renameFreeHoles,
79

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

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

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

98 99 100 101
        -- * MonadThings
        MonadThings(..),

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

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

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

115
        -- * Program coverage
116
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
117

118
        -- * Breakpoints
119
        ModBreaks (..), emptyModBreaks,
120

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

125 126
        -- * Safe Haskell information
        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
127
        trustInfoToNum, numToTrustInfo, IsSafeImport,
128

129 130 131
        -- * result of the parser
        HsParsedModule(..),

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

#include "HsVersions.h"

140
#ifdef GHCI
141
import ByteCodeTypes
142
import InteractiveEvalTypes ( Resume )
143
import GHCi.Message         ( Pipe )
144
import GHCi.RemoteTypes
145 146
#endif

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

Alan Zimmerman's avatar
Alan Zimmerman committed
165
import ApiAnnotation    ( ApiAnns )
166
import Annotations      ( Annotation, AnnEnv, mkAnnEnv, plusAnnEnv )
167
import Class
168
import TyCon
169
import CoAxiom
cactus's avatar
cactus committed
170
import ConLike
171
import DataCon
cactus's avatar
cactus committed
172
import PatSyn
173 174 175
import PrelNames        ( gHC_PRIM, ioTyConName, printName, mkInteractiveModule
                        , eqTyConName )
import TysWiredIn
dterei's avatar
dterei committed
176
import Packages hiding  ( Version(..) )
177
import DynFlags
178
import DriverPhases     ( Phase, HscSource(..), isHsBootOrSig, hscSourceString )
179
import BasicTypes
180
import IfaceSyn
181
import Maybes
182
import Outputable
Ian Lynagh's avatar
Ian Lynagh committed
183
import SrcLoc
niteria's avatar
niteria committed
184 185
import Unique
import UniqDFM
186
import FastString
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
187
import StringBuffer     ( StringBuffer )
188
import Fingerprint
189
import MonadUtils
190
import Bag
191
import Binary
192
import ErrUtils
193
import NameCache
194
import Platform
195
import Util
Edward Z. Yang's avatar
Edward Z. Yang committed
196
import UniqDSet
197
import GHC.Serialized   ( Serialized )
Simon Marlow's avatar
Simon Marlow committed
198

199
import Foreign
200
import Control.Monad    ( guard, liftM, when, ap )
dterei's avatar
dterei committed
201
import Data.IORef
202
import Data.Time
dterei's avatar
dterei committed
203 204
import Exception
import System.FilePath
205 206
#ifdef GHCI
import Control.Concurrent
207
import System.Process   ( ProcessHandle )
208
#endif
209

210 211 212 213 214 215 216 217 218
-- -----------------------------------------------------------------------------
-- Compilation state
-- -----------------------------------------------------------------------------

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

251
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
252 253
-- A variant of runHsc that switches in the DynFlags from the
-- InteractiveContext before running the Hsc computation.
254 255 256 257
runInteractiveHsc hsc_env
  = runHsc (hsc_env { hsc_dflags = interactive_dflags })
  where
    interactive_dflags = ic_dflags (hsc_IC hsc_env)
258

259 260
-- -----------------------------------------------------------------------------
-- Source Errors
261

262 263
-- When the compiler (HscMain) discovers errors, it throws an
-- exception in the IO monad.
264 265

mkSrcErr :: ErrorMessages -> SourceError
dterei's avatar
dterei committed
266 267
mkSrcErr = SourceError

268
srcErrorMessages :: SourceError -> ErrorMessages
dterei's avatar
dterei committed
269 270
srcErrorMessages (SourceError msgs) = msgs

271
mkApiErr :: DynFlags -> SDoc -> GhcApiError
Ian Lynagh's avatar
Ian Lynagh committed
272
mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
273

274 275 276
throwOneError :: MonadIO m => ErrMsg -> m ab
throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err

277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
-- | 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.
293
newtype SourceError = SourceError ErrorMessages
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308

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
309
-- | An error thrown if the GHC API is used in an incorrect fashion.
310
newtype GhcApiError = GhcApiError String
311 312

instance Show GhcApiError where
313
  show (GhcApiError msg) = msg
314 315 316

instance Exception GhcApiError

317 318 319 320
-- | 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
321
  | gopt Opt_WarnIsError dflags
322
  = when (not (isEmptyBag warns)) $ do
Ian Lynagh's avatar
Ian Lynagh committed
323
      throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
324
  | otherwise
325
  = printBagOfErrors dflags warns
326

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

335
      printOrThrowWarnings dflags bag
336

Austin Seipp's avatar
Austin Seipp committed
337 338 339
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
340
\subsection{HscEnv}
Austin Seipp's avatar
Austin Seipp committed
341 342 343
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
344

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

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
394 395 396 397 398 399 400
        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
401

402
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
403
                -- ^ Used for one-shot compilation only, to initialise
dterei's avatar
dterei committed
404
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
405
                -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]
406 407 408 409 410 411

#ifdef GHCI
        , hsc_iserv :: MVar (Maybe IServ)
                -- ^ interactive server process.  Created the first
                -- time it is needed.
#endif
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 448 449 450 451 452 453 454 455 456
-- 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.


457 458 459 460 461 462 463 464 465
#ifdef GHCI
data IServ = IServ
  { iservPipe :: Pipe
  , iservProcess :: ProcessHandle
  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
  , iservPendingFrees :: [HValueRef]
  }
#endif

dterei's avatar
dterei committed
466
-- | Retrieve the ExternalPackageState cache.
467 468
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
469

470 471 472 473 474 475
-- | 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
476 477 478 479
data Target
  = Target {
      targetId           :: TargetId, -- ^ module or filename
      targetAllowObjCode :: Bool,     -- ^ object code allowed?
480
      targetContents     :: Maybe (StringBuffer,UTCTime)
481
                                        -- ^ in-memory text buffer?
dterei's avatar
dterei committed
482
    }
483 484

data TargetId
Simon Marlow's avatar
Simon Marlow committed
485
  = TargetModule ModuleName
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
486
        -- ^ A module name: search for the file
487
  | TargetFile FilePath (Maybe Phase)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
488 489 490 491
        -- ^ 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.
492
  deriving Eq
493 494

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

Ian Lynagh's avatar
Ian Lynagh committed
498 499 500
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
501
pprTargetId :: TargetId -> SDoc
502
pprTargetId (TargetModule m) = ppr m
503
pprTargetId (TargetFile f _) = text f
504

Ian Lynagh's avatar
Ian Lynagh committed
505 506 507
instance Outputable TargetId where
    ppr = pprTargetId

Austin Seipp's avatar
Austin Seipp committed
508 509 510
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
511
\subsection{Package and Module Tables}
Austin Seipp's avatar
Austin Seipp committed
512 513 514
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
515

516
-- | Helps us find information about modules in the home package
niteria's avatar
niteria committed
517
type HomePackageTable  = DModuleNameEnv HomeModInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
518
        -- Domain = modules in the home package that have been fully compiled
519
        -- "home" unit id cached here for convenience
520 521

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

dterei's avatar
dterei committed
525
-- | Constructs an empty HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
526
emptyHomePackageTable :: HomePackageTable
niteria's avatar
niteria committed
527
emptyHomePackageTable  = emptyUDFM
Simon Marlow's avatar
Simon Marlow committed
528

dterei's avatar
dterei committed
529
-- | Constructs an empty PackageIfaceTable
Simon Marlow's avatar
Simon Marlow committed
530
emptyPackageIfaceTable :: PackageIfaceTable
531 532
emptyPackageIfaceTable = emptyModuleEnv

533 534
pprHPT :: HomePackageTable -> SDoc
-- A bit aribitrary for now
niteria's avatar
niteria committed
535
pprHPT hpt = pprUDFM hpt $ \hms ->
536
    vcat [ hang (ppr (mi_module (hm_iface hm)))
537
              2 (ppr (md_types (hm_details hm)))
538
         | hm <- hms ]
539

niteria's avatar
niteria committed
540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570
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

571 572 573 574
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
575
  = case lookupHpt hpt (moduleName mod) of
576 577 578
      Just hm | mi_module (hm_iface hm) == mod -> Just hm
      _otherwise                               -> Nothing

579
-- | Information about modules in the package being compiled
dterei's avatar
dterei committed
580
data HomeModInfo
581 582 583 584 585 586
  = 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
587
        -- the module, typically during typechecking
588 589
      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
590 591 592 593 594 595 596 597 598 599 600 601 602 603 604
        -- 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).
605
    }
606

607 608
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
Simon Marlow's avatar
Simon Marlow committed
609
lookupIfaceByModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
610 611 612 613 614
        :: DynFlags
        -> HomePackageTable
        -> PackageIfaceTable
        -> Module
        -> Maybe ModIface
615 616 617 618
lookupIfaceByModule _dflags hpt pit mod
  = case lookupHptByModule hpt mod of
       Just hm -> Just (hm_iface hm)
       Nothing -> lookupModuleEnv pit mod
619 620 621 622 623

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

627

628 629 630 631
-- | 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.
632
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
633
hptInstances hsc_env want_this_module
634 635 636 637 638 639
  = 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
640
-- | Get the combined VectInfo of all modules in the home package table. In
641
-- contrast to instances and rules, we don't care whether the modules are
dterei's avatar
dterei committed
642
-- "below" us in the dependency sense. The VectInfo of those modules not "below"
643
-- us does not affect the compilation of the current module.
dterei's avatar
dterei committed
644
hptVectInfo :: HscEnv -> VectInfo
645
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
646

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

651

dterei's avatar
dterei committed
652
-- | Get annotations from modules "below" this one (in the dependency sense)
653 654 655 656
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

657
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
niteria's avatar
niteria committed
658
hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
659

dterei's avatar
dterei committed
660
-- | Get things from modules "below" this one (in the dependency sense)
661
-- C.f Inst.hptInstances
dterei's avatar
dterei committed
662
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
663
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
dterei's avatar
dterei committed
664 665
  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []

666
  | otherwise
dterei's avatar
dterei committed
667
  = let hpt = hsc_HPT hsc_env
668
    in
669
    [ thing
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
670
    |   -- Find each non-hi-boot module below me
671 672
      (mod, is_boot_mod) <- deps
    , include_hi_boot || not is_boot_mod
673

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
680
        -- Look it up in the HPT
niteria's avatar
niteria committed
681
    , let things = case lookupHpt hpt mod of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
682
                    Just info -> extract info
dterei's avatar
dterei committed
683
                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
684 685
          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
686
                        -- This really shouldn't happen, but see Trac #962
687

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
688
        -- And get its dfuns
689
    , thing <- things ]
690 691

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

Luite Stegeman's avatar
Luite Stegeman committed
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 724 725 726 727 728 729 730 731 732 733 734
{-
************************************************************************
*                                                                      *
\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
735 736 737
{-
************************************************************************
*                                                                      *
738
\subsection{Dealing with Annotations}
Austin Seipp's avatar
Austin Seipp committed
739 740 741
*                                                                      *
************************************************************************
-}
742

dterei's avatar
dterei committed
743
-- | Deal with gathering annotations in from all possible places
744
--   and combining them into a single 'AnnEnv'
dterei's avatar
dterei committed
745 746 747 748 749
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
750 751 752
        -- 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
753 754
        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
755 756
        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
                                                         Just home_pkg_anns,
dterei's avatar
dterei committed
757 758
                                                         Just other_pkg_anns]
    return ann_env
759

Austin Seipp's avatar
Austin Seipp committed
760 761 762
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
763
\subsection{The Finder cache}
Austin Seipp's avatar
Austin Seipp committed
764 765 766
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
767

768
-- | The 'FinderCache' maps modules to the result of
dterei's avatar
dterei committed
769 770
-- 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
771 772
-- contents of this cache.
--
773 774 775 776 777 778
type FinderCache = InstalledModuleEnv InstalledFindResult

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

-- | The result of searching for an imported module.
Edward Z. Yang's avatar
Edward Z. Yang committed
781 782 783
--
-- NB: FindResult manages both user source-import lookups
-- (which can result in 'Module') as well as direct imports
784
-- for interfaces (which always result in 'InstalledModule').
Simon Marlow's avatar
Simon Marlow committed
785
data FindResult
786
  = Found ModLocation Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
787
        -- ^ The module was found
788
  | NoPackage UnitId
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
789
        -- ^ The requested package was not found
790
  | FoundMultiple [(Module, ModuleOrigin)]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
791
        -- ^ _Error_: both in multiple packages
dterei's avatar
dterei committed
792

dterei's avatar
dterei committed
793 794
        -- | Not found
  | NotFound
795 796
      { fr_paths       :: [FilePath]       -- Places where I looked

797
      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's
798 799 800
                                           --           manifest, but couldn't find
                                           --           the .hi file

801
      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,
802 803
                                           --   but the *module* is hidden

804
      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,
805 806
                                           --   but the *package* is hidden

807
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
808
      }
Simon Marlow's avatar
Simon Marlow committed
809

Austin Seipp's avatar
Austin Seipp committed
810 811 812
{-
************************************************************************
*                                                                      *
813
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
814 815 816
*                                                                      *
************************************************************************
-}
817

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

dterei's avatar
dterei committed
836 837
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts     :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
838
        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?
839

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
840 841 842 843
        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
844

845 846
        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
847 848 849 850
                -- 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
851

852
        mi_exports  :: ![IfaceExport],