HscTypes.lhs 45.9 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
module HscTypes ( 
8
	-- * Sessions and compilation state
9
10
	Session(..), withSession, modifySession, 
        HscEnv(..), hscEPS,
Simon Marlow's avatar
Simon Marlow committed
11
	FinderCache, FindResult(..), ModLocationCache,
12
13
	Target(..), TargetId(..), pprTarget, pprTargetId,
	ModuleGraph, emptyMG,
14

15
	ModDetails(..),	emptyModDetails,
16
	ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
17

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

	HscSource(..), isHsBoot, hscSourceString,	-- Re-exported from DriverPhases
	
23
	HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
24
	hptInstances, hptRules,
25

26
	ExternalPackageState(..), EpsStats(..), addEpsInStats,
27
	PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
Simon Marlow's avatar
Simon Marlow committed
28
	lookupIfaceByModule, emptyModIface,
29

30
	InteractiveContext(..), emptyInteractiveContext, 
31
	icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
32
33

	ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
34
	emptyIfaceDepCache,
35

36
	Deprecs(..), IfaceDeprecs,
37

38
	FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
39

40
	implicitTyThings, isImplicitTyThing,
41

42
	TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
43
	TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
44
	extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
45
	typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
46
	typeEnvDataCons,
47

48
	WhetherHasOrphans, IsBootInterface, Usage(..), 
49
	Dependencies(..), noDependencies,
50
	NameCache(..), OrigNameCache, OrigIParamCache,
51
	Avails, availsToNameSet, availsToNameEnv, availName, availNames,
52
	GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
53
	IfaceExport,
54

55
	Deprecations, DeprecTxt, plusDeprecs,
56

57
	PackageInstEnv, PackageRuleBase,
58

59
60
61
	-- Linker stuff
	Linkable(..), isObjectLinkable,
	Unlinked(..), CompiledByteCode,
andy@galois.com's avatar
andy@galois.com committed
62
	isObject, nameOfObject, isInterpretable, byteCodeOfObject,
63
        HpcInfo(..), noHpcInfo,
64
65

        -- Breakpoints
66
        ModBreaks (..), BreakIndex, emptyModBreaks
67
    ) where
68
69
70

#include "HsVersions.h"

71
72
#ifdef GHCI
import ByteCodeAsm	( CompiledByteCode )
73
import {-# SOURCE #-}  InteractiveEval ( Resume )
74
75
#endif

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
76
import RdrName		( GlobalRdrEnv, emptyGlobalRdrEnv, GlobalRdrElt(..), 
Simon Marlow's avatar
Simon Marlow committed
77
78
                          unQualOK, ImpDeclSpec(..), Provenance(..),
                          ImportSpec(..), lookupGlobalRdrEnv )
79
import Name		( Name, NamedThing, getName, nameOccName, nameModule )
80
import NameEnv
81
import NameSet	
82
import OccName		( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
83
			  extendOccEnv )
84
import Module
85
import InstEnv		( InstEnv, Instance )
86
import FamInstEnv	( FamInstEnv, FamInst )
87
import Rules		( RuleBase )
88
import CoreSyn		( CoreBind )
89
import VarSet
90
import Id
91
92
import Type		( TyThing(..) )

93
import Class		( Class, classSelIds, classATs, classTyCon )
94
import TyCon
95
import DataCon		( DataCon, dataConImplicitIds )
96
import PrelNames	( gHC_PRIM )
Simon Marlow's avatar
Simon Marlow committed
97
import Packages		( PackageId )
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
98
import DynFlags		( DynFlags(..), isOneShot, HscTarget (..) )
99
import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
100
101
import BasicTypes	( Version, initialVersion, IPName, 
			  Fixity, defaultFixity, DeprecTxt )
102
import IfaceSyn
103
import FiniteMap	( FiniteMap )
104
import CoreSyn		( CoreRule )
sof@galois.com's avatar
sof@galois.com committed
105
import Maybes		( orElse, expectJust, catMaybes, seqMaybe )
106
import Outputable
107
import BreakArray
108
import SrcLoc		( SrcSpan, Located )
Simon Marlow's avatar
Simon Marlow committed
109
import UniqFM		( lookupUFM, eltsUFM, emptyUFM )
110
import UniqSupply	( UniqSupply )
111
112
import FastString	( FastString )

113
import StringBuffer	( StringBuffer )
Simon Marlow's avatar
Simon Marlow committed
114
115

import System.Time	( ClockTime )
116
import Data.IORef
117
import Data.Array       ( Array, array )
118
119
\end{code}

120

121
122
%************************************************************************
%*									*
123
\subsection{Compilation environment}
124
125
126
%*									*
%************************************************************************

127
128
129
130
131
132
133

\begin{code}
-- | The Session is a handle to the complete state of a compilation
-- session.  A compilation session consists of a set of modules
-- constituting the current program or library, the context for
-- interactive evaluation, and various caches.
newtype Session = Session (IORef HscEnv)
134
135
136
137
138
139

withSession :: Session -> (HscEnv -> IO a) -> IO a
withSession (Session ref) f = do h <- readIORef ref; f h

modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
140
141
142
143
144
145
146
147
148
149
150
151
\end{code}

HscEnv is like Session, except that some of the fields are immutable.
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.
152

153
\begin{code}
154
data HscEnv 
155
156
157
158
159
160
  = HscEnv { 
	hsc_dflags :: DynFlags,
		-- The dynamic flag settings

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

162
163
164
165
166
167
168
	hsc_mod_graph :: ModuleGraph,
		-- The module graph of the current session

	hsc_IC :: InteractiveContext,
		-- The context for evaluating interactive statements

	hsc_HPT    :: HomePackageTable,
169
170
171
172
173
		-- The home package table describes already-compiled
		-- home-packge modules, *excluding* the module we 
		-- are compiling right now.
		-- (In one-shot mode the current module is the only
		--  home-package module, so hsc_HPT is empty.  All other
174
175
176
177
		--  modules count as "external-package" modules.
		--  However, even in GHCi mode, hi-boot interfaces are
		--  demand-loadeded into the external-package table.)
		--
178
179
		-- hsc_HPT is not mutable because we only demand-load 
		-- external packages; the home package is eagerly 
180
		-- loaded, module by module, by the compilation manager.
181
182
183
184
		--	
		-- The HPT may contain modules compiled earlier by --make
		-- but not actually below the current module in the dependency
		-- graph.  (This changes a previous invariant: changed Jan 05.)
185
	
186
187
188
189
190
191
	hsc_EPS	:: {-# UNPACK #-} !(IORef ExternalPackageState),
	hsc_NC	:: {-# UNPACK #-} !(IORef NameCache),
		-- These are side-effected by compiling to reflect
		-- sucking in interface files.  They cache the state of
		-- external interface files, in effect.

Simon Marlow's avatar
Simon Marlow committed
192
193
	hsc_FC   :: {-# UNPACK #-} !(IORef FinderCache),
	hsc_MLC  :: {-# UNPACK #-} !(IORef ModLocationCache),
194
195
		-- The finder's cache.  This caches the location of modules,
		-- so we don't have to search the filesystem multiple times.
Simon Marlow's avatar
Simon Marlow committed
196

197
198
        hsc_global_rdr_env :: GlobalRdrEnv,
        hsc_global_type_env :: TypeEnv
199
 }
200
201
202

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

204
205
206
207
208
209
-- | 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).
210
data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
211
212

data TargetId
Simon Marlow's avatar
Simon Marlow committed
213
  = TargetModule ModuleName
214
215
216
217
218
219
	-- ^ 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.
220
  deriving Eq
221
222
223
224

pprTarget :: Target -> SDoc
pprTarget (Target id _) = pprTargetId id

Ian Lynagh's avatar
Ian Lynagh committed
225
226
227
instance Outputable Target where
    ppr = pprTarget

228
pprTargetId (TargetModule m) = ppr m
229
pprTargetId (TargetFile f _) = text f
230

Ian Lynagh's avatar
Ian Lynagh committed
231
232
233
instance Outputable TargetId where
    ppr = pprTargetId

Simon Marlow's avatar
Simon Marlow committed
234
type HomePackageTable  = ModuleNameEnv HomeModInfo
235
	-- Domain = modules in the home package
Simon Marlow's avatar
Simon Marlow committed
236
	-- "home" package name cached here for convenience
237
238
type PackageIfaceTable = ModuleEnv ModIface
	-- Domain = modules in the imported packages
239

Simon Marlow's avatar
Simon Marlow committed
240
emptyHomePackageTable  = emptyUFM
241
242
emptyPackageIfaceTable = emptyModuleEnv

243
data HomeModInfo 
244
245
246
247
248
249
250
251
252
  = HomeModInfo { hm_iface    :: !ModIface,
		  hm_details  :: !ModDetails,
		  hm_linkable :: !(Maybe Linkable) }
		-- hm_linkable might be Nothing if:
		--   a) this is an .hs-boot module
		--   b) 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 HPT will be Just.
253
254
255
256
		--
		-- When re-linking a module (hscNoRecomp), we construct
		-- the HomModInfo by building a new ModDetails from the
		-- old ModIface (only).
257

Simon Marlow's avatar
Simon Marlow committed
258
259
260
261
262
263
264
265
-- | Find the 'ModIface' for a 'Module'
lookupIfaceByModule
	:: DynFlags
	-> HomePackageTable
	-> PackageIfaceTable
	-> Module
	-> Maybe ModIface
lookupIfaceByModule dflags hpt pit mod
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
  | 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)) 
    `seqMaybe` lookupModuleEnv pit mod

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

283
284

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
285
hptInstances :: HscEnv -> (ModuleName -> Bool) -> [Instance]
286
287
288
289
-- Find all the instance declarations that are in modules imported 
-- by this one, directly or indirectly, and are in the Home Package Table
-- This ensures that we don't see instances from modules --make compiled 
-- before this one, but which are not below this one
290
hptInstances hsc_env want_this_module
291
  = [ ispec 
Simon Marlow's avatar
Simon Marlow committed
292
293
    | mod_info <- eltsUFM (hsc_HPT hsc_env)
    , want_this_module (moduleName (mi_module (hm_iface mod_info)))
294
    , ispec <- md_insts (hm_details mod_info) ]
295

Simon Marlow's avatar
Simon Marlow committed
296
hptRules :: HscEnv -> [(ModuleName, IsBootInterface)] -> [CoreRule]
297
298
299
-- Get rules from modules "below" this one (in the dependency sense)
-- C.f Inst.hptInstances
hptRules hsc_env deps
300
  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
301
302
303
304
305
306
307
308
  | otherwise
  = let 
	hpt = hsc_HPT hsc_env
    in
    [ rule
    |	-- Find each non-hi-boot module below me
      (mod, False) <- deps

309
310
311
312
313
	-- unsavoury: when compiling the base package with --make, we
	-- sometimes try to look up RULES for GHC.Prim.  GHC.Prim won't
	-- 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
314
    , mod /= moduleName gHC_PRIM
315

316
	-- Look it up in the HPT
317
318
319
320
321
322
    , let rules = case lookupUFM hpt mod of
		    Just info -> md_rules (hm_details info)
		    Nothing -> pprTrace "WARNING in hptRules" msg [] 
	  msg = vcat [ptext SLIT("missing module") <+> ppr mod,
		      ptext SLIT("Probable cause: out-of-date interface files")]
			-- This really shouldn't happen, but see Trac #962
323
324

	-- And get its dfuns
325
    , rule <- rules ]
326
327
\end{code}

Simon Marlow's avatar
Simon Marlow committed
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
%************************************************************************
%*									*
\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
	-- the module was found
  | NoPackage PackageId
	-- the requested package was not found
  | FoundMultiple [PackageId]
	-- *error*: both in multiple packages
  | PackageHidden PackageId
	-- for an explicit source import: the package containing the module is
	-- not exposed.
  | ModuleHidden  PackageId
	-- for an explicit source import: the package containing the module is
	-- exposed, but the module itself is hidden.
359
360
  | NotFound [FilePath] (Maybe PackageId)
	-- the module was not found, the specified places were searched
Simon Marlow's avatar
Simon Marlow committed
361
362
363
364
365
366
367
368
  | NotFoundInPackage PackageId
	-- the module was not found in this package

-- | 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}
369

370
371
%************************************************************************
%*									*
372
\subsection{Symbol tables and Module details}
373
374
375
%*									*
%************************************************************************

376
377
A @ModIface@ plus a @ModDetails@ summarises everything we know 
about a compiled module.  The @ModIface@ is the stuff *before* linking,
378
379
380
381
382
383
and can be written out to an interface file.  (The @ModDetails@ is after 
linking; it is the "linked" form of the mi_decls field.)

When we *read* an interface file, we also construct a @ModIface@ from it,
except that the mi_decls part is empty; when reading we consolidate
the declarations into a single indexed map in the @PersistentRenamerState@.
384
385

\begin{code}
386
387
data ModIface 
   = ModIface {
388
389
390
        mi_module   :: !Module,
        mi_mod_vers :: !Version,	    -- Module version: changes when anything changes

391
        mi_orphan   :: !WhetherHasOrphans,  -- Whether this module has orphans
392
        mi_finsts   :: !WhetherHasFamInst,  -- Whether module has family insts
393
	mi_boot	    :: !IsBootInterface,    -- Read from an hi-boot file?
394

395
	mi_deps	    :: Dependencies,
396
397
		-- This is consulted for directly-imported modules,
		-- but not for anything else (hence lazy)
398

399
400
401
		-- Usages; kept sorted so that it's easy to decide
		-- whether to write a new iface file (changing usages
		-- doesn't affect the version of this module)
402
        mi_usages   :: [Usage],
403
		-- NOT STRICT!  we read this field lazily from the interface file
404
		-- It is *only* consulted by the recompilation checker
405

406
407
408
409
		-- Exports
		-- Kept sorted by (mod,occ), to make version comparisons easier
        mi_exports  :: ![IfaceExport],
        mi_exp_vers :: !Version,	-- Version number of export list
410

411
412
413
		-- Fixities
        mi_fixities :: [(OccName,Fixity)],
		-- NOT STRICT!  we read this field lazily from the interface file
414

415
		-- Deprecations
416
	mi_deprecs  :: IfaceDeprecs,
417
		-- NOT STRICT!  we read this field lazily from the interface file
418

419
420
421
422
423
424
425
		-- Type, class and variable declarations
		-- The version of an Id changes if its fixity or deprecations change
		--	(as well as its type of course)
		-- Ditto data constructors, class operations, except that 
		-- the version of the parent class/tycon changes
	mi_decls :: [(Version,IfaceDecl)],	-- Sorted

426
        mi_globals  :: !(Maybe GlobalRdrEnv),
427
428
429
430
431
432
433
434
435
436
		-- Binds all the things defined at the top level in
		-- the *original source* code for this module. which
		-- 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
		-- from source then this field contains Nothing).
437
438
439
		--
		-- Strictly speaking this field should live in the
		-- HomeModInfo, but that leads to more plumbing.
440

441
		-- Instance declarations and rules
442
	mi_insts     :: [IfaceInst],			-- Sorted
443
	mi_fam_insts :: [IfaceFamInst],			-- Sorted
444
445
	mi_rules     :: [IfaceRule],			-- Sorted
	mi_rule_vers :: !Version,	-- Version number for rules and 
446
447
					-- instances (for classes and families)
					-- combined
448
449
450
451
452
453

		-- Cached environments for easy lookup
		-- These are computed (lazily) from other fields
		-- and are not put into the interface file
	mi_dep_fn  :: Name -> Maybe DeprecTxt,	-- Cached lookup for mi_deprecs
	mi_fix_fn  :: OccName -> Fixity,	-- Cached lookup for mi_fixities
454
455
	mi_ver_fn  :: OccName -> Maybe (OccName, Version)
                        -- Cached lookup for mi_decls
456
457
458
			-- The Nothing in mi_ver_fn means that the thing
			-- isn't in decls. It's useful to know that when
			-- seeing if we are up to date wrt the old interface
459
                        -- The 'OccName' is the parent of the name, if it has one.
460
     }
461

462
463
464
-- Should be able to construct ModDetails from mi_decls in ModIface
data ModDetails
   = ModDetails {
465
466
467
468
469
	-- The next two fields are created by the typechecker
	md_exports   :: [AvailInfo],
        md_types     :: !TypeEnv,
        md_insts     :: ![Instance],	-- Dfun-ids for the instances in this module
        md_fam_insts :: ![FamInst],
mnislaih's avatar
mnislaih committed
470
        md_rules     :: ![CoreRule],	-- Domain may include Ids from other modules
471
        md_modBreaks :: !ModBreaks  -- breakpoint information for this module 
472
     }
473

474
emptyModDetails = ModDetails { md_types = emptyTypeEnv,
475
			       md_exports = [],
476
477
			       md_insts     = [],
			       md_rules     = [],
mnislaih's avatar
mnislaih committed
478
			       md_fam_insts = [],
479
                               md_modBreaks = emptyModBreaks } 
480

481
482
483
484
485
486
487
-- 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 
-- ModDetails are extracted and the ModGuts is dicarded.

data ModGuts
  = ModGuts {
488
489
        mg_module    :: !Module,
	mg_boot      :: IsBootInterface, -- Whether it's an hs-boot module
490
	mg_exports   :: ![AvailInfo],	 -- What it exports
491
492
493
494
495
496
497
498
499
	mg_deps	     :: !Dependencies,	 -- What is below it, directly or
					 --   otherwise 
	mg_dir_imps  :: ![Module],	 -- Directly-imported modules; used to
					 --	generate initialisation code
	mg_usages    :: ![Usage],	 -- Version info for what it needed

        mg_rdr_env   :: !GlobalRdrEnv,	 -- Top-level lexical environment
	mg_fix_env   :: !FixityEnv,	 -- Fixity env, for things declared in
					 --   this module 
500
501
502
503

	mg_fam_inst_env :: FamInstEnv,	 -- Type-family instance enviroment
					 -- for *home-package* modules (including
					 -- this one).  c.f. tcg_fam_inst_env
504
505
506
507
508
509

	mg_types     :: !TypeEnv,
	mg_insts     :: ![Instance],	 -- Instances 
	mg_fam_insts :: ![FamInst],	 -- Instances 
        mg_rules     :: ![CoreRule],	 -- Rules from this module
	mg_binds     :: ![CoreBind],	 -- Bindings for this module
andy@galois.com's avatar
andy@galois.com committed
510
	mg_foreign   :: !ForeignStubs,
511
	mg_deprecs   :: !Deprecations,	 -- Deprecations declared in the module
mnislaih's avatar
mnislaih committed
512
	mg_hpc_info  :: !HpcInfo,        -- info about coverage tick boxes
513
        mg_modBreaks :: !ModBreaks
514
515
516
    }

-- The ModGuts takes on several slightly different forms:
517
--
518
519
520
521
522
-- After simplification, the following fields change slightly:
--	mg_rules	Orphan rules only (local ones now attached to binds)
--	mg_binds	With rules attached


523
524
525
526
527
528
529
530
531
---------------------------------------------------------
-- 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)
data CgGuts 
  = CgGuts {
	cg_module   :: !Module,

532
533
534
535
536
	cg_tycons   :: [TyCon],
		-- Algebraic data types (including ones that started
		-- life as classes); generate constructors and info
		-- tables Includes newtypes, just for the benefit of
		-- External Core
537

538
539
540
541
542
543
	cg_binds    :: [CoreBind],
		-- The tidied main bindings, including
		-- 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
544

545
546
547
	cg_dir_imps :: ![Module],
		-- Directly-imported modules; used to generate
		-- initialisation code
548
549

	cg_foreign  :: !ForeignStubs,	
andy@galois.com's avatar
andy@galois.com committed
550
551
	cg_dep_pkgs :: ![PackageId],	-- Used to generate #includes for C code gen
        cg_hpc_info :: !HpcInfo         -- info about coverage tick boxes
552
    }
553

554
-----------------------------------
555
556
557
558
559
560
561
562
563
564
565
data ModImports
  = ModImports {
	imp_direct     :: ![(Module,Bool)],	-- Explicitly-imported modules
						-- Boolean is true if we imported the whole
						--	module (apart, perhaps, from hiding some)
	imp_pkg_mods   :: !ModuleSet,		-- Non-home-package modules on which we depend,
						--	directly or indirectly
	imp_home_names :: !NameSet		-- Home package things on which we depend,
						--	directly or indirectly
    }

566
-----------------------------------
567
568
569
570
571
572
573
574
575
576
577
data ForeignStubs = NoStubs
		  | ForeignStubs
			SDoc 		-- Header file prototypes for
                                      	-- 	"foreign exported" functions
			SDoc 		-- C stubs to use when calling
                                        -- 	"foreign exported" functions
			[FastString] 	-- Headers that need to be included
				        -- 	into C code generated for this module
			[Id]		-- Foreign-exported binders
					-- 	we have to generate code to register these

578
579
580
\end{code}

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
581
582
583
emptyModIface :: Module -> ModIface
emptyModIface mod
  = ModIface { mi_module   = mod,
584
	       mi_mod_vers = initialVersion,
585
	       mi_orphan   = False,
586
	       mi_finsts   = False,
587
	       mi_boot	   = False,
588
589
	       mi_deps     = noDependencies,
	       mi_usages   = [],
590
	       mi_exports  = [],
591
592
	       mi_exp_vers = initialVersion,
	       mi_fixities = [],
593
	       mi_deprecs  = NoDeprecs,
594
595
596
597
598
	       mi_insts     = [],
	       mi_fam_insts = [],
	       mi_rules     = [],
	       mi_decls     = [],
	       mi_globals   = Nothing,
599
600
601
602
	       mi_rule_vers = initialVersion,
	       mi_dep_fn = emptyIfaceDepCache,
	       mi_fix_fn = emptyIfaceFixCache,
	       mi_ver_fn = emptyIfaceVerCache
603
    }		
604
605
\end{code}

606

607
608
609
610
611
612
613
614
615
%************************************************************************
%*									*
\subsection{The interactive context}
%*									*
%************************************************************************

\begin{code}
data InteractiveContext 
  = InteractiveContext { 
616
	ic_toplev_scope :: [Module],	-- Include the "top-level" scope of
617
					-- these modules
618

619
	ic_exports :: [Module],		-- Include just the exports of these
620
621
622
623
624
					-- modules

	ic_rn_gbl_env :: GlobalRdrEnv,	-- The cached GlobalRdrEnv, built from
					-- ic_toplev_scope and ic_exports

625
	ic_tmp_ids :: [Id],             -- Names bound during interaction.
626
627
                                        -- Later Ids shadow
                                        -- earlier ones with the same OccName.
628
629

        ic_tyvars :: TyVarSet           -- skolem type variables free in
630
                                        -- ic_tmp_ids.  These arise at
631
632
633
                                        -- breakpoints in a polymorphic 
                                        -- context, where we have only partial
                                        -- type information.
634
635
636
637

#ifdef GHCI
        , ic_resume :: [Resume]         -- the stack of breakpoint contexts
#endif
638
    }
639

640

641
642
643
emptyInteractiveContext
  = InteractiveContext { ic_toplev_scope = [],
			 ic_exports = [],
644
			 ic_rn_gbl_env = emptyGlobalRdrEnv,
645
646
647
648
649
650
			 ic_tmp_ids = [],
                         ic_tyvars = emptyVarSet
#ifdef GHCI
                         , ic_resume = []
#endif
                       }
651
652

icPrintUnqual :: InteractiveContext -> PrintUnqualified
Simon Marlow's avatar
Simon Marlow committed
653
icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
654
655
656
657
658
659
660
661


extendInteractiveContext
        :: InteractiveContext
        -> [Id]
        -> TyVarSet
        -> InteractiveContext
extendInteractiveContext ictxt ids tyvars
662
663
664
  = ictxt { ic_tmp_ids =  ic_tmp_ids ictxt ++ ids,
                          -- NB. must be this way around, because we want
                          -- new ids to shadow existing bindings.
665
            ic_tyvars   = ic_tyvars ictxt `unionVarSet` tyvars }
666
667
\end{code}

Simon Marlow's avatar
Simon Marlow committed
668
669
670
671
672
%************************************************************************
%*									*
        Building a PrintUnqualified		
%*									*
%************************************************************************
673
674

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
mkPrintUnqualified :: GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualified env = (qual_name, qual_mod)
  where
  qual_name mod occ
        | null gres = Just (moduleName mod)
                -- it isn't in scope at all, this probably shouldn't happen,
                -- but we'll qualify it by the original module anyway.
        | any unQualOK gres = Nothing
        | (Imported is : _) <- map gre_prov gres, (idecl : _) <- is
          = Just (is_as (is_decl idecl))
        | otherwise = panic "mkPrintUnqualified" 
      where
        gres  = [ gre | gre <- lookupGlobalRdrEnv env occ,
	                nameModule (gre_name gre) == mod ]

  qual_mod mod = Nothing       -- For now...
691
692
\end{code}

693

694
695
%************************************************************************
%*									*
696
		TyThing
697
698
699
700
%*									*
%************************************************************************

\begin{code}
701
implicitTyThings :: TyThing -> [TyThing]
702
703
-- If you change this, make sure you change LoadIface.ifaceDeclSubBndrs in sync

704
705
706
707
708
709
implicitTyThings (AnId id)   = []

	-- For type constructors, add the data cons (and their extras),
	-- and the selectors and generic-programming Ids too
	--
	-- Newtypes don't have a worker Id, so don't generate that?
710
implicitTyThings (ATyCon tc) = implicitCoTyCon tc ++
711
			       map AnId (tyConSelIds tc) ++ 
712
713
			       concatMap (extras_plus . ADataCon) 
					 (tyConDataCons tc)
714
		     
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
715
716
717
718
719
720
721
722
	-- For classes, add the class selector Ids, and assoicated TyCons
	-- and the class TyCon too (and its extras)
implicitTyThings (AClass cl) 
  = map AnId (classSelIds cl) ++
    map ATyCon (classATs cl) ++
	-- No extras_plus for the classATs, because they
	-- are only the family decls; they have no implicit things
    extras_plus (ATyCon (classTyCon cl))
723
724
725
726

	-- For data cons add the worker and wrapper (if any)
implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)

727
728
729
730
731
732
733
734
735
736
-- | returns 'True' if there should be no interface-file declaration
-- for this thing on its own: either it is built-in, or it is part
-- of some other declaration, or it is generated implicitly by some
-- other declaration.
isImplicitTyThing :: TyThing -> Bool
isImplicitTyThing (ADataCon _)  = True
isImplicitTyThing (AnId     id) = isImplicitId id
isImplicitTyThing (AClass   _)  = False
isImplicitTyThing (ATyCon   tc) = isImplicitTyCon tc

737
738
739
740
	-- For newtypes and indexed data types, add the implicit coercion tycon
implicitCoTyCon tc 
  = map ATyCon . catMaybes $ [newTyConCo_maybe tc, 
			      tyConFamilyCoercion_maybe tc]
741

742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
extras_plus thing = thing : implicitTyThings thing

extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
extendTypeEnvWithIds env ids
  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
\end{code}

%************************************************************************
%*									*
		TypeEnv
%*									*
%************************************************************************

\begin{code}
type TypeEnv = NameEnv TyThing

758
759
760
761
762
763
764
765
766
767
768
769
770
771
emptyTypeEnv    :: TypeEnv
typeEnvElts     :: TypeEnv -> [TyThing]
typeEnvClasses  :: TypeEnv -> [Class]
typeEnvTyCons   :: TypeEnv -> [TyCon]
typeEnvIds      :: TypeEnv -> [Id]
typeEnvDataCons :: TypeEnv -> [DataCon]
lookupTypeEnv   :: TypeEnv -> Name -> Maybe TyThing

emptyTypeEnv 	    = emptyNameEnv
typeEnvElts     env = nameEnvElts env
typeEnvClasses  env = [cl | AClass cl   <- typeEnvElts env]
typeEnvTyCons   env = [tc | ATyCon tc   <- typeEnvElts env] 
typeEnvIds      env = [id | AnId id     <- typeEnvElts env] 
typeEnvDataCons env = [dc | ADataCon dc <- typeEnvElts env] 
772

773
774
mkTypeEnv :: [TyThing] -> TypeEnv
mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
775
		
776
777
lookupTypeEnv = lookupNameEnv

778
-- Extend the type environment
779
780
781
782
783
extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
extendTypeEnv env thing = extendNameEnv env (getName thing) thing 

extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
extendTypeEnvList env things = foldl extendTypeEnv env things
784
785
\end{code}

786
\begin{code}
Simon Marlow's avatar
Simon Marlow committed
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
lookupType :: DynFlags
	   -> HomePackageTable
	   -> PackageTypeEnv
	   -> Name
	   -> Maybe TyThing

lookupType dflags hpt pte name
  -- in one-shot, we don't use the HPT
  | not (isOneShot (ghcMode dflags)) && modulePackageId mod == this_pkg 
  = do hm <- lookupUFM hpt (moduleName mod) -- Maybe monad
       lookupNameEnv (md_types (hm_details hm)) name
  | otherwise
  = lookupNameEnv pte name
  where mod = nameModule name
	this_pkg = thisPackage dflags
802
\end{code}
803

804
805
806
807
808
809
810
811
812
813
814
815
816
817
\begin{code}
tyThingTyCon (ATyCon tc) = tc
tyThingTyCon other	 = pprPanic "tyThingTyCon" (ppr other)

tyThingClass (AClass cls) = cls
tyThingClass other	  = pprPanic "tyThingClass" (ppr other)

tyThingDataCon (ADataCon dc) = dc
tyThingDataCon other	     = pprPanic "tyThingDataCon" (ppr other)

tyThingId (AnId id) = id
tyThingId other     = pprPanic "tyThingId" (ppr other)
\end{code}

818
819
820
821
822
823
824
825
%************************************************************************
%*									*
\subsection{Auxiliary types}
%*									*
%************************************************************************

These types are defined here because they are mentioned in ModDetails,
but they are mostly elaborated elsewhere
826
827

\begin{code}
828
829
mkIfaceVerCache :: [(Version,IfaceDecl)]
                -> (OccName -> Maybe (OccName, Version))
830
831
832
mkIfaceVerCache pairs 
  = \occ -> lookupOccEnv env occ
  where
833
834
835
836
837
838
    env = foldr add_decl emptyOccEnv pairs
    add_decl (v,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
      where
          decl_name = ifName d
          env1 = extendOccEnv env0 decl_name (decl_name, v)
          add_imp bndr env = extendOccEnv env bndr (decl_name, v)
839

840
emptyIfaceVerCache :: OccName -> Maybe (OccName, Version)
841
842
843
844
845
846
847
848
emptyIfaceVerCache occ = Nothing

------------------ Deprecations -------------------------
data Deprecs a
  = NoDeprecs
  | DeprecAll DeprecTxt	-- Whole module deprecated
  | DeprecSome a	-- Some specific things deprecated
  deriving( Eq )
849

850
851
type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
852
853
854
855
856
	-- Keep the OccName so we can flatten the NameEnv to
	-- get an IfaceDeprecs from a Deprecations
	-- Only an OccName is needed, because a deprecation always
	-- applies to things defined in the module in which the
	-- deprecation appears.
857

858
859
860
861
mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
mkIfaceDepCache NoDeprecs     	  = \n -> Nothing
mkIfaceDepCache (DeprecAll t) 	  = \n -> Just t
mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
862

863
864
emptyIfaceDepCache :: Name -> Maybe DeprecTxt
emptyIfaceDepCache n = Nothing
865

866
867
868
869
870
871
plusDeprecs :: Deprecations -> Deprecations -> Deprecations
plusDeprecs d NoDeprecs = d
plusDeprecs NoDeprecs d = d
plusDeprecs d (DeprecAll t) = DeprecAll t
plusDeprecs (DeprecAll t) d = DeprecAll t
plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
872
873
874
875
876
877
878
879
\end{code}


\begin{code}
type Avails	  = [AvailInfo]
type AvailInfo    = GenAvailInfo Name
type RdrAvailInfo = GenAvailInfo OccName

880
881
882
883
884
885
886
887
888
data GenAvailInfo name	= Avail name	 -- An ordinary identifier
			| AvailTC name 	 -- The name of the type or class
				  [name] -- The available pieces of type/class.
					 -- NB: If the type or class is itself
					 -- to be in scope, it must be in this list.
					 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
			deriving( Eq )
			-- Equality used when deciding if the interface has changed

889
type IfaceExport = (Module, [GenAvailInfo OccName])
890

891
availsToNameSet :: [AvailInfo] -> NameSet
892
893
894
895
896
897
898
availsToNameSet avails = foldr add emptyNameSet avails
      where add avail set = addListToNameSet set (availNames avail)

availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv avails = foldr add emptyNameEnv avails
     where add avail env = extendNameEnvList env
                                (zip (availNames avail) (repeat avail))
899
900
901
902

availName :: GenAvailInfo name -> name
availName (Avail n)     = n
availName (AvailTC n _) = n
903

904
905
906
availNames :: GenAvailInfo name -> [name]
availNames (Avail n)      = [n]
availNames (AvailTC n ns) = ns
907

908
909
910
911
instance Outputable n => Outputable (GenAvailInfo n) where
   ppr = pprAvail

pprAvail :: Outputable n => GenAvailInfo n -> SDoc
912
913
pprAvail (Avail n)      = ppr n
pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
914
915
\end{code}

916
\begin{code}
917
918
919
920
921
922
923
924
925
926
927
928
929
mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
mkIfaceFixCache pairs 
  = \n -> lookupOccEnv env n `orElse` defaultFixity
  where
   env = mkOccEnv pairs

emptyIfaceFixCache :: OccName -> Fixity
emptyIfaceFixCache n = defaultFixity

-- This fixity environment is for source code only
type FixityEnv = NameEnv FixItem

-- We keep the OccName in the range so that we can generate an interface from it
930
data FixItem = FixItem OccName Fixity SrcSpan
931
932
933

instance Outputable FixItem where
  ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
934
935
936

emptyFixityEnv :: FixityEnv
emptyFixityEnv = emptyNameEnv
937
938

lookupFixity :: FixityEnv -> Name -> Fixity
939
lookupFixity env n = case lookupNameEnv env n of
940
941
			Just (FixItem _ fix _) -> fix
			Nothing	      	       -> defaultFixity
942
943
\end{code}

944
945
946

%************************************************************************
%*									*
947
\subsection{WhatsImported}
948
949
950
951
%*									*
%************************************************************************

\begin{code}
952
953
954
955
956
957
958
type WhetherHasOrphans   = Bool
	-- An "orphan" is 
	-- 	* an instance decl in a module other than the defn module for 
	--		one of the tycons or classes in the instance head
	--	* a transformation rule in a module other than the one defining
	--		the function in the head of the rule.

959
960
type WhetherHasFamInst = Bool	     -- This module defines family instances?

961
type IsBootInterface = Bool
962

963
964
-- Dependency info about modules and packages below this one
-- in the import hierarchy.  See TcRnTypes.ImportAvails for details.
965
966
-- The orphan modules in `dep_orphs' do *not* include family instance orphans,
-- as they are anyway included in `dep_finsts'.
967
968
--
-- Invariant: the dependencies of a module M never includes M
969
-- Invariant: the lists are unordered, with no duplicates
970
data Dependencies
971
972
973
974
975
976
977
978
979
  = Deps { dep_mods   :: [(ModuleName,      -- Home-package module dependencies
			   IsBootInterface)]
	 , dep_pkgs   :: [PackageId] 	    -- External package dependencies
	 , dep_orphs  :: [Module]	    -- Orphan modules (whether home or
					    -- external pkg)
         , dep_finsts :: [Module]	    -- Modules that contain family
					    -- instances (whether home or
					    -- external pkg)
         }
980
981
  deriving( Eq )
	-- Equality used only for old/new comparison in MkIface.addVersionInfo
982
983

noDependencies :: Dependencies
984
noDependencies = Deps [] [] [] []
985
 	  
986
data Usage
Simon Marlow's avatar
Simon Marlow committed
987
  = Usage { usg_name     :: ModuleName,			-- Name of the module
988
989
	    usg_mod      :: Version,			-- Module version
	    usg_entities :: [(OccName,Version)],	-- Sorted by occurrence name
990
                -- NB. usages are for parent names only, eg. tycon but not constructors.
991
992
993
	    usg_exports  :: Maybe Version,		-- Export-list version, if we depend on it
	    usg_rules    :: Version 			-- Orphan-rules version (for non-orphan
							-- modules this will always be initialVersion)
994
995
    }	    deriving( Eq )
	-- This type doesn't let you say "I imported f but none of the rules in
996
997
	-- the module". If you use anything in the module you get its rule version
	-- So if the rules change, you'll recompile, even if you don't use them.
998
999
1000
	-- This is easy to implement, and it's safer: you might not have used the rules last
	-- time round, but if someone has added a new rule you might need it this time

1001
	-- The export list field is (Just v) if we depend on the export list:
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
	--	i.e. we imported the module directly, whether or not we
	--	     enumerated the things we imported, or just imported everything
	-- We need to recompile if M's exports change, because 
	-- if the import was	import M, 	we might now have a name clash in the 
	--					importing module.
	-- if the import was	import M(x)	M might no longer export x
	-- The only way we don't depend on the export list is if we have
	--			import M()
	-- And of course, for modules that aren't imported directly we don't
	-- depend on their export lists
1012
1013
\end{code}

1014

1015
1016
%************************************************************************
%*									*
1017
		The External Package State
1018
1019
1020
%*									*
%************************************************************************

1021
\begin{code}
1022
1023
1024
1025
type PackageTypeEnv    = TypeEnv
type PackageRuleBase   = RuleBase
type PackageInstEnv    = InstEnv
type PackageFamInstEnv = FamInstEnv
1026

1027
1028
data ExternalPackageState
  = EPS {
Simon Marlow's avatar
Simon Marlow committed
1029
1030
1031
1032
1033
1034
1035
1036
	eps_is_boot :: !(ModuleNameEnv (ModuleName, IsBootInterface)),
		-- In OneShot mode (only), home-package modules
		-- accumulate in the external package state, and are
		-- sucked in lazily.  For these home-pkg modules
		-- (only) we need to record which are boot modules.
		-- We set this field after loading all the
		-- explicitly-imported interfaces, but before doing
		-- anything else
1037
		--
Simon Marlow's avatar
Simon Marlow committed
1038
		-- The ModuleName part is not necessary, but it's useful for
1039
1040
1041
		-- debug prints, and it's convenient because this field comes
		-- direct from TcRnTypes.ImportAvails.imp_dep_mods

1042
1043
1044
1045
	eps_PIT :: !PackageIfaceTable,
		-- The ModuleIFaces for modules in external packages
		-- whose interfaces we have opened
		-- The declarations in these interface files are held in
1046
1047
		-- eps_decls, eps_inst_env, eps_fam_inst_env, eps_rules
		-- (below), not in the mi_decls fields of the iPIT.  
1048
1049
1050
1051
1052
1053
1054
		-- What _is_ in the iPIT is:
		--	* The Module 
		--	* Version info
		--	* Its exports
		--	* Fixities
		--	* Deprecations

1055
	eps_PTE :: !PackageTypeEnv,	   -- Domain = external-package modules
1056

1057
1058
1059
1060
1061
	eps_inst_env     :: !PackageInstEnv,   -- The total InstEnv accumulated
					       -- from all the external-package
					       -- modules 
	eps_fam_inst_env :: !PackageFamInstEnv,-- Ditto FamInstEnv
	eps_rule_base    :: !PackageRuleBase,  -- Ditto RuleEnv
1062

1063
1064
1065
        eps_mod_fam_inst_env :: !(ModuleEnv FamInstEnv), -- identifies family
						       -- instances of each mod

1066
	eps_stats :: !EpsStats
1067
  }
1068
1069
1070
1071
1072
1073
1074

-- "In" means read from iface files
-- "Out" means actually sucked in and type-checked
data EpsStats = EpsStats { n_ifaces_in
			 , n_decls_in, n_decls_out 
			 , n_rules_in, n_rules_out
			 , n_insts_in, n_insts_out :: !Int }
1075
1076
1077
1078
1079
1080
1081
1082

addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
-- Add stats for one newly-read interface
addEpsInStats stats n_decls n_insts n_rules
  = stats { n_ifaces_in = n_ifaces_in stats + 1
	  , n_decls_in  = n_decls_in stats + n_decls
	  , n_insts_in  = n_insts_in stats + n_insts
	  , n_rules_in  = n_rules_in stats + n_rules }
1083
1084
\end{code}

1085
The NameCache makes sure that there is just one Unique assigned for
1086
1087
1088
1089
1090
1091
1092
1093
each original name; i.e. (module-name, occ-name) pair.  The Name is
always stored as a Global, and has the SrcLoc of its binding location.
Actually that's not quite right.  When we first encounter the original
name, we might not be at its binding site (e.g. we are reading an
interface file); so we give it 'noSrcLoc' then.  Later, when we find
its binding site, we fix it up.

\begin{code}
1094
1095
data NameCache
 = NameCache {  nsUniqs :: UniqSupply,
1096
		-- Supply of uniques
1097
		nsNames :: OrigNameCache,
1098
		-- Ensures that one original name gets one unique
1099
		nsIPs   :: OrigIParamCache
1100
		-- Ensures that one implicit parameter name gets one unique
1101
   }
1102

1103
1104
type OrigNameCache   = ModuleEnv (OccEnv Name)
type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
1105
\end{code}
1106

1107

1108

1109
1110
%************************************************************************
%*									*
1111
		The module graph and ModSummary type
1112
1113
1114
1115
1116
	A ModSummary is a node in the compilation manager's
	dependency graph, and it's also passed to hscMain
%*									*
%************************************************************************

1117
1118
1119
A ModuleGraph contains all the nodes from the home package (only).  
There will be a node for each source module, plus a node for each hi-boot
module.
1120
1121

\begin{code}
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
type ModuleGraph = [ModSummary]  -- The module graph, 
				 -- NOT NECESSARILY IN TOPOLOGICAL ORDER

emptyMG :: ModuleGraph
emptyMG = []

-- The nodes of the module graph are
-- 	EITHER a regular Haskell source module
-- 	OR     a hi-boot source module

1132
1133
data ModSummary
   = ModSummary {
Simon Marlow's avatar
Simon Marlow committed
1134
        ms_mod       :: Module,			-- Identity of the module
1135
1136
	ms_hsc_src   :: HscSource,		-- Source is Haskell, hs-boot, external core
        ms_location  :: ModLocation,		-- Location
1137
1138
        ms_hs_date   :: ClockTime,		-- Timestamp of source file
	ms_obj_date  :: Maybe ClockTime,	-- Timestamp of object, maybe
Simon Marlow's avatar
Simon Marlow committed
1139
1140
        ms_srcimps   :: [Located ModuleName],	-- Source imports
        ms_imps      :: [Located ModuleName],	-- Non-source imports
1141
1142
1143
1144
        ms_hspp_file :: FilePath,		-- Filename of preprocessed source.
        ms_hspp_opts :: DynFlags,               -- Cached flags from OPTIONS, INCLUDE
                                                -- and LANGUAGE pragmas.
	ms_hspp_buf  :: Maybe StringBuffer    	-- The actual preprocessed source, maybe.
1145
1146
     }

1147
1148
1149
ms_mod_name :: ModSummary -> ModuleName
ms_mod_name = moduleName . ms_mod

1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
-- The ModLocation contains both the original source filename and the
-- filename of the cleaned-up source file after all preprocessing has been
-- done.  The point is that the summariser will have to cpp/unlit/whatever
-- all files anyway, and there's no point in doing this twice -- just 
-- park the result in a temp file, put the name of it in the location,
-- and let @compile@ read from that file on the way back up.

-- The ModLocation is stable over successive up-sweeps in GHCi, wheres
-- the ms_hs_date and imports can, of course, change

msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
msHsFilePath  ms = expectJust "msHsFilePath" (ml_hs_file  (ms_location ms))
msHiFilePath  ms = ml_hi_file  (ms_location ms)
msObjFilePath ms = ml_obj_file (ms_location ms)

1165
1166
isBootSummary :: ModSummary -> Bool
isBootSummary ms = isHsBoot (ms_hsc_src ms)
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178

instance Outputable ModSummary where
   ppr ms
      = sep [text "ModSummary {",
             nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
                          text "ms_mod =" <+> ppr (ms_mod ms) 
				<> text (hscSourceString (ms_hsc_src ms)) <> comma,
                          text "ms_imps =" <+> ppr (ms_imps ms),
                          text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
             char '}'
            ]

1179
1180
showModMsg :: HscTarget -> Bool -> ModSummary -> String
showModMsg target recomp mod_summary
1181
1182
  = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
	            char '(', text (msHsFilePath mod_summary) <> comma,
1183
		    case target of
1184
                      HscInterpreted | recomp 
1185
1186
1187
                                 -> text "interpreted"
                      HscNothing -> text "nothing"
                      _other     -> text (msObjFilePath mod_summary),
1188
1189
		    char ')'])
 where 
1190
    mod     = moduleName (ms_mod mod_summary)
Simon Marlow's avatar
Simon Marlow committed
1191
    mod_str = showSDoc (ppr mod) ++ hscSourceString (ms_hsc_src mod_summary)
1192
1193
1194
\end{code}


andy@galois.com's avatar
andy@galois.com committed
1195
1196
1197
1198
1199
1200
1201
%************************************************************************
%*									*
\subsection{Hpc Support}
%*									*
%************************************************************************

\begin{code}
1202
1203
1204
1205
1206
data HpcInfo = HpcInfo 
     { hpcInfoTickCount :: Int 
     , hpcInfoHash      :: Int  
     }
     | NoHpcInfo
andy@galois.com's avatar
andy@galois.com committed
1207
1208

noHpcInfo :: HpcInfo
1209
noHpcInfo = NoHpcInfo
andy@galois.com's avatar
andy@galois.com committed
1210
1211
\end{code}

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
%************************************************************************
%*									*
\subsection{Linkable stuff}
%*									*
%************************************************************************

This stuff is in here, rather than (say) in Linker.lhs, because the Linker.lhs
stuff is the *dynamic* linker, and isn't present in a stage-1 compiler

\begin{code}
data Linkable = LM {
  linkableTime     :: ClockTime,	-- Time at which this linkable was built
					-- (i.e. when the bytecodes were produced,
					--	 or the mod date on the files)
1226
  linkableModule   :: Module,		-- Should be Module, but see below
1227
1228
1229