HscTypes.lhs 77 KB
Newer Older
1 2
%
% (c) The University of Glasgow, 2006
3 4 5 6
%
\section[HscTypes]{Types for the per-module compiler}

\begin{code}
7
-- | Types for the per-module compiler
8
module HscTypes ( 
9
	-- * compilation state
10
        HscEnv(..), hscEPS,
Simon Marlow's avatar
Simon Marlow committed
11
	FinderCache, FindResult(..), ModLocationCache,
12 13
	Target(..), TargetId(..), pprTarget, pprTargetId,
	ModuleGraph, emptyMG,
14

15
        -- * Information about modules
16
	ModDetails(..),	emptyModDetails,
17
        ModGuts(..), CgGuts(..), ForeignStubs(..), appendStubC,
18
        ImportedMods, ImportedModsVal,
19

20
	ModSummary(..), ms_mod_name, showModMsg, isBootSummary,
21
	msHsFilePath, msHiFilePath, msObjFilePath,
22

23
        -- * Information about the module being compiled
24 25
	HscSource(..), isHsBoot, hscSourceString,	-- Re-exported from DriverPhases
	
26
	-- * State relating to modules in this package
27
	HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
28 29 30
        hptInstances, hptRules, hptVectInfo,
        hptObjs,

31
	-- * State relating to known packages
32
	ExternalPackageState(..), EpsStats(..), addEpsInStats,
33
	PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
Simon Marlow's avatar
Simon Marlow committed
34
	lookupIfaceByModule, emptyModIface,
35 36
	
	PackageInstEnv, PackageRuleBase,
37

38 39 40 41

        -- * Annotations
        prepareAnnotations,

42
        -- * Interactive context
43
	InteractiveContext(..), emptyInteractiveContext, 
44
	icPrintUnqual, extendInteractiveContext,
mnislaih's avatar
mnislaih committed
45
        substInteractiveContext,
46
        mkPrintUnqualified, pprModulePrefix,
47

48
	-- * Interfaces
Ian Lynagh's avatar
Ian Lynagh committed
49 50
	ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
	emptyIfaceWarnCache,
51

52
        -- * Fixity
53
	FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
54

55 56
        -- * TyThings and type environments
	TyThing(..),
57
	tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId, tyThingCoAxiom,
58
	implicitTyThings, implicitTyConThings, implicitClassThings, isImplicitTyThing,
59 60
	
	TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv,
61
	extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
62
	typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
63
	typeEnvDataCons, typeEnvCoAxioms,
64

65 66 67 68
        -- * MonadThings
        MonadThings(..),

        -- * Information on imports and exports
69
	WhetherHasOrphans, IsBootInterface, Usage(..), 
70
	Dependencies(..), noDependencies,
71
	NameCache(..), OrigNameCache, OrigIParamCache,
72
	Avails, availsToNameSet, availsToNameEnv, availName, availNames,
73
	GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
74
	IfaceExport,
75

76
	-- * Warnings
Ian Lynagh's avatar
Ian Lynagh committed
77
	Warnings(..), WarningTxt(..), plusWarns,
78

79
	-- * Linker stuff
80
        Linkable(..), isObjectLinkable, linkableObjs,
81
	Unlinked(..), CompiledByteCode,
andy@galois.com's avatar
andy@galois.com committed
82
	isObject, nameOfObject, isInterpretable, byteCodeOfObject,
83 84
        
        -- * Program coverage
85
        HpcInfo(..), emptyHpcInfo, isHpcUsed, AnyHpcUsage,
86

87
        -- * Breakpoints
88 89
        ModBreaks (..), BreakIndex, emptyModBreaks,

90
        -- * Vectorisation information
91
        VectInfo(..), IfaceVectInfo(..), noVectInfo, plusVectInfo, 
92 93
        noIfaceVectInfo,

94 95
        -- * Safe Haskell information
        IfaceTrustInfo, getSafeMode, setSafeMode, noIfaceTrustInfo,
96
        trustInfoToNum, numToTrustInfo, IsSafeImport,
97

98 99 100 101
        -- * Compilation errors and warnings
        SourceError, GhcApiError, mkSrcErr, srcErrorMessages, mkApiErr,
        throwOneError, handleSourceError,
        handleFlagWarnings, printOrThrowWarnings,
102
    ) where
103 104 105

#include "HsVersions.h"

106
#ifdef GHCI
107
import ByteCodeAsm      ( CompiledByteCode )
108
import {-# SOURCE #-}  InteractiveEval ( Resume )
109 110
#endif

111
import HsSyn
112
import RdrName
113
import Name
114
import NameEnv
115
import NameSet  
116
import Module
117 118 119 120
import InstEnv          ( InstEnv, Instance )
import FamInstEnv       ( FamInstEnv, FamInst )
import Rules            ( RuleBase )
import CoreSyn          ( CoreBind )
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
121
import VarEnv
122
import VarSet
123
import Var
124
import Id
125
import Type             
126

127
import Annotations
128
import Class		( Class, classAllSelIds, classATs, classTyCon )
129
import TyCon
130
import DataCon		( DataCon, dataConImplicitIds, dataConWrapId )
131
import PrelNames	( gHC_PRIM )
132
import Packages hiding ( Version(..) )
133
import DynFlags		( DynFlags(..), isOneShot, HscTarget (..), dopt,
134
                          DynFlag(..), SafeHaskellMode(..) )
135
import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
Ian Lynagh's avatar
Ian Lynagh committed
136
import BasicTypes	( IPName, defaultFixity, WarningTxt(..) )
dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
137
import OptimizationFuel	( OptFuelState )
138
import IfaceSyn
139
import CoreSyn		( CoreRule, CoreVect )
140
import Maybes		( orElse, expectJust, catMaybes )
141
import Outputable
142
import BreakArray
Ian Lynagh's avatar
Ian Lynagh committed
143
import SrcLoc
144
import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
145
import UniqSupply	( UniqSupply )
146
import FastString
147
import StringBuffer	( StringBuffer )
148
import Fingerprint
149 150 151
import MonadUtils
import Data.Dynamic     ( Typeable )
import qualified Data.Dynamic as Dyn
152 153
import Bag
import ErrUtils
Simon Marlow's avatar
Simon Marlow committed
154

155
import System.FilePath
Simon Marlow's avatar
Simon Marlow committed
156
import System.Time	( ClockTime )
157
import Data.IORef
158
import Data.Array       ( Array, array )
mnislaih's avatar
mnislaih committed
159
import Data.List
160
import Data.Map (Map)
161
import Data.Word
162
import Control.Monad    ( mplus, guard, liftM, when )
163
import Exception
164

165 166
-- -----------------------------------------------------------------------------
-- Source Errors
167

168 169
-- When the compiler (HscMain) discovers errors, it throws an
-- exception in the IO monad.
170 171 172 173 174

mkSrcErr :: ErrorMessages -> SourceError
srcErrorMessages :: SourceError -> ErrorMessages
mkApiErr :: SDoc -> GhcApiError

175 176 177
throwOneError :: MonadIO m => ErrMsg -> m ab
throwOneError err = liftIO $ throwIO $ mkSrcErr $ unitBag err

178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
-- | 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.
data SourceError = SourceError ErrorMessages

instance Show SourceError where
  show (SourceError msgs) = unlines . map show . bagToList $ msgs
    -- ToDo: is there some nicer way to print this?

sourceErrorTc :: Dyn.TyCon
sourceErrorTc = Dyn.mkTyCon "SourceError"
{-# NOINLINE sourceErrorTc #-}
instance Typeable SourceError where
  typeOf _ = Dyn.mkTyConApp sourceErrorTc []

instance Exception SourceError

mkSrcErr = 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)

srcErrorMessages (SourceError msgs) = msgs

-- | XXX: what exactly is an API error?
data GhcApiError = GhcApiError SDoc

instance Show GhcApiError where
  show (GhcApiError msg) = showSDoc msg

ghcApiErrorTc :: Dyn.TyCon
ghcApiErrorTc = Dyn.mkTyCon "GhcApiError"
{-# NOINLINE ghcApiErrorTc #-}
instance Typeable GhcApiError where
  typeOf _ = Dyn.mkTyConApp ghcApiErrorTc []

instance Exception GhcApiError

mkApiErr = GhcApiError

237 238 239 240 241 242 243 244 245
-- | 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
  | dopt Opt_WarnIsError dflags
  = when (not (isEmptyBag warns)) $ do
      throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg
  | otherwise
  = printBagOfWarnings dflags warns
246

247
handleFlagWarnings :: DynFlags -> [Located String] -> IO ()
248
handleFlagWarnings dflags warns
249 250 251 252 253
 = when (dopt Opt_WarnDeprecatedFlags dflags) $ do
        -- It would be nicer if warns :: [Located Message], but that
        -- has circular import problems.
      let bag = listToBag [ mkPlainWarnMsg loc (text warn) 
                          | L loc warn <- warns ]
254

255
      printOrThrowWarnings dflags bag
256 257 258 259
\end{code}

\begin{code}
-- | Hscenv is like 'Session', except that some of the fields are immutable.
260 261 262 263 264 265 266 267 268
-- 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.
269
data HscEnv 
270 271
  = HscEnv { 
	hsc_dflags :: DynFlags,
272
		-- ^ The dynamic flag settings
273 274

	hsc_targets :: [Target],
275
		-- ^ The targets (or roots) of the current session
276

277
	hsc_mod_graph :: ModuleGraph,
278
		-- ^ The module graph of the current session
279 280

	hsc_IC :: InteractiveContext,
281
		-- ^ The context for evaluating interactive statements
282 283

	hsc_HPT    :: HomePackageTable,
284 285
		-- ^ The home package table describes already-compiled
		-- home-package modules, /excluding/ the module we 
286 287 288
		-- are compiling right now.
		-- (In one-shot mode the current module is the only
		--  home-package module, so hsc_HPT is empty.  All other
289
		--  modules count as \"external-package\" modules.
290
		--  However, even in GHCi mode, hi-boot interfaces are
291
		--  demand-loaded into the external-package table.)
292
		--
293
		-- 'hsc_HPT' is not mutable because we only demand-load 
294
		-- external packages; the home package is eagerly 
295
		-- loaded, module by module, by the compilation manager.
296
		--	
297
		-- The HPT may contain modules compiled earlier by @--make@
298
		-- but not actually below the current module in the dependency
299 300 301
		-- graph.

		-- (This changes a previous invariant: changed Jan 05.)
302
	
303
	hsc_EPS	:: {-# UNPACK #-} !(IORef ExternalPackageState),
304 305 306 307
	        -- ^ Information about the currently loaded external packages.
	        -- This is mutable because packages will be demand-loaded during
	        -- a compilation run as required.
	
308
	hsc_NC	:: {-# UNPACK #-} !(IORef NameCache),
309 310
		-- ^ As with 'hsc_EPS', this is side-effected by compiling to
		-- reflect sucking in interface files.  They cache the state of
311 312
		-- external interface files, in effect.

Simon Marlow's avatar
Simon Marlow committed
313
	hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),
314
	        -- ^ The cached result of performing finding in the file system
Simon Marlow's avatar
Simon Marlow committed
315
	hsc_MLC  :: {-# UNPACK #-} !(IORef ModLocationCache),
316 317
		-- ^ This caches the location of modules, so we don't have to 
		-- search the filesystem multiple times. See also 'hsc_FC'.
Simon Marlow's avatar
Simon Marlow committed
318

dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
319
        hsc_OptFuel :: OptFuelState,
320
                -- ^ Settings to control the use of \"optimization fuel\":
dias@eecs.harvard.edu's avatar
dias@eecs.harvard.edu committed
321 322 323
                -- by limiting the number of transformations,
                -- we can use binary search to help find compiler bugs.

324
        hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
325 326 327
                -- ^ Used for one-shot compilation only, to initialise
                -- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for 
                -- 'TcRunTypes.TcGblEnv'
328
 }
329 330 331

hscEPS :: HscEnv -> IO ExternalPackageState
hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
332

333 334 335 336 337 338
-- | 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).
Simon Marlow's avatar
Simon Marlow committed
339
data Target = Target
340 341 342 343 344
      { targetId           :: TargetId  -- ^ module or filename
      , targetAllowObjCode :: Bool      -- ^ object code allowed?
      , targetContents     :: Maybe (StringBuffer,ClockTime)
                                        -- ^ in-memory text buffer?
      }
345 346

data TargetId
Simon Marlow's avatar
Simon Marlow committed
347
  = TargetModule ModuleName
348 349 350 351 352 353
	-- ^ A module name: search for the file
  | TargetFile FilePath (Maybe Phase)
	-- ^ 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.
354
  deriving Eq
355 356

pprTarget :: Target -> SDoc
Simon Marlow's avatar
Simon Marlow committed
357 358
pprTarget (Target id obj _) = 
   (if obj then char '*' else empty) <> pprTargetId id
359

Ian Lynagh's avatar
Ian Lynagh committed
360 361 362
instance Outputable Target where
    ppr = pprTarget

Simon Marlow's avatar
Simon Marlow committed
363
pprTargetId :: TargetId -> SDoc
364
pprTargetId (TargetModule m) = ppr m
365
pprTargetId (TargetFile f _) = text f
366

Ian Lynagh's avatar
Ian Lynagh committed
367 368 369
instance Outputable TargetId where
    ppr = pprTargetId

370
-- | Helps us find information about modules in the home package
Simon Marlow's avatar
Simon Marlow committed
371
type HomePackageTable  = ModuleNameEnv HomeModInfo
372
	-- Domain = modules in the home package that have been fully compiled
Simon Marlow's avatar
Simon Marlow committed
373
	-- "home" package name cached here for convenience
374 375

-- | Helps us find information about modules in the imported packages
376 377
type PackageIfaceTable = ModuleEnv ModIface
	-- Domain = modules in the imported packages
378

Simon Marlow's avatar
Simon Marlow committed
379
emptyHomePackageTable :: HomePackageTable
Simon Marlow's avatar
Simon Marlow committed
380
emptyHomePackageTable  = emptyUFM
Simon Marlow's avatar
Simon Marlow committed
381 382

emptyPackageIfaceTable :: PackageIfaceTable
383 384
emptyPackageIfaceTable = emptyModuleEnv

385
-- | Information about modules in the package being compiled
386
data HomeModInfo 
387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411
  = 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
	-- the module, typically during typechecking
      hm_linkable :: !(Maybe Linkable)
        -- ^ The actual artifact we would like to link to access things in
	-- 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).
    }
412

413 414
-- | Find the 'ModIface' for a 'Module', searching in both the loaded home
-- and external package module information
Simon Marlow's avatar
Simon Marlow committed
415 416 417 418 419 420 421
lookupIfaceByModule
	:: DynFlags
	-> HomePackageTable
	-> PackageIfaceTable
	-> Module
	-> Maybe ModIface
lookupIfaceByModule dflags hpt pit mod
422 423 424 425 426
  | modulePackageId mod == thisPackage dflags
  = 	-- The module comes from the home package, so look first
	-- in the HPT.  If it's not from the home package it's wrong to look
	-- in the HPT, because the HPT is indexed by *ModuleName* not Module
    fmap hm_iface (lookupUFM hpt (moduleName mod)) 
427
    `mplus` lookupModuleEnv pit mod
428 429 430 431 432 433 434

  | otherwise = lookupModuleEnv pit mod		-- Look in PIT only 

-- 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.
435
-- We could eliminate (b) if we wanted, by making GHC.Prim belong to a package
436
-- of its own, but it doesn't seem worth the bother.
437
\end{code}
438

439 440

\begin{code}
441
hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([Instance], [FamInst])
442
-- ^ Find all the instance declarations (of classes and families) that are in
443
-- modules imported by this one, directly or indirectly, and are in the Home
444
-- Package Table.  This ensures that we don't see instances from modules @--make@
445
-- compiled before this one, but which are not below this one.
446
hptInstances hsc_env want_this_module
447 448 449 450 451 452 453 454 455 456 457 458
  = 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)

hptVectInfo :: HscEnv -> VectInfo
-- ^ Get the combined VectInfo of all modules in the home package table.  In
-- contrast to instances and rules, we don't care whether the modules are
-- \"below\" us in the dependency sense.  The VectInfo of those modules not \"below\" 
-- us does not affect the compilation of the current module.
hptVectInfo = concatVectInfo . hptAllThings ((: []) . md_vect_info . hm_details)
459

Simon Marlow's avatar
Simon Marlow committed
460
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
461 462 463
-- ^ Get rules from modules \"below\" this one (in the dependency sense)
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False

464 465 466 467 468 469

hptAnns :: HscEnv -> Maybe [(ModuleName, IsBootInterface)] -> [Annotation]
-- ^ Get annotations from modules \"below\" this one (in the dependency sense)
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

470 471 472 473 474
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings extract hsc_env = concatMap extract (eltsUFM (hsc_HPT hsc_env))

hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [(ModuleName, IsBootInterface)] -> [a]
-- Get things from modules \"below\" this one (in the dependency sense)
475
-- C.f Inst.hptInstances
476 477
hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
 | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
478 479 480 481
  | otherwise
  = let 
	hpt = hsc_HPT hsc_env
    in
482
    [ thing
483
    |	-- Find each non-hi-boot module below me
484 485
      (mod, is_boot_mod) <- deps
    , include_hi_boot || not is_boot_mod
486

487
	-- unsavoury: when compiling the base package with --make, we
488
	-- sometimes try to look up RULES etc for GHC.Prim.  GHC.Prim won't
489 490 491
	-- be in the HPT, because we never compile it; it's in the EPT
	-- instead.  ToDo: clean up, and remove this slightly bogus
	-- filter:
Simon Marlow's avatar
Simon Marlow committed
492
    , mod /= moduleName gHC_PRIM
493

494
	-- Look it up in the HPT
495 496 497
    , let things = case lookupUFM hpt mod of
		    Just info -> extract info
		    Nothing -> pprTrace "WARNING in hptSomeThingsBelowUs" msg [] 
Ian Lynagh's avatar
Ian Lynagh committed
498 499
	  msg = vcat [ptext (sLit "missing module") <+> ppr mod,
		      ptext (sLit "Probable cause: out-of-date interface files")]
500
			-- This really shouldn't happen, but see Trac #962
501 502

	-- And get its dfuns
503
    , thing <- things ]
504 505 506

hptObjs :: HomePackageTable -> [FilePath]
hptObjs hpt = concat (map (maybe [] linkableObjs . hm_linkable) (eltsUFM hpt))
507
\end{code}
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
508

509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532
%************************************************************************
%*									*
\subsection{Dealing with Annotations}
%*									*
%************************************************************************

\begin{code}
prepareAnnotations :: HscEnv -> Maybe ModGuts -> IO AnnEnv
-- ^ Deal with gathering annotations in from all possible places 
--   and combining them into a single '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
        -- Extract dependencies of the module if we are supplied one,
        -- otherwise load annotations from all home package table
        -- entries regardless of dependency ordering.
            home_pkg_anns  = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
            other_pkg_anns = eps_ann_env eps
            ann_env        = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns, 
                                                             Just home_pkg_anns, 
                                                             Just other_pkg_anns]

       ; return ann_env }
533 534
\end{code}

Simon Marlow's avatar
Simon Marlow committed
535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554
%************************************************************************
%*									*
\subsection{The Finder cache}
%*									*
%************************************************************************

\begin{code}
-- | The 'FinderCache' maps home module names to the result of
-- searching for that module.  It records the results of searching for
-- modules along the search path.  On @:load@, we flush the entire
-- contents of this cache.
--
-- Although the @FinderCache@ range is 'FindResult' for convenience ,
-- in fact it will only ever contain 'Found' or 'NotFound' entries.
--
type FinderCache = ModuleNameEnv FindResult

-- | The result of searching for an imported module.
data FindResult
  = Found ModLocation Module
555
	-- ^ The module was found
Simon Marlow's avatar
Simon Marlow committed
556
  | NoPackage PackageId
557
	-- ^ The requested package was not found
Simon Marlow's avatar
Simon Marlow committed
558
  | FoundMultiple [PackageId]
559
	-- ^ _Error_: both in multiple packages
560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575

  | NotFound          -- Not found
      { fr_paths       :: [FilePath]       -- Places where I looked

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

      , fr_mods_hidden :: [PackageId]      -- Module is in these packages,
                                           --   but the *module* is hidden

      , fr_pkgs_hidden :: [PackageId]      -- Module is in these packages,
                                           --   but the *package* is hidden

      , fr_suggestions :: [Module]         -- Possible mis-spelled modules
      }
Simon Marlow's avatar
Simon Marlow committed
576 577 578 579 580 581

-- | Cache that remembers where we found a particular module.  Contains both
-- home modules and package modules.  On @:load@, only home modules are
-- purged from this cache.
type ModLocationCache = ModuleEnv ModLocation
\end{code}
582

583 584
%************************************************************************
%*									*
585
\subsection{Symbol tables and Module details}
586 587 588 589
%*									*
%************************************************************************

\begin{code}
590 591 592 593 594 595 596 597 598
-- | A 'ModIface' plus a 'ModDetails' summarises everything we know 
-- about a compiled module.  The 'ModIface' is the stuff *before* linking,
-- and can be written out to an interface file. The 'ModDetails is after 
-- linking and can be completely recovered from just the 'ModIface'.
-- 
-- 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'.
599 600
data ModIface 
   = ModIface {
601 602 603
        mi_module   :: !Module,             -- ^ Name of the module we are for
        mi_iface_hash :: !Fingerprint,      -- ^ Hash of the whole interface
        mi_mod_hash :: !Fingerprint,	    -- ^ Hash of the ABI only
604

605 606 607
        mi_orphan   :: !WhetherHasOrphans,  -- ^ Whether this module has orphans
        mi_finsts   :: !WhetherHasFamInst,  -- ^ Whether this module has family instances
	mi_boot	    :: !IsBootInterface,    -- ^ Read from an hi-boot file?
608

609
	mi_deps	    :: Dependencies,
Simon Marlow's avatar
Simon Marlow committed
610 611 612 613
	        -- ^ The dependencies of the module.  This is
		-- consulted for directly-imported modules, but not
		-- for anything else (hence lazy)

614 615
        mi_usages   :: [Usage],
                -- ^ Usages; kept sorted so that it's easy to decide
616
		-- whether to write a new iface file (changing usages
617
		-- doesn't affect the hash of this module)
618
        
619
		-- NOT STRICT!  we read this field lazily from the interface file
620
		-- It is *only* consulted by the recompilation checker
621

622 623 624
		-- Exports
		-- Kept sorted by (mod,occ), to make version comparisons easier
        mi_exports  :: ![IfaceExport],
625 626 627 628
                -- ^ Records the modules that are the declaration points for things
                -- exported by this module, and the 'OccName's of those things
        
        mi_exp_hash :: !Fingerprint,	-- ^ Hash of export list
629

630
        mi_fixities :: [(OccName,Fixity)],
631 632
                -- ^ Fixities
        
633
		-- NOT STRICT!  we read this field lazily from the interface file
634

Ian Lynagh's avatar
Ian Lynagh committed
635
	mi_warns  :: Warnings,
636 637
		-- ^ Warnings
		
638
		-- NOT STRICT!  we read this field lazily from the interface file
639

640 641 642 643 644
	mi_anns  :: [IfaceAnnotation],
	        -- ^ Annotations
	
		-- NOT STRICT!  we read this field lazily from the interface file

645
		-- Type, class and variable declarations
646
		-- The hash of an Id changes if its fixity or deprecations change
647 648
		--	(as well as its type of course)
		-- Ditto data constructors, class operations, except that 
649
		-- the hash of the parent class/tycon changes
650
	mi_decls :: [(Fingerprint,IfaceDecl)],	-- ^ Sorted type, variable, class etc. declarations
651

652
        mi_globals  :: !(Maybe GlobalRdrEnv),
653 654
		-- ^ Binds all the things defined at the top level in
		-- the /original source/ code for this module. which
655 656 657 658 659 660 661
		-- is NOT the same as mi_exports, nor mi_decls (which
		-- may contains declarations for things not actually
		-- defined by the user).  Used for GHCi and for inspecting
		-- the contents of modules via the GHC API only.
		--
		-- (We need the source file to figure out the
		-- top-level environment, if we didn't compile this module
662
		-- from source then this field contains @Nothing@).
663 664
		--
		-- Strictly speaking this field should live in the
665
		-- 'HomeModInfo', but that leads to more plumbing.
666

667
		-- Instance declarations and rules
668 669 670 671 672
	mi_insts     :: [IfaceInst],			-- ^ Sorted class instance
	mi_fam_insts :: [IfaceFamInst],			-- ^ Sorted family instances
	mi_rules     :: [IfaceRule],			-- ^ Sorted rules
	mi_orphan_hash :: !Fingerprint,	-- ^ Hash for orphan rules and 
					-- class and family instances
673
					-- combined
674

675
        mi_vect_info :: !IfaceVectInfo, -- ^ Vectorisation information
676

677 678 679
		-- Cached environments for easy lookup
		-- These are computed (lazily) from other fields
		-- and are not put into the interface file
680 681
	mi_warn_fn  :: Name -> Maybe WarningTxt,        -- ^ Cached lookup for 'mi_warns'
	mi_fix_fn  :: OccName -> Fixity,	        -- ^ Cached lookup for 'mi_fixities'
682
	mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint),
683 684
                        -- ^ Cached lookup for 'mi_decls'.
			-- The @Nothing@ in 'mi_hash_fn' means that the thing
685
			-- isn't in decls. It's useful to know that when
686
			-- seeing if we are up to date wrt. the old interface.
687
                        -- The 'OccName' is the parent of the name, if it has one.
688
	mi_hpc    :: !AnyHpcUsage,
689
	        -- ^ True if this program uses Hpc at any point in the program.
690 691
	mi_trust  :: !IfaceTrustInfo
	        -- ^ Safe Haskell Trust information for this module.
692
     }
693

694 695 696
-- | The 'ModDetails' is essentially a cache for information in the 'ModIface'
-- for home modules only. Information relating to packages will be loaded into
-- global environments in 'ExternalPackageState'.
697 698
data ModDetails
   = ModDetails {
699 700
	-- The next two fields are created by the typechecker
	md_exports   :: [AvailInfo],
701 702
        md_types     :: !TypeEnv,       -- ^ Local type environment for this particular module
        md_insts     :: ![Instance],    -- ^ 'DFunId's for the instances in this module
703
        md_fam_insts :: ![FamInst],
704
        md_rules     :: ![CoreRule],    -- ^ Domain may include 'Id's from other modules
705 706
        md_anns      :: ![Annotation],  -- ^ Annotations present in this module: currently 
                                        -- they only annotate things also declared in this module
707
        md_vect_info :: !VectInfo       -- ^ Module vectorisation information
708
     }
709

Simon Marlow's avatar
Simon Marlow committed
710
emptyModDetails :: ModDetails
711
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
712
			       md_exports = [],
713 714
			       md_insts     = [],
			       md_rules     = [],
mnislaih's avatar
mnislaih committed
715
			       md_fam_insts = [],
716
                               md_anns      = [],
chak@cse.unsw.edu.au.'s avatar
chak@cse.unsw.edu.au. committed
717 718
                               md_vect_info = noVectInfo
                             } 
719

720
-- | Records the modules directly imported by a module for extracting e.g. usage information
721 722 723
type ImportedMods = ModuleEnv [ImportedModsVal]
type ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)

724 725
-- TODO: we are not actually using the codomain of this type at all, so it can be
-- replaced with ModuleEnv ()
Simon Marlow's avatar
Simon Marlow committed
726

727 728 729
-- | A ModGuts is carried through the compiler, accumulating stuff as it goes
-- There is only one ModGuts at any time, the one for the module
-- being compiled right now.  Once it is compiled, a 'ModIface' and 
dterei's avatar
dterei committed
730
-- 'ModDetails' are extracted and the ModGuts is discarded.
731 732
data ModGuts
  = ModGuts {
733 734 735 736 737 738 739 740
        mg_module    :: !Module,         -- ^ Module being compiled
	mg_boot      :: IsBootInterface, -- ^ Whether it's an hs-boot module
	mg_exports   :: ![AvailInfo],	 -- ^ What it exports
	mg_deps	     :: !Dependencies,	 -- ^ What it depends on, directly or
	                                 -- otherwise
	mg_dir_imps  :: !ImportedMods,	 -- ^ Directly-imported modules; used to
					 -- generate initialisation code
	mg_used_names:: !NameSet,	 -- ^ What the module needed (used in 'MkIface.mkIface')
741

742
        mg_rdr_env   :: !GlobalRdrEnv,	 -- ^ Top-level lexical environment
743

744
	-- These fields all describe the things **declared in this module**
745 746 747 748 749 750
	mg_fix_env   :: !FixityEnv,	 -- ^ Fixities declared in this module
	                                 -- TODO: I'm unconvinced this is actually used anywhere
	mg_types     :: !TypeEnv,        -- ^ Types declared in this module
	mg_insts     :: ![Instance],	 -- ^ Class instances declared in this module
	mg_fam_insts :: ![FamInst],	 -- ^ Family instances declared in this module
        mg_rules     :: ![CoreRule],	 -- ^ Before the core pipeline starts, contains 
751
		     			 -- See Note [Overall plumbing for rules] in Rules.lhs
752 753 754
	mg_binds     :: ![CoreBind],	 -- ^ Bindings for this module
	mg_foreign   :: !ForeignStubs,   -- ^ Foreign exports declared in this module
	mg_warns     :: !Warnings,	 -- ^ Warnings declared in the module
755 756
        mg_anns      :: [Annotation],    -- ^ Annotations declared in this module
        mg_hpc_info  :: !HpcInfo,        -- ^ Coverage tick boxes in the module
757
        mg_modBreaks :: !ModBreaks,      -- ^ Breakpoints for the module
758 759
        mg_vect_decls:: ![CoreVect],     -- ^ Vectorisation declarations in this module
                                         --   (produced by desugarer & consumed by vectoriser)
760
        mg_vect_info :: !VectInfo,       -- ^ Pool of vectorised declarations in the module
761 762 763 764 765 766

	-- The next two fields are unusual, because they give instance
	-- environments for *all* modules in the home package, including
	-- this module, rather than for *just* this module.  
	-- Reason: when looking up an instance we don't want to have to
	--	  look at each module in the home package in turn
Thomas Schilling's avatar
Thomas Schilling committed
767
	mg_inst_env     :: InstEnv,
768 769
        -- ^ Class instance environment from /home-package/ modules (including
	-- this one); c.f. 'tcg_inst_env'
Thomas Schilling's avatar
Thomas Schilling committed
770 771
	mg_fam_inst_env :: FamInstEnv
        -- ^ Type-family instance enviroment for /home-package/ modules
772
	-- (including this one); c.f. 'tcg_fam_inst_env'
773 774
    }

775 776 777 778 779 780
-- The ModGuts takes on several slightly different forms:
--
-- After simplification, the following fields change slightly:
--	mg_rules	Orphan rules only (local ones now attached to binds)
--	mg_binds	With rules attached

781
-- The ModGuts takes on several slightly different forms:
782
--
783 784 785 786 787
-- After simplification, the following fields change slightly:
--	mg_rules	Orphan rules only (local ones now attached to binds)
--	mg_binds	With rules attached


788 789 790 791 792
---------------------------------------------------------
-- The Tidy pass forks the information about this module: 
--	* one lot goes to interface file generation (ModIface)
--	  and later compilations (ModDetails)
--	* the other lot goes to code generation (CgGuts)
793 794

-- | A restricted form of 'ModGuts' for code generation purposes
795 796
data CgGuts 
  = CgGuts {
797
	cg_module   :: !Module, -- ^ Module being compiled
798

799
	cg_tycons   :: [TyCon],
800
		-- ^ Algebraic data types (including ones that started
801
		-- life as classes); generate constructors and info
802
		-- tables. Includes newtypes, just for the benefit of
803
		-- External Core
804

805
	cg_binds    :: [CoreBind],
806
		-- ^ The tidied main bindings, including
807 808 809 810
		-- previously-implicit bindings for record and class
		-- selectors, and data construtor wrappers.  But *not*
		-- data constructor workers; reason: we we regard them
		-- as part of the code-gen of tycons
811

812
        cg_foreign  :: !ForeignStubs,   -- ^ Foreign export stubs
813 814 815 816
	cg_dep_pkgs :: ![PackageId],	-- ^ Dependent packages, used to 
	                                -- generate #includes for C code gen
        cg_hpc_info :: !HpcInfo,        -- ^ Program coverage tick box information
        cg_modBreaks :: !ModBreaks      -- ^ Module breakpoints
817
    }
818

819
-----------------------------------
820 821
-- | Foreign export stubs
data ForeignStubs = NoStubs             -- ^ We don't have any stubs
822
		  | ForeignStubs
823 824 825 826 827 828 829 830 831
			SDoc 		
			SDoc 		
		   -- ^ There are some stubs. Parameters:
		   --
		   --  1) Header file prototypes for
                   --     "foreign exported" functions
                   --
                   --  2) C stubs to use when calling
                   --     "foreign exported" functions
832 833 834 835

appendStubC :: ForeignStubs -> SDoc -> ForeignStubs
appendStubC NoStubs            c_code = ForeignStubs empty c_code
appendStubC (ForeignStubs h c) c_code = ForeignStubs h (c $$ c_code)
836 837 838
\end{code}

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
839 840 841
emptyModIface :: Module -> ModIface
emptyModIface mod
  = ModIface { mi_module   = mod,
842 843
	       mi_iface_hash = fingerprint0,
	       mi_mod_hash = fingerprint0,
844
	       mi_orphan   = False,
845
	       mi_finsts   = False,
846
	       mi_boot	   = False,
847 848
	       mi_deps     = noDependencies,
	       mi_usages   = [],
849
	       mi_exports  = [],
850
	       mi_exp_hash = fingerprint0,
851
	       mi_fixities = [],
Ian Lynagh's avatar
Ian Lynagh committed
852
	       mi_warns    = NoWarnings,
853
	       mi_anns     = [],
854 855 856 857 858
	       mi_insts     = [],
	       mi_fam_insts = [],
	       mi_rules     = [],
	       mi_decls     = [],
	       mi_globals   = Nothing,
859
	       mi_orphan_hash = fingerprint0,
860
               mi_vect_info = noIfaceVectInfo,
Ian Lynagh's avatar
Ian Lynagh committed
861
	       mi_warn_fn    = emptyIfaceWarnCache,
862 863
	       mi_fix_fn    = emptyIfaceFixCache,
	       mi_hash_fn   = emptyIfaceHashCache,
864 865
	       mi_hpc       = False,
	       mi_trust     = noIfaceTrustInfo
866
    }		
867 868
\end{code}

869

870 871 872 873 874 875 876
%************************************************************************
%*									*
\subsection{The interactive context}
%*									*
%************************************************************************

\begin{code}
877 878 879
-- | Interactive context, recording information about the state of the
-- context in which statements are executed in a GHC session.
--
880 881
data InteractiveContext 
  = InteractiveContext { 
882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902
         -- These two fields are only stored here so that the client
         -- can retrieve them with GHC.getContext.  GHC itself doesn't
         -- use them, but it does reset them to empty sometimes (such
         -- as before a GHC.load).  The context is set with GHC.setContext.
         ic_toplev_scope :: [Module],
             -- ^ The context includes the "top-level" scope of
             -- these modules
         ic_imports :: [ImportDecl RdrName],
             -- ^ The context is extended with these import declarations

         ic_rn_gbl_env :: GlobalRdrEnv,
             -- ^ The contexts' cached 'GlobalRdrEnv', built by
             -- 'InteractiveEval.setContext'

         ic_tmp_ids :: [Id],
             -- ^ Names bound during interaction with the user.  Later
             -- Ids shadow earlier ones with the same OccName
             -- Expressions are typed with these Ids in the envt For
             -- runtime-debugging, these Ids may have free TcTyVars of
             -- RuntimUnkSkol flavour, but no free TyVars (because the
             -- typechecker doesn't expect that)
903

904
#ifdef GHCI
905 906
         ic_resume :: [Resume],
             -- ^ The stack of breakpoint contexts
907
#endif
908

909 910
         ic_cwd :: Maybe FilePath
             -- virtual CWD of the program
911
    }
912

913

Simon Marlow's avatar
Simon Marlow committed
914
emptyInteractiveContext :: InteractiveContext
915 916
emptyInteractiveContext
  = InteractiveContext { ic_toplev_scope = [],
917
                         ic_imports = [],
918
			 ic_rn_gbl_env = emptyGlobalRdrEnv,
919
			 ic_tmp_ids = []
920 921 922
#ifdef GHCI
                         , ic_resume = []
#endif
923
                         , ic_cwd = Nothing
924
                       }
925

926 927
icPrintUnqual :: DynFlags -> InteractiveContext -> PrintUnqualified
icPrintUnqual dflags ictxt = mkPrintUnqualified dflags (ic_rn_gbl_env ictxt)
928 929 930 931 932 933


extendInteractiveContext
        :: InteractiveContext
        -> [Id]
        -> InteractiveContext
934 935
extendInteractiveContext ictxt ids
  = ictxt { ic_tmp_ids =  snub ((ic_tmp_ids ictxt \\ ids) ++ ids)
936 937
                          -- NB. must be this way around, because we want
                          -- new ids to shadow existing bindings.
938
          }
pepe's avatar
pepe committed
939
    where snub = map head . group . sort
mnislaih's avatar
mnislaih committed
940 941 942

substInteractiveContext :: InteractiveContext -> TvSubst -> InteractiveContext
substInteractiveContext ictxt subst | isEmptyTvSubst subst = ictxt
943 944 945 946
substInteractiveContext ictxt@InteractiveContext{ic_tmp_ids=ids} subst 
  = ictxt { ic_tmp_ids = map subst_ty ids }
  where
   subst_ty id = id `setIdType` substTy subst (idType id)
947 948
\end{code}

Simon Marlow's avatar