TcRnTypes.lhs 56 KB
Newer Older
1

2
% (c) The University of Glasgow 2006
3
4
% (c) The GRASP Project, Glasgow University, 1992-2002
%
5
6
7
8
9
10
11
12
13
14
15
16
17

Various types used during typechecking, please see TcRnMonad as well for
operations on these types. You probably want to import it, instead of this
module.

All the monads exported here are built on top of the same IOEnv monad. The
monad functions like a Reader monad in the way it passes the environment
around. This is done to allow the environment to be manipulated in a stack
like fashion when entering expressions... ect.

For state that is global and should be returned at the end (e.g not part
of the stack mechanism), you should use an TcRef (= IORef) to store them.

18
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
19
20
21
22
23
24
25
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

26
module TcRnTypes(
27
28
	TcRnIf, TcRn, TcM, RnM,	IfM, IfL, IfG, -- The monad is opaque outside this module
	TcRef,
29
30

	-- The environment types
31
32
	Env(..), 
	TcGblEnv(..), TcLclEnv(..), 
33
	IfGblEnv(..), IfLclEnv(..), 
34
35

	-- Ranamer types
36
	ErrCtxt, RecFieldEnv(..),
37
	ImportAvails(..), emptyImportAvails, plusImportAvails, 
38
	WhereFrom(..), mkModDeps,
39
40

	-- Typechecker types
41
	TcTypeEnv, TcTyThing(..), pprTcTyThingCategory, 
42
43

	-- Template Haskell
44
	ThStage(..), topStage, topAnnStage, topSpliceStage,
45
	ThLevel, impLevel, outerLevel, thLevel,
46

ross's avatar
ross committed
47
	-- Arrows
ross's avatar
ross committed
48
	ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
ross's avatar
ross committed
49

50
	-- Constraints
51
        Untouchables(..), inTouchableRange, isNoUntouchables,
52

53
54
55
56
       -- Canonical constraints
        Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, 
        singleCt, extendCts, isEmptyCts, isCTyEqCan, 
        isCDictCan_Maybe, isCIPCan_Maybe, isCFunEqCan_Maybe,
57
58
59
60
        isCIrredEvCan, isCNonCanonical, isWantedCt, isDerivedCt, 
        isGivenCt_maybe, isGivenOrSolvedCt,
        ctWantedLoc,
        SubGoalDepth, mkNonCanonical, ctPred, 
61

62
63
64
65
        WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
        andWC, addFlats, addImplics, mkFlatWC,

        Implication(..),
66
67
        CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin,
	CtOrigin(..), EqOrigin(..), 
68
69
        WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt, 
        pushErrCtxtSameOrigin,
70

71
	SkolemInfo(..),
72

73
74
75
76
77
        CtFlavor(..), pprFlavorArising, 
        mkSolvedFlavor, mkGivenFlavor, mkWantedFlavor,
        isWanted, isGivenOrSolved, isGiven_maybe, isSolved,
        isDerived, getWantedLoc, canSolve, canRewrite,
        combineCtLoc, 
78
79

	-- Pretty printing
80
81
        pprEvVarTheta, pprWantedsWithLocs,
	pprEvVars, pprEvVarWithType, 
82
        pprArising, pprArisingAt,
83
84

	-- Misc other types
85
	TcId, TcIdSet, TcTyVarBind(..), TcTyVarBinds
86
	
87
88
89
90
  ) where

#include "HsVersions.h"

91
import HsSyn
92
import HscTypes
93
import TcEvidence( EvBind, EvBindsVar, EvTerm )
94
import Type
95
import Class    ( Class )
96
import TyCon    ( TyCon )
97
import DataCon  ( DataCon, dataConUserType )
98
import TcType
99
import Annotations
100
101
import InstEnv
import FamInstEnv
102
import IOEnv
103
104
import RdrName
import Name
105
import NameEnv
106
import NameSet
107
import Avail
108
109
import Var
import VarEnv
110
import Module
111
112
113
import SrcLoc
import VarSet
import ErrUtils
114
import UniqFM
115
import UniqSupply
116
import Unique
117
import BasicTypes
118
import Bag
Ian Lynagh's avatar
Ian Lynagh committed
119
import DynFlags
120
import Outputable
121
import ListSetOps
122
import FastString
123

124
import Data.Set (Set)
125

126
127
128
129
130
131
132
133
134
135
\end{code}


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

136
The monad itself has to be defined here, because it is mentioned by ErrCtxt
137
138

\begin{code}
139
type TcRef a 	 = IORef a
140
type TcId    	 = Id 			
141
type TcIdSet 	 = IdSet
142

143

144
145
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
146

147
148
149
150
151
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
152
153
\end{code}

154
155
156
157
158
159
160
161
162
163
164
165
Representation of type bindings to uninstantiated meta variables used during
constraint solving.

\begin{code}
data TcTyVarBind = TcTyVarBind TcTyVar TcType

type TcTyVarBinds = Bag TcTyVarBind

instance Outputable TcTyVarBind where
  ppr (TcTyVarBind tv ty) = ppr tv <+> text ":=" <+> ppr ty
\end{code}

166
167

%************************************************************************
168
169
170
%*                                                                      *
                The main environment types
%*                                                                      *
171
172
173
%************************************************************************

\begin{code}
174
175
176
177
-- We 'stack' these envs through the Reader like monad infastructure
-- as we move into an expression (although the change is focused in
-- the lcl type).
data Env gbl lcl
178
  = Env {
179
180
        env_top  :: HscEnv,  -- Top-level stuff that never changes
                             -- Includes all info about imported things
181

182
183
        env_us   :: {-# UNPACK #-} !(IORef UniqSupply),
                             -- Unique supply for local varibles
184

185
186
        env_gbl  :: gbl,     -- Info about things defined at the top level
                             -- of the module being compiled
187

188
        env_lcl  :: lcl      -- Nested stuff; changes as we go into 
189
    }
190

Ian Lynagh's avatar
Ian Lynagh committed
191
192
193
instance ContainsDynFlags (Env gbl lcl) where
    extractDynFlags env = hsc_dflags (env_top env)

194
195
196
-- 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
197
198
-- For state that needs to be updated during the typechecking
-- phase and returned at end, use a TcRef (= IORef).
199
200
201

data TcGblEnv
  = TcGblEnv {
202
203
204
	tcg_mod     :: Module,         -- ^ Module being compiled
	tcg_src     :: HscSource,
          -- ^ What kind of module (regular Haskell, hs-boot, ext-core)
205

206
207
208
	tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming
	tcg_default :: Maybe [Type],
          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
209

210
211
	tcg_fix_env   :: FixityEnv,	-- ^ Just for things in this module
	tcg_field_env :: RecFieldEnv,	-- ^ Just for things in this module
212

213
214
215
216
217
218
219
	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)
220

221
	tcg_type_env_var :: TcRef TypeEnv,
222
223
224
225
		-- 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)
226
	
227
228
229
230
	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
231

232
233
234
235
		-- 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.
236
237
238
	tcg_exports :: [AvailInfo],	-- ^ What is exported
	tcg_imports :: ImportAvails,
          -- ^ Information about what was imported from where, including
239
240
	  -- things bound in this module. Also store Safe Haskell info
          -- here about transative trusted packaage requirements.
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269

	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

	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

270
        tcg_th_used :: TcRef Bool,
271
272
          -- ^ @True@ <=> Template Haskell syntax used.
          --
273
274
275
276
          -- 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.  The reference
          -- is implicit rather than explicit, so we have to zap a
277
278
          -- mutable variable.

279
280
281
282
283
        tcg_th_splice_used :: TcRef Bool,
          -- ^ @True@ <=> A Template Haskell splice was used.
          --
          -- Splices disable recompilation avoidance (see #481)

284
285
	tcg_dfun_n  :: TcRef OccSet,
          -- ^ Allows us to choose unique DFun names.
286
287
288
289

	-- 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
290

291
        tcg_rn_exports :: Maybe [Located (IE Name)],
292
293
294
        tcg_rn_imports :: [LImportDecl Name],
		-- Keep the renamed imports regardless.  They are not 
		-- voluminous and are needed if you want to report unused imports
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
295

296
        tcg_used_rdrnames :: TcRef (Set RdrName),
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
297
298
299
		-- The set of used *imported* (not locally-defined) RdrNames
		-- Used only to report unused import declarations

300
301
302
	tcg_rn_decls :: Maybe (HsGroup Name),
          -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed
          -- decls.
303

304
        tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile
GregWeber's avatar
GregWeber committed
305

306
        tcg_ev_binds  :: Bag EvBind,	    -- Top-level evidence bindings
307
	tcg_binds     :: LHsBinds Id,	    -- Value bindings in this module
308
        tcg_sigs      :: NameSet, 	    -- ...Top-level names that *lack* a signature
309
        tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
Ian Lynagh's avatar
Ian Lynagh committed
310
	tcg_warns     :: Warnings,	    -- ...Warnings and deprecations
311
	tcg_anns      :: [Annotation],      -- ...Annotations
dreixel's avatar
dreixel committed
312
        tcg_tcs       :: [TyCon],           -- ...TyCons and Classes
313
	tcg_insts     :: [ClsInst],	    -- ...Instances
314
315
316
317
        tcg_fam_insts :: [FamInst],         -- ...Family instances
        tcg_rules     :: [LRuleDecl Id],    -- ...Rules
        tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
        tcg_vects     :: [LVectDecl Id],    -- ...Vectorisation declarations
318

319
	tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
320
321
322
        tcg_hpc       :: AnyHpcUsage,        -- ^ @True@ if any part of the
                                             --  prog uses hpc instrumentation.

323
        tcg_main      :: Maybe Name,         -- ^ The Name of the main
324
325
                                             -- function, if this module is
                                             -- the main module.
326
327
        tcg_safeInfer :: TcRef Bool          -- Has the typechecker infered this
                                             -- module as -XSafe (Safe Haskell)
328
    }
329

330
331
332
333
334
335
336
data RecFieldEnv 
  = RecFields (NameEnv [Name])	-- Maps a constructor name *in this module*
				-- to the fields for that constructor
	      NameSet		-- Set of all fields declared *in this module*;
				-- used to suppress name-shadowing complaints
				-- when using record wild cards
				-- E.g.  let fld = e in C {..}
337
338
	-- This is used when dealing with ".." notation in record 
	-- construction and pattern matching.
339
	-- The FieldEnv deals *only* with constructors defined in *this*
Thomas Schilling's avatar
Thomas Schilling committed
340
341
	-- module.  For imported modules, we get the same info from the
	-- TypeEnv
342
343
\end{code}

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
%************************************************************************
%*									*
		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.
359
	if_rec_types :: Maybe (Module, IfG TypeEnv)
360
361
362
363
364
365
366
367
368
369
		-- 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
370
	if_mod :: Module,
371

372
373
374
375
376
377
378
	-- 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

379
	if_tv_env  :: UniqFM TyVar,	-- Nested tyvar bindings
380
		      	     		-- (and coercions)
381
	if_id_env  :: UniqFM Id		-- Nested id binding
382
383
384
    }
\end{code}

385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407

%************************************************************************
%*									*
		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}
408
409
data TcLclEnv		-- Changes as we move inside an expression
			-- Discarded after typecheck/rename; not passed on to desugarer
410
  = TcLclEnv {
411
	tcl_loc  :: SrcSpan,		-- Source span
412
	tcl_ctxt :: [ErrCtxt],		-- Error context, innermost on top
413
	tcl_errs :: TcRef Messages,	-- Place to accumulate errors
414

415
416
	tcl_th_ctxt    :: ThStage,	      -- Template Haskell context
	tcl_arrow_ctxt :: ArrowCtxt,	      -- Arrow-notation context
417

418
	tcl_rdr :: LocalRdrEnv,		-- Local name envt
419
420
421
422
		-- 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.
		-- 
423
424
425
426
		--   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)
427
428
429
		-- We still need the unsullied global name env so that
    		--   we can look up record field names

430
431
	tcl_env  :: TcTypeEnv,    -- The local type environment: Ids and
			          -- TyVars defined in this module
432
433
					
	tcl_tyvars :: TcRef TcTyVarSet,	-- The "global tyvars"
434
			-- Namely, the in-scope TyVars bound in tcl_env, 
435
436
437
438
			-- plus the tyvars mentioned in the types of Ids bound
			-- in tcl_lenv. 
                        -- Why mutable? see notes with tcGetGlobalTyVars

439
	tcl_lie   :: TcRef WantedConstraints,    -- Place to accumulate type constraints
440
441
442
443
444
445
446

	-- TcMetaTyVars have 
	tcl_meta  :: TcRef Unique,  -- The next free unique for TcMetaTyVars
		     		    -- Guaranteed to be allocated linearly
	tcl_untch :: Unique	    -- Any TcMetaTyVar with 
		     		    --     unique >= tcl_untch is touchable
		     		    --     unique <  tcl_untch is untouchable
447
448
    }

449
450
type TcTypeEnv = NameEnv TcTyThing

451

452
453
454
455
456
457
458
459
460
461
462
463
464
{- 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.

-}
465

466
---------------------------
467
-- Template Haskell stages and levels 
468
469
---------------------------

470
471
472
473
474
475
476
477
478
479
480
481
data ThStage	-- See Note [Template Haskell state diagram] in TcSplice
  = Splice	-- Top-level splicing
		-- This code will be run *at compile time*;
		--   the result replaces the splice
		-- Binding level = 0
 
  | Comp   	-- Ordinary Haskell code
		-- Binding level = 1

  | Brack  			-- Inside brackets 
      ThStage 			--   Binding level = level(stage) + 1
      (TcRef [PendingSplice])	--   Accumulate pending splices here
482
      (TcRef WantedConstraints)	--     and type constraints here
483
484
485
486
487
488
489
490
491
492
493

topStage, topAnnStage, topSpliceStage :: ThStage
topStage       = Comp
topAnnStage    = Splice
topSpliceStage = Splice

instance Outputable ThStage where
   ppr Splice        = text "Splice"
   ppr Comp	     = text "Comp"
   ppr (Brack s _ _) = text "Brack" <> parens (ppr s)

494
type ThLevel = Int	
495
        -- See Note [Template Haskell levels] in TcSplice
496
497
	-- Incremented when going inside a bracket,
	-- decremented when going inside a splice
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
498
	-- NB: ThLevel is one greater than the 'n' in Fig 2 of the
499
	--     original "Template meta-programming for Haskell" paper
500

501
impLevel, outerLevel :: ThLevel
502
impLevel = 0	-- Imported things; they can be used inside a top level splice
503
504
505
outerLevel = 1	-- Things defined outside brackets
-- NB: Things at level 0 are not *necessarily* imported.
--	eg  $( \b -> ... )   here b is bound at level 0
506
507
508
509
510
511
--
-- For example: 
--	f = ...
--	g1 = $(map ...)		is OK
--	g2 = $(f ...)		is not OK; because we havn't compiled f yet

512
513
514
515
thLevel :: ThStage -> ThLevel
thLevel Splice        = 0
thLevel Comp          = 1
thLevel (Brack s _ _) = thLevel s + 1
516

ross's avatar
ross committed
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
---------------------------
-- 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
540
541
542
data ArrowCtxt
  = NoArrowCtxt
  | ArrowCtxt (Env TcGblEnv TcLclEnv)
ross's avatar
ross committed
543
544
545
546
547
548
549
550
551

-- 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
552
553
554
555
escapeArrowScope
  = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
	NoArrowCtxt -> env
	ArrowCtxt env' -> env'
556

557
558
559
560
---------------------------
-- TcTyThing
---------------------------

561
data TcTyThing
562
  = AGlobal TyThing		-- Used only in the return type of a lookup
563

564
  | ATcId   {		-- Ids defined in this module; may not be fully zonked
565
566
567
	tct_id     :: TcId,		
	tct_closed :: TopLevelFlag,   -- See Note [Bindings with closed types]
	tct_level  :: ThLevel }
568

569
570
  | ATyVar  Name TcType		-- The type to which the lexically scoped type vaiable
				-- is currently refined. We only need the Name
571
572
				-- for error-message purposes; it is the corresponding
				-- Name in the domain of the envt
573

dreixel's avatar
dreixel committed
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
  | AThing  TcKind   -- Used temporarily, during kind checking, for the
		     --	tycons and clases in this recursive group
                     -- Can be a mono-kind or a poly-kind; in TcTyClsDcls see
                     -- Note [Type checking recursive type and class declarations]

  | ANothing                    -- see Note [ANothing]

{-
Note [ANothing]
~~~~~~~~~~~~~~~

We don't want to allow promotion in a strongly connected component
when kind checking.

Consider:
  data T f = K (f (K Any))

When kind checking the `data T' declaration the local env contains the
mappings:
  T -> AThing <some initial kind>
  K -> ANothing

ANothing is only used for DataCons, and only used during type checking
in tcTyClGroup.
-}

600
601

instance Outputable TcTyThing where	-- Debugging only
602
   ppr (AGlobal g)      = pprTyThing g
603
   ppr elt@(ATcId {})   = text "Identifier" <> 
604
605
			  brackets (ppr (tct_id elt) <> dcolon 
                                 <> ppr (varType (tct_id elt)) <> comma
606
				 <+> ppr (tct_closed elt) <> comma
607
				 <+> ppr (tct_level elt))
608
   ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
609
   ppr (AThing k)       = text "AThing" <+> ppr k
dreixel's avatar
dreixel committed
610
   ppr ANothing         = text "ANothing"
611
612
613

pprTcTyThingCategory :: TcTyThing -> SDoc
pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
Ian Lynagh's avatar
Ian Lynagh committed
614
615
616
pprTcTyThingCategory (ATyVar {})     = ptext (sLit "Type variable")
pprTcTyThingCategory (ATcId {})      = ptext (sLit "Local identifier")
pprTcTyThingCategory (AThing {})     = ptext (sLit "Kinded thing")
dreixel's avatar
dreixel committed
617
pprTcTyThingCategory ANothing        = ptext (sLit "Opaque thing")
618
619
\end{code}

620
621
Note [Bindings with closed types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
622
623
624
625
626
627
Consider

  f x = let g ys = map not ys
        in ...

Can we generalise 'g' under the OutsideIn algorithm?  Yes, 
dreixel's avatar
dreixel committed
628
because all g's free variables are top-level; that is they themselves
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
have no free type variables, and it is the type variables in the
environment that makes things tricky for OutsideIn generalisation.

Definition:

   A variable is "closed", and has tct_closed set to TopLevel,
      iff 
   a) all its free variables are imported, or are themselves closed
   b) generalisation is not restricted by the monomorphism restriction

Under OutsideIn we are free to generalise a closed let-binding.
This is an extension compared to the JFP paper on OutsideIn, which
used "top-level" as a proxy for "closed".  (It's not a good proxy 
anyway -- the MR can make a top-level binding with a free type
variable.)

Note that:
  * A top-level binding may not be closed, if it suffer from the MR

  * A nested binding may be closed (eg 'g' in the example we started with)
    Indeed, that's the point; whether a function is defined at top level
    or nested is orthogonal to the question of whether or not it is closed 

  * A binding may be non-closed because it mentions a lexically scoped
    *type variable*  Eg
        f :: forall a. blah
        f x = let g y = ...(y::a)...

657

658
\begin{code}
659
type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
660
661
662
663
664
665
	-- Monadic so that we have a chance
	-- to deal with bound type variables just before error
	-- message construction

	-- Bool:  True <=> this is a landmark context; do not
	--		   discard it when trimming for display
666
667
668
669
670
671
672
673
674
675
\end{code}


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

\begin{code}
676
677
678
679
680
681
682
683
684
685
686
687
-- | 'ImportAvails' summarises what was imported from where, irrespective of
-- whether the imported things are actually used or not.  It is used:
--
--  * when processing the export list,
--
--  * when constructing usage info for the interface file,
--
--  * to identify the list of directly imported modules for initialisation
--    purposes and for optimised overlap checking of family instances,
--
--  * when figuring out what things are really unused
--
688
689
data ImportAvails 
   = ImportAvails {
690
691
	imp_mods :: ImportedMods,
	  --      = ModuleEnv [(ModuleName, Bool, SrcSpan, Bool)],
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
          -- ^ Domain is all directly-imported modules
          -- The 'ModuleName' is what the module was imported as, e.g. in
          -- @
          --     import Foo as Bar
          -- @
          -- it is @Bar@.
          --
          -- The 'Bool' means:
          --
          --  - @True@ => import was @import Foo ()@
          --
          --  - @False@ => import was some other form
          --
          -- Used
          --
          --   (a) to help construct the usage information in the interface
          --       file; if we import somethign we need to recompile if the
          --       export version changes
          --
          --   (b) to specify what child modules to initialise
          --
          -- 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).
717

718
719
720
721
722
723
724
725
726
727
728
        imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
          -- ^ Home-package modules needed by the module being compiled
          --
          -- 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],
729
730
731
          -- ^ Packages needed by the module being compiled, whether directly,
          -- or via other modules in this package, or via modules imported
          -- from other packages.
732
733
734
735
736
737
738
739
740
741
        
        imp_trust_pkgs :: [PackageId],
          -- ^ This is strictly a subset of imp_dep_pkgs and records the
          -- packages the current module needs to trust for Safe Haskell
          -- compilation to succeed. A package is required to be trusted if
          -- we are dependent on a trustworthy module in that package.
          -- While perhaps making imp_dep_pkgs a tuple of (PackageId, Bool)
          -- where True for the bool indicates the package is required to be
          -- trusted is the more logical  design, doing so complicates a lot
          -- of code not concerned with Safe Haskell.
742
          -- See Note [RnNames . Tracking Trust Transitively]
743

744
745
746
747
748
749
750
        imp_trust_own_pkg :: Bool,
          -- ^ Do we require that our own package is trusted?
          -- This is to handle efficiently the case where a Safe module imports
          -- a Trustworthy module that resides in the same package as it.
          -- See Note [RnNames . Trust Own Package]

        imp_orphs :: [Module],
751
752
          -- ^ Orphan modules below us in the import tree (and maybe including
          -- us for imported modules)
753

754
        imp_finsts :: [Module]
755
756
          -- ^ Family instance modules below us in the import tree (and maybe
          -- including us for imported modules)
757
758
      }

Simon Marlow's avatar
Simon Marlow committed
759
760
761
mkModDeps :: [(ModuleName, IsBootInterface)]
	  -> ModuleNameEnv (ModuleName, IsBootInterface)
mkModDeps deps = foldl add emptyUFM deps
762
	       where
Simon Marlow's avatar
Simon Marlow committed
763
		 add env elt@(m,_) = addToUFM env m elt
764

765
emptyImportAvails :: ImportAvails
766
767
768
769
770
771
772
773
774
775
776
777
778
emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,
                                   imp_dep_mods      = emptyUFM,
                                   imp_dep_pkgs      = [],
                                   imp_trust_pkgs    = [],
                                   imp_trust_own_pkg = False,
                                   imp_orphs         = [],
                                   imp_finsts        = [] }

-- | Union two ImportAvails
--
-- This function is a key part of Import handling, basically
-- for each import we create a seperate ImportAvails structure
-- and then union them all together with this function.
779
780
plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
plusImportAvails
781
  (ImportAvails { imp_mods = mods1,
782
783
                  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
                  imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,
784
785
                  imp_orphs = orphs1, imp_finsts = finsts1 })
  (ImportAvails { imp_mods = mods2,
786
787
                  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
                  imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
788
                  imp_orphs = orphs2, imp_finsts = finsts2 })
789
790
791
792
793
794
795
  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,
                   imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,
                   imp_dep_pkgs      = dpkgs1 `unionLists` dpkgs2,
                   imp_trust_pkgs    = tpkgs1 `unionLists` tpkgs2,
                   imp_trust_own_pkg = tself1 || tself2,
                   imp_orphs         = orphs1 `unionLists` orphs2,
                   imp_finsts        = finsts1 `unionLists` finsts2 }
796
  where
797
    plus_mod_dep (m1, boot1) (m2, boot2) 
798
799
800
        = 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
801
802
803
804
805
806
807
808
809
810
811
812
813
\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 #-})
814
  | ImportBySystem			-- Non user import.
815
816

instance Outputable WhereFrom where
Ian Lynagh's avatar
Ian Lynagh committed
817
  ppr (ImportByUser is_boot) | is_boot     = ptext (sLit "{- SOURCE -}")
818
			     | otherwise   = empty
Ian Lynagh's avatar
Ian Lynagh committed
819
  ppr ImportBySystem     		   = ptext (sLit "{- SYSTEM -}")
820
821
\end{code}

822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
%************************************************************************
%*									*
%*                       Canonical constraints                          *
%*                                                                      *
%*   These are the constraints the low-level simplifier works with      *
%*									*
%************************************************************************


\begin{code}
-- Types without any type functions inside.  However, note that xi
-- types CAN contain unexpanded type synonyms; however, the
-- (transitive) expansions of those type synonyms will not contain any
-- type functions.
type Xi = Type       -- In many comments, "xi" ranges over Xi

type Cts = Bag Ct

type SubGoalDepth = Int -- An ever increasing number used to restrict 
                        -- simplifier iterations. Bounded by -fcontext-stack.

data Ct
  -- Atomic canonical constraints 
  = CDictCan {  -- e.g.  Num xi
      cc_id     :: EvVar,
      cc_flavor :: CtFlavor, 
      cc_class  :: Class, 
      cc_tyargs :: [Xi],

      cc_depth  :: SubGoalDepth -- Simplification depth of this constraint
                       -- See Note [WorkList]
    }

  | CIPCan {	-- ?x::tau
      -- See note [Canonical implicit parameter constraints].
      cc_id     :: EvVar,
      cc_flavor :: CtFlavor,
      cc_ip_nm  :: IPName Name,
      cc_ip_ty  :: TcTauType, -- Not a Xi! See same not as above
      cc_depth  :: SubGoalDepth        -- See Note [WorkList]
    }

  | CIrredEvCan {  -- These stand for yet-unknown predicates
      cc_id     :: EvVar,
      cc_flavor :: CtFlavor,
      cc_ty     :: Xi, -- cc_ty is flat hence it may only be of the form (tv xi1 xi2 ... xin)
                       -- Since, if it were a type constructor application, that'd make the
                       -- whole constraint a CDictCan, CIPCan, or CTyEqCan. And it can't be
                       -- a type family application either because it's a Xi type.
      cc_depth :: SubGoalDepth -- See Note [WorkList]
    }

  | CTyEqCan {  -- tv ~ xi	(recall xi means function free)
       -- Invariant: 
       --   * tv not in tvs(xi)   (occurs check)
       --   * typeKind xi `compatKind` typeKind tv
       --       See Note [Spontaneous solving and kind compatibility]
       --   * We prefer unification variables on the left *JUST* for efficiency
      cc_id     :: EvVar, 
      cc_flavor :: CtFlavor, 
      cc_tyvar  :: TcTyVar, 
      cc_rhs    :: Xi,

      cc_depth :: SubGoalDepth -- See Note [WorkList] 
    }

  | CFunEqCan {  -- F xis ~ xi  
                 -- Invariant: * isSynFamilyTyCon cc_fun 
                 --            * typeKind (F xis) `compatKind` typeKind xi
      cc_id     :: EvVar,
      cc_flavor :: CtFlavor, 
      cc_fun    :: TyCon,	-- A type function
      cc_tyargs :: [Xi],	-- Either under-saturated or exactly saturated
      cc_rhs    :: Xi,      	--    *never* over-saturated (because if so
      		      		--    we should have decomposed)

      cc_depth  :: SubGoalDepth -- See Note [WorkList]
                   
    }

  | CNonCanonical { -- See Note [NonCanonical Semantics] 
      cc_id     :: EvVar,
      cc_flavor :: CtFlavor, 
      cc_depth  :: SubGoalDepth
    }

908
909
910
\end{code}

\begin{code}
911
912
mkNonCanonical :: EvVar -> CtFlavor -> Ct
mkNonCanonical ev flav = CNonCanonical { cc_id = ev, cc_flavor = flav, cc_depth = 0}
913

914
915
916
917
918
919
920
921
922
923
924
925
926
927
ctPred :: Ct -> PredType 
ctPred (CNonCanonical { cc_id = v }) = evVarPred v
ctPred (CDictCan { cc_class = cls, cc_tyargs = xis }) 
  = mkClassPred cls xis
ctPred (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) 
  = mkEqPred (mkTyVarTy tv, xi)
ctPred (CFunEqCan { cc_fun = fn, cc_tyargs = xis1, cc_rhs = xi2 }) 
  = mkEqPred(mkTyConApp fn xis1, xi2)
ctPred (CIPCan { cc_ip_nm = nm, cc_ip_ty = xi }) 
  = mkIPPred nm xi
ctPred (CIrredEvCan { cc_ty = xi }) = xi
\end{code}


928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
%************************************************************************
%*									*
                    CtFlavor
         The "flavor" of a canonical constraint
%*									*
%************************************************************************

\begin{code}
ctWantedLoc :: Ct -> WantedLoc
-- Only works for Wanted/Derived
ctWantedLoc ct = ASSERT2( not (isGivenOrSolved (cc_flavor ct)), ppr ct )
                 getWantedLoc (cc_flavor ct)

isWantedCt :: Ct -> Bool
isWantedCt ct = isWanted (cc_flavor ct)

isDerivedCt :: Ct -> Bool
isDerivedCt ct = isDerived (cc_flavor ct)

isGivenCt_maybe :: Ct -> Maybe GivenKind
isGivenCt_maybe ct = isGiven_maybe (cc_flavor ct)

isGivenOrSolvedCt :: Ct -> Bool
isGivenOrSolvedCt ct = isGivenOrSolved (cc_flavor ct)

isCTyEqCan :: Ct -> Bool 
isCTyEqCan (CTyEqCan {})  = True 
isCTyEqCan (CFunEqCan {}) = False
isCTyEqCan _              = False 

isCDictCan_Maybe :: Ct -> Maybe Class
isCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls
isCDictCan_Maybe _              = Nothing

isCIPCan_Maybe :: Ct -> Maybe (IPName Name)
isCIPCan_Maybe  (CIPCan {cc_ip_nm = nm }) = Just nm
isCIPCan_Maybe _                = Nothing

isCIrredEvCan :: Ct -> Bool
isCIrredEvCan (CIrredEvCan {}) = True
isCIrredEvCan _                = False

isCFunEqCan_Maybe :: Ct -> Maybe TyCon
isCFunEqCan_Maybe (CFunEqCan { cc_fun = tc }) = Just tc
isCFunEqCan_Maybe _ = Nothing

isCNonCanonical :: Ct -> Bool
isCNonCanonical (CNonCanonical {}) = True 
isCNonCanonical _ = False 
\end{code}

979
\begin{code}
980
981
instance Outputable Ct where
  ppr ct = ppr (cc_flavor ct) <> braces (ppr (cc_depth ct))
982
                  <+> ppr ev_var <+> dcolon <+> ppr (ctPred ct)
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
                  <+> parens (text ct_sort)
         where ev_var  = cc_id ct
               ct_sort = case ct of 
                           CTyEqCan {}      -> "CTyEqCan"
                           CFunEqCan {}     -> "CFunEqCan"
                           CNonCanonical {} -> "CNonCanonical"
                           CDictCan {}      -> "CDictCan"
                           CIPCan {}        -> "CIPCan"
                           CIrredEvCan {}   -> "CIrredEvCan"
\end{code}

\begin{code}
singleCt :: Ct -> Cts 
singleCt = unitBag 

andCts :: Cts -> Cts -> Cts 
andCts = unionBags