TcRnTypes.lhs 32.6 KB
Newer Older
1

2
% (c) The University of Glasgow 2006
3
4
5
% (c) The GRASP Project, Glasgow University, 1992-2002
%
\begin{code}
6
{-# OPTIONS -w #-}
7
8
9
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
10
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
11
12
-- for details

13
module TcRnTypes(
14
15
	TcRnIf, TcRn, TcM, RnM,	IfM, IfL, IfG, -- The monad is opaque outside this module
	TcRef,
16
17

	-- The environment types
18
19
	Env(..), 
	TcGblEnv(..), TcLclEnv(..), 
20
	IfGblEnv(..), IfLclEnv(..), 
21
22

	-- Ranamer types
23
	ErrCtxt, RecFieldEnv,
24
	ImportAvails(..), emptyImportAvails, plusImportAvails, 
25
	WhereFrom(..), mkModDeps,
26
27

	-- Typechecker types
28
	TcTyThing(..), pprTcTyThingCategory, RefinementVisibility(..),
29
30

	-- Template Haskell
31
32
33
	ThStage(..), topStage, topSpliceStage,
	ThLevel, impLevel, topLevel,

ross's avatar
ross committed
34
	-- Arrows
ross's avatar
ross committed
35
	ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
ross's avatar
ross committed
36

37
	-- Insts
38
39
	Inst(..), InstOrigin(..), InstLoc(..), 
	pprInstLoc, pprInstArising, instLocSpan, instLocOrigin,
40
	LIE, emptyLIE, unitLIE, plusLIE, consLIE, instLoc, instSpan,
41
42
43
	plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,

	-- Misc other types
44
45
	TcId, TcIdSet, TcDictBinds,
	
46
47
48
49
  ) where

#include "HsVersions.h"

50
51
52
53
import HsSyn hiding (LIE)
import HscTypes
import Packages
import Type
54
import Coercion
55
import TcType
56
import TcGadt
57
58
import InstEnv
import FamInstEnv
59
import IOEnv
60
61
import RdrName
import Name
62
import NameEnv
63
64
65
import NameSet
import Var
import VarEnv
66
import Module
Simon Marlow's avatar
Simon Marlow committed
67
import UniqFM
68
69
70
71
72
73
import SrcLoc
import VarSet
import ErrUtils
import UniqSupply
import BasicTypes
import Util
74
75
import Bag
import Outputable
76
import ListSetOps
77
import FiniteMap
78
79
80

import Data.Maybe
import Data.List
81
82
83
84
85
86
87
88
89
90
\end{code}


%************************************************************************
%*									*
	       Standard monad definition for TcRn
    All the combinators for the monad can be found in TcRnMonad
%*									*
%************************************************************************

91
The monad itself has to be defined here, because it is mentioned by ErrCtxt
92
93

\begin{code}
94
95
96
97
98
type TcRef a 	 = IORef a
type TcId    	 = Id 			-- Type may be a TcType
type TcIdSet 	 = IdSet
type TcDictBinds = DictBinds TcId	-- Bag of dictionary bindings

99
100
type TcRnIf a b c = IOEnv (Env a b) c
type IfM lcl a  = TcRnIf IfGblEnv lcl a		-- Iface stuff
Simon Marlow's avatar
Simon Marlow committed
101

102
103
104
105
106
type IfG a  = IfM () a				-- Top level
type IfL a  = IfM IfLclEnv a			-- Nested
type TcRn a = TcRnIf TcGblEnv TcLclEnv a
type RnM  a = TcRn a		-- Historical
type TcM  a = TcRn a		-- Historical
107
108
109
110
111
112
113
114
115
116
\end{code}


%************************************************************************
%*									*
		The main environment types
%*									*
%************************************************************************

\begin{code}
117
data Env gbl lcl	-- Changes as we move into an expression
118
  = Env {
119
	env_top	 :: HscEnv,	-- Top-level stuff that never changes
120
				-- Includes all info about imported things
121

Simon Marlow's avatar
Simon Marlow committed
122
123
	env_us   :: {-# UNPACK #-} !(IORef UniqSupply),	
				-- Unique supply for local varibles
124

125
	env_gbl  :: gbl,	-- Info about things defined at the top level
126
				-- of the module being compiled
127

128
	env_lcl  :: lcl	 	-- Nested stuff; changes as we go into 
129
    }
130
131
132
133
134
135
136

-- TcGblEnv describes the top-level of the module at the 
-- point at which the typechecker is finished work.
-- It is this structure that is handed on to the desugarer

data TcGblEnv
  = TcGblEnv {
137
	tcg_mod     :: Module,		-- Module being compiled
138
139
140
	tcg_src     :: HscSource,	-- What kind of module 
					-- (regular Haskell, hs-boot, ext-core)

141
	tcg_rdr_env :: GlobalRdrEnv,	-- Top level envt; used during renaming
142
143
144
	tcg_default :: Maybe [Type],	-- Types used for defaulting
					-- Nothing => no 'default' decl

145
146
	tcg_fix_env   :: FixityEnv,	-- Just for things in this module
	tcg_field_env :: RecFieldEnv,	-- Just for things in this module
147
148
149
150
151
152
153

	tcg_type_env :: TypeEnv,	-- Global type env for the module we are compiling now
		-- All TyCons and Classes (for this module) end up in here right away,
		-- along with their derived constructors, selectors.
		--
		-- (Ids defined in this module start in the local envt, 
		--  though they move to the global envt during zonking)
154

155
	tcg_type_env_var :: TcRef TypeEnv,
156
157
158
159
		-- Used only to initialise the interface-file
		-- typechecker in initIfaceTcRn, so that it can see stuff
		-- bound in this module when dealing with hi-boot recursions
		-- Updated at intervals (e.g. after dealing with types and classes)
160
	
161
162
163
164
165
	tcg_inst_env     :: InstEnv,	-- Instance envt for *home-package* 
					-- modules; Includes the dfuns in 
					-- tcg_insts
	tcg_fam_inst_env :: FamInstEnv,	-- Ditto for family instances

166
167
168
169
		-- Now a bunch of things about this module that are simply 
		-- accumulated, but never consulted until the end.  
		-- Nevertheless, it's convenient to accumulate them along 
		-- with the rest of the info from this module.
170
	tcg_exports :: [AvailInfo],	-- What is exported
171
172
173
	tcg_imports :: ImportAvails,	-- Information about what was imported 
					--    from where, including things bound
					--    in this module
174

175
176
177
178
179
	tcg_dus :: DefUses,  	-- What is defined in this module and what is used.
				-- The latter is used to generate 
				--	(a) version tracking; no need to recompile if these
				--		things have not changed version stamp
				-- 	(b) unused-import info
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
	tcg_keep :: TcRef NameSet,	-- Locally-defined top-level names to keep alive
		-- "Keep alive" means give them an Exported flag, so
		-- that the simplifier does not discard them as dead 
		-- code, and so that they are exposed in the interface file
		-- (but not to export to the user).
		--
		-- Some things, like dict-fun Ids and default-method Ids are 
		-- "born" with the Exported flag on, for exactly the above reason,
		-- but some we only discover as we go.  Specifically:
		--	* The to/from functions for generic data types
		--	* Top-level variables appearing free in the RHS of an orphan rule
		--	* Top-level variables appearing free in a TH bracket

	tcg_inst_uses :: TcRef NameSet,	-- Home-package Dfuns actually used 
		-- Used to generate version dependencies
		-- This records usages, rather like tcg_dus, but it has to
		-- be a mutable variable so it can be augmented 
		-- when we look up an instance.  These uses of dfuns are
		-- rather like the free variables of the program, but
		-- are implicit instead of explicit.

	tcg_th_used :: TcRef Bool,	-- True <=> Template Haskell syntax used
		-- We need this so that we can generate a dependency on the
		-- Template Haskell package, becuase the desugarer is going to
		-- emit loads of references to TH symbols.  It's rather like 
		-- tcg_inst_uses; the reference is implicit rather than explicit,
		-- so we have to zap a mutable variable.
208

209
210
211
212
213
214
215
216
217
218
219
	tcg_dfun_n  :: TcRef Int,	-- Allows us to number off the names of DFuns
		-- It's convenient to allocate an External Name for a DFun, with
		-- a permanently-fixed unique, just like other top-level functions
		-- defined in this module.  But that means we need a canonical 
		-- occurrence name, distinct from all other dfuns in this module,
		-- and this name supply serves that purpose (df1, df2, etc).

		-- The next fields accumulate the payload of the module
		-- The binds, rules and foreign-decl fiels are collected
		-- initially in un-zonked form and are finally zonked in tcRnSrcDecls

220
221
222
223
224
		-- The next fields accumulate the payload of the
		-- module The binds, rules and foreign-decl fiels are
		-- collected initially in un-zonked form and are
		-- finally zonked in tcRnSrcDecls

225
226
        tcg_rn_imports :: Maybe [LImportDecl Name],
        tcg_rn_exports :: Maybe [Located (IE Name)],
227
228
229
	tcg_rn_decls :: Maybe (HsGroup Name),	-- renamed decls, maybe
		-- Nothing <=> Don't retain renamed decls

230
231
232
233
234
235
	tcg_binds     :: LHsBinds Id,	    -- Value bindings in this module
	tcg_deprecs   :: Deprecations,	    -- ...Deprecations 
	tcg_insts     :: [Instance],	    -- ...Instances
	tcg_fam_insts :: [FamInst],	    -- ...Family instances
	tcg_rules     :: [LRuleDecl Id],    -- ...Rules
	tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
236
237

	tcg_doc :: Maybe (HsDoc Name), -- Maybe Haddock documentation
238
239
        tcg_hmi :: HaddockModInfo Name, -- Haddock module information
        tcg_hpc :: AnyHpcUsage -- True if any part of the prog uses hpc instrumentation.
240
    }
241
242
243
244
245
246
247
248

type RecFieldEnv = NameEnv [Name]	-- Maps a constructor name *in this module*
					-- to the fields for that constructor
	-- This is used when dealing with ".." notation in record 
	-- construction and pattern matching.
	-- The FieldEnv deals *only* with constructors defined in
	-- *thie* module.  For imported modules, we get the same info
	-- from the TypeEnv
249
250
\end{code}

251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
%************************************************************************
%*									*
		The interface environments
  	      Used when dealing with IfaceDecls
%*									*
%************************************************************************

\begin{code}
data IfGblEnv 
  = IfGblEnv {
	-- The type environment for the module being compiled,
	-- in case the interface refers back to it via a reference that
	-- was originally a hi-boot file.
	-- We need the module name so we can test when it's appropriate
	-- to look in this env.
266
	if_rec_types :: Maybe (Module, IfG TypeEnv)
267
268
269
270
271
272
273
274
275
276
		-- Allows a read effect, so it can be in a mutable
		-- variable; c.f. handling the external package type env
		-- Nothing => interactive stuff, no loops possible
    }

data IfLclEnv
  = IfLclEnv {
	-- The module for the current IfaceDecl
	-- So if we see   f = \x -> x
	-- it means M.f = \x -> x, where M is the if_mod
277
	if_mod :: Module,
278

279
280
281
282
283
284
285
	-- The field is used only for error reporting
	-- if (say) there's a Lint error in it
	if_loc :: SDoc,
		-- Where the interface came from:
		--	.hi file, or GHCi state, or ext core
		-- plus which bit is currently being examined

286
287
	if_tv_env  :: UniqFM TyVar,	-- Nested tyvar bindings
	if_id_env  :: UniqFM Id		-- Nested id binding
288
289
290
    }
\end{code}

291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313

%************************************************************************
%*									*
		The local typechecker environment
%*									*
%************************************************************************

The Global-Env/Local-Env story
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
During type checking, we keep in the tcg_type_env
	* All types and classes
	* All Ids derived from types and classes (constructors, selectors)

At the end of type checking, we zonk the local bindings,
and as we do so we add to the tcg_type_env
	* Locally defined top-level Ids

Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
	a) fed back (via the knot) to typechecking the 
	   unfoldings of interface signatures
	b) used in the ModDetails of this module

\begin{code}
314
315
data TcLclEnv		-- Changes as we move inside an expression
			-- Discarded after typecheck/rename; not passed on to desugarer
316
  = TcLclEnv {
317
	tcl_loc  :: SrcSpan,		-- Source span
318
319
	tcl_ctxt :: ErrCtxt,		-- Error context
	tcl_errs :: TcRef Messages,	-- Place to accumulate errors
320

321
	tcl_th_ctxt    :: ThStage,	-- Template Haskell context
ross's avatar
ross committed
322
	tcl_arrow_ctxt :: ArrowCtxt,	-- Arrow-notation context
323

324
	tcl_rdr :: LocalRdrEnv,		-- Local name envt
325
326
327
328
		-- Maintained during renaming, of course, but also during
		-- type checking, solely so that when renaming a Template-Haskell
		-- splice we have the right environment for the renamer.
		-- 
329
330
331
332
		--   Does *not* include global name envt; may shadow it
		--   Includes both ordinary variables and type variables;
		--   they are kept distinct because tyvar have a different
		--   occurrence contructor (Name.TvOcc)
333
334
335
		-- We still need the unsullied global name env so that
    		--   we can look up record field names

336
337
	tcl_env  :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
					-- defined in this module
338
339
					
	tcl_tyvars :: TcRef TcTyVarSet,	-- The "global tyvars"
340
			-- Namely, the in-scope TyVars bound in tcl_env, 
341
342
			-- plus the tyvars mentioned in the types of Ids bound in tcl_lenv
			-- Why mutable? see notes with tcGetGlobalTyVars
343

344
	tcl_lie   :: TcRef LIE		-- Place to accumulate type constraints
345
346
    }

347

348
349
350
351
352
353
354
355
356
357
358
359
360
{- Note [Given Insts]
   ~~~~~~~~~~~~~~~~~~
Because of GADTs, we have to pass inwards the Insts provided by type signatures 
and existential contexts. Consider
	data T a where { T1 :: b -> b -> T [b] }
	f :: Eq a => T a -> Bool
	f (T1 x y) = [x]==[y]

The constructor T1 binds an existential variable 'b', and we need Eq [b].
Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we 
pass it inwards.

-}
361

362
363
364
365
---------------------------
-- Template Haskell levels 
---------------------------

366
367
368
369
370
type ThLevel = Int	
	-- Indicates how many levels of brackets we are inside
	-- 	(always >= 0)
	-- Incremented when going inside a bracket,
	-- decremented when going inside a splice
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
371
	-- NB: ThLevel is one greater than the 'n' in Fig 2 of the
372
	--     original "Template meta-programming for Haskell" paper
373
374
375
376
377
378
379
380
381
382

impLevel, topLevel :: ThLevel
topLevel = 1	-- Things defined at top level of this module
impLevel = 0	-- Imported things; they can be used inside a top level splice
--
-- For example: 
--	f = ...
--	g1 = $(map ...)		is OK
--	g2 = $(f ...)		is not OK; because we havn't compiled f yet

383

384
data ThStage
385
  = Comp   				-- Ordinary compiling, at level topLevel
386
387
  | Splice ThLevel 			-- Inside a splice
  | Brack  ThLevel 			-- Inside brackets; 
388
389
	   (TcRef [PendingSplice])	--   accumulate pending splices here
	   (TcRef LIE)			--   and type constraints here
390
topStage, topSpliceStage :: ThStage
391
392
393
topStage       = Comp
topSpliceStage = Splice (topLevel - 1)	-- Stage for the body of a top-level splice

ross's avatar
ross committed
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
---------------------------
-- Arrow-notation context
---------------------------

{-
In arrow notation, a variable bound by a proc (or enclosed let/kappa)
is not in scope to the left of an arrow tail (-<) or the head of (|..|).
For example

	proc x -> (e1 -< e2)

Here, x is not in scope in e1, but it is in scope in e2.  This can get
a bit complicated:

	let x = 3 in
	proc y -> (proc z -> e1) -< e2

Here, x and z are in scope in e1, but y is not.  We implement this by
recording the environment when passing a proc (using newArrowScope),
and returning to that (using escapeArrowScope) on the left of -< and the
head of (|..|).
-}

ross's avatar
ross committed
417
418
419
data ArrowCtxt
  = NoArrowCtxt
  | ArrowCtxt (Env TcGblEnv TcLclEnv)
ross's avatar
ross committed
420
421
422
423
424
425
426
427
428

-- Record the current environment (outside a proc)
newArrowScope :: TcM a -> TcM a
newArrowScope
  = updEnv $ \env ->
	env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } }

-- Return to the stored environment (from the enclosing proc)
escapeArrowScope :: TcM a -> TcM a
ross's avatar
ross committed
429
430
431
432
escapeArrowScope
  = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
	NoArrowCtxt -> env
	ArrowCtxt env' -> env'
433

434
435
436
437
---------------------------
-- TcTyThing
---------------------------

438
data TcTyThing
439
  = AGlobal TyThing		-- Used only in the return type of a lookup
440

441
442
  | ATcId   {		-- Ids defined in this module; may not be fully zonked
	tct_id :: TcId,		
443
444
	tct_co :: RefinementVisibility,	-- Previously: Maybe HsWrapper
					-- Nothing <=>	Do not apply a GADT type refinement
445
446
447
448
449
450
					--		I am wobbly, or have no free
					--		type variables
					-- Just co <=>  Apply any type refinement to me,
					--		and record it in the coercion
	tct_type  :: TcType,	-- Type of (coercion applied to id)
	tct_level :: ThLevel }
451

452
453
454
  | ATyVar  Name TcType		-- The type to which the lexically scoped type vaiable
				-- is currently refined. We only need the Name
				-- for error-message purposes
455

456
457
  | AThing  TcKind 		-- Used temporarily, during kind checking, for the
				--	tycons and clases in this recursive group
458

459
460
461
462
463
464
465
466
467
468
469
470
471
data RefinementVisibility
  = Unrefineable			-- Do not apply a GADT refinement
					-- I have no free variables	

  | Rigid HsWrapper			-- Apply any refinement to me
					-- and record it in the coercion

  | Wobbly				-- Do not apply a GADT refinement
					-- I am wobbly

  | WobblyInvisible			-- Wobbly type, not available inside current
					-- GADT refinement

472
instance Outputable TcTyThing where	-- Debugging only
473
   ppr (AGlobal g)      = pprTyThing g
474
475
476
   ppr elt@(ATcId {})   = text "Identifier" <> 
			  ifPprDebug (brackets (ppr (tct_id elt) <> dcolon <> ppr (tct_type elt) <> comma
				 <+> ppr (tct_level elt) <+> ppr (tct_co elt)))
477
   ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
478
   ppr (AThing k)       = text "AThing" <+> ppr k
479
480
481

pprTcTyThingCategory :: TcTyThing -> SDoc
pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
482
483
484
pprTcTyThingCategory (ATyVar {})     = ptext SLIT("Type variable")
pprTcTyThingCategory (ATcId {})      = ptext SLIT("Local identifier")
pprTcTyThingCategory (AThing {})     = ptext SLIT("Kinded thing")
485
486
487
488
489
490
491

instance Outputable RefinementVisibility where
    ppr Unrefineable	      = ptext SLIT("unrefineable")
    ppr (Rigid co)	      = ptext SLIT("rigid") <+> ppr co
    ppr	Wobbly		      = ptext SLIT("wobbly")
    ppr WobblyInvisible	      = ptext SLIT("wobbly-invisible")

492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
\end{code}

\begin{code}
type ErrCtxt = [TidyEnv -> TcM (TidyEnv, Message)]	
			-- Innermost first.  Monadic so that we have a chance
			-- to deal with bound type variables just before error
			-- message construction
\end{code}


%************************************************************************
%*									*
	Operations over ImportAvails
%*									*
%************************************************************************

ImportAvails summarises what was imported from where, irrespective
509
of whether the imported things are actually used or not
510
It is used 	* when processing the export list
511
512
		* when constructing usage info for the inteface file
		* to identify the list of directly imported modules
513
514
			for initialisation purposes and
			for optimsed overlap checking of family instances
515
		* when figuring out what things are really unused
516
517
518
519

\begin{code}
data ImportAvails 
   = ImportAvails {
520
	imp_mods :: ModuleEnv (Module, [(ModuleName, Bool, SrcSpan)]),
521
		-- Domain is all directly-imported modules
522
523
524
        -- The ModuleName is what the module was imported as, e.g. in
        --     import Foo as Bar
        -- it is Bar.
525
526
527
		-- Bool means:
		--   True => import was "import Foo ()"
		--   False  => import was some other form
sof's avatar
sof committed
528
		--
529
530
531
532
		-- We need the Module in the range because we can't get
		-- 	the keys of a ModuleEnv
		-- Used 
		--   (a) to help construct the usage information in 
533
534
		--       the interface file; if we import somethign we
		--       need to recompile if the export version changes
535
		--   (b) to specify what child modules to initialise
536
537
538
539
540
                --
                -- We need a full ModuleEnv rather than a ModuleNameEnv
                -- here, because we might be importing modules of the
                -- same name from different packages. (currently not the case,
                -- but might be in the future).
541

Simon Marlow's avatar
Simon Marlow committed
542
	imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
543
		-- Home-package modules needed by the module being compiled
544
		--
545
546
547
548
549
550
551
552
		-- It doesn't matter whether any of these dependencies
		-- are actually *used* when compiling the module; they
		-- are listed if they are below it at all.  For
		-- example, suppose M imports A which imports X.  Then
		-- compiling M might not need to consult X.hi, but X
		-- is still listed in M's dependencies.

	imp_dep_pkgs :: [PackageId],
553
554
555
		-- Packages needed by the module being compiled, whether
		-- directly, or via other modules in this package, or via
		-- modules imported from other packages.
556

557
 	imp_orphs :: [Module],
558
559
560
		-- Orphan modules below us in the import tree (and maybe
		-- including us for imported modules) 

561
 	imp_finsts :: [Module]
562
563
		-- Family instance modules below us in the import tree  (and
		-- maybe including us for imported modules)
564
565
      }

Simon Marlow's avatar
Simon Marlow committed
566
567
568
mkModDeps :: [(ModuleName, IsBootInterface)]
	  -> ModuleNameEnv (ModuleName, IsBootInterface)
mkModDeps deps = foldl add emptyUFM deps
569
	       where
Simon Marlow's avatar
Simon Marlow committed
570
		 add env elt@(m,_) = addToUFM env m elt
571

572
emptyImportAvails :: ImportAvails
573
emptyImportAvails = ImportAvails { imp_mods   	= emptyModuleEnv,
Simon Marlow's avatar
Simon Marlow committed
574
				   imp_dep_mods = emptyUFM,
575
				   imp_dep_pkgs = [],
576
				   imp_orphs    = [],
577
				   imp_finsts   = [] }
578
579
580

plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
plusImportAvails
581
  (ImportAvails { imp_mods = mods1,
582
		  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, 
583
584
                  imp_orphs = orphs1, imp_finsts = finsts1 })
  (ImportAvails { imp_mods = mods2,
585
		  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
586
                  imp_orphs = orphs2, imp_finsts = finsts2 })
587
  = ImportAvails { imp_mods     = plusModuleEnv_C plus_mod mods1 mods2,	
Simon Marlow's avatar
Simon Marlow committed
588
		   imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,	
589
		   imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
590
		   imp_orphs    = orphs1 `unionLists` orphs2,
591
		   imp_finsts   = finsts1 `unionLists` finsts2 }
592
  where
593
    plus_mod (m1, xs1) (_, xs2) = (m1, xs1 ++ xs2)
594
595
596
597
    plus_mod_dep (m1, boot1) (m2, boot2) 
	= WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
		-- Check mod-names match
	  (m1, boot1 && boot2)	-- If either side can "see" a non-hi-boot interface, use that
598
599
600
601
602
603
604
605
606
607
608
609
610
\end{code}

%************************************************************************
%*									*
\subsection{Where from}
%*									*
%************************************************************************

The @WhereFrom@ type controls where the renamer looks for an interface file

\begin{code}
data WhereFrom 
  = ImportByUser IsBootInterface	-- Ordinary user import (perhaps {-# SOURCE #-})
611
  | ImportBySystem			-- Non user import.
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633

instance Outputable WhereFrom where
  ppr (ImportByUser is_boot) | is_boot     = ptext SLIT("{- SOURCE -}")
			     | otherwise   = empty
  ppr ImportBySystem     		   = ptext SLIT("{- SYSTEM -}")
\end{code}


%************************************************************************
%*									*
\subsection[Inst-types]{@Inst@ types}
%*									*
v%************************************************************************

An @Inst@ is either a dictionary, an instance of an overloaded
literal, or an instance of an overloaded value.  We call the latter a
``method'' even though it may not correspond to a class operation.
For example, we might have an instance of the @double@ function at
type Int, represented by

	Method 34 doubleId [Int] origin

634
635
636
637
In addition to the basic Haskell variants of 'Inst's, they can now also
represent implication constraints 'forall tvs. (reft, given) => wanted'
and equality constraints 'co :: ty1 ~ ty2'.

638
639
640
641
642
643
644
645
646
647
648
NB: Equalities occur in two flavours:

  (1) Dict {tci_pred = EqPred ty1 ty2}
  (2) EqInst {tci_left = ty1, tci_right = ty2, tci_co = coe}

The former arises from equalities in contexts, whereas the latter is used
whenever the type checker introduces an equality (e.g., during deferring
unification).

I am not convinced that this duplication is necessary or useful! -=chak

649
650
\begin{code}
data Inst
651
652
653
654
655
656
  = Dict {
	tci_name :: Name,
	tci_pred :: TcPredType,
	tci_loc  :: InstLoc 
    }

657
658
659
  | ImplicInst {	-- An implication constraint
			-- forall tvs. (reft, given) => wanted
	tci_name   :: Name,
660
661
	tci_tyvars :: [TcTyVar],    -- Quantified type variables
				    -- Includes coercion variables
662
				    --   mentioned in tci_reft
663
	tci_reft   :: Refinement,
664
	tci_given  :: [Inst],	    -- Only Dicts and EqInsts
665
				    --   (no Methods, LitInsts, ImplicInsts)
666
	tci_wanted :: [Inst],	    -- Only Dicts, EqInst, and ImplicInsts
667
				    --   (no Methods or LitInsts)
668

669
670
	tci_loc    :: InstLoc
    }
671
672
673
	-- NB: the tci_given are not necessarily rigid,
	--     although they will be if the tci_reft is non-trivial
	-- NB: the tci_reft is already applied to tci_given and tci_wanted
674

675
676
  | Method {
	tci_id :: TcId,		-- The Id for the Inst
677

678
679
680
681
682
683
	tci_oid :: TcId,	-- The overloaded function
		-- This function will be a global, local, or ClassOpId;
		--   inside instance decls (only) it can also be an InstId!
		-- The id needn't be completely polymorphic.
		-- You'll probably find its name (for documentation purposes)
		--	  inside the InstOrigin
684

685
686
687
688
689
690
691
	tci_tys :: [TcType],	-- The types to which its polymorphic tyvars
				--	should be instantiated.
				-- These types must saturate the Id's foralls.

	tci_theta :: TcThetaType,	
			-- The (types of the) dictionaries to which the function
			-- must be applied to get the method
692

693
694
695
696
697
698
	tci_loc :: InstLoc 
    }
	-- INVARIANT 1: in (Method m f tys theta tau loc)
	--	type of m = type of (f tys dicts(from theta))

	-- INVARIANT 2: type of m must not be of form (Pred -> Tau)
699
	--   Reason: two methods are considered equal if the 
700
701
702
703
	--   	     base Id matches, and the instantiating types
	--	     match.  The TcThetaType should then match too.
	--   This only bites in the call to tcInstClassOp in TcClassDcl.mkMethodBind

704
705
706
707
708
709
710
711
712
713
714
  | LitInst {
	tci_name :: Name,
	tci_lit  :: HsOverLit Name,	-- The literal from the occurrence site
			-- INVARIANT: never a rebindable-syntax literal
			-- Reason: tcSyntaxName does unification, and we
			--	   don't want to deal with that during tcSimplify,
			--	   when resolving LitInsts

	tci_ty :: TcType,	-- The type at which the literal is used
	tci_loc :: InstLoc
    }
715
716
717

  | EqInst {			  -- delayed unification of the form 
				  --  	co :: ty1 ~ ty2
718
719
	tci_left  :: TcType,      -- ty1    -- both types are...
	tci_right :: TcType,      -- ty2    -- ...free of boxes
720
	tci_co    :: Either    	  -- co
721
722
723
724
725
726
727
728
729
730
731
732
733
			TcTyVar	  --  - a wanted equation, with a hole, to be 
				  --    filled with a witness for the equality;
                                  --    for equation arising from deferring
                                  --    unification, 'ty1' is the actual and
                                  --    'ty2' the expected type
			Coercion, --  - a given equation, with a coercion
				  --	witnessing the equality;
				  --    a coercion that originates from a
				  --    signature or a GADT is a CoVar, but
                                  --    after normalisation of coercions, they
				  --    can be arbitrary Coercions involving
                                  --    constructors and pseudo-constructors 
                                  --    like sym and trans.
734
735
736
737
738
739
740
	tci_loc   :: InstLoc,

	tci_name  :: Name	-- Debugging help only: this makes it easier to
				-- follow where a constraint is used in a morass
				-- of trace messages!  Unlike other Insts, it has
				-- no semantic significance whatsoever.
    }
741
742
743
744
\end{code}

@Insts@ are ordered by their class/type info, rather than by their
unique.  This allows the context-reduction mechanism to use standard finite
745
746
maps to do their stuff.  It's horrible that this code is here, rather
than with the Avails handling stuff in TcSimplify
747
748
749
750
751
752
753
754
755
756

\begin{code}
instance Ord Inst where
  compare = cmpInst

instance Eq Inst where
  (==) i1 i2 = case i1 `cmpInst` i2 of
	         EQ    -> True
		 other -> False

757
758
cmpInst d1@(Dict {}) 	d2@(Dict {})	= tci_pred d1 `tcCmpPred` tci_pred d2
cmpInst (Dict {})	other 		= LT
759

760
761
762
763
cmpInst (Method {}) 	(Dict {})	= GT
cmpInst m1@(Method {}) 	m2@(Method {})	= (tci_oid m1 `compare` tci_oid m2) `thenCmp`
					  (tci_tys m1 `tcCmpTypes` tci_tys m2)
cmpInst (Method {})  	other		= LT
764

765
766
767
768
cmpInst (LitInst {})	(Dict {}) 	= GT
cmpInst (LitInst {})	(Method {})	= GT
cmpInst l1@(LitInst {})	l2@(LitInst {})	= (tci_lit l1 `compare` tci_lit l2) `thenCmp`
					  (tci_ty l1 `tcCmpType` tci_ty l2)
769
770
771
772
773
774
775
776
cmpInst (LitInst {})  	other		= LT

	-- Implication constraints are compared by *name*
	-- not by type; that is, we make no attempt to do CSE on them
cmpInst (ImplicInst {})    (Dict {})	      = GT
cmpInst (ImplicInst {})    (Method {})	      = GT
cmpInst (ImplicInst {})    (LitInst {})	      = GT
cmpInst i1@(ImplicInst {}) i2@(ImplicInst {}) = tci_name i1 `compare` tci_name i2
777
778
779
780
781
782
783
784
cmpInst (ImplicInst {})    other	      = LT

	-- same for Equality constraints
cmpInst (EqInst {})    (Dict {})	      = GT
cmpInst (EqInst {})    (Method {})	      = GT
cmpInst (EqInst {})    (LitInst {})	      = GT
cmpInst (EqInst {})    (ImplicInst {})	      = GT
cmpInst i1@(EqInst {}) i2@(EqInst {})         = tci_name i1 `compare` tci_name i2
785
786
787
788
789
790
791
792
793
794
\end{code}


%************************************************************************
%*									*
\subsection[Inst-collections]{LIE: a collection of Insts}
%*									*
%************************************************************************

\begin{code}
795
-- FIXME: Rename this. It clashes with (Located (IE ...))
796
797
798
799
800
801
802
803
804
805
type LIE = Bag Inst

isEmptyLIE	  = isEmptyBag
emptyLIE          = emptyBag
unitLIE inst 	  = unitBag inst
mkLIE insts	  = listToBag insts
plusLIE lie1 lie2 = lie1 `unionBags` lie2
plusLIEs lies	  = unionManyBags lies
lieToList	  = bagToList
listToLIE	  = listToBag
806
807
808
809
810
811
812
813
814
815
816

consLIE inst lie  = lie `snocBag` inst
-- Putting the new Inst at the *end* of the bag is a half-hearted attempt
-- to ensure that we tend to report the *leftmost* type-constraint error
-- E.g. 	f :: [a]
--		f = [1,2,3]
-- we'd like to complain about the '1', not the '3'.
--
-- "Half-hearted" because the rest of the type checker makes no great
-- claims for retaining order in the constraint set.  Still, this 
-- seems to improve matters slightly.  Exampes: mdofail001, tcfail015
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
\end{code}


%************************************************************************
%*									*
\subsection[Inst-origin]{The @InstOrigin@ type}
%*									*
%************************************************************************

The @InstOrigin@ type gives information about where a dictionary came from.
This is important for decent error message reporting because dictionaries
don't appear in the original source code.  Doubtless this type will evolve...

It appears in TcMonad because there are a couple of error-message-generation
functions that deal with it.

\begin{code}
834
-------------------------------------------
835
data InstLoc = InstLoc InstOrigin SrcSpan ErrCtxt
836

837
838
839
840
841
842
instLoc :: Inst -> InstLoc
instLoc inst = tci_loc inst

instSpan :: Inst -> SrcSpan
instSpan wanted = instLocSpan (instLoc wanted)

843
844
845
846
847
instLocSpan :: InstLoc -> SrcSpan
instLocSpan (InstLoc _ s _) = s

instLocOrigin :: InstLoc -> InstOrigin
instLocOrigin (InstLoc o _ _) = o
848

849
850
851
852
853
pprInstArising :: Inst -> SDoc
pprInstArising loc = ptext SLIT("arising from") <+> pprInstLoc (tci_loc loc)

pprInstLoc :: InstLoc -> SDoc
pprInstLoc (InstLoc orig span _) = sep [ppr orig, text "at" <+> ppr span]
854

855
-------------------------------------------
856
data InstOrigin
857
858
859
  = SigOrigin SkolemInfo	-- Pattern, class decl, inst decl etc;
				-- Places that bind type variables and introduce
				-- available constraints
860

861
  | IPBindOrigin (IPName Name)	-- Binding site of an implicit parameter
862

863
864
865
866
	-------------------------------------------------------
	-- The rest are all occurrences: Insts that are 'wanted'
	-------------------------------------------------------
  | OccurrenceOf Name		-- Occurrence of an overloaded identifier
867
  | SpecPragOrigin Name		-- Specialisation pragma for identifier
868

869
  | IPOccOrigin  (IPName Name)	-- Occurrence of an implicit parameter
870

871
  | LiteralOrigin (HsOverLit Name)	-- Occurrence of a literal
872
  | NegateOrigin			-- Occurrence of syntactic negation
873

874
875
  | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
  | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
876
  | TupleOrigin			       -- (..,..)
877

878
879
  | InstSigOrigin	-- A dict occurrence arising from instantiating
			-- a polymorphic type during a subsumption check
880

881
  | ExprSigOrigin	-- e :: ty
882
  | RecordUpdOrigin
883
  | ViewPatOrigin
884
885
  | InstScOrigin	-- Typechecking superclasses of an instance declaration
  | DerivOrigin		-- Typechecking deriving
886
  | StandAloneDerivOrigin -- Typechecking stand-alone deriving
887
888
889
  | DefaultOrigin	-- Typechecking a default decl
  | DoOrigin		-- Arising from a do expression
  | ProcOrigin		-- Arising from a proc expression
890
  | ImplicOrigin SDoc	-- An implication constraint
891
  | EqOrigin		-- A type equality
892
893
894

instance Outputable InstOrigin where
    ppr (OccurrenceOf name)   = hsep [ptext SLIT("a use of"), quotes (ppr name)]
895
    ppr (SpecPragOrigin name) = hsep [ptext SLIT("a specialisation pragma for"), quotes (ppr name)]
896
897
898
    ppr (IPOccOrigin name)    = hsep [ptext SLIT("a use of implicit parameter"), quotes (ppr name)]
    ppr (IPBindOrigin name)   = hsep [ptext SLIT("a binding for implicit parameter"), quotes (ppr name)]
    ppr RecordUpdOrigin       = ptext SLIT("a record update")
899
900
    ppr ExprSigOrigin         = ptext SLIT("an expression type signature")
    ppr ViewPatOrigin         = ptext SLIT("a view pattern")
901
902
903
    ppr (LiteralOrigin lit)   = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
    ppr (ArithSeqOrigin seq)  = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
    ppr (PArrSeqOrigin seq)   = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
904
905
    ppr TupleOrigin	      = ptext SLIT("a tuple")
    ppr NegateOrigin	      = ptext SLIT("a use of syntactic negation")
906
907
908
909
910
911
912
913
    ppr InstScOrigin	      = ptext SLIT("the superclasses of an instance declaration")
    ppr DerivOrigin	      = ptext SLIT("the 'deriving' clause of a data type declaration")
    ppr StandAloneDerivOrigin = ptext SLIT("a 'deriving' declaration")
    ppr DefaultOrigin	      = ptext SLIT("a 'default' declaration")
    ppr DoOrigin	      = ptext SLIT("a do statement")
    ppr ProcOrigin	      = ptext SLIT("a proc expression")
    ppr (ImplicOrigin doc)    = doc
    ppr (SigOrigin info)      = pprSkolInfo info
914
    ppr EqOrigin	      = ptext SLIT("a type equality")
915
\end{code}