Implememt -fdefer-type-errors (Trac #5624)
[ghc.git] / compiler / typecheck / TcRnTypes.lhs
1
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP Project, Glasgow University, 1992-2002
4 %
5
6 Various types used during typechecking, please see TcRnMonad as well for
7 operations on these types. You probably want to import it, instead of this
8 module.
9
10 All the monads exported here are built on top of the same IOEnv monad. The
11 monad functions like a Reader monad in the way it passes the environment
12 around. This is done to allow the environment to be manipulated in a stack
13 like fashion when entering expressions... ect.
14
15 For state that is global and should be returned at the end (e.g not part
16 of the stack mechanism), you should use an TcRef (= IORef) to store them.
17
18 \begin{code}
19 {-# OPTIONS -fno-warn-tabs #-}
20 -- The above warning supression flag is a temporary kludge.
21 -- While working on this module you are encouraged to remove it and
22 -- detab the module (please do the detabbing in a separate patch). See
23 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
24 -- for details
25
26 module TcRnTypes(
27         TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module
28         TcRef,
29
30         -- The environment types
31         Env(..), 
32         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
47         -- Arrows
48         ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
49
50         -- Constraints
51         Untouchables(..), inTouchableRange, isNoUntouchables,
52
53        -- Canonical constraints
54         Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, 
55         singleCt, extendCts, isEmptyCts, isCTyEqCan, 
56         isCDictCan_Maybe, isCIPCan_Maybe, isCFunEqCan_Maybe,
57         isCIrredEvCan, isCNonCanonical, isWantedCt, isDerivedCt, 
58         isGivenCt_maybe, isGivenOrSolvedCt,
59         ctWantedLoc,
60         SubGoalDepth, mkNonCanonical, ctPred, 
61
62         WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
63         andWC, addFlats, addImplics, mkFlatWC,
64
65         Implication(..),
66         CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin,
67         CtOrigin(..), EqOrigin(..), 
68         WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt, 
69         pushErrCtxtSameOrigin,
70
71         SkolemInfo(..),
72
73         CtFlavor(..), pprFlavorArising, 
74         mkSolvedFlavor, mkGivenFlavor, mkWantedFlavor,
75         isWanted, isGivenOrSolved, isGiven_maybe, isSolved,
76         isDerived, getWantedLoc, canSolve, canRewrite,
77         combineCtLoc, 
78
79         -- Pretty printing
80         pprEvVarTheta, pprWantedsWithLocs,
81         pprEvVars, pprEvVarWithType, 
82         pprArising, pprArisingAt,
83
84         -- Misc other types
85         TcId, TcIdSet, TcTyVarBind(..), TcTyVarBinds
86         
87   ) where
88
89 #include "HsVersions.h"
90
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 import InstEnv
101 import FamInstEnv
102 import IOEnv
103 import RdrName
104 import Name
105 import NameEnv
106 import NameSet
107 import Avail
108 import Var
109 import VarEnv
110 import Module
111 import SrcLoc
112 import VarSet
113 import ErrUtils
114 import UniqFM
115 import UniqSupply
116 import Unique
117 import BasicTypes
118 import Bag
119 import Outputable
120 import ListSetOps
121 import FastString
122
123 import Data.Set (Set)
124
125 \end{code}
126
127
128 %************************************************************************
129 %*                                                                      *
130                Standard monad definition for TcRn
131     All the combinators for the monad can be found in TcRnMonad
132 %*                                                                      *
133 %************************************************************************
134
135 The monad itself has to be defined here, because it is mentioned by ErrCtxt
136
137 \begin{code}
138 type TcRef a     = IORef a
139 type TcId        = Id                   
140 type TcIdSet     = IdSet
141
142
143 type TcRnIf a b c = IOEnv (Env a b) c
144 type IfM lcl a  = TcRnIf IfGblEnv lcl a         -- Iface stuff
145
146 type IfG a  = IfM () a                          -- Top level
147 type IfL a  = IfM IfLclEnv a                    -- Nested
148 type TcRn a = TcRnIf TcGblEnv TcLclEnv a
149 type RnM  a = TcRn a            -- Historical
150 type TcM  a = TcRn a            -- Historical
151 \end{code}
152
153 Representation of type bindings to uninstantiated meta variables used during
154 constraint solving.
155
156 \begin{code}
157 data TcTyVarBind = TcTyVarBind TcTyVar TcType
158
159 type TcTyVarBinds = Bag TcTyVarBind
160
161 instance Outputable TcTyVarBind where
162   ppr (TcTyVarBind tv ty) = ppr tv <+> text ":=" <+> ppr ty
163 \end{code}
164
165
166 %************************************************************************
167 %*                                                                      *
168                 The main environment types
169 %*                                                                      *
170 %************************************************************************
171
172 \begin{code}
173 -- We 'stack' these envs through the Reader like monad infastructure
174 -- as we move into an expression (although the change is focused in
175 -- the lcl type).
176 data Env gbl lcl
177   = Env {
178         env_top  :: HscEnv,  -- Top-level stuff that never changes
179                              -- Includes all info about imported things
180
181         env_us   :: {-# UNPACK #-} !(IORef UniqSupply),
182                              -- Unique supply for local varibles
183
184         env_gbl  :: gbl,     -- Info about things defined at the top level
185                              -- of the module being compiled
186
187         env_lcl  :: lcl      -- Nested stuff; changes as we go into 
188     }
189
190 -- TcGblEnv describes the top-level of the module at the 
191 -- point at which the typechecker is finished work.
192 -- It is this structure that is handed on to the desugarer
193 -- For state that needs to be updated during the typechecking
194 -- phase and returned at end, use a TcRef (= IORef).
195
196 data TcGblEnv
197   = TcGblEnv {
198         tcg_mod     :: Module,         -- ^ Module being compiled
199         tcg_src     :: HscSource,
200           -- ^ What kind of module (regular Haskell, hs-boot, ext-core)
201
202         tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming
203         tcg_default :: Maybe [Type],
204           -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
205
206         tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module
207         tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module
208
209         tcg_type_env :: TypeEnv,
210           -- ^ Global type env for the module we are compiling now.  All
211           -- TyCons and Classes (for this module) end up in here right away,
212           -- along with their derived constructors, selectors.
213           --
214           -- (Ids defined in this module start in the local envt, though they
215           --  move to the global envt during zonking)
216
217         tcg_type_env_var :: TcRef TypeEnv,
218                 -- Used only to initialise the interface-file
219                 -- typechecker in initIfaceTcRn, so that it can see stuff
220                 -- bound in this module when dealing with hi-boot recursions
221                 -- Updated at intervals (e.g. after dealing with types and classes)
222         
223         tcg_inst_env     :: InstEnv,
224           -- ^ Instance envt for /home-package/ modules; Includes the dfuns in
225           -- tcg_insts
226         tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
227
228                 -- Now a bunch of things about this module that are simply 
229                 -- accumulated, but never consulted until the end.  
230                 -- Nevertheless, it's convenient to accumulate them along 
231                 -- with the rest of the info from this module.
232         tcg_exports :: [AvailInfo],     -- ^ What is exported
233         tcg_imports :: ImportAvails,
234           -- ^ Information about what was imported from where, including
235           -- things bound in this module. Also store Safe Haskell info
236           -- here about transative trusted packaage requirements.
237
238         tcg_dus :: DefUses,
239           -- ^ What is defined in this module and what is used.
240           -- The latter is used to generate
241           --
242           --  (a) version tracking; no need to recompile if these things have
243           --      not changed version stamp
244           --
245           --  (b) unused-import info
246
247         tcg_keep :: TcRef NameSet,
248           -- ^ Locally-defined top-level names to keep alive.
249           --
250           -- "Keep alive" means give them an Exported flag, so that the
251           -- simplifier does not discard them as dead code, and so that they
252           -- are exposed in the interface file (but not to export to the
253           -- user).
254           --
255           -- Some things, like dict-fun Ids and default-method Ids are "born"
256           -- with the Exported flag on, for exactly the above reason, but some
257           -- we only discover as we go.  Specifically:
258           --
259           --   * The to/from functions for generic data types
260           --
261           --   * Top-level variables appearing free in the RHS of an orphan
262           --     rule
263           --
264           --   * Top-level variables appearing free in a TH bracket
265
266         tcg_th_used :: TcRef Bool,
267           -- ^ @True@ <=> Template Haskell syntax used.
268           --
269           -- We need this so that we can generate a dependency on the
270           -- Template Haskell package, becuase the desugarer is going
271           -- to emit loads of references to TH symbols.  The reference
272           -- is implicit rather than explicit, so we have to zap a
273           -- mutable variable.
274
275         tcg_th_splice_used :: TcRef Bool,
276           -- ^ @True@ <=> A Template Haskell splice was used.
277           --
278           -- Splices disable recompilation avoidance (see #481)
279
280         tcg_dfun_n  :: TcRef OccSet,
281           -- ^ Allows us to choose unique DFun names.
282
283         -- The next fields accumulate the payload of the module
284         -- The binds, rules and foreign-decl fiels are collected
285         -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
286
287         tcg_rn_exports :: Maybe [Located (IE Name)],
288         tcg_rn_imports :: [LImportDecl Name],
289                 -- Keep the renamed imports regardless.  They are not 
290                 -- voluminous and are needed if you want to report unused imports
291
292         tcg_used_rdrnames :: TcRef (Set RdrName),
293                 -- The set of used *imported* (not locally-defined) RdrNames
294                 -- Used only to report unused import declarations
295
296         tcg_rn_decls :: Maybe (HsGroup Name),
297           -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed
298           -- decls.
299
300         tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile
301
302         tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings
303         tcg_binds     :: LHsBinds Id,       -- Value bindings in this module
304         tcg_sigs      :: NameSet,           -- ...Top-level names that *lack* a signature
305         tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
306         tcg_warns     :: Warnings,          -- ...Warnings and deprecations
307         tcg_anns      :: [Annotation],      -- ...Annotations
308         tcg_tcs       :: [TyCon],           -- ...TyCons and Classes
309         tcg_insts     :: [ClsInst],         -- ...Instances
310         tcg_fam_insts :: [FamInst],         -- ...Family instances
311         tcg_rules     :: [LRuleDecl Id],    -- ...Rules
312         tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
313         tcg_vects     :: [LVectDecl Id],    -- ...Vectorisation declarations
314
315         tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
316         tcg_hpc       :: AnyHpcUsage,        -- ^ @True@ if any part of the
317                                              --  prog uses hpc instrumentation.
318
319         tcg_main      :: Maybe Name,         -- ^ The Name of the main
320                                              -- function, if this module is
321                                              -- the main module.
322         tcg_safeInfer :: TcRef Bool          -- Has the typechecker infered this
323                                              -- module as -XSafe (Safe Haskell)
324     }
325
326 data RecFieldEnv 
327   = RecFields (NameEnv [Name])  -- Maps a constructor name *in this module*
328                                 -- to the fields for that constructor
329               NameSet           -- Set of all fields declared *in this module*;
330                                 -- used to suppress name-shadowing complaints
331                                 -- when using record wild cards
332                                 -- E.g.  let fld = e in C {..}
333         -- This is used when dealing with ".." notation in record 
334         -- construction and pattern matching.
335         -- The FieldEnv deals *only* with constructors defined in *this*
336         -- module.  For imported modules, we get the same info from the
337         -- TypeEnv
338 \end{code}
339
340 %************************************************************************
341 %*                                                                      *
342                 The interface environments
343               Used when dealing with IfaceDecls
344 %*                                                                      *
345 %************************************************************************
346
347 \begin{code}
348 data IfGblEnv 
349   = IfGblEnv {
350         -- The type environment for the module being compiled,
351         -- in case the interface refers back to it via a reference that
352         -- was originally a hi-boot file.
353         -- We need the module name so we can test when it's appropriate
354         -- to look in this env.
355         if_rec_types :: Maybe (Module, IfG TypeEnv)
356                 -- Allows a read effect, so it can be in a mutable
357                 -- variable; c.f. handling the external package type env
358                 -- Nothing => interactive stuff, no loops possible
359     }
360
361 data IfLclEnv
362   = IfLclEnv {
363         -- The module for the current IfaceDecl
364         -- So if we see   f = \x -> x
365         -- it means M.f = \x -> x, where M is the if_mod
366         if_mod :: Module,
367
368         -- The field is used only for error reporting
369         -- if (say) there's a Lint error in it
370         if_loc :: SDoc,
371                 -- Where the interface came from:
372                 --      .hi file, or GHCi state, or ext core
373                 -- plus which bit is currently being examined
374
375         if_tv_env  :: UniqFM TyVar,     -- Nested tyvar bindings
376                                         -- (and coercions)
377         if_id_env  :: UniqFM Id         -- Nested id binding
378     }
379 \end{code}
380
381
382 %************************************************************************
383 %*                                                                      *
384                 The local typechecker environment
385 %*                                                                      *
386 %************************************************************************
387
388 The Global-Env/Local-Env story
389 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
390 During type checking, we keep in the tcg_type_env
391         * All types and classes
392         * All Ids derived from types and classes (constructors, selectors)
393
394 At the end of type checking, we zonk the local bindings,
395 and as we do so we add to the tcg_type_env
396         * Locally defined top-level Ids
397
398 Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
399         a) fed back (via the knot) to typechecking the 
400            unfoldings of interface signatures
401         b) used in the ModDetails of this module
402
403 \begin{code}
404 data TcLclEnv           -- Changes as we move inside an expression
405                         -- Discarded after typecheck/rename; not passed on to desugarer
406   = TcLclEnv {
407         tcl_loc  :: SrcSpan,            -- Source span
408         tcl_ctxt :: [ErrCtxt],          -- Error context, innermost on top
409         tcl_errs :: TcRef Messages,     -- Place to accumulate errors
410
411         tcl_th_ctxt    :: ThStage,            -- Template Haskell context
412         tcl_arrow_ctxt :: ArrowCtxt,          -- Arrow-notation context
413
414         tcl_rdr :: LocalRdrEnv,         -- Local name envt
415                 -- Maintained during renaming, of course, but also during
416                 -- type checking, solely so that when renaming a Template-Haskell
417                 -- splice we have the right environment for the renamer.
418                 -- 
419                 --   Does *not* include global name envt; may shadow it
420                 --   Includes both ordinary variables and type variables;
421                 --   they are kept distinct because tyvar have a different
422                 --   occurrence contructor (Name.TvOcc)
423                 -- We still need the unsullied global name env so that
424                 --   we can look up record field names
425
426         tcl_env  :: TcTypeEnv,    -- The local type environment: Ids and
427                                   -- TyVars defined in this module
428                                         
429         tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"
430                         -- Namely, the in-scope TyVars bound in tcl_env, 
431                         -- plus the tyvars mentioned in the types of Ids bound
432                         -- in tcl_lenv. 
433                         -- Why mutable? see notes with tcGetGlobalTyVars
434
435         tcl_lie   :: TcRef WantedConstraints,    -- Place to accumulate type constraints
436
437         -- TcMetaTyVars have 
438         tcl_meta  :: TcRef Unique,  -- The next free unique for TcMetaTyVars
439                                     -- Guaranteed to be allocated linearly
440         tcl_untch :: Unique         -- Any TcMetaTyVar with 
441                                     --     unique >= tcl_untch is touchable
442                                     --     unique <  tcl_untch is untouchable
443     }
444
445 type TcTypeEnv = NameEnv TcTyThing
446
447
448 {- Note [Given Insts]
449    ~~~~~~~~~~~~~~~~~~
450 Because of GADTs, we have to pass inwards the Insts provided by type signatures 
451 and existential contexts. Consider
452         data T a where { T1 :: b -> b -> T [b] }
453         f :: Eq a => T a -> Bool
454         f (T1 x y) = [x]==[y]
455
456 The constructor T1 binds an existential variable 'b', and we need Eq [b].
457 Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we 
458 pass it inwards.
459
460 -}
461
462 ---------------------------
463 -- Template Haskell stages and levels 
464 ---------------------------
465
466 data ThStage    -- See Note [Template Haskell state diagram] in TcSplice
467   = Splice      -- Top-level splicing
468                 -- This code will be run *at compile time*;
469                 --   the result replaces the splice
470                 -- Binding level = 0
471  
472   | Comp        -- Ordinary Haskell code
473                 -- Binding level = 1
474
475   | Brack                       -- Inside brackets 
476       ThStage                   --   Binding level = level(stage) + 1
477       (TcRef [PendingSplice])   --   Accumulate pending splices here
478       (TcRef WantedConstraints) --     and type constraints here
479
480 topStage, topAnnStage, topSpliceStage :: ThStage
481 topStage       = Comp
482 topAnnStage    = Splice
483 topSpliceStage = Splice
484
485 instance Outputable ThStage where
486    ppr Splice        = text "Splice"
487    ppr Comp          = text "Comp"
488    ppr (Brack s _ _) = text "Brack" <> parens (ppr s)
489
490 type ThLevel = Int      
491         -- See Note [Template Haskell levels] in TcSplice
492         -- Incremented when going inside a bracket,
493         -- decremented when going inside a splice
494         -- NB: ThLevel is one greater than the 'n' in Fig 2 of the
495         --     original "Template meta-programming for Haskell" paper
496
497 impLevel, outerLevel :: ThLevel
498 impLevel = 0    -- Imported things; they can be used inside a top level splice
499 outerLevel = 1  -- Things defined outside brackets
500 -- NB: Things at level 0 are not *necessarily* imported.
501 --      eg  $( \b -> ... )   here b is bound at level 0
502 --
503 -- For example: 
504 --      f = ...
505 --      g1 = $(map ...)         is OK
506 --      g2 = $(f ...)           is not OK; because we havn't compiled f yet
507
508 thLevel :: ThStage -> ThLevel
509 thLevel Splice        = 0
510 thLevel Comp          = 1
511 thLevel (Brack s _ _) = thLevel s + 1
512
513 ---------------------------
514 -- Arrow-notation context
515 ---------------------------
516
517 {-
518 In arrow notation, a variable bound by a proc (or enclosed let/kappa)
519 is not in scope to the left of an arrow tail (-<) or the head of (|..|).
520 For example
521
522         proc x -> (e1 -< e2)
523
524 Here, x is not in scope in e1, but it is in scope in e2.  This can get
525 a bit complicated:
526
527         let x = 3 in
528         proc y -> (proc z -> e1) -< e2
529
530 Here, x and z are in scope in e1, but y is not.  We implement this by
531 recording the environment when passing a proc (using newArrowScope),
532 and returning to that (using escapeArrowScope) on the left of -< and the
533 head of (|..|).
534 -}
535
536 data ArrowCtxt
537   = NoArrowCtxt
538   | ArrowCtxt (Env TcGblEnv TcLclEnv)
539
540 -- Record the current environment (outside a proc)
541 newArrowScope :: TcM a -> TcM a
542 newArrowScope
543   = updEnv $ \env ->
544         env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } }
545
546 -- Return to the stored environment (from the enclosing proc)
547 escapeArrowScope :: TcM a -> TcM a
548 escapeArrowScope
549   = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
550         NoArrowCtxt -> env
551         ArrowCtxt env' -> env'
552
553 ---------------------------
554 -- TcTyThing
555 ---------------------------
556
557 data TcTyThing
558   = AGlobal TyThing             -- Used only in the return type of a lookup
559
560   | ATcId   {           -- Ids defined in this module; may not be fully zonked
561         tct_id     :: TcId,             
562         tct_closed :: TopLevelFlag,   -- See Note [Bindings with closed types]
563         tct_level  :: ThLevel }
564
565   | ATyVar  Name TcType         -- The type to which the lexically scoped type vaiable
566                                 -- is currently refined. We only need the Name
567                                 -- for error-message purposes; it is the corresponding
568                                 -- Name in the domain of the envt
569
570   | AThing  TcKind   -- Used temporarily, during kind checking, for the
571                      -- tycons and clases in this recursive group
572                      -- Can be a mono-kind or a poly-kind; in TcTyClsDcls see
573                      -- Note [Type checking recursive type and class declarations]
574
575   | ANothing                    -- see Note [ANothing]
576
577 {-
578 Note [ANothing]
579 ~~~~~~~~~~~~~~~
580
581 We don't want to allow promotion in a strongly connected component
582 when kind checking.
583
584 Consider:
585   data T f = K (f (K Any))
586
587 When kind checking the `data T' declaration the local env contains the
588 mappings:
589   T -> AThing <some initial kind>
590   K -> ANothing
591
592 ANothing is only used for DataCons, and only used during type checking
593 in tcTyClGroup.
594 -}
595
596
597 instance Outputable TcTyThing where     -- Debugging only
598    ppr (AGlobal g)      = pprTyThing g
599    ppr elt@(ATcId {})   = text "Identifier" <> 
600                           brackets (ppr (tct_id elt) <> dcolon 
601                                  <> ppr (varType (tct_id elt)) <> comma
602                                  <+> ppr (tct_closed elt) <> comma
603                                  <+> ppr (tct_level elt))
604    ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
605    ppr (AThing k)       = text "AThing" <+> ppr k
606    ppr ANothing         = text "ANothing"
607
608 pprTcTyThingCategory :: TcTyThing -> SDoc
609 pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
610 pprTcTyThingCategory (ATyVar {})     = ptext (sLit "Type variable")
611 pprTcTyThingCategory (ATcId {})      = ptext (sLit "Local identifier")
612 pprTcTyThingCategory (AThing {})     = ptext (sLit "Kinded thing")
613 pprTcTyThingCategory ANothing        = ptext (sLit "Opaque thing")
614 \end{code}
615
616 Note [Bindings with closed types]
617 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
618 Consider
619
620   f x = let g ys = map not ys
621         in ...
622
623 Can we generalise 'g' under the OutsideIn algorithm?  Yes, 
624 because all g's free variables are top-level; that is they themselves
625 have no free type variables, and it is the type variables in the
626 environment that makes things tricky for OutsideIn generalisation.
627
628 Definition:
629
630    A variable is "closed", and has tct_closed set to TopLevel,
631       iff 
632    a) all its free variables are imported, or are themselves closed
633    b) generalisation is not restricted by the monomorphism restriction
634
635 Under OutsideIn we are free to generalise a closed let-binding.
636 This is an extension compared to the JFP paper on OutsideIn, which
637 used "top-level" as a proxy for "closed".  (It's not a good proxy 
638 anyway -- the MR can make a top-level binding with a free type
639 variable.)
640
641 Note that:
642   * A top-level binding may not be closed, if it suffer from the MR
643
644   * A nested binding may be closed (eg 'g' in the example we started with)
645     Indeed, that's the point; whether a function is defined at top level
646     or nested is orthogonal to the question of whether or not it is closed 
647
648   * A binding may be non-closed because it mentions a lexically scoped
649     *type variable*  Eg
650         f :: forall a. blah
651         f x = let g y = ...(y::a)...
652
653
654 \begin{code}
655 type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))
656         -- Monadic so that we have a chance
657         -- to deal with bound type variables just before error
658         -- message construction
659
660         -- Bool:  True <=> this is a landmark context; do not
661         --                 discard it when trimming for display
662 \end{code}
663
664
665 %************************************************************************
666 %*                                                                      *
667         Operations over ImportAvails
668 %*                                                                      *
669 %************************************************************************
670
671 \begin{code}
672 -- | 'ImportAvails' summarises what was imported from where, irrespective of
673 -- whether the imported things are actually used or not.  It is used:
674 --
675 --  * when processing the export list,
676 --
677 --  * when constructing usage info for the interface file,
678 --
679 --  * to identify the list of directly imported modules for initialisation
680 --    purposes and for optimised overlap checking of family instances,
681 --
682 --  * when figuring out what things are really unused
683 --
684 data ImportAvails 
685    = ImportAvails {
686         imp_mods :: ImportedMods,
687           --      = ModuleEnv [(ModuleName, Bool, SrcSpan, Bool)],
688           -- ^ Domain is all directly-imported modules
689           -- The 'ModuleName' is what the module was imported as, e.g. in
690           -- @
691           --     import Foo as Bar
692           -- @
693           -- it is @Bar@.
694           --
695           -- The 'Bool' means:
696           --
697           --  - @True@ => import was @import Foo ()@
698           --
699           --  - @False@ => import was some other form
700           --
701           -- Used
702           --
703           --   (a) to help construct the usage information in the interface
704           --       file; if we import somethign we need to recompile if the
705           --       export version changes
706           --
707           --   (b) to specify what child modules to initialise
708           --
709           -- We need a full ModuleEnv rather than a ModuleNameEnv here,
710           -- because we might be importing modules of the same name from
711           -- different packages. (currently not the case, but might be in the
712           -- future).
713
714         imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
715           -- ^ Home-package modules needed by the module being compiled
716           --
717           -- It doesn't matter whether any of these dependencies
718           -- are actually /used/ when compiling the module; they
719           -- are listed if they are below it at all.  For
720           -- example, suppose M imports A which imports X.  Then
721           -- compiling M might not need to consult X.hi, but X
722           -- is still listed in M's dependencies.
723
724         imp_dep_pkgs :: [PackageId],
725           -- ^ Packages needed by the module being compiled, whether directly,
726           -- or via other modules in this package, or via modules imported
727           -- from other packages.
728         
729         imp_trust_pkgs :: [PackageId],
730           -- ^ This is strictly a subset of imp_dep_pkgs and records the
731           -- packages the current module needs to trust for Safe Haskell
732           -- compilation to succeed. A package is required to be trusted if
733           -- we are dependent on a trustworthy module in that package.
734           -- While perhaps making imp_dep_pkgs a tuple of (PackageId, Bool)
735           -- where True for the bool indicates the package is required to be
736           -- trusted is the more logical  design, doing so complicates a lot
737           -- of code not concerned with Safe Haskell.
738           -- See Note [RnNames . Tracking Trust Transitively]
739
740         imp_trust_own_pkg :: Bool,
741           -- ^ Do we require that our own package is trusted?
742           -- This is to handle efficiently the case where a Safe module imports
743           -- a Trustworthy module that resides in the same package as it.
744           -- See Note [RnNames . Trust Own Package]
745
746         imp_orphs :: [Module],
747           -- ^ Orphan modules below us in the import tree (and maybe including
748           -- us for imported modules)
749
750         imp_finsts :: [Module]
751           -- ^ Family instance modules below us in the import tree (and maybe
752           -- including us for imported modules)
753       }
754
755 mkModDeps :: [(ModuleName, IsBootInterface)]
756           -> ModuleNameEnv (ModuleName, IsBootInterface)
757 mkModDeps deps = foldl add emptyUFM deps
758                where
759                  add env elt@(m,_) = addToUFM env m elt
760
761 emptyImportAvails :: ImportAvails
762 emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,
763                                    imp_dep_mods      = emptyUFM,
764                                    imp_dep_pkgs      = [],
765                                    imp_trust_pkgs    = [],
766                                    imp_trust_own_pkg = False,
767                                    imp_orphs         = [],
768                                    imp_finsts        = [] }
769
770 -- | Union two ImportAvails
771 --
772 -- This function is a key part of Import handling, basically
773 -- for each import we create a seperate ImportAvails structure
774 -- and then union them all together with this function.
775 plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
776 plusImportAvails
777   (ImportAvails { imp_mods = mods1,
778                   imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
779                   imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,
780                   imp_orphs = orphs1, imp_finsts = finsts1 })
781   (ImportAvails { imp_mods = mods2,
782                   imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
783                   imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,
784                   imp_orphs = orphs2, imp_finsts = finsts2 })
785   = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,
786                    imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,
787                    imp_dep_pkgs      = dpkgs1 `unionLists` dpkgs2,
788                    imp_trust_pkgs    = tpkgs1 `unionLists` tpkgs2,
789                    imp_trust_own_pkg = tself1 || tself2,
790                    imp_orphs         = orphs1 `unionLists` orphs2,
791                    imp_finsts        = finsts1 `unionLists` finsts2 }
792   where
793     plus_mod_dep (m1, boot1) (m2, boot2) 
794         = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
795                 -- Check mod-names match
796           (m1, boot1 && boot2) -- If either side can "see" a non-hi-boot interface, use that
797 \end{code}
798
799 %************************************************************************
800 %*                                                                      *
801 \subsection{Where from}
802 %*                                                                      *
803 %************************************************************************
804
805 The @WhereFrom@ type controls where the renamer looks for an interface file
806
807 \begin{code}
808 data WhereFrom 
809   = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})
810   | ImportBySystem                      -- Non user import.
811
812 instance Outputable WhereFrom where
813   ppr (ImportByUser is_boot) | is_boot     = ptext (sLit "{- SOURCE -}")
814                              | otherwise   = empty
815   ppr ImportBySystem                       = ptext (sLit "{- SYSTEM -}")
816 \end{code}
817
818 %************************************************************************
819 %*                                                                      *
820 %*                       Canonical constraints                          *
821 %*                                                                      *
822 %*   These are the constraints the low-level simplifier works with      *
823 %*                                                                      *
824 %************************************************************************
825
826
827 \begin{code}
828 -- Types without any type functions inside.  However, note that xi
829 -- types CAN contain unexpanded type synonyms; however, the
830 -- (transitive) expansions of those type synonyms will not contain any
831 -- type functions.
832 type Xi = Type       -- In many comments, "xi" ranges over Xi
833
834 type Cts = Bag Ct
835
836 type SubGoalDepth = Int -- An ever increasing number used to restrict 
837                         -- simplifier iterations. Bounded by -fcontext-stack.
838
839 data Ct
840   -- Atomic canonical constraints 
841   = CDictCan {  -- e.g.  Num xi
842       cc_id     :: EvVar,
843       cc_flavor :: CtFlavor, 
844       cc_class  :: Class, 
845       cc_tyargs :: [Xi],
846
847       cc_depth  :: SubGoalDepth -- Simplification depth of this constraint
848                        -- See Note [WorkList]
849     }
850
851   | CIPCan {    -- ?x::tau
852       -- See note [Canonical implicit parameter constraints].
853       cc_id     :: EvVar,
854       cc_flavor :: CtFlavor,
855       cc_ip_nm  :: IPName Name,
856       cc_ip_ty  :: TcTauType, -- Not a Xi! See same not as above
857       cc_depth  :: SubGoalDepth        -- See Note [WorkList]
858     }
859
860   | CIrredEvCan {  -- These stand for yet-unknown predicates
861       cc_id     :: EvVar,
862       cc_flavor :: CtFlavor,
863       cc_ty     :: Xi, -- cc_ty is flat hence it may only be of the form (tv xi1 xi2 ... xin)
864                        -- Since, if it were a type constructor application, that'd make the
865                        -- whole constraint a CDictCan, CIPCan, or CTyEqCan. And it can't be
866                        -- a type family application either because it's a Xi type.
867       cc_depth :: SubGoalDepth -- See Note [WorkList]
868     }
869
870   | CTyEqCan {  -- tv ~ xi      (recall xi means function free)
871        -- Invariant: 
872        --   * tv not in tvs(xi)   (occurs check)
873        --   * typeKind xi `compatKind` typeKind tv
874        --       See Note [Spontaneous solving and kind compatibility]
875        --   * We prefer unification variables on the left *JUST* for efficiency
876       cc_id     :: EvVar, 
877       cc_flavor :: CtFlavor, 
878       cc_tyvar  :: TcTyVar, 
879       cc_rhs    :: Xi,
880
881       cc_depth :: SubGoalDepth -- See Note [WorkList] 
882     }
883
884   | CFunEqCan {  -- F xis ~ xi  
885                  -- Invariant: * isSynFamilyTyCon cc_fun 
886                  --            * typeKind (F xis) `compatKind` typeKind xi
887       cc_id     :: EvVar,
888       cc_flavor :: CtFlavor, 
889       cc_fun    :: TyCon,       -- A type function
890       cc_tyargs :: [Xi],        -- Either under-saturated or exactly saturated
891       cc_rhs    :: Xi,          --    *never* over-saturated (because if so
892                                 --    we should have decomposed)
893
894       cc_depth  :: SubGoalDepth -- See Note [WorkList]
895                    
896     }
897
898   | CNonCanonical { -- See Note [NonCanonical Semantics] 
899       cc_id     :: EvVar,
900       cc_flavor :: CtFlavor, 
901       cc_depth  :: SubGoalDepth
902     }
903
904 \end{code}
905
906 \begin{code}
907 mkNonCanonical :: EvVar -> CtFlavor -> Ct
908 mkNonCanonical ev flav = CNonCanonical { cc_id = ev, cc_flavor = flav, cc_depth = 0}
909
910 ctPred :: Ct -> PredType 
911 ctPred (CNonCanonical { cc_id = v }) = evVarPred v
912 ctPred (CDictCan { cc_class = cls, cc_tyargs = xis }) 
913   = mkClassPred cls xis
914 ctPred (CTyEqCan { cc_tyvar = tv, cc_rhs = xi }) 
915   = mkEqPred (mkTyVarTy tv, xi)
916 ctPred (CFunEqCan { cc_fun = fn, cc_tyargs = xis1, cc_rhs = xi2 }) 
917   = mkEqPred(mkTyConApp fn xis1, xi2)
918 ctPred (CIPCan { cc_ip_nm = nm, cc_ip_ty = xi }) 
919   = mkIPPred nm xi
920 ctPred (CIrredEvCan { cc_ty = xi }) = xi
921 \end{code}
922
923
924 %************************************************************************
925 %*                                                                      *
926                     CtFlavor
927          The "flavor" of a canonical constraint
928 %*                                                                      *
929 %************************************************************************
930
931 \begin{code}
932 ctWantedLoc :: Ct -> WantedLoc
933 -- Only works for Wanted/Derived
934 ctWantedLoc ct = ASSERT2( not (isGivenOrSolved (cc_flavor ct)), ppr ct )
935                  getWantedLoc (cc_flavor ct)
936
937 isWantedCt :: Ct -> Bool
938 isWantedCt ct = isWanted (cc_flavor ct)
939
940 isDerivedCt :: Ct -> Bool
941 isDerivedCt ct = isDerived (cc_flavor ct)
942
943 isGivenCt_maybe :: Ct -> Maybe GivenKind
944 isGivenCt_maybe ct = isGiven_maybe (cc_flavor ct)
945
946 isGivenOrSolvedCt :: Ct -> Bool
947 isGivenOrSolvedCt ct = isGivenOrSolved (cc_flavor ct)
948
949 isCTyEqCan :: Ct -> Bool 
950 isCTyEqCan (CTyEqCan {})  = True 
951 isCTyEqCan (CFunEqCan {}) = False
952 isCTyEqCan _              = False 
953
954 isCDictCan_Maybe :: Ct -> Maybe Class
955 isCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls
956 isCDictCan_Maybe _              = Nothing
957
958 isCIPCan_Maybe :: Ct -> Maybe (IPName Name)
959 isCIPCan_Maybe  (CIPCan {cc_ip_nm = nm }) = Just nm
960 isCIPCan_Maybe _                = Nothing
961
962 isCIrredEvCan :: Ct -> Bool
963 isCIrredEvCan (CIrredEvCan {}) = True
964 isCIrredEvCan _                = False
965
966 isCFunEqCan_Maybe :: Ct -> Maybe TyCon
967 isCFunEqCan_Maybe (CFunEqCan { cc_fun = tc }) = Just tc
968 isCFunEqCan_Maybe _ = Nothing
969
970 isCNonCanonical :: Ct -> Bool
971 isCNonCanonical (CNonCanonical {}) = True 
972 isCNonCanonical _ = False 
973 \end{code}
974
975 \begin{code}
976 instance Outputable Ct where
977   ppr ct = ppr (cc_flavor ct) <> braces (ppr (cc_depth ct))
978                   <+> ppr ev_var <+> dcolon <+> ppr (ctPred ct)
979                   <+> parens (text ct_sort)
980          where ev_var  = cc_id ct
981                ct_sort = case ct of 
982                            CTyEqCan {}      -> "CTyEqCan"
983                            CFunEqCan {}     -> "CFunEqCan"
984                            CNonCanonical {} -> "CNonCanonical"
985                            CDictCan {}      -> "CDictCan"
986                            CIPCan {}        -> "CIPCan"
987                            CIrredEvCan {}   -> "CIrredEvCan"
988 \end{code}
989
990 \begin{code}
991 singleCt :: Ct -> Cts 
992 singleCt = unitBag 
993
994 andCts :: Cts -> Cts -> Cts 
995 andCts = unionBags
996
997 extendCts :: Cts -> Ct -> Cts 
998 extendCts = snocBag 
999
1000 andManyCts :: [Cts] -> Cts 
1001 andManyCts = unionManyBags
1002
1003 emptyCts :: Cts 
1004 emptyCts = emptyBag
1005
1006 isEmptyCts :: Cts -> Bool
1007 isEmptyCts = isEmptyBag
1008 \end{code}
1009
1010 %************************************************************************
1011 %*                                                                      *
1012                 Wanted constraints
1013      These are forced to be in TcRnTypes because
1014            TcLclEnv mentions WantedConstraints
1015            WantedConstraint mentions CtLoc
1016            CtLoc mentions ErrCtxt
1017            ErrCtxt mentions TcM
1018 %*                                                                      *
1019 v%************************************************************************
1020
1021 \begin{code}
1022
1023 data WantedConstraints
1024   = WC { wc_flat  :: Cts               -- Unsolved constraints, all wanted
1025        , wc_impl  :: Bag Implication
1026        , wc_insol :: Cts               -- Insoluble constraints, can be
1027                                        -- wanted, given, or derived
1028                                        -- See Note [Insoluble constraints]
1029     }
1030
1031 emptyWC :: WantedConstraints
1032 emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
1033
1034 mkFlatWC :: [Ct] -> WantedConstraints
1035 mkFlatWC cts 
1036   = WC { wc_flat = listToBag cts, wc_impl = emptyBag, wc_insol = emptyBag }
1037
1038 isEmptyWC :: WantedConstraints -> Bool
1039 isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
1040   = isEmptyBag f && isEmptyBag i && isEmptyBag n
1041
1042 insolubleWC :: WantedConstraints -> Bool
1043 -- True if there are any insoluble constraints in the wanted bag
1044 insolubleWC wc = not (isEmptyBag (wc_insol wc))
1045                || anyBag ic_insol (wc_impl wc)
1046
1047 andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
1048 andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
1049       (WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
1050   = WC { wc_flat  = f1 `unionBags` f2
1051        , wc_impl  = i1 `unionBags` i2
1052        , wc_insol = n1 `unionBags` n2 }
1053
1054 addFlats :: WantedConstraints -> Bag Ct -> WantedConstraints
1055 addFlats wc cts
1056   = wc { wc_flat = wc_flat wc `unionBags` cts }
1057
1058 addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
1059 addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
1060
1061 instance Outputable WantedConstraints where
1062   ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
1063    = ptext (sLit "WC") <+> braces (vcat
1064         [ if isEmptyBag f then empty else
1065           ptext (sLit "wc_flat =")  <+> pprBag ppr f
1066         , if isEmptyBag i then empty else
1067           ptext (sLit "wc_impl =")  <+> pprBag ppr i
1068         , if isEmptyBag n then empty else
1069           ptext (sLit "wc_insol =") <+> pprBag ppr n ])
1070
1071 pprBag :: (a -> SDoc) -> Bag a -> SDoc
1072 pprBag pp b = foldrBag (($$) . pp) empty b
1073 \end{code}
1074  
1075
1076 \begin{code}
1077 data Untouchables = NoUntouchables
1078                   | TouchableRange
1079                           Unique  -- Low end
1080                           Unique  -- High end
1081  -- A TcMetaTyvar is *touchable* iff its unique u satisfies
1082  --   u >= low
1083  --   u < high
1084
1085 instance Outputable Untouchables where
1086   ppr NoUntouchables = ptext (sLit "No untouchables")
1087   ppr (TouchableRange low high) = ptext (sLit "Touchable range:") <+> 
1088                                   ppr low <+> char '-' <+> ppr high
1089
1090 isNoUntouchables :: Untouchables -> Bool
1091 isNoUntouchables NoUntouchables      = True
1092 isNoUntouchables (TouchableRange {}) = False
1093
1094 inTouchableRange :: Untouchables -> TcTyVar -> Bool
1095 inTouchableRange NoUntouchables _ = True
1096 inTouchableRange (TouchableRange low high) tv 
1097   = uniq >= low && uniq < high
1098   where
1099     uniq = varUnique tv
1100
1101 -- EvVar defined in module Var.lhs:
1102 -- Evidence variables include all *quantifiable* constraints
1103 --   dictionaries
1104 --   implicit parameters
1105 --   coercion variables
1106 \end{code}
1107
1108 %************************************************************************
1109 %*                                                                      *
1110                 Implication constraints
1111 %*                                                                      *
1112 %************************************************************************
1113
1114 \begin{code}
1115 data Implication
1116   = Implic {  
1117       ic_untch :: Untouchables, -- Untouchables: unification variables
1118                                 -- free in the environment
1119       ic_env   :: TcTypeEnv,    -- The type environment
1120                                 -- Used only when generating error messages
1121           -- Generally, ic_untch is a superset of tvsof(ic_env)
1122           -- However, we don't zonk ic_env when zonking the Implication
1123           -- Instead we do that when generating a skolem-escape error message
1124
1125       ic_skols  :: [TcTyVar],    -- Introduced skolems 
1126                                  -- See Note [Skolems in an implication]
1127
1128       ic_given  :: [EvVar],      -- Given evidence variables
1129                                  --   (order does not matter)
1130       ic_loc   :: GivenLoc,      -- Binding location of the implication,
1131                                  --   which is also the location of all the
1132                                  --   given evidence variables
1133
1134       ic_wanted :: WantedConstraints,  -- The wanted
1135       ic_insol  :: Bool,               -- True iff insolubleWC ic_wanted is true
1136
1137       ic_binds  :: EvBindsVar   -- Points to the place to fill in the
1138                                 -- abstraction and bindings
1139     }
1140
1141 instance Outputable Implication where
1142   ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given
1143               , ic_wanted = wanted
1144               , ic_binds = binds, ic_loc = loc })
1145    = ptext (sLit "Implic") <+> braces 
1146      (sep [ ptext (sLit "Untouchables = ") <+> ppr untch
1147           , ptext (sLit "Skolems = ") <+> ppr skols
1148           , ptext (sLit "Given = ") <+> pprEvVars given
1149           , ptext (sLit "Wanted = ") <+> ppr wanted
1150           , ptext (sLit "Binds = ") <+> ppr binds
1151           , pprSkolInfo (ctLocOrigin loc)
1152           , ppr (ctLocSpan loc) ])
1153 \end{code}
1154
1155 Note [Skolems in an implication]
1156 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1157 The skolems in an implication are not there to perform a skolem escape
1158 check.  That happens because all the environment variables are in the
1159 untouchables, and therefore cannot be unified with anything at all,
1160 let alone the skolems.
1161
1162 Instead, ic_skols is used only when considering floating a constraint
1163 outside the implication in TcSimplify.floatEqualities or 
1164 TcSimplify.approximateImplications
1165
1166 Note [Insoluble constraints]
1167 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1168 Some of the errors that we get during canonicalization are best
1169 reported when all constraints have been simplified as much as
1170 possible. For instance, assume that during simplification the
1171 following constraints arise:
1172    
1173  [Wanted]   F alpha ~  uf1 
1174  [Wanted]   beta ~ uf1 beta 
1175
1176 When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail
1177 we will simply see a message:
1178     'Can't construct the infinite type  beta ~ uf1 beta' 
1179 and the user has no idea what the uf1 variable is.
1180
1181 Instead our plan is that we will NOT fail immediately, but:
1182     (1) Record the "frozen" error in the ic_insols field
1183     (2) Isolate the offending constraint from the rest of the inerts 
1184     (3) Keep on simplifying/canonicalizing
1185
1186 At the end, we will hopefully have substituted uf1 := F alpha, and we
1187 will be able to report a more informative error:
1188     'Can't construct the infinite type beta ~ F alpha beta'
1189
1190 %************************************************************************
1191 %*                                                                      *
1192             Pretty printing
1193 %*                                                                      *
1194 %************************************************************************
1195
1196 \begin{code}
1197 pprEvVars :: [EvVar] -> SDoc    -- Print with their types
1198 pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)
1199
1200 pprEvVarTheta :: [EvVar] -> SDoc
1201 pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
1202                               
1203 pprEvVarWithType :: EvVar -> SDoc
1204 pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)
1205
1206 pprWantedsWithLocs :: WantedConstraints -> SDoc
1207 pprWantedsWithLocs wcs
1208   =  vcat [ pprBag ppr (wc_flat wcs)
1209           , pprBag ppr (wc_impl wcs)
1210           , pprBag ppr (wc_insol wcs) ]
1211 \end{code}
1212
1213 %************************************************************************
1214 %*                                                                      *
1215             CtLoc
1216 %*                                                                      *
1217 %************************************************************************
1218
1219 \begin{code}
1220 data CtFlavor
1221   = Given GivenLoc GivenKind -- We have evidence for this constraint in TcEvBinds
1222   | Derived WantedLoc        -- Derived's are just hints for unifications 
1223   | Wanted WantedLoc         -- We have no evidence bindings for this constraint. 
1224
1225 data GivenKind
1226   = GivenOrig   -- Originates in some given, such as signature or pattern match
1227   | GivenSolved (Maybe EvTerm) 
1228                 -- Is given as result of being solved, maybe provisionally on
1229                 -- some other wanted constraints. We cache the evidence term 
1230                 -- sometimes here as well /as well as/ in the EvBinds, 
1231                 -- see Note [Optimizing Spontaneously Solved Coercions]
1232
1233 instance Outputable CtFlavor where
1234   ppr (Given _ GivenOrig)        = ptext (sLit "[G]")
1235   ppr (Given _ (GivenSolved {})) = ptext (sLit "[S]") -- Print [S] for Given/Solved's
1236   ppr (Wanted {})                = ptext (sLit "[W]")
1237   ppr (Derived {})               = ptext (sLit "[D]")
1238
1239 getWantedLoc :: CtFlavor -> WantedLoc
1240 getWantedLoc (Wanted wl)     = wl
1241 getWantedLoc (Derived wl)    = wl
1242 getWantedLoc flav@(Given {}) = pprPanic "getWantedLoc" (ppr flav)
1243
1244 pprFlavorArising :: CtFlavor -> SDoc
1245 pprFlavorArising (Derived wl)   = pprArisingAt wl
1246 pprFlavorArising (Wanted  wl)   = pprArisingAt wl
1247 pprFlavorArising (Given gl _)   = pprArisingAt gl
1248
1249 isWanted :: CtFlavor -> Bool
1250 isWanted (Wanted {}) = True
1251 isWanted _           = False
1252
1253 isGivenOrSolved :: CtFlavor -> Bool
1254 isGivenOrSolved (Given {}) = True
1255 isGivenOrSolved _ = False
1256
1257 isSolved :: CtFlavor -> Bool
1258 isSolved (Given _ (GivenSolved {})) = True
1259 isSolved _ = False
1260
1261 isGiven_maybe :: CtFlavor -> Maybe GivenKind 
1262 isGiven_maybe (Given _ gk) = Just gk
1263 isGiven_maybe _            = Nothing
1264
1265 isDerived :: CtFlavor -> Bool 
1266 isDerived (Derived {}) = True
1267 isDerived _            = False
1268
1269 canSolve :: CtFlavor -> CtFlavor -> Bool 
1270 -- canSolve ctid1 ctid2 
1271 -- The constraint ctid1 can be used to solve ctid2 
1272 -- "to solve" means a reaction where the active parts of the two constraints match.
1273 --  active(F xis ~ xi) = F xis 
1274 --  active(tv ~ xi)    = tv 
1275 --  active(D xis)      = D xis 
1276 --  active(IP nm ty)   = nm 
1277 --
1278 -- NB:  either (a `canSolve` b) or (b `canSolve` a) must hold
1279 -----------------------------------------
1280 canSolve (Given {})   _            = True 
1281 canSolve (Wanted {})  (Derived {}) = True
1282 canSolve (Wanted {})  (Wanted {})  = True
1283 canSolve (Derived {}) (Derived {}) = True  -- Important: derived can't solve wanted/given
1284 canSolve _ _ = False                       -- (There is no *evidence* for a derived.)
1285
1286 canRewrite :: CtFlavor -> CtFlavor -> Bool 
1287 -- canRewrite ctid1 ctid2 
1288 -- The *equality_constraint* ctid1 can be used to rewrite inside ctid2 
1289 canRewrite = canSolve 
1290
1291 combineCtLoc :: CtFlavor -> CtFlavor -> WantedLoc
1292 -- Precondition: At least one of them should be wanted 
1293 combineCtLoc (Wanted loc) _    = loc
1294 combineCtLoc _ (Wanted loc)    = loc
1295 combineCtLoc (Derived loc ) _  = loc
1296 combineCtLoc _ (Derived loc )  = loc
1297 combineCtLoc _ _ = panic "combineCtLoc: both given"
1298
1299 mkSolvedFlavor :: CtFlavor -> SkolemInfo -> EvTerm -> CtFlavor
1300 -- To be called when we actually solve a wanted/derived (perhaps leaving residual goals)
1301 mkSolvedFlavor (Wanted  loc) sk  evterm  = Given (setCtLocOrigin loc sk) (GivenSolved (Just evterm))
1302 mkSolvedFlavor (Derived loc) sk  evterm  = Given (setCtLocOrigin loc sk) (GivenSolved (Just evterm))
1303 mkSolvedFlavor fl@(Given {}) _sk _evterm = pprPanic "Solving a given constraint!" $ ppr fl
1304
1305 mkGivenFlavor :: CtFlavor -> SkolemInfo -> CtFlavor
1306 mkGivenFlavor (Wanted  loc) sk  = Given (setCtLocOrigin loc sk) GivenOrig
1307 mkGivenFlavor (Derived loc) sk  = Given (setCtLocOrigin loc sk) GivenOrig
1308 mkGivenFlavor fl@(Given {}) _sk = pprPanic "Solving a given constraint!" $ ppr fl
1309
1310 mkWantedFlavor :: CtFlavor -> CtFlavor
1311 mkWantedFlavor (Wanted  loc) = Wanted loc
1312 mkWantedFlavor (Derived loc) = Wanted loc
1313 mkWantedFlavor fl@(Given {}) = pprPanic "mkWantedFlavor" (ppr fl)
1314 \end{code}
1315
1316 %************************************************************************
1317 %*                                                                      *
1318             CtLoc
1319 %*                                                                      *
1320 %************************************************************************
1321
1322 The 'CtLoc' gives information about where a constraint came from.
1323 This is important for decent error message reporting because
1324 dictionaries don't appear in the original source code.
1325 type will evolve...
1326
1327 \begin{code}
1328 data CtLoc orig = CtLoc orig SrcSpan [ErrCtxt]
1329
1330 type WantedLoc = CtLoc CtOrigin      -- Instantiation for wanted constraints
1331 type GivenLoc  = CtLoc SkolemInfo    -- Instantiation for given constraints
1332
1333 ctLocSpan :: CtLoc o -> SrcSpan
1334 ctLocSpan (CtLoc _ s _) = s
1335
1336 ctLocOrigin :: CtLoc o -> o
1337 ctLocOrigin (CtLoc o _ _) = o
1338
1339 setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
1340 setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
1341
1342 pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig
1343 pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs)
1344
1345 pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc orig -> CtLoc orig
1346 -- Just add information w/o updating the origin!
1347 pushErrCtxtSameOrigin err (CtLoc o s errs) = CtLoc o s (err:errs)
1348
1349 pprArising :: CtOrigin -> SDoc
1350 -- Used for the main, top-level error message
1351 -- We've done special processing for TypeEq and FunDep origins
1352 pprArising (TypeEqOrigin {}) = empty
1353 pprArising FunDepOrigin      = empty
1354 pprArising orig              = text "arising from" <+> ppr orig
1355
1356 pprArisingAt :: Outputable o => CtLoc o -> SDoc
1357 pprArisingAt (CtLoc o s _) = sep [ text "arising from" <+> ppr o
1358                                  , text "at" <+> ppr s]
1359 \end{code}
1360
1361 %************************************************************************
1362 %*                                                                      *
1363                 SkolemInfo
1364 %*                                                                      *
1365 %************************************************************************
1366
1367 \begin{code}
1368 -- SkolemInfo gives the origin of *given* constraints
1369 --   a) type variables are skolemised
1370 --   b) an implication constraint is generated
1371 data SkolemInfo
1372   = SigSkol UserTypeCtxt        -- A skolem that is created by instantiating
1373             Type                -- a programmer-supplied type signature
1374                                 -- Location of the binding site is on the TyVar
1375
1376         -- The rest are for non-scoped skolems
1377   | ClsSkol Class       -- Bound at a class decl
1378   | InstSkol            -- Bound at an instance decl
1379   | DataSkol            -- Bound at a data type declaration
1380   | FamInstSkol         -- Bound at a family instance decl
1381   | PatSkol             -- An existential type variable bound by a pattern for
1382       DataCon           -- a data constructor with an existential type.
1383       (HsMatchContext Name)     
1384              -- e.g.   data T = forall a. Eq a => MkT a
1385              --        f (MkT x) = ...
1386              -- The pattern MkT x will allocate an existential type
1387              -- variable for 'a'.  
1388
1389   | ArrowSkol           -- An arrow form (see TcArrows)
1390
1391   | IPSkol [IPName Name]  -- Binding site of an implicit parameter
1392
1393   | RuleSkol RuleName   -- The LHS of a RULE
1394
1395   | InferSkol [(Name,TcType)]
1396                         -- We have inferred a type for these (mutually-recursivive)
1397                         -- polymorphic Ids, and are now checking that their RHS
1398                         -- constraints are satisfied.
1399
1400   | BracketSkol         -- Template Haskell bracket
1401
1402   | UnifyForAllSkol     -- We are unifying two for-all types
1403        [TcTyVar]        -- The instantiated skolem variables
1404        TcType           -- The instantiated type *inside* the forall
1405
1406   | UnkSkol             -- Unhelpful info (until I improve it)
1407
1408 instance Outputable SkolemInfo where
1409   ppr = pprSkolInfo
1410
1411 pprSkolInfo :: SkolemInfo -> SDoc
1412 -- Complete the sentence "is a rigid type variable bound by..."
1413 pprSkolInfo (SigSkol (FunSigCtxt f) ty)
1414                             = hang (ptext (sLit "the type signature for"))
1415                                  2 (ppr f <+> dcolon <+> ppr ty)
1416 pprSkolInfo (SigSkol cx ty) = hang (pprUserTypeCtxt cx <> colon)
1417                                  2 (ppr ty)
1418 pprSkolInfo (IPSkol ips)    = ptext (sLit "the implicit-parameter bindings for")
1419                               <+> pprWithCommas ppr ips
1420 pprSkolInfo (ClsSkol cls)   = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
1421 pprSkolInfo InstSkol        = ptext (sLit "the instance declaration")
1422 pprSkolInfo DataSkol        = ptext (sLit "the data type declaration")
1423 pprSkolInfo FamInstSkol     = ptext (sLit "the family instance declaration")
1424 pprSkolInfo BracketSkol     = ptext (sLit "a Template Haskell bracket")
1425 pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
1426 pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
1427 pprSkolInfo (PatSkol dc mc)  = sep [ ptext (sLit "a pattern with constructor")
1428                                    , nest 2 $ ppr dc <+> dcolon
1429                                               <+> ppr (dataConUserType dc) <> comma
1430                                   , ptext (sLit "in") <+> pprMatchContext mc ]
1431 pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
1432                                   , vcat [ ppr name <+> dcolon <+> ppr ty
1433                                          | (name,ty) <- ids ]]
1434 pprSkolInfo (UnifyForAllSkol tvs ty) = ptext (sLit "the type") <+> ppr (mkForAllTys tvs ty)
1435
1436 -- UnkSkol
1437 -- For type variables the others are dealt with by pprSkolTvBinding.  
1438 -- For Insts, these cases should not happen
1439 pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
1440 \end{code}
1441
1442
1443 %************************************************************************
1444 %*                                                                      *
1445             CtOrigin
1446 %*                                                                      *
1447 %************************************************************************
1448
1449 \begin{code}
1450 -- CtOrigin gives the origin of *wanted* constraints
1451 data CtOrigin
1452   = OccurrenceOf Name           -- Occurrence of an overloaded identifier
1453   | AppOrigin                   -- An application of some kind
1454
1455   | SpecPragOrigin Name         -- Specialisation pragma for identifier
1456
1457   | TypeEqOrigin EqOrigin
1458
1459   | IPOccOrigin  (IPName Name)  -- Occurrence of an implicit parameter
1460
1461   | LiteralOrigin (HsOverLit Name)      -- Occurrence of a literal
1462   | NegateOrigin                        -- Occurrence of syntactic negation
1463
1464   | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
1465   | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
1466   | SectionOrigin
1467   | TupleOrigin                        -- (..,..)
1468   | AmbigOrigin Name    -- f :: ty
1469   | ExprSigOrigin       -- e :: ty
1470   | PatSigOrigin        -- p :: ty
1471   | PatOrigin           -- Instantiating a polytyped pattern at a constructor
1472   | RecordUpdOrigin
1473   | ViewPatOrigin
1474
1475   | ScOrigin            -- Typechecking superclasses of an instance declaration
1476   | DerivOrigin         -- Typechecking deriving
1477   | StandAloneDerivOrigin -- Typechecking stand-alone deriving
1478   | DefaultOrigin       -- Typechecking a default decl
1479   | DoOrigin            -- Arising from a do expression
1480   | MCompOrigin         -- Arising from a monad comprehension
1481   | IfOrigin            -- Arising from an if statement
1482   | ProcOrigin          -- Arising from a proc expression
1483   | AnnOrigin           -- An annotation
1484   | FunDepOrigin
1485
1486 data EqOrigin 
1487   = UnifyOrigin 
1488        { uo_actual   :: TcType
1489        , uo_expected :: TcType }
1490
1491 instance Outputable CtOrigin where
1492   ppr orig = pprO orig
1493
1494 pprO :: CtOrigin -> SDoc
1495 pprO (OccurrenceOf name)   = hsep [ptext (sLit "a use of"), quotes (ppr name)]
1496 pprO AppOrigin             = ptext (sLit "an application")
1497 pprO (SpecPragOrigin name) = hsep [ptext (sLit "a specialisation pragma for"), quotes (ppr name)]
1498 pprO (IPOccOrigin name)    = hsep [ptext (sLit "a use of implicit parameter"), quotes (ppr name)]
1499 pprO RecordUpdOrigin       = ptext (sLit "a record update")
1500 pprO (AmbigOrigin name)    = ptext (sLit "the ambiguity check for") <+> quotes (ppr name)
1501 pprO ExprSigOrigin         = ptext (sLit "an expression type signature")
1502 pprO PatSigOrigin          = ptext (sLit "a pattern type signature")
1503 pprO PatOrigin             = ptext (sLit "a pattern")
1504 pprO ViewPatOrigin         = ptext (sLit "a view pattern")
1505 pprO IfOrigin              = ptext (sLit "an if statement")
1506 pprO (LiteralOrigin lit)   = hsep [ptext (sLit "the literal"), quotes (ppr lit)]
1507 pprO (ArithSeqOrigin seq)  = hsep [ptext (sLit "the arithmetic sequence"), quotes (ppr seq)]
1508 pprO (PArrSeqOrigin seq)   = hsep [ptext (sLit "the parallel array sequence"), quotes (ppr seq)]
1509 pprO SectionOrigin         = ptext (sLit "an operator section")
1510 pprO TupleOrigin           = ptext (sLit "a tuple")
1511 pprO NegateOrigin          = ptext (sLit "a use of syntactic negation")
1512 pprO ScOrigin              = ptext (sLit "the superclasses of an instance declaration")
1513 pprO DerivOrigin           = ptext (sLit "the 'deriving' clause of a data type declaration")
1514 pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
1515 pprO DefaultOrigin         = ptext (sLit "a 'default' declaration")
1516 pprO DoOrigin              = ptext (sLit "a do statement")
1517 pprO MCompOrigin           = ptext (sLit "a statement in a monad comprehension")
1518 pprO ProcOrigin            = ptext (sLit "a proc expression")
1519 pprO (TypeEqOrigin eq)     = ptext (sLit "an equality") <+> ppr eq
1520 pprO AnnOrigin             = ptext (sLit "an annotation")
1521 pprO FunDepOrigin          = ptext (sLit "a functional dependency")
1522
1523 instance Outputable EqOrigin where
1524   ppr (UnifyOrigin t1 t2) = ppr t1 <+> char '~' <+> ppr t2
1525 \end{code}
1526