TcRnTypes.lhs 47.1 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
57
58
59
60
        WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
        andWC, addFlats, addImplics, mkFlatWC,

        EvVarX(..), mkEvVarX, evVarOf, evVarX, evVarOfPred,
        WantedEvVar, wantedToFlavored,
        keepWanted,

        Implication(..),
61
62
        CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin,
	CtOrigin(..), EqOrigin(..), 
dimitris's avatar
dimitris committed
63
        WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt,
64

65
	SkolemInfo(..),
66

dimitris's avatar
dimitris committed
67
68
69
        CtFlavor(..), pprFlavorArising, isWanted, 
        isGivenOrSolved, isGiven_maybe,
        isDerived,
70
        FlavoredEvVar,
71
72

	-- Pretty printing
73
        pprEvVarTheta, pprWantedEvVar, pprWantedsWithLocs,
74
	pprEvVars, pprEvVarWithType,
75
        pprArising, pprArisingAt,
76
77

	-- Misc other types
78
	TcId, TcIdSet, TcTyVarBind(..), TcTyVarBinds
79
	
80
81
82
83
  ) where

#include "HsVersions.h"

84
import HsSyn
85
86
import HscTypes
import Type
87
import Class    ( Class )
88
import TyCon    ( TyCon )
89
import DataCon  ( DataCon, dataConUserType )
90
import TcType
91
import Annotations
92
93
import InstEnv
import FamInstEnv
94
import IOEnv
95
96
import RdrName
import Name
97
import NameEnv
98
import NameSet
99
import Avail
100
101
import Var
import VarEnv
102
import Module
103
104
105
import SrcLoc
import VarSet
import ErrUtils
106
import UniqFM
107
import UniqSupply
108
import Unique
109
import BasicTypes
110
111
import Bag
import Outputable
112
import ListSetOps
113
import FastString
114

115
import Data.Set (Set)
116
117
118
119
120
121
122
123
124
125
\end{code}


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

126
The monad itself has to be defined here, because it is mentioned by ErrCtxt
127
128

\begin{code}
129
type TcRef a 	 = IORef a
130
type TcId    	 = Id 			-- Type may be a TcType  DV: WHAT??????????
131
type TcIdSet 	 = IdSet
132

133

134
135
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
136

137
138
139
140
141
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
142
143
\end{code}

144
145
146
147
148
149
150
151
152
153
154
155
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}

156
157

%************************************************************************
158
159
160
%*                                                                      *
                The main environment types
%*                                                                      *
161
162
163
%************************************************************************

\begin{code}
164
165
166
167
-- 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
168
  = Env {
169
170
        env_top  :: HscEnv,  -- Top-level stuff that never changes
                             -- Includes all info about imported things
171

172
173
        env_us   :: {-# UNPACK #-} !(IORef UniqSupply),
                             -- Unique supply for local varibles
174

175
176
        env_gbl  :: gbl,     -- Info about things defined at the top level
                             -- of the module being compiled
177

178
        env_lcl  :: lcl      -- Nested stuff; changes as we go into 
179
    }
180
181
182
183

-- 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
184
185
-- For state that needs to be updated during the typechecking
-- phase and returned at end, use a TcRef (= IORef).
186
187
188

data TcGblEnv
  = TcGblEnv {
189
190
191
	tcg_mod     :: Module,         -- ^ Module being compiled
	tcg_src     :: HscSource,
          -- ^ What kind of module (regular Haskell, hs-boot, ext-core)
192

193
194
195
	tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming
	tcg_default :: Maybe [Type],
          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
196

197
198
	tcg_fix_env   :: FixityEnv,	-- ^ Just for things in this module
	tcg_field_env :: RecFieldEnv,	-- ^ Just for things in this module
199

200
201
202
203
204
205
206
	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)
207

208
	tcg_type_env_var :: TcRef TypeEnv,
209
210
211
212
		-- 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)
213
	
214
215
216
217
	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
218

219
220
221
222
		-- 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.
223
224
225
	tcg_exports :: [AvailInfo],	-- ^ What is exported
	tcg_imports :: ImportAvails,
          -- ^ Information about what was imported from where, including
226
227
	  -- things bound in this module. Also store Safe Haskell info
          -- here about transative trusted packaage requirements.
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256

	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

257
        tcg_th_used :: TcRef Bool,
258
259
          -- ^ @True@ <=> Template Haskell syntax used.
          --
260
261
262
263
          -- 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
264
265
          -- mutable variable.

266
267
268
269
270
        tcg_th_splice_used :: TcRef Bool,
          -- ^ @True@ <=> A Template Haskell splice was used.
          --
          -- Splices disable recompilation avoidance (see #481)

271
272
	tcg_dfun_n  :: TcRef OccSet,
          -- ^ Allows us to choose unique DFun names.
273
274
275
276

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

278
        tcg_rn_exports :: Maybe [Located (IE Name)],
279
280
281
        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
282

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

287
288
289
	tcg_rn_decls :: Maybe (HsGroup Name),
          -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed
          -- decls.
290

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

293
        tcg_ev_binds  :: Bag EvBind,	    -- Top-level evidence bindings
294
	tcg_binds     :: LHsBinds Id,	    -- Value bindings in this module
295
        tcg_sigs      :: NameSet, 	    -- ...Top-level names that *lack* a signature
296
        tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
Ian Lynagh's avatar
Ian Lynagh committed
297
	tcg_warns     :: Warnings,	    -- ...Warnings and deprecations
298
	tcg_anns      :: [Annotation],      -- ...Annotations
299
300
        tcg_tcs       :: [TyCon],           -- ...TyCons
        tcg_clss      :: [Class],           -- ...Classes
301
	tcg_insts     :: [Instance],	    -- ...Instances
302
303
304
305
        tcg_fam_insts :: [FamInst],         -- ...Family instances
        tcg_rules     :: [LRuleDecl Id],    -- ...Rules
        tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
        tcg_vects     :: [LVectDecl Id],    -- ...Vectorisation declarations
306

307
	tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
308
309
310
        tcg_hpc       :: AnyHpcUsage,        -- ^ @True@ if any part of the
                                             --  prog uses hpc instrumentation.

311
        tcg_main      :: Maybe Name,         -- ^ The Name of the main
312
313
                                             -- function, if this module is
                                             -- the main module.
314
315
        tcg_safeInfer :: TcRef Bool          -- Has the typechecker infered this
                                             -- module as -XSafe (Safe Haskell)
316
    }
317

318
319
320
321
322
323
324
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 {..}
325
326
	-- This is used when dealing with ".." notation in record 
	-- construction and pattern matching.
327
	-- The FieldEnv deals *only* with constructors defined in *this*
Thomas Schilling's avatar
Thomas Schilling committed
328
329
	-- module.  For imported modules, we get the same info from the
	-- TypeEnv
330
331
\end{code}

332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
%************************************************************************
%*									*
		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.
347
	if_rec_types :: Maybe (Module, IfG TypeEnv)
348
349
350
351
352
353
354
355
356
357
		-- 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
358
	if_mod :: Module,
359

360
361
362
363
364
365
366
	-- 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

367
	if_tv_env  :: UniqFM TyVar,	-- Nested tyvar bindings
368
		      	     		-- (and coercions)
369
	if_id_env  :: UniqFM Id		-- Nested id binding
370
371
372
    }
\end{code}

373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395

%************************************************************************
%*									*
		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}
396
397
data TcLclEnv		-- Changes as we move inside an expression
			-- Discarded after typecheck/rename; not passed on to desugarer
398
  = TcLclEnv {
399
	tcl_loc  :: SrcSpan,		-- Source span
400
	tcl_ctxt :: [ErrCtxt],		-- Error context, innermost on top
401
	tcl_errs :: TcRef Messages,	-- Place to accumulate errors
402

403
404
	tcl_th_ctxt    :: ThStage,	      -- Template Haskell context
	tcl_arrow_ctxt :: ArrowCtxt,	      -- Arrow-notation context
405

406
	tcl_rdr :: LocalRdrEnv,		-- Local name envt
407
408
409
410
		-- 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.
		-- 
411
412
413
414
		--   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)
415
416
417
		-- We still need the unsullied global name env so that
    		--   we can look up record field names

418
419
	tcl_env  :: TcTypeEnv,    -- The local type environment: Ids and
			          -- TyVars defined in this module
420
421
					
	tcl_tyvars :: TcRef TcTyVarSet,	-- The "global tyvars"
422
			-- Namely, the in-scope TyVars bound in tcl_env, 
423
424
425
426
			-- plus the tyvars mentioned in the types of Ids bound
			-- in tcl_lenv. 
                        -- Why mutable? see notes with tcGetGlobalTyVars

427
	tcl_lie   :: TcRef WantedConstraints,    -- Place to accumulate type constraints
428
429
430
431
432
433
434

	-- 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
435
436
    }

437
438
type TcTypeEnv = NameEnv TcTyThing

439

440
441
442
443
444
445
446
447
448
449
450
451
452
{- 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.

-}
453

454
---------------------------
455
-- Template Haskell stages and levels 
456
457
---------------------------

458
459
460
461
462
463
464
465
466
467
468
469
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
470
      (TcRef WantedConstraints)	--     and type constraints here
471
472
473
474
475
476
477
478
479
480
481

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)

482
type ThLevel = Int	
483
        -- See Note [Template Haskell levels] in TcSplice
484
485
	-- Incremented when going inside a bracket,
	-- decremented when going inside a splice
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
486
	-- NB: ThLevel is one greater than the 'n' in Fig 2 of the
487
	--     original "Template meta-programming for Haskell" paper
488

489
impLevel, outerLevel :: ThLevel
490
impLevel = 0	-- Imported things; they can be used inside a top level splice
491
492
493
outerLevel = 1	-- Things defined outside brackets
-- NB: Things at level 0 are not *necessarily* imported.
--	eg  $( \b -> ... )   here b is bound at level 0
494
495
496
497
498
499
--
-- For example: 
--	f = ...
--	g1 = $(map ...)		is OK
--	g2 = $(f ...)		is not OK; because we havn't compiled f yet

500
501
502
503
thLevel :: ThStage -> ThLevel
thLevel Splice        = 0
thLevel Comp          = 1
thLevel (Brack s _ _) = thLevel s + 1
504

ross's avatar
ross committed
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
---------------------------
-- 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
528
529
530
data ArrowCtxt
  = NoArrowCtxt
  | ArrowCtxt (Env TcGblEnv TcLclEnv)
ross's avatar
ross committed
531
532
533
534
535
536
537
538
539

-- 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
540
541
542
543
escapeArrowScope
  = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
	NoArrowCtxt -> env
	ArrowCtxt env' -> env'
544

545
546
547
548
---------------------------
-- TcTyThing
---------------------------

549
data TcTyThing
550
  = AGlobal TyThing		-- Used only in the return type of a lookup
551

552
  | ATcId   {		-- Ids defined in this module; may not be fully zonked
553
554
555
	tct_id     :: TcId,		
	tct_closed :: TopLevelFlag,   -- See Note [Bindings with closed types]
	tct_level  :: ThLevel }
556

557
558
  | ATyVar  Name TcType		-- The type to which the lexically scoped type vaiable
				-- is currently refined. We only need the Name
559
560
				-- for error-message purposes; it is the corresponding
				-- Name in the domain of the envt
561

562
563
  | AThing  TcKind 		-- Used temporarily, during kind checking, for the
				--	tycons and clases in this recursive group
564
565

instance Outputable TcTyThing where	-- Debugging only
566
   ppr (AGlobal g)      = pprTyThing g
567
   ppr elt@(ATcId {})   = text "Identifier" <> 
568
569
			  brackets (ppr (tct_id elt) <> dcolon 
                                 <> ppr (varType (tct_id elt)) <> comma
570
				 <+> ppr (tct_closed elt) <> comma
571
				 <+> ppr (tct_level elt))
572
   ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
573
   ppr (AThing k)       = text "AThing" <+> ppr k
574
575
576

pprTcTyThingCategory :: TcTyThing -> SDoc
pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
Ian Lynagh's avatar
Ian Lynagh committed
577
578
579
pprTcTyThingCategory (ATyVar {})     = ptext (sLit "Type variable")
pprTcTyThingCategory (ATcId {})      = ptext (sLit "Local identifier")
pprTcTyThingCategory (AThing {})     = ptext (sLit "Kinded thing")
580
581
\end{code}

582
583
Note [Bindings with closed types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
Consider

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

Can we generalise 'g' under the OutsideIn algorithm?  Yes, 
becuase all g's free variables are top-level; that is they themselves
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)...

619

620
\begin{code}
621
622
623
624
625
626
627
type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, Message))
	-- 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
628
629
630
631
632
633
634
635
636
637
\end{code}


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

\begin{code}
638
639
640
641
642
643
644
645
646
647
648
649
-- | '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
--
650
651
data ImportAvails 
   = ImportAvails {
652
653
	imp_mods :: ImportedMods,
	  --      = ModuleEnv [(ModuleName, Bool, SrcSpan, Bool)],
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
          -- ^ 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).
679

680
681
682
683
684
685
686
687
688
689
690
        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],
691
692
693
          -- ^ Packages needed by the module being compiled, whether directly,
          -- or via other modules in this package, or via modules imported
          -- from other packages.
694
695
696
697
698
699
700
701
702
703
        
        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.
704
          -- See Note [RnNames . Tracking Trust Transitively]
705

706
707
708
709
710
711
712
        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],
713
714
          -- ^ Orphan modules below us in the import tree (and maybe including
          -- us for imported modules)
715

716
        imp_finsts :: [Module]
717
718
          -- ^ Family instance modules below us in the import tree (and maybe
          -- including us for imported modules)
719
720
      }

Simon Marlow's avatar
Simon Marlow committed
721
722
723
mkModDeps :: [(ModuleName, IsBootInterface)]
	  -> ModuleNameEnv (ModuleName, IsBootInterface)
mkModDeps deps = foldl add emptyUFM deps
724
	       where
Simon Marlow's avatar
Simon Marlow committed
725
		 add env elt@(m,_) = addToUFM env m elt
726

727
emptyImportAvails :: ImportAvails
728
729
730
731
732
733
734
735
736
737
738
739
740
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.
741
742
plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
plusImportAvails
743
  (ImportAvails { imp_mods = mods1,
744
745
                  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
                  imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,
746
747
                  imp_orphs = orphs1, imp_finsts = finsts1 })
  (ImportAvails { imp_mods = mods2,
748
749
                  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
                  imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
750
                  imp_orphs = orphs2, imp_finsts = finsts2 })
751
752
753
754
755
756
757
  = 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 }
758
  where
759
    plus_mod_dep (m1, boot1) (m2, boot2) 
760
761
762
        = 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
763
764
765
766
767
768
769
770
771
772
773
774
775
\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 #-})
776
  | ImportBySystem			-- Non user import.
777
778

instance Outputable WhereFrom where
Ian Lynagh's avatar
Ian Lynagh committed
779
  ppr (ImportByUser is_boot) | is_boot     = ptext (sLit "{- SOURCE -}")
780
			     | otherwise   = empty
Ian Lynagh's avatar
Ian Lynagh committed
781
  ppr ImportBySystem     		   = ptext (sLit "{- SYSTEM -}")
782
783
784
785
786
\end{code}


%************************************************************************
%*									*
787
788
789
790
791
792
		Wanted constraints
     These are forced to be in TcRnTypes because
     	   TcLclEnv mentions WantedConstraints
	   WantedConstraint mentions CtLoc
	   CtLoc mentions ErrCtxt
	   ErrCtxt mentions TcM
793
794
795
%*									*
v%************************************************************************

796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
\begin{code}
data WantedConstraints
  = WC { wc_flat  :: Bag WantedEvVar   -- Unsolved constraints, all wanted
       , wc_impl  :: Bag Implication
       , wc_insol :: Bag FlavoredEvVar -- Insoluble constraints, can be
                                       -- wanted, given, or derived
                                       -- See Note [Insoluble constraints]
    }

emptyWC :: WantedConstraints
emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }

mkFlatWC :: Bag WantedEvVar -> WantedConstraints
mkFlatWC wevs = WC { wc_flat = wevs, wc_impl = emptyBag, wc_insol = emptyBag }

isEmptyWC :: WantedConstraints -> Bool
isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
  = isEmptyBag f && isEmptyBag i && isEmptyBag n

insolubleWC :: WantedConstraints -> Bool
-- True if there are any insoluble constraints in the wanted bag
insolubleWC wc = not (isEmptyBag (wc_insol wc))
               || anyBag ic_insol (wc_impl wc)

andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
      (WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
  = WC { wc_flat  = f1 `unionBags` f2
       , wc_impl  = i1 `unionBags` i2
       , wc_insol = n1 `unionBags` n2 }

addFlats :: WantedConstraints -> Bag WantedEvVar -> WantedConstraints
828
addFlats wc wevs = wc { wc_flat = wc_flat wc `unionBags` wevs }
829
830

addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
831
addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847

instance Outputable WantedConstraints where
  ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
   = ptext (sLit "WC") <+> braces (vcat
        [ if isEmptyBag f then empty else
          ptext (sLit "wc_flat =")  <+> pprBag pprWantedEvVar f
        , if isEmptyBag i then empty else
          ptext (sLit "wc_impl =")  <+> pprBag ppr i
        , if isEmptyBag n then empty else
          ptext (sLit "wc_insol =") <+> pprBag ppr n ])

pprBag :: (a -> SDoc) -> Bag a -> SDoc
pprBag pp b = foldrBag (($$) . pp) empty b
\end{code}
 

848
\begin{code}
849
850
851
852
853
854
855
856
857
858
859
860
861
data Untouchables = NoUntouchables
                  | TouchableRange
                          Unique  -- Low end
                          Unique  -- High end
 -- A TcMetaTyvar is *touchable* iff its unique u satisfies
 --   u >= low
 --   u < high

instance Outputable Untouchables where
  ppr NoUntouchables = ptext (sLit "No untouchables")
  ppr (TouchableRange low high) = ptext (sLit "Touchable range:") <+> 
                                  ppr low <+> char '-' <+> ppr high

862
863
864
865
isNoUntouchables :: Untouchables -> Bool
isNoUntouchables NoUntouchables      = True
isNoUntouchables (TouchableRange {}) = False

866
867
868
869
870
871
inTouchableRange :: Untouchables -> TcTyVar -> Bool
inTouchableRange NoUntouchables _ = True
inTouchableRange (TouchableRange low high) tv 
  = uniq >= low && uniq < high
  where
    uniq = varUnique tv
872

873
-- EvVar defined in module Var.lhs:
874
875
876
877
-- Evidence variables include all *quantifiable* constraints
--   dictionaries
--   implicit parameters
--   coercion variables
878
\end{code}
879

880
881
882
883
884
%************************************************************************
%*									*
                Implication constraints
%*                                                                      *
%************************************************************************
885

886
\begin{code}
887
888
data Implication
  = Implic {  
889
      ic_untch :: Untouchables, -- Untouchables: unification variables
890
                                -- free in the environment
891
      ic_env   :: TcTypeEnv,    -- The type environment
892
                                -- Used only when generating error messages
893
	  -- Generally, ic_untch is a superset of tvsof(ic_env)
894
895
	  -- However, we don't zonk ic_env when zonking the Implication
	  -- Instead we do that when generating a skolem-escape error message
896

897
898
      ic_skols  :: TcTyVarSet,   -- Introduced skolems 
      		   	         -- See Note [Skolems in an implication]
899

900
901
      ic_given  :: [EvVar],      -- Given evidence variables
      		   		 --   (order does not matter)
902
903
904
      ic_loc   :: GivenLoc,      -- Binding location of the implication,
                                 --   which is also the location of all the
                                 --   given evidence variables
905

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
906
      ic_wanted :: WantedConstraints,  -- The wanted
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
907
      ic_insol  :: Bool,               -- True iff insolubleWC ic_wanted is true
908

909
910
911
      ic_binds  :: EvBindsVar   -- Points to the place to fill in the
                                -- abstraction and bindings
    }
912

913
914
915
916
917
918
919
920
921
922
923
924
instance Outputable Implication where
  ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given
              , ic_wanted = wanted
              , ic_binds = binds, ic_loc = loc })
   = ptext (sLit "Implic") <+> braces 
     (sep [ ptext (sLit "Untouchables = ") <+> ppr untch
          , ptext (sLit "Skolems = ") <+> ppr skols
          , ptext (sLit "Given = ") <+> pprEvVars given
          , ptext (sLit "Wanted = ") <+> ppr wanted
          , ptext (sLit "Binds = ") <+> ppr binds
          , pprSkolInfo (ctLocOrigin loc)
          , ppr (ctLocSpan loc) ])
925
926
\end{code}

927
928
929
930
931
932
Note [Skolems in an implication]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The skolems in an implication are not there to perform a skolem escape
check.  That happens because all the environment variables are in the
untouchables, and therefore cannot be unified with anything at all,
let alone the skolems.
933

934
935
936
Instead, ic_skols is used only when considering floating a constraint
outside the implication in TcSimplify.floatEqualities or 
TcSimplify.approximateImplications
937

938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
Note [Insoluble constraints]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Some of the errors that we get during canonicalization are best
reported when all constraints have been simplified as much as
possible. For instance, assume that during simplification the
following constraints arise:
   
 [Wanted]   F alpha ~  uf1 
 [Wanted]   beta ~ uf1 beta 

When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail
we will simply see a message:
    'Can't construct the infinite type  beta ~ uf1 beta' 
and the user has no idea what the uf1 variable is.

Instead our plan is that we will NOT fail immediately, but:
    (1) Record the "frozen" error in the ic_insols field
    (2) Isolate the offending constraint from the rest of the inerts 
    (3) Keep on simplifying/canonicalizing

At the end, we will hopefully have substituted uf1 := F alpha, and we
will be able to report a more informative error:
    'Can't construct the infinite type beta ~ F alpha beta'
Ian Lynagh's avatar
Ian Lynagh committed
961

962
963
964
965
966
%************************************************************************
%*									*
            EvVarX, WantedEvVar, FlavoredEvVar
%*									*
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
967

968
\begin{code}
969
970
971
972
973
974
975
976
977
978
979
980
981
data EvVarX a = EvVarX EvVar a
     -- An evidence variable with accompanying info

type WantedEvVar   = EvVarX WantedLoc     -- The location where it arose
type FlavoredEvVar = EvVarX CtFlavor

instance Outputable (EvVarX a) where
  ppr (EvVarX ev _) = pprEvVarWithType ev
  -- If you want to see the associated info,
  -- use a more specific printing function

mkEvVarX :: EvVar -> a -> EvVarX a
mkEvVarX = EvVarX
Ian Lynagh's avatar
Ian Lynagh committed
982

983
984
evVarOf :: EvVarX a -> EvVar
evVarOf (EvVarX ev _) = ev
Ian Lynagh's avatar
Ian Lynagh committed
985

986
987
988
989
990
991
992
993
994
995
996
evVarX :: EvVarX a -> a
evVarX (EvVarX _ a) = a

evVarOfPred :: EvVarX a -> PredType
evVarOfPred wev = evVarPred (evVarOf wev)

wantedToFlavored :: WantedEvVar -> FlavoredEvVar
wantedToFlavored (EvVarX v wl) = EvVarX v (Wanted wl)

keepWanted :: Bag FlavoredEvVar -> Bag WantedEvVar
keepWanted flevs
997
998
  = foldrBag keep_wanted emptyBag flevs
    -- Important: use fold*r*Bag to preserve the order of the evidence variables.
999
  where
1000
1001
1002
    keep_wanted :: FlavoredEvVar -> Bag WantedEvVar -> Bag WantedEvVar
    keep_wanted (EvVarX ev (Wanted wloc)) r = consBag (EvVarX ev wloc) r
    keep_wanted _                         r = r
1003
\end{code}
1004
1005


1006
1007
1008
1009
1010
1011
1012
1013
\begin{code}
pprEvVars :: [EvVar] -> SDoc	-- Print with their types
pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)

pprEvVarTheta :: [EvVar] -> SDoc
pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
                              
pprEvVarWithType :: EvVar -> SDoc
batterseapower's avatar
batterseapower committed
1014
pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)
1015

1016
1017
1018
1019
1020
pprWantedsWithLocs :: WantedConstraints -> SDoc
pprWantedsWithLocs wcs
  =  vcat [ pprBag pprWantedEvVarWithLoc (wc_flat wcs)
          , pprBag ppr (wc_impl wcs)
          , pprBag ppr (wc_insol wcs) ]
1021
1022

pprWantedEvVarWithLoc, pprWantedEvVar :: WantedEvVar -> SDoc
1023
1024
1025
1026
pprWantedEvVarWithLoc (EvVarX v loc) = hang (pprEvVarWithType v)
                                          2 (pprArisingAt loc)
pprWantedEvVar        (EvVarX v _)   = pprEvVarWithType v
\end{code}
1027

1028
1029
1030
1031
1032
1033
1034
1035
%************************************************************************
%*									*
            CtLoc
%*									*
%************************************************************************

\begin{code}
data CtFlavor
dimitris's avatar
dimitris committed
1036
1037
1038
1039
1040
1041
1042
1043
  = Given GivenLoc GivenKind -- We have evidence for this constraint in TcEvBinds
  | Derived WantedLoc        -- Derived's are just hints for unifications 
  | Wanted WantedLoc         -- We have no evidence bindings for this constraint. 

data GivenKind
  = GivenOrig   -- Originates in some given, such as signature or pattern match
  | GivenSolved -- Is given as result of being solved, maybe provisionally on
                -- some other wanted constraints. 
1044
1045

instance Outputable CtFlavor where
dimitris's avatar
dimitris committed
1046
1047
1048
1049
1050
  ppr (Given _ GivenOrig)   = ptext (sLit "[G]")
  ppr (Given _ GivenSolved) = ptext (sLit "[S]") -- Print [S] for Given/Solved's
  ppr (Wanted {})           = ptext (sLit "[W]")
  ppr (Derived {})          = ptext (sLit "[D]") 

1051
pprFlavorArising :: CtFlavor -> SDoc
dimitris's avatar
dimitris committed
1052
pprFlavorArising (Derived wl)   = pprArisingAt wl
1053
pprFlavorArising (Wanted  wl)   = pprArisingAt wl
dimitris's avatar
dimitris committed
1054
pprFlavorArising (Given gl _)   = pprArisingAt gl
1055
1056
1057
1058
1059

isWanted :: CtFlavor -> Bool
isWanted (Wanted {}) = True
isWanted _           = False

dimitris's avatar
dimitris committed
1060
1061
1062
1063
1064
1065
1066
isGivenOrSolved :: CtFlavor -> Bool
isGivenOrSolved (Given {}) = True
isGivenOrSolved _ = False

isGiven_maybe :: CtFlavor -> Maybe GivenKind 
isGiven_maybe (Given _ gk) = Just gk
isGiven_maybe _            = Nothing
1067
1068
1069
1070

isDerived :: CtFlavor -> Bool 
isDerived (Derived {}) = True
isDerived _            = False
1071
1072
1073
1074
\end{code}

%************************************************************************
%*									*
1075
            CtLoc
1076
1077
1078
%*									*
%************************************************************************

1079
1080
1081
1082
The 'CtLoc' gives information about where a constraint came from.
This is important for decent error message reporting because
dictionaries don't appear in the original source code.
type will evolve...
1083
1084

\begin{code}
1085
data CtLoc orig = CtLoc orig SrcSpan [ErrCtxt]
1086

1087
1088
1089
type WantedLoc = CtLoc CtOrigin      -- Instantiation for wanted constraints
type GivenLoc  = CtLoc SkolemInfo    -- Instantiation for given constraints

1090
1091
ctLocSpan :: CtLoc o -> SrcSpan
ctLocSpan (CtLoc _ s _) = s
1092

1093
1094
ctLocOrigin :: CtLoc o -> o
ctLocOrigin (CtLoc o _ _) = o
1095

1096
1097
setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
1098

1099
1100
1101
pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig
pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs)

1102
pprArising :: CtOrigin -> SDoc
1103
1104
-- Used for the main, top-level error message
-- We've done special processing for TypeEq and FunDep origins
1105
pprArising (TypeEqOrigin {}) = empty
1106
pprArising FunDepOrigin      = empty
1107
pprArising orig              = text "arising from" <+> ppr orig
1108

1109
1110
1111
pprArisingAt :: Outputable o => CtLoc o -> SDoc
pprArisingAt (CtLoc o s _) = sep [ text "arising from" <+> ppr o
                                 , text "at" <+> ppr s]
1112
\end{code}
1113

1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
%************************************************************************
%*                                                                      *
                SkolemInfo
%*                                                                      *
%************************************************************************

\begin{code}
-- SkolemInfo gives the origin of *given* constraints
--   a) type variables are skolemised
--   b) an implication constraint is generated
data SkolemInfo
  = SigSkol UserTypeCtxt	-- A skolem that is created by instantiating
            Type                -- a programmer-supplied type signature
				-- Location of the binding site is on the TyVar

	-- The rest are for non-scoped skolems
  | ClsSkol Class	-- Bound at a class decl
  | InstSkol 		-- Bound at an instance decl
  | DataSkol            -- Bound at a data type declaration
  | FamInstSkol         -- Bound at a family instance decl
  | PatSkol 	        -- An existential type variable bound by a pattern for
      DataCon           -- a data constructor with an existential type.
      (HsMatchContext Name)	
	     --	e.g.   data T = forall a. Eq a => MkT a
	     --        f (MkT x) = ...
	     -- The pattern MkT x will allocate an existential type
	     -- variable for 'a'.  

  | ArrowSkol 	  	-- An arrow form (see TcArrows)

  | IPSkol [IPName Name]  -- Binding site of an implicit parameter

  | RuleSkol RuleName	-- The LHS of a RULE

  | InferSkol [(Name,TcType)]
                        -- We have inferred a type for these (mutually-recursivive)
                        -- polymorphic Ids, and are now checking that their RHS
                        -- constraints are satisfied.

  | BracketSkol         -- Template Haskell bracket

  | UnkSkol             -- Unhelpful info (until I improve it)

instance Outputable SkolemInfo where
  ppr = pprSkolInfo

pprSkolInfo :: SkolemInfo -> SDoc
-- Complete the sentence "is a rigid type variable bound by..."
pprSkolInfo (SigSkol (FunSigCtxt f) ty)
                            = hang (ptext (sLit "the type signature for"))
                                 2 (ppr f <+> dcolon <+> ppr ty)
pprSkolInfo (SigSkol cx ty) = hang (pprUserTypeCtxt cx <> colon)
                                 2 (ppr ty)
pprSkolInfo (IPSkol ips)    = ptext (sLit "the implicit-parameter bindings for")
                              <+> pprWithCommas ppr ips
pprSkolInfo (ClsSkol cls)   = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
pprSkolInfo InstSkol        = ptext (sLit "the instance declaration")
pprSkolInfo DataSkol        = ptext (sLit "the data type declaration")
pprSkolInfo FamInstSkol     = ptext (sLit "the family instance declaration")
pprSkolInfo BracketSkol     = ptext (sLit "a Template Haskell bracket")
pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
pprSkolInfo (PatSkol dc mc)  = sep [ ptext (sLit "a pattern with constructor")
                                   , nest 2 $ ppr dc <+> dcolon
                                              <+> ppr (dataConUserType dc) <> comma
                                  , ptext (sLit "in") <+> pprMatchContext mc ]
pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
                                  , vcat [ ppr name <+> dcolon <+> ppr ty
                                         | (name,ty) <- ids ]]

-- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding.  
-- For Insts, these cases should not happen
Simon Peyton Jones's avatar
Simon Peyton Jones committed
1187
pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
\end{code}


%************************************************************************
%*									*
            CtOrigin
%*									*
%************************************************************************

\begin{code}
1198
1199
1200
1201
-- CtOrigin gives the origin of *wanted* constraints
data CtOrigin
  = OccurrenceOf Name		-- Occurrence of an overloaded identifier
  | AppOrigin	 		-- An application of some kind
1202

1203
  | SpecPragOrigin Name		-- Specialisation pragma for identifier
1204

1205
  | TypeEqOrigin EqOrigin
1206

1207
  | IPOccOrigin  (IPName Name)	-- Occurrence of an implicit parameter
1208

1209
  | LiteralOrigin (HsOverLit Name)	-- Occurrence of a literal
1210
  | NegateOrigin			-- Occurrence of syntactic negation
1211

1212
1213
  | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
  | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
1214
  | SectionOrigin
1215
  | TupleOrigin			       -- (..,..)
1216
  | AmbigOrigin Name	-- f :: ty
1217
  | ExprSigOrigin	-- e :: ty
1218
1219
  | PatSigOrigin	-- p :: ty
  | PatOrigin	        -- Instantiating a polytyped pattern at a constructor
1220
  | RecordUpdOrigin
1221
  | ViewPatOrigin
1222

1223
  | ScOrigin	        -- Typechecking superclasses of an instance declaration
1224
  | DerivOrigin		-- Typechecking deriving
1225
  | StandAloneDerivOrigin -- Typechecking stand-alone deriving
1226
1227
  | DefaultOrigin	-- Typechecking a default decl
  | DoOrigin		-- Arising from a do expression
1228
  | MCompOrigin         -- Arising from a monad comprehension
1229
  | IfOrigin            -- Arising from an if statement
1230
  | ProcOrigin		-- Arising from a proc expression
1231
  | AnnOrigin           -- An annotation
1232
  | FunDepOrigin
1233

1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
data EqOrigin 
  = UnifyOrigin 
       { uo_actual   :: TcType
       , uo_expected :: TcType }

instance Outputable CtOrigin where
  ppr orig = pprO orig

pprO :: CtOrigin -> SDoc
pprO (OccurrenceOf name)   = hsep [ptext (sLit "a use of"), quotes (ppr name)]
pprO AppOrigin             = ptext (sLit "an application")
pprO (SpecPragOrigin name) = hsep [ptext (sLit "a specialisation pragma for"), quotes (ppr name)]
pprO (IPOccOrigin name)    = hsep [ptext (sLit "a use of implicit parameter"), quotes (ppr name)]
pprO RecordUpdOrigin       = ptext (sLit "a record update")
1248
pprO (AmbigOrigin name)    = ptext (sLit "the ambiguity check for") <+> quotes (ppr name)
1249
1250
1251
1252
pprO ExprSigOrigin         = ptext (sLit "an expression type signature")
pprO PatSigOrigin          = ptext (sLit "a pattern type signature")
pprO PatOrigin             = ptext (sLit "a pattern")
pprO ViewPatOrigin         = ptext (sLit "a view pattern")
1253
pprO IfOrigin              = ptext (sLit "an if statement")
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
pprO (LiteralOrigin lit)   = hsep [ptext (sLit "the literal"), quotes (ppr lit)]
pprO (ArithSeqOrigin seq)  = hsep [ptext (sLit "the arithmetic sequence"), quotes (ppr seq)]
pprO (PArrSeqOrigin seq)   = hsep [ptext (sLit "the parallel array sequence"), quotes (ppr seq)]
pprO SectionOrigin	   = ptext (sLit "an operator section")
pprO TupleOrigin	   = ptext (sLit "a tuple")
pprO NegateOrigin	   = ptext (sLit "a use of syntactic negation")
pprO ScOrigin	           = ptext (sLit "the superclasses of an instance declaration")
pprO DerivOrigin	   = ptext (sLit "the 'deriving' clause of a data type declaration")
pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
pprO DefaultOrigin	   = ptext (sLit "a 'default' declaration")
pprO DoOrigin	           = ptext (sLit "a do statement")
1265
pprO MCompOrigin           = ptext (sLit "a statement in a monad comprehension")
1266
pprO ProcOrigin	           = ptext (sLit "a proc expression")
1267
pprO (TypeEqOrigin eq)     = ptext (sLit "an equality") <+> ppr eq
1268
pprO AnnOrigin             = ptext (sLit "an annotation")
1269
pprO FunDepOrigin          = ptext (sLit "a functional dependency")
1270
1271
1272

instance Outputable EqOrigin where
  ppr (UnifyOrigin t1 t2) = ppr t1 <+> char '~' <+> ppr t2
1273
\end{code}
1274