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
        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
        hptCompleteSigs,
41
        hptInstances, hptRules, hptVectInfo, pprHPT,
42 43
        hptObjs,

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

49
        PackageInstEnv, PackageFamInstEnv, PackageRuleBase,
50

51
        mkSOName, mkHsSOName, soExt,
52

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

59 60 61
        -- * Annotations
        prepareAnnotations,

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

        -- * COMPLETE signature
        CompleteMatch(..)
138
    ) where
139 140 141

#include "HsVersions.h"

142
import ByteCodeTypes
143
import InteractiveEvalTypes ( Resume )
144
import GHCi.Message         ( Pipe )
145
import GHCi.RemoteTypes
146

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 )
201
import Data.Foldable    ( foldl' )
dterei's avatar
dterei committed
202
import Data.IORef
203
import Data.Time
dterei's avatar
dterei committed
204 205
import Exception
import System.FilePath
206
import Control.Concurrent
207
import System.Process   ( ProcessHandle )
208

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

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

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

258 259
-- -----------------------------------------------------------------------------
-- Source Errors
260

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

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

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

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

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

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

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

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

instance Exception GhcApiError

316 317 318 319
-- | 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
320 321
  | anyBag (isWarnMsgFatal dflags) warns
  = throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags
322
  | otherwise
323
  = printBagOfErrors dflags warns
324

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

333
      printOrThrowWarnings dflags bag
334

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

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

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

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

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

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


453 454 455 456 457 458 459
data IServ = IServ
  { iservPipe :: Pipe
  , iservProcess :: ProcessHandle
  , iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
  , iservPendingFrees :: [HValueRef]
  }

dterei's avatar
dterei committed
460
-- | Retrieve the ExternalPackageState cache.
461 462
hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
463

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

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

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

Ian Lynagh's avatar
Ian Lynagh committed
492 493 494
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
495
pprTargetId :: TargetId -> SDoc
496
pprTargetId (TargetModule m) = ppr m
497
pprTargetId (TargetFile f _) = text f
498

Ian Lynagh's avatar
Ian Lynagh committed
499 500 501
instance Outputable TargetId where
    ppr = pprTargetId

Austin Seipp's avatar
Austin Seipp committed
502 503 504
{-
************************************************************************
*                                                                      *
dterei's avatar
dterei committed
505
\subsection{Package and Module Tables}
Austin Seipp's avatar
Austin Seipp committed
506 507 508
*                                                                      *
************************************************************************
-}
dterei's avatar
dterei committed
509

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

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

dterei's avatar
dterei committed
519
-- | Constructs an empty HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
520
emptyHomePackageTable :: HomePackageTable
niteria's avatar
niteria committed
521
emptyHomePackageTable  = emptyUDFM
Simon Marlow's avatar
Simon Marlow committed
522

dterei's avatar
dterei committed
523
-- | Constructs an empty PackageIfaceTable
Simon Marlow's avatar
Simon Marlow committed
524
emptyPackageIfaceTable :: PackageIfaceTable
525 526
emptyPackageIfaceTable = emptyModuleEnv

527
pprHPT :: HomePackageTable -> SDoc
528
-- A bit arbitrary for now
niteria's avatar
niteria committed
529
pprHPT hpt = pprUDFM hpt $ \hms ->
530
    vcat [ hang (ppr (mi_module (hm_iface hm)))
531
              2 (ppr (md_types (hm_details hm)))
532
         | hm <- hms ]
533

niteria's avatar
niteria committed
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 560 561 562 563 564
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

565 566 567 568
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
569
  = case lookupHpt hpt (moduleName mod) of
570 571 572
      Just hm | mi_module (hm_iface hm) == mod -> Just hm
      _otherwise                               -> Nothing

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

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

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

621 622
hptCompleteSigs :: HscEnv -> [CompleteMatch]
hptCompleteSigs = hptAllThings  (md_complete_sigs . hm_details)
623

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

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

647

dterei's avatar
dterei committed
648
-- | Get annotations from modules "below" this one (in the dependency sense)
649 650 651 652
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

653
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
niteria's avatar
niteria committed
654
hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
655

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

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

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

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

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
684
        -- And get its dfuns
685
    , thing <- things ]
686 687

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

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

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

Austin Seipp's avatar
Austin Seipp committed
756 757 758
{-
************************************************************************
*                                                                      *
Simon Marlow's avatar
Simon Marlow committed
759
\subsection{The Finder cache}
Austin Seipp's avatar
Austin Seipp committed
760 761 762
*                                                                      *
************************************************************************
-}
Simon Marlow's avatar
Simon Marlow committed
763

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

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

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

dterei's avatar
dterei committed
789 790
        -- | Not found
  | NotFound
791 792
      { fr_paths       :: [FilePath]       -- Places where I looked

793
      , fr_pkg         :: Maybe UnitId  -- Just p => module is in this package's
794 795 796
                                           --           manifest, but couldn't find
                                           --           the .hi file

797
      , fr_mods_hidden :: [UnitId]      -- Module is in these packages,
798 799
                                           --   but the *module* is hidden

800
      , fr_pkgs_hidden :: [UnitId]      -- Module is in these packages,
801 802
                                           --   but the *package* is hidden

803
      , fr_suggestions :: [ModuleSuggestion] -- Possible mis-spelled modules
804
      }
Simon Marlow's avatar
Simon Marlow committed
805

Austin Seipp's avatar
Austin Seipp committed
806 807 808
{-
************************************************************************
*                                                                      *
809
\subsection{Symbol tables and Module details}
Austin Seipp's avatar
Austin Seipp committed
810 811 812
*                                                                      *
************************************************************************
-}
813

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

dterei's avatar
dterei committed
832 833
        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts     :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
834
        mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?
835

chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
836 837 838 839
        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
840

841 842
        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
843 844 845 846
                -- 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
847

848
        mi_exports  :: ![IfaceExport],
dterei's avatar
dterei committed
849 850 851
                -- ^ Exports
                -- Kept sorted by (mod,occ), to make version comparisons easier
                -- Records the modules that are the declaration points for things
852
                -- exported by this module, and the 'OccName's of those things
dterei's avatar
dterei committed
853

dterei's avatar
dterei committed
854 855
        mi_exp_hash :: !Fingerprint,
                -- ^ Hash of export list
856

dterei's avatar
dterei committed
857 858 859
        mi_used_th  :: !Bool,
                -- ^ Module required TH splices when it was compiled.
                -- This disables recompilation avoidance (see #481).
860

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

dterei's avatar
dterei committed
865
        mi_warns    :: Warnings,
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
866 867
                -- ^ Warnings
                -- NOT STRICT!  we read this field lazily from the interface file
868

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

dterei's avatar