HscTypes.hs 126 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
{-# LANGUAGE RecordWildCards #-}
9
{-# LANGUAGE ViewPatterns #-}
10

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

20 21 22 23 24
        -- * ModuleGraph
        ModuleGraph, emptyMG, mkModuleGraph, extendMG, mapMG,
        mgModSummaries, mgElemModule, mgLookupModule,
        needsTemplateHaskellOrQQ, mgBootModules,

25
        -- * Hsc monad
26
        Hsc(..), runHsc, mkInteractiveHscEnv, runInteractiveHsc,
27

28
        -- * Information about modules
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
29
        ModDetails(..), emptyModDetails,
30
        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
31
        ImportedMods, ImportedBy(..), importedByUser, ImportedModsVal(..), SptEntry(..),
32
        ForeignSrcLang(..),
33

34
        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
35
        msHsFilePath, msHiFilePath, msObjFilePath,
36
        SourceModified(..), isTemplateHaskellOrQQNonBoot,
37

38
        -- * Information about the module being compiled
39
        -- (re-exported from DriverPhases)
40
        HscSource(..), isHsBootOrSig, isHsigFile, hscSourceString,
41

dterei's avatar
dterei committed
42

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
43 44
        -- * State relating to modules in this package
        HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
niteria's avatar
niteria committed
45 46
        lookupHpt, eltsHpt, filterHpt, allHpt, mapHpt, delFromHpt,
        addToHpt, addListToHpt, lookupHptDirectly, listToHpt,
47
        hptCompleteSigs,
48
        hptInstances, hptRules, pprHPT,
49

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
50 51 52
        -- * State relating to known packages
        ExternalPackageState(..), EpsStats(..), addEpsInStats,
        PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
53
        lookupIfaceByModule, emptyModIface, lookupHptByModule,
dterei's avatar
dterei committed
54

55
        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
56
        PackageCompleteMatchMap,
57

58
        mkSOName, mkHsSOName, soExt,
59

Luite Stegeman's avatar
Luite Stegeman committed
60 61 62 63 64 65
        -- * Metaprogramming
        MetaRequest(..),
        MetaResult, -- data constructors not exported to ensure correct response type
        metaRequestE, metaRequestP, metaRequestT, metaRequestD, metaRequestAW,
        MetaHook,

66 67 68
        -- * Annotations
        prepareAnnotations,

69
        -- * Interactive context
dterei's avatar
dterei committed
70
        InteractiveContext(..), emptyInteractiveContext,
71
        icPrintUnqual, icInScopeTTs, icExtendGblRdrEnv,
72 73
        extendInteractiveContext, extendInteractiveContextWithIds,
        substInteractiveContext,
74 75
        setInteractivePrintName, icInteractiveModule,
        InteractiveImport(..), setInteractivePackage,
76
        mkPrintUnqualified, pprModulePrefix,
77
        mkQualPackage, mkQualModule, pkgQual,
78

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
79 80
        -- * Interfaces
        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
81
        emptyIfaceWarnCache, mi_boot, mi_fix,
Edward Z. Yang's avatar
Edward Z. Yang committed
82 83 84
        mi_semantic_module,
        mi_free_holes,
        renameFreeHoles,
85

86
        -- * Fixity
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
87
        FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
88

89
        -- * TyThings and type environments
90
        TyThing(..),  tyThingAvailInfo,
91
        tyThingTyCon, tyThingDataCon, tyThingConLike,
92
        tyThingId, tyThingCoAxiom, tyThingParent_maybe, tyThingsTyCoVars,
93 94
        implicitTyThings, implicitTyConThings, implicitClassThings,
        isImplicitTyThing,
dterei's avatar
dterei committed
95

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
96
        TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
97
        typeEnvFromEntities, mkTypeEnvWithImplicits,
cactus's avatar
cactus committed
98
        extendTypeEnv, extendTypeEnvList,
niteria's avatar
niteria committed
99
        extendTypeEnvWithIds, plusTypeEnv,
cactus's avatar
cactus committed
100 101
        lookupTypeEnv,
        typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns,
102
        typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses,
103

104 105 106 107
        -- * MonadThings
        MonadThings(..),

        -- * Information on imports and exports
dterei's avatar
dterei committed
108
        WhetherHasOrphans, IsBootInterface, Usage(..),
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
109
        Dependencies(..), noDependencies,
110
        updNameCache,
111
        IfaceExport,
112

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
113 114
        -- * Warnings
        Warnings(..), WarningTxt(..), plusWarns,
115

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
116
        -- * Linker stuff
117
        Linkable(..), isObjectLinkable, linkableObjs,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
118 119
        Unlinked(..), CompiledByteCode,
        isObject, nameOfObject, isInterpretable, byteCodeOfObject,
dterei's avatar
dterei committed
120

121
        -- * Program coverage
122
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
123

124
        -- * Breakpoints
125
        ModBreaks (..), emptyModBreaks,
126

127 128
        -- * Safe Haskell information
        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
129
        trustInfoToNum, numToTrustInfo, IsSafeImport,
130

131 132 133
        -- * result of the parser
        HsParsedModule(..),

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

        -- * COMPLETE signature
140 141
        CompleteMatch(..), CompleteMatchMap,
        mkCompleteMatchMap, extendCompleteMatchMap
142
    ) where
143 144 145

#include "HsVersions.h"

146 147
import GhcPrelude

148
import ByteCodeTypes
149
import InteractiveEvalTypes ( Resume )
150
import GHCi.Message         ( Pipe )
151
import GHCi.RemoteTypes
152
import GHC.ForeignSrcLang
153

Edward Z. Yang's avatar
Edward Z. Yang committed
154
import UniqFM
155
import HsSyn
156
import RdrName
157
import Avail
158
import Module
159
import InstEnv          ( InstEnv, ClsInst, identicalClsInstHead )
160
import FamInstEnv
161
import CoreSyn          ( CoreProgram, RuleBase, CoreRule )
dterei's avatar
dterei committed
162 163
import Name
import NameEnv
164
import VarSet
165
import Var
166
import Id
Matthew Pickering's avatar
Matthew Pickering committed
167
import IdInfo           ( IdDetails(..), RecSelParent(..))
dterei's avatar
dterei committed
168
import Type
169

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

206
import Foreign
207
import Control.Monad    ( guard, liftM, ap )
dterei's avatar
dterei committed
208
import Data.IORef
209
import Data.Time
dterei's avatar
dterei committed
210 211
import Exception
import System.FilePath
212
import Control.Concurrent
213
import System.Process   ( ProcessHandle )
214

215 216 217 218 219 220 221 222 223
-- -----------------------------------------------------------------------------
-- Compilation state
-- -----------------------------------------------------------------------------

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

256 257 258 259 260
mkInteractiveHscEnv :: HscEnv -> HscEnv
mkInteractiveHscEnv hsc_env = hsc_env{ hsc_dflags = interactive_dflags }
  where
    interactive_dflags = ic_dflags (hsc_IC hsc_env)

261
runInteractiveHsc :: HscEnv -> Hsc a -> IO a
262 263
-- A variant of runHsc that switches in the DynFlags from the
-- InteractiveContext before running the Hsc computation.
264
runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)
265

266 267
-- -----------------------------------------------------------------------------
-- Source Errors
268

269 270
-- When the compiler (HscMain) discovers errors, it throws an
-- exception in the IO monad.
271 272

mkSrcErr :: ErrorMessages -> SourceError
dterei's avatar
dterei committed
273 274
mkSrcErr = SourceError

275
srcErrorMessages :: SourceError -> ErrorMessages
dterei's avatar
dterei committed
276 277
srcErrorMessages (SourceError msgs) = msgs

278
mkApiErr :: DynFlags -> SDoc -> GhcApiError
Ian Lynagh's avatar
Ian Lynagh committed
279
mkApiErr dflags msg = GhcApiError (showSDoc dflags msg)
280

281 282 283 284 285
throwErrors :: MonadIO io => ErrorMessages -> io a
throwErrors = liftIO . throwIO . mkSrcErr

throwOneError :: MonadIO io => ErrMsg -> io a
throwOneError = throwErrors . unitBag
286

287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302
-- | 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.
303
newtype SourceError = SourceError ErrorMessages
304 305 306 307 308 309 310 311 312 313 314 315 316 317 318

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
319
-- | An error thrown if the GHC API is used in an incorrect fashion.
320
newtype GhcApiError = GhcApiError String
321 322

instance Show GhcApiError where
323
  show (GhcApiError msg) = msg
324 325 326

instance Exception GhcApiError

327 328 329
-- | Given a bag of warnings, turn them into an exception if
-- -Werror is enabled, or print them out otherwise.
printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO ()
330 331 332 333 334 335 336 337 338 339 340 341 342 343 344
printOrThrowWarnings dflags warns = do
  let (make_error, warns') =
        mapAccumBagL
          (\make_err warn ->
            case isWarnMsgFatal dflags warn of
              Nothing ->
                (make_err, warn)
              Just err_reason ->
                (True, warn{ errMsgSeverity = SevError
                           , errMsgReason = ErrReason err_reason
                           }))
          False warns
  if make_error
    then throwIO (mkSrcErr warns')
    else printBagOfErrors dflags warns
345

346 347 348 349 350 351 352
handleFlagWarnings :: DynFlags -> [Warn] -> IO ()
handleFlagWarnings dflags warns = do
  let warns' = filter (shouldPrintWarning dflags . warnReason)  warns

      -- It would be nicer if warns :: [Located MsgDoc], but that
      -- has circular import problems.
      bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
353
                      | Warn _ (dL->L loc warn) <- warns' ]
354 355 356 357

  printOrThrowWarnings dflags bag

-- Given a warn reason, check to see if it's associated -W opt is enabled
358
shouldPrintWarning :: DynFlags -> CmdLineParser.WarnReason -> Bool
359 360 361 362 363 364
shouldPrintWarning dflags ReasonDeprecatedFlag
  = wopt Opt_WarnDeprecatedFlags dflags
shouldPrintWarning dflags ReasonUnrecognisedFlag
  = wopt Opt_WarnUnrecognisedWarningFlags dflags
shouldPrintWarning _ _
  = True
365

Austin Seipp's avatar
Austin Seipp committed
366 367 368
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
369
\subsection{HscEnv}
Austin Seipp's avatar
Austin Seipp committed
370 371 372
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
373

374
-- | HscEnv is like 'Session', except that some of the fields are immutable.
375 376 377 378 379 380 381 382 383
-- 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
384 385
data HscEnv
  = HscEnv {
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
386 387 388 389 390 391 392 393 394 395 396 397 398 399
        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
400
                -- home-package modules, /excluding/ the module we
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
401 402
                -- are compiling right now.
                -- (In one-shot mode the current module is the only
dterei's avatar
dterei committed
403 404 405 406
                -- 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
407
                --
dterei's avatar
dterei committed
408 409
                -- '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
410
                -- loaded, module by module, by the compilation manager.
dterei's avatar
dterei committed
411
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
412 413 414
                -- 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
415
                --
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
416
                -- (This changes a previous invariant: changed Jan 05.)
dterei's avatar
dterei committed
417

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
418 419 420 421
        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
422

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
423 424 425 426 427 428 429
        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
430

431
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
432
                -- ^ Used for one-shot compilation only, to initialise
dterei's avatar
dterei committed
433
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
434
                -- 'TcRnTypes.TcGblEnv'.  See also Note [hsc_type_env_var hack]
435 436 437 438

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

441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483
-- 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.


484 485 486 487 488 489 490
data IServ = IServ
  { iservPipe :: Pipe
  , iservProcess :: ProcessHandle
  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
  , iservPendingFrees :: [HValueRef]
  }

dterei's avatar
dterei committed
491
-- | Retrieve the ExternalPackageState cache.
492 493
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
494

495 496 497 498 499 500
-- | 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
501 502 503 504
data Target
  = Target {
      targetId           :: TargetId, -- ^ module or filename
      targetAllowObjCode :: Bool,     -- ^ object code allowed?
505
      targetContents     :: Maybe (StringBuffer,UTCTime)
506
                                        -- ^ in-memory text buffer?
dterei's avatar
dterei committed
507
    }
508 509

data TargetId
Simon Marlow's avatar
Simon Marlow committed
510
  = TargetModule ModuleName
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
511
        -- ^ A module name: search for the file
512
  | TargetFile FilePath (Maybe Phase)
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
513 514 515 516
        -- ^ 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.
517
  deriving Eq
518 519

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

Ian Lynagh's avatar
Ian Lynagh committed
523 524 525
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
526
pprTargetId :: TargetId -> SDoc
527
pprTargetId (TargetModule m) = ppr m
528
pprTargetId (TargetFile f _) = text f
529

Ian Lynagh's avatar
Ian Lynagh committed
530 531 532
instance Outputable TargetId where
    ppr = pprTargetId

Austin Seipp's avatar
Austin Seipp committed
533 534 535
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
536
\subsection{Package and Module Tables}
Austin Seipp's avatar
Austin Seipp committed
537 538 539
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
540

541
-- | Helps us find information about modules in the home package
niteria's avatar
niteria committed
542
type HomePackageTable  = DModuleNameEnv HomeModInfo
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
543
        -- Domain = modules in the home package that have been fully compiled
544
        -- "home" unit id cached here for convenience
545 546

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

dterei's avatar
dterei committed
550
-- | Constructs an empty HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
551
emptyHomePackageTable :: HomePackageTable
niteria's avatar
niteria committed
552
emptyHomePackageTable  = emptyUDFM
Simon Marlow's avatar
Simon Marlow committed
553

dterei's avatar
dterei committed
554
-- | Constructs an empty PackageIfaceTable
Simon Marlow's avatar
Simon Marlow committed
555
emptyPackageIfaceTable :: PackageIfaceTable
556 557
emptyPackageIfaceTable = emptyModuleEnv

558
pprHPT :: HomePackageTable -> SDoc
559
-- A bit arbitrary for now
niteria's avatar
niteria committed
560
pprHPT hpt = pprUDFM hpt $ \hms ->
561
    vcat [ hang (ppr (mi_module (hm_iface hm)))
562
              2 (ppr (md_types (hm_details hm)))
563
         | hm <- hms ]
564

niteria's avatar
niteria committed
565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595
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

596 597 598 599
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
600
  = case lookupHpt hpt (moduleName mod) of
601 602 603
      Just hm | mi_module (hm_iface hm) == mod -> Just hm
      _otherwise                               -> Nothing

604
-- | Information about modules in the package being compiled
dterei's avatar
dterei committed
605
data HomeModInfo
606 607 608 609 610 611
  = 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
612
        -- the module, typically during typechecking
613 614
      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
615 616 617 618 619 620 621 622 623 624 625 626 627 628 629
        -- 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).
630
    }
631

632 633
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
Simon Marlow's avatar
Simon Marlow committed
634
lookupIfaceByModule
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
635 636 637 638 639
        :: DynFlags
        -> HomePackageTable
        -> PackageIfaceTable
        -> Module
        -> Maybe ModIface
640 641 642 643
lookupIfaceByModule _dflags hpt pit mod
  = case lookupHptByModule hpt mod of
       Just hm -> Just (hm_iface hm)
       Nothing -> lookupModuleEnv pit mod
644 645 646 647 648

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

652 653
hptCompleteSigs :: HscEnv -> [CompleteMatch]
hptCompleteSigs = hptAllThings  (md_complete_sigs . hm_details)
654

655 656 657 658
-- | 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.
659
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
660
hptInstances hsc_env want_this_module
661 662 663 664 665 666
  = 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
667
-- | Get rules from modules "below" this one (in the dependency sense)
Simon Marlow's avatar
Simon Marlow committed
668
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
669 670
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False

671

dterei's avatar
dterei committed
672
-- | Get annotations from modules "below" this one (in the dependency sense)
673 674 675 676
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

677
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
niteria's avatar
niteria committed
678
hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
679

dterei's avatar
dterei committed
680
-- | Get things from modules "below" this one (in the dependency sense)
681
-- C.f Inst.hptInstances
dterei's avatar
dterei committed
682
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
683
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
dterei's avatar
dterei committed
684 685
  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []

686
  | otherwise
dterei's avatar
dterei committed
687
  = let hpt = hsc_HPT hsc_env
688
    in
689
    [ thing
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
690
    |   -- Find each non-hi-boot module below me
691 692
      (mod, is_boot_mod) <- deps
    , include_hi_boot || not is_boot_mod
693

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
700
        -- Look it up in the HPT
niteria's avatar
niteria committed
701
    , let things = case lookupHpt hpt mod of
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
702
                    Just info -> extract info
dterei's avatar
dterei committed
703
                    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg []
704 705
          msg = vcat [text "missing module" <+> ppr mod,
                      text "Probable cause: out-of-date interface files"]
706
                        -- This really shouldn't happen, but see #962
707

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
708
        -- And get its dfuns
709
    , thing <- things ]
710

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
711

Luite Stegeman's avatar
Luite Stegeman committed
712 713 714 715 716 717 718 719 720 721
{-
************************************************************************
*                                                                      *
\subsection{Metaprogramming}
*                                                                      *
************************************************************************
-}

-- | The supported metaprogramming result types
data MetaRequest
722 723 724 725 726
  = MetaE  (LHsExpr GhcPs   -> MetaResult)
  | MetaP  (LPat GhcPs      -> MetaResult)
  | MetaT  (LHsType GhcPs   -> MetaResult)
  | MetaD  ([LHsDecl GhcPs] -> MetaResult)
  | MetaAW (Serialized     -> MetaResult)
Luite Stegeman's avatar
Luite Stegeman committed
727 728 729

-- | data constructors not exported to ensure correct result type
data MetaResult
730 731 732 733
  = MetaResE  { unMetaResE  :: LHsExpr GhcPs   }
  | MetaResP  { unMetaResP  :: LPat GhcPs      }
  | MetaResT  { unMetaResT  :: LHsType GhcPs   }
  | MetaResD  { unMetaResD  :: [LHsDecl GhcPs] }
Luite Stegeman's avatar
Luite Stegeman committed
734 735
  | MetaResAW { unMetaResAW :: Serialized        }

736
type MetaHook f = MetaRequest -> LHsExpr GhcTc -> f MetaResult
Luite Stegeman's avatar
Luite Stegeman committed
737

738
metaRequestE :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsExpr GhcPs)
Luite Stegeman's avatar
Luite Stegeman committed
739 740
metaRequestE h = fmap unMetaResE . h (MetaE MetaResE)

741
metaRequestP :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LPat GhcPs)
Luite Stegeman's avatar
Luite Stegeman committed
742 743
metaRequestP h = fmap unMetaResP . h (MetaP MetaResP)

744
metaRequestT :: Functor f => MetaHook f -> LHsExpr GhcTc -> f (LHsType GhcPs)
Luite Stegeman's avatar
Luite Stegeman committed
745 746
metaRequestT h = fmap unMetaResT . h (MetaT MetaResT)

747
metaRequestD :: Functor f => MetaHook f -> LHsExpr GhcTc -> f [LHsDecl GhcPs]
Luite Stegeman's avatar
Luite Stegeman committed
748 749
metaRequestD h = fmap unMetaResD . h (MetaD MetaResD)

750
metaRequestAW :: Functor f => MetaHook f -> LHsExpr GhcTc -> f Serialized
Luite Stegeman's avatar
Luite Stegeman committed
751 752
metaRequestAW h = fmap unMetaResAW . h (MetaAW MetaResAW)

Austin Seipp's avatar
Austin Seipp committed
753 754 755
{-
************************************************************************
*                                                                      *
756
\subsection{Dealing with Annotations}
Austin Seipp's avatar
Austin Seipp committed
757 758 759
*                                                                      *
************************************************************************
-}
760

dterei's avatar
dterei committed
761
-- | Deal with gathering annotations in from all possible places
762
--   and combining them into a single 'AnnEnv'
dterei's avatar
dterei committed
763 764 765 766 767
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
768 769 770
        -- 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
771 772
        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
773 774
        ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
                                                         Just home_pkg_anns,
dterei's avatar
dterei committed
775 776
                                                         Just other_pkg_anns]
    return ann_env
777

Austin Seipp's avatar
Austin Seipp committed
778 779 780
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
781
\subsection{The Finder cache}
Austin Seipp's avatar
Austin Seipp committed
782 783 784
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
785

786
-- | The 'FinderCache' maps modules to the result of
dterei's avatar
dterei committed
787 788
-- 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
789 790
-- contents of this cache.
--
791 792 793 794 795 796
type FinderCache = InstalledModuleEnv InstalledFindResult

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

-- | The result of searching for an imported module.
Edward Z. Yang's avatar
Edward Z. Yang committed
799 800 801
--
-- NB: FindResult manages both user source-import lookups
-- (which can result in 'Module') as well as direct imports
802
-- for interfaces (which always result in 'InstalledModule').
Simon Marlow's avatar
Simon Marlow committed
803
data FindResult
804
  = Found ModLocation Module
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
805
        -- ^ The module was found
806
  | NoPackage UnitId
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
807
        -- ^ The requested package was not found
808
  | FoundMultiple [(Module, ModuleOrigin)]
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
809
        -- ^ _Error_: both in multiple packages
dterei's avatar
dterei committed
810

dterei's avatar
dterei committed
811 812
        -- | Not found
  | NotFound
813 814
      { fr_paths       :: [FilePath]       -- Places where I looked

815
      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's
816 817 818
                                           --           manifest, but couldn't find
                                           --           the .hi file

819
      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,
820 821
                                           --   but the *module* is hidden

822
      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,
823 824
                                           --   but the *package* is hidden

825 826 827
        -- Modules are in these packages, but it is unusable
      , fr_unusables   :: [(UnitId, UnusablePackageReason)]

828
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
829
      }
Simon Marlow's avatar
Simon Marlow committed
830

Austin Seipp's avatar
Austin Seipp committed
831 832 833
{-
************************************************************************
*                                                                      *
834
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
835 836 837
*                                                                      *
************************************************************************
-}
838

dterei's avatar
dterei committed
839
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know
840
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
dterei's avatar
dterei committed
841
-- and can be written out to an interface file. The 'ModDetails is after
842
-- linking and can be completely recovered from just the 'ModIface'.
dterei's avatar
dterei committed
843
--
844 845 846 847
-- 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
848
data ModIface
dterei's avatar
dterei committed
849 850
  = ModIface {
        mi_module     :: !Module,             -- ^ Name of the module we are for
851
        mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?
dterei's avatar
dterei committed
852 853
        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface
        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only
854
        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags
855 856 857 858
                                              -- used when compiling the module,
                                              -- excluding optimisation flags
        mi_opt_hash   :: !Fingerprint,        -- ^ Hash of optimisation flags
        mi_hpc_hash   :: !Fingerprint,        -- ^ Hash of hpc flags
859
        mi_plugin_hash :: !Fingerprint,       -- ^ Hash of plugins
860

dterei's avatar
dterei committed
861
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
862 863 864
        mi_finsts     :: !WhetherHasFamInst,
                -- ^ Whether this module has family instances.
                -- See Note [The type family instance consistency story].
865
        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?
866

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
867 868 869 870
        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
871

872 873
        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
874 875 876 877
                -- 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
878