compiler/typecheck/TcRnTypes.lhs

   1
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP Project, Glasgow University, 1992-2002
   4 %
   5 \begin{code}
   6 module TcRnTypes(
   7         TcRnIf, TcRn, TcM, RnM, IfM, IfL, IfG, -- The monad is opaque outside this module
   8         TcRef,
   9
  10         -- The environment types
  11         Env(..),
  12         TcGblEnv(..), TcLclEnv(..),
  13         IfGblEnv(..), IfLclEnv(..),
  14
  15         -- Ranamer types
  16         ErrCtxt, RecFieldEnv(..),
  17         ImportAvails(..), emptyImportAvails, plusImportAvails,
  18         WhereFrom(..), mkModDeps,
  19
  20         -- Typechecker types
  21         TcTypeEnv, TcTyThing(..), pprTcTyThingCategory,
  22
  23         -- Template Haskell
  24         ThStage(..), topStage, topAnnStage, topSpliceStage,
  25         ThLevel, impLevel, outerLevel, thLevel,
  26
  27         -- Arrows
  28         ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
  29
  30         -- Constraints
  31         Untouchables(..), inTouchableRange, isNoUntouchables,
  32
  33         WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,
  34         andWC, addFlats, addImplics, mkFlatWC,
  35
  36         EvVarX(..), mkEvVarX, evVarOf, evVarX, evVarOfPred,
  37         WantedEvVar, wantedToFlavored,
  38         keepWanted,
  39
  40         Implication(..),
  41         CtLoc(..), ctLocSpan, ctLocOrigin, setCtLocOrigin,
  42         CtOrigin(..), EqOrigin(..),
  43         WantedLoc, GivenLoc, GivenKind(..), pushErrCtxt,
  44
  45         SkolemInfo(..),
  46
  47         CtFlavor(..), pprFlavorArising, isWanted,
  48         isGivenOrSolved, isGiven_maybe,
  49         isDerived,
  50         FlavoredEvVar,
  51
  52         -- Pretty printing
  53         pprEvVarTheta, pprWantedEvVar, pprWantedsWithLocs,
  54         pprEvVars, pprEvVarWithType,
  55         pprArising, pprArisingAt,
  56
  57         -- Misc other types
  58         TcId, TcIdSet, TcTyVarBind(..), TcTyVarBinds
  59
  60   ) where
  61
  62 #include "HsVersions.h"
  63
  64 import HsSyn
  65 import HscTypes
  66 import Type
  67 import Class    ( Class )
  68 import DataCon  ( DataCon, dataConUserType )
  69 import TcType
  70 import Annotations
  71 import InstEnv
  72 import FamInstEnv
  73 import IOEnv
  74 import RdrName
  75 import Name
  76 import NameEnv
  77 import NameSet
  78 import Var
  79 import VarEnv
  80 import Module
  81 import SrcLoc
  82 import VarSet
  83 import ErrUtils
  84 import UniqFM
  85 import UniqSupply
  86 import Unique
  87 import BasicTypes
  88 import Bag
  89 import Outputable
  90 import ListSetOps
  91 import FastString
  92
  93 import Data.Set (Set)
  94 \end{code}
  95
  96
  97 %************************************************************************
  98 %*                                                                      *
  99                Standard monad definition for TcRn
 100     All the combinators for the monad can be found in TcRnMonad
 101 %*                                                                      *
 102 %************************************************************************
 103
 104 The monad itself has to be defined here, because it is mentioned by ErrCtxt
 105
 106 \begin{code}
 107 type TcRef a     = IORef a
 108 type TcId        = Id                   -- Type may be a TcType  DV: WHAT??????????
 109 type TcIdSet     = IdSet
 110
 111
 112 type TcRnIf a b c = IOEnv (Env a b) c
 113 type IfM lcl a  = TcRnIf IfGblEnv lcl a         -- Iface stuff
 114
 115 type IfG a  = IfM () a                          -- Top level
 116 type IfL a  = IfM IfLclEnv a                    -- Nested
 117 type TcRn a = TcRnIf TcGblEnv TcLclEnv a
 118 type RnM  a = TcRn a            -- Historical
 119 type TcM  a = TcRn a            -- Historical
 120 \end{code}
 121
 122 Representation of type bindings to uninstantiated meta variables used during
 123 constraint solving.
 124
 125 \begin{code}
 126 data TcTyVarBind = TcTyVarBind TcTyVar TcType
 127
 128 type TcTyVarBinds = Bag TcTyVarBind
 129
 130 instance Outputable TcTyVarBind where
 131   ppr (TcTyVarBind tv ty) = ppr tv <+> text ":=" <+> ppr ty
 132 \end{code}
 133
 134
 135 %************************************************************************
 136 %*                                                                      *
 137                 The main environment types
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 \begin{code}
 142 data Env gbl lcl        -- Changes as we move into an expression
 143   = Env {
 144         env_top  :: HscEnv,     -- Top-level stuff that never changes
 145                                 -- Includes all info about imported things
 146
 147         env_us   :: {-# UNPACK #-} !(IORef UniqSupply),
 148                                 -- Unique supply for local varibles
 149
 150         env_gbl  :: gbl,        -- Info about things defined at the top level
 151                                 -- of the module being compiled
 152
 153         env_lcl  :: lcl         -- Nested stuff; changes as we go into
 154     }
 155
 156 -- TcGblEnv describes the top-level of the module at the
 157 -- point at which the typechecker is finished work.
 158 -- It is this structure that is handed on to the desugarer
 159
 160 data TcGblEnv
 161   = TcGblEnv {
 162         tcg_mod     :: Module,         -- ^ Module being compiled
 163         tcg_src     :: HscSource,
 164           -- ^ What kind of module (regular Haskell, hs-boot, ext-core)
 165
 166         tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming
 167         tcg_default :: Maybe [Type],
 168           -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
 169
 170         tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module
 171         tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module
 172
 173         tcg_type_env :: TypeEnv,
 174           -- ^ Global type env for the module we are compiling now.  All
 175           -- TyCons and Classes (for this module) end up in here right away,
 176           -- along with their derived constructors, selectors.
 177           --
 178           -- (Ids defined in this module start in the local envt, though they
 179           --  move to the global envt during zonking)
 180
 181         tcg_type_env_var :: TcRef TypeEnv,
 182                 -- Used only to initialise the interface-file
 183                 -- typechecker in initIfaceTcRn, so that it can see stuff
 184                 -- bound in this module when dealing with hi-boot recursions
 185                 -- Updated at intervals (e.g. after dealing with types and classes)
 186
 187         tcg_inst_env     :: InstEnv,
 188           -- ^ Instance envt for /home-package/ modules; Includes the dfuns in
 189           -- tcg_insts
 190         tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
 191
 192                 -- Now a bunch of things about this module that are simply
 193                 -- accumulated, but never consulted until the end.
 194                 -- Nevertheless, it's convenient to accumulate them along
 195                 -- with the rest of the info from this module.
 196         tcg_exports :: [AvailInfo],     -- ^ What is exported
 197         tcg_imports :: ImportAvails,
 198           -- ^ Information about what was imported from where, including
 199           -- things bound in this module.
 200
 201         tcg_dus :: DefUses,
 202           -- ^ What is defined in this module and what is used.
 203           -- The latter is used to generate
 204           --
 205           --  (a) version tracking; no need to recompile if these things have
 206           --      not changed version stamp
 207           --
 208           --  (b) unused-import info
 209
 210         tcg_keep :: TcRef NameSet,
 211           -- ^ Locally-defined top-level names to keep alive.
 212           --
 213           -- "Keep alive" means give them an Exported flag, so that the
 214           -- simplifier does not discard them as dead code, and so that they
 215           -- are exposed in the interface file (but not to export to the
 216           -- user).
 217           --
 218           -- Some things, like dict-fun Ids and default-method Ids are "born"
 219           -- with the Exported flag on, for exactly the above reason, but some
 220           -- we only discover as we go.  Specifically:
 221           --
 222           --   * The to/from functions for generic data types
 223           --
 224           --   * Top-level variables appearing free in the RHS of an orphan
 225           --     rule
 226           --
 227           --   * Top-level variables appearing free in a TH bracket
 228
 229         tcg_th_used :: TcRef Bool,
 230           -- ^ @True@ <=> Template Haskell syntax used.
 231           --
 232           -- We need this so that we can generate a dependency on the
 233           -- Template Haskell package, becuase the desugarer is going
 234           -- to emit loads of references to TH symbols.  The reference
 235           -- is implicit rather than explicit, so we have to zap a
 236           -- mutable variable.
 237
 238         tcg_dfun_n  :: TcRef OccSet,
 239           -- ^ Allows us to choose unique DFun names.
 240
 241         -- The next fields accumulate the payload of the module
 242         -- The binds, rules and foreign-decl fiels are collected
 243         -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
 244
 245         tcg_rn_exports :: Maybe [Located (IE Name)],
 246         tcg_rn_imports :: [LImportDecl Name],
 247                 -- Keep the renamed imports regardless.  They are not
 248                 -- voluminous and are needed if you want to report unused imports
 249
 250         tcg_used_rdrnames :: TcRef (Set RdrName),
 251                 -- The set of used *imported* (not locally-defined) RdrNames
 252                 -- Used only to report unused import declarations
 253
 254         tcg_rn_decls :: Maybe (HsGroup Name),
 255           -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed
 256           -- decls.
 257
 258         tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings
 259         tcg_binds     :: LHsBinds Id,       -- Value bindings in this module
 260         tcg_sigs      :: NameSet,           -- ...Top-level names that *lack* a signature
 261         tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
 262         tcg_warns     :: Warnings,          -- ...Warnings and deprecations
 263         tcg_anns      :: [Annotation],      -- ...Annotations
 264         tcg_insts     :: [Instance],        -- ...Instances
 265         tcg_fam_insts :: [FamInst],         -- ...Family instances
 266         tcg_rules     :: [LRuleDecl Id],    -- ...Rules
 267         tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
 268         tcg_vects     :: [LVectDecl Id],    -- ...Vectorisation declarations
 269
 270         tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
 271         tcg_hpc       :: AnyHpcUsage,        -- ^ @True@ if any part of the
 272                                              --  prog uses hpc instrumentation.
 273
 274         tcg_main      :: Maybe Name          -- ^ The Name of the main
 275                                              -- function, if this module is
 276                                              -- the main module.
 277     }
 278
 279 data RecFieldEnv
 280   = RecFields (NameEnv [Name])  -- Maps a constructor name *in this module*
 281                                 -- to the fields for that constructor
 282               NameSet           -- Set of all fields declared *in this module*;
 283                                 -- used to suppress name-shadowing complaints
 284                                 -- when using record wild cards
 285                                 -- E.g.  let fld = e in C {..}
 286         -- This is used when dealing with ".." notation in record
 287         -- construction and pattern matching.
 288         -- The FieldEnv deals *only* with constructors defined in *this*
 289         -- module.  For imported modules, we get the same info from the
 290         -- TypeEnv
 291 \end{code}
 292
 293 %************************************************************************
 294 %*                                                                      *
 295                 The interface environments
 296               Used when dealing with IfaceDecls
 297 %*                                                                      *
 298 %************************************************************************
 299
 300 \begin{code}
 301 data IfGblEnv
 302   = IfGblEnv {
 303         -- The type environment for the module being compiled,
 304         -- in case the interface refers back to it via a reference that
 305         -- was originally a hi-boot file.
 306         -- We need the module name so we can test when it's appropriate
 307         -- to look in this env.
 308         if_rec_types :: Maybe (Module, IfG TypeEnv)
 309                 -- Allows a read effect, so it can be in a mutable
 310                 -- variable; c.f. handling the external package type env
 311                 -- Nothing => interactive stuff, no loops possible
 312     }
 313
 314 data IfLclEnv
 315   = IfLclEnv {
 316         -- The module for the current IfaceDecl
 317         -- So if we see   f = \x -> x
 318         -- it means M.f = \x -> x, where M is the if_mod
 319         if_mod :: Module,
 320
 321         -- The field is used only for error reporting
 322         -- if (say) there's a Lint error in it
 323         if_loc :: SDoc,
 324                 -- Where the interface came from:
 325                 --      .hi file, or GHCi state, or ext core
 326                 -- plus which bit is currently being examined
 327
 328         if_tv_env  :: UniqFM TyVar,     -- Nested tyvar bindings
 329         if_id_env  :: UniqFM Id         -- Nested id binding
 330     }
 331 \end{code}
 332
 333
 334 %************************************************************************
 335 %*                                                                      *
 336                 The local typechecker environment
 337 %*                                                                      *
 338 %************************************************************************
 339
 340 The Global-Env/Local-Env story
 341 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 342 During type checking, we keep in the tcg_type_env
 343         * All types and classes
 344         * All Ids derived from types and classes (constructors, selectors)
 345
 346 At the end of type checking, we zonk the local bindings,
 347 and as we do so we add to the tcg_type_env
 348         * Locally defined top-level Ids
 349
 350 Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
 351         a) fed back (via the knot) to typechecking the
 352            unfoldings of interface signatures
 353         b) used in the ModDetails of this module
 354
 355 \begin{code}
 356 data TcLclEnv           -- Changes as we move inside an expression
 357                         -- Discarded after typecheck/rename; not passed on to desugarer
 358   = TcLclEnv {
 359         tcl_loc  :: SrcSpan,            -- Source span
 360         tcl_ctxt :: [ErrCtxt],          -- Error context, innermost on top
 361         tcl_errs :: TcRef Messages,     -- Place to accumulate errors
 362
 363         tcl_th_ctxt    :: ThStage,            -- Template Haskell context
 364         tcl_arrow_ctxt :: ArrowCtxt,          -- Arrow-notation context
 365
 366         tcl_rdr :: LocalRdrEnv,         -- Local name envt
 367                 -- Maintained during renaming, of course, but also during
 368                 -- type checking, solely so that when renaming a Template-Haskell
 369                 -- splice we have the right environment for the renamer.
 370                 --
 371                 --   Does *not* include global name envt; may shadow it
 372                 --   Includes both ordinary variables and type variables;
 373                 --   they are kept distinct because tyvar have a different
 374                 --   occurrence contructor (Name.TvOcc)
 375                 -- We still need the unsullied global name env so that
 376                 --   we can look up record field names
 377
 378         tcl_env  :: TcTypeEnv,    -- The local type environment: Ids and
 379                                   -- TyVars defined in this module
 380
 381         tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"
 382                         -- Namely, the in-scope TyVars bound in tcl_env,
 383                         -- plus the tyvars mentioned in the types of Ids bound
 384                         -- in tcl_lenv.
 385                         -- Why mutable? see notes with tcGetGlobalTyVars
 386
 387         tcl_lie   :: TcRef WantedConstraints,    -- Place to accumulate type constraints
 388
 389         -- TcMetaTyVars have
 390         tcl_meta  :: TcRef Unique,  -- The next free unique for TcMetaTyVars
 391                                     -- Guaranteed to be allocated linearly
 392         tcl_untch :: Unique         -- Any TcMetaTyVar with
 393                                     --     unique >= tcl_untch is touchable
 394                                     --     unique <  tcl_untch is untouchable
 395     }
 396
 397 type TcTypeEnv = NameEnv TcTyThing
 398
 399
 400 {- Note [Given Insts]
 401    ~~~~~~~~~~~~~~~~~~
 402 Because of GADTs, we have to pass inwards the Insts provided by type signatures
 403 and existential contexts. Consider
 404         data T a where { T1 :: b -> b -> T [b] }
 405         f :: Eq a => T a -> Bool
 406         f (T1 x y) = [x]==[y]
 407
 408 The constructor T1 binds an existential variable 'b', and we need Eq [b].
 409 Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we
 410 pass it inwards.
 411
 412 -}
 413
 414 ---------------------------
 415 -- Template Haskell stages and levels
 416 ---------------------------
 417
 418 data ThStage    -- See Note [Template Haskell state diagram] in TcSplice
 419   = Splice      -- Top-level splicing
 420                 -- This code will be run *at compile time*;
 421                 --   the result replaces the splice
 422                 -- Binding level = 0
 423
 424   | Comp        -- Ordinary Haskell code
 425                 -- Binding level = 1
 426
 427   | Brack                       -- Inside brackets
 428       ThStage                   --   Binding level = level(stage) + 1
 429       (TcRef [PendingSplice])   --   Accumulate pending splices here
 430       (TcRef WantedConstraints) --     and type constraints here
 431
 432 topStage, topAnnStage, topSpliceStage :: ThStage
 433 topStage       = Comp
 434 topAnnStage    = Splice
 435 topSpliceStage = Splice
 436
 437 instance Outputable ThStage where
 438    ppr Splice        = text "Splice"
 439    ppr Comp          = text "Comp"
 440    ppr (Brack s _ _) = text "Brack" <> parens (ppr s)
 441
 442 type ThLevel = Int
 443         -- See Note [Template Haskell levels] in TcSplice
 444         -- Incremented when going inside a bracket,
 445         -- decremented when going inside a splice
 446         -- NB: ThLevel is one greater than the 'n' in Fig 2 of the
 447         --     original "Template meta-programming for Haskell" paper
 448
 449 impLevel, outerLevel :: ThLevel
 450 impLevel = 0    -- Imported things; they can be used inside a top level splice
 451 outerLevel = 1  -- Things defined outside brackets
 452 -- NB: Things at level 0 are not *necessarily* imported.
 453 --      eg  $( \b -> ... )   here b is bound at level 0
 454 --
 455 -- For example:
 456 --      f = ...
 457 --      g1 = $(map ...)         is OK
 458 --      g2 = $(f ...)           is not OK; because we havn't compiled f yet
 459
 460 thLevel :: ThStage -> ThLevel
 461 thLevel Splice        = 0
 462 thLevel Comp          = 1
 463 thLevel (Brack s _ _) = thLevel s + 1
 464
 465 ---------------------------
 466 -- Arrow-notation context
 467 ---------------------------
 468
 469 {-
 470 In arrow notation, a variable bound by a proc (or enclosed let/kappa)
 471 is not in scope to the left of an arrow tail (-<) or the head of (|..|).
 472 For example
 473
 474         proc x -> (e1 -< e2)
 475
 476 Here, x is not in scope in e1, but it is in scope in e2.  This can get
 477 a bit complicated:
 478
 479         let x = 3 in
 480         proc y -> (proc z -> e1) -< e2
 481
 482 Here, x and z are in scope in e1, but y is not.  We implement this by
 483 recording the environment when passing a proc (using newArrowScope),
 484 and returning to that (using escapeArrowScope) on the left of -< and the
 485 head of (|..|).
 486 -}
 487
 488 data ArrowCtxt
 489   = NoArrowCtxt
 490   | ArrowCtxt (Env TcGblEnv TcLclEnv)
 491
 492 -- Record the current environment (outside a proc)
 493 newArrowScope :: TcM a -> TcM a
 494 newArrowScope
 495   = updEnv $ \env ->
 496         env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } }
 497
 498 -- Return to the stored environment (from the enclosing proc)
 499 escapeArrowScope :: TcM a -> TcM a
 500 escapeArrowScope
 501   = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
 502         NoArrowCtxt -> env
 503         ArrowCtxt env' -> env'
 504
 505 ---------------------------
 506 -- TcTyThing
 507 ---------------------------
 508
 509 data TcTyThing
 510   = AGlobal TyThing             -- Used only in the return type of a lookup
 511
 512   | ATcId   {           -- Ids defined in this module; may not be fully zonked
 513         tct_id    :: TcId,
 514         tct_level :: ThLevel }
 515
 516   | ATyVar  Name TcType         -- The type to which the lexically scoped type vaiable
 517                                 -- is currently refined. We only need the Name
 518                                 -- for error-message purposes; it is the corresponding
 519                                 -- Name in the domain of the envt
 520
 521   | AThing  TcKind              -- Used temporarily, during kind checking, for the
 522                                 --      tycons and clases in this recursive group
 523
 524 instance Outputable TcTyThing where     -- Debugging only
 525    ppr (AGlobal g)      = pprTyThing g
 526    ppr elt@(ATcId {})   = text "Identifier" <>
 527                           brackets (ppr (tct_id elt) <> dcolon
 528                                  <> ppr (varType (tct_id elt)) <> comma
 529                                  <+> ppr (tct_level elt))
 530    ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
 531    ppr (AThing k)       = text "AThing" <+> ppr k
 532
 533 pprTcTyThingCategory :: TcTyThing -> SDoc
 534 pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
 535 pprTcTyThingCategory (ATyVar {})     = ptext (sLit "Type variable")
 536 pprTcTyThingCategory (ATcId {})      = ptext (sLit "Local identifier")
 537 pprTcTyThingCategory (AThing {})     = ptext (sLit "Kinded thing")
 538 \end{code}
 539
 540 \begin{code}
 541 type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, Message))
 542         -- Monadic so that we have a chance
 543         -- to deal with bound type variables just before error
 544         -- message construction
 545
 546         -- Bool:  True <=> this is a landmark context; do not
 547         --                 discard it when trimming for display
 548 \end{code}
 549
 550
 551 %************************************************************************
 552 %*                                                                      *
 553         Operations over ImportAvails
 554 %*                                                                      *
 555 %************************************************************************
 556
 557 \begin{code}
 558 -- | 'ImportAvails' summarises what was imported from where, irrespective of
 559 -- whether the imported things are actually used or not.  It is used:
 560 --
 561 --  * when processing the export list,
 562 --
 563 --  * when constructing usage info for the interface file,
 564 --
 565 --  * to identify the list of directly imported modules for initialisation
 566 --    purposes and for optimised overlap checking of family instances,
 567 --
 568 --  * when figuring out what things are really unused
 569 --
 570 data ImportAvails
 571    = ImportAvails {
 572         imp_mods :: ModuleEnv [(ModuleName, Bool, SrcSpan)],
 573           -- ^ Domain is all directly-imported modules
 574           -- The 'ModuleName' is what the module was imported as, e.g. in
 575           -- @
 576           --     import Foo as Bar
 577           -- @
 578           -- it is @Bar@.
 579           --
 580           -- The 'Bool' means:
 581           --
 582           --  - @True@ => import was @import Foo ()@
 583           --
 584           --  - @False@ => import was some other form
 585           --
 586           -- Used
 587           --
 588           --   (a) to help construct the usage information in the interface
 589           --       file; if we import somethign we need to recompile if the
 590           --       export version changes
 591           --
 592           --   (b) to specify what child modules to initialise
 593           --
 594           -- We need a full ModuleEnv rather than a ModuleNameEnv here,
 595           -- because we might be importing modules of the same name from
 596           -- different packages. (currently not the case, but might be in the
 597           -- future).
 598
 599         imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
 600           -- ^ Home-package modules needed by the module being compiled
 601           --
 602           -- It doesn't matter whether any of these dependencies
 603           -- are actually /used/ when compiling the module; they
 604           -- are listed if they are below it at all.  For
 605           -- example, suppose M imports A which imports X.  Then
 606           -- compiling M might not need to consult X.hi, but X
 607           -- is still listed in M's dependencies.
 608
 609         imp_dep_pkgs :: [PackageId],
 610           -- ^ Packages needed by the module being compiled, whether directly,
 611           -- or via other modules in this package, or via modules imported
 612           -- from other packages.
 613
 614         imp_orphs :: [Module],
 615           -- ^ Orphan modules below us in the import tree (and maybe including
 616           -- us for imported modules)
 617
 618         imp_finsts :: [Module]
 619           -- ^ Family instance modules below us in the import tree (and maybe
 620           -- including us for imported modules)
 621       }
 622
 623 mkModDeps :: [(ModuleName, IsBootInterface)]
 624           -> ModuleNameEnv (ModuleName, IsBootInterface)
 625 mkModDeps deps = foldl add emptyUFM deps
 626                where
 627                  add env elt@(m,_) = addToUFM env m elt
 628
 629 emptyImportAvails :: ImportAvails
 630 emptyImportAvails = ImportAvails { imp_mods     = emptyModuleEnv,
 631                                    imp_dep_mods = emptyUFM,
 632                                    imp_dep_pkgs = [],
 633                                    imp_orphs    = [],
 634                                    imp_finsts   = [] }
 635
 636 plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
 637 plusImportAvails
 638   (ImportAvails { imp_mods = mods1,
 639                   imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
 640                   imp_orphs = orphs1, imp_finsts = finsts1 })
 641   (ImportAvails { imp_mods = mods2,
 642                   imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
 643                   imp_orphs = orphs2, imp_finsts = finsts2 })
 644   = ImportAvails { imp_mods     = plusModuleEnv_C (++) mods1 mods2,
 645                    imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,
 646                    imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
 647                    imp_orphs    = orphs1 `unionLists` orphs2,
 648                    imp_finsts   = finsts1 `unionLists` finsts2 }
 649   where
 650     plus_mod_dep (m1, boot1) (m2, boot2)
 651         = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
 652                 -- Check mod-names match
 653           (m1, boot1 && boot2)  -- If either side can "see" a non-hi-boot interface, use that
 654 \end{code}
 655
 656 %************************************************************************
 657 %*                                                                      *
 658 \subsection{Where from}
 659 %*                                                                      *
 660 %************************************************************************
 661
 662 The @WhereFrom@ type controls where the renamer looks for an interface file
 663
 664 \begin{code}
 665 data WhereFrom
 666   = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})
 667   | ImportBySystem                      -- Non user import.
 668
 669 instance Outputable WhereFrom where
 670   ppr (ImportByUser is_boot) | is_boot     = ptext (sLit "{- SOURCE -}")
 671                              | otherwise   = empty
 672   ppr ImportBySystem                       = ptext (sLit "{- SYSTEM -}")
 673 \end{code}
 674
 675
 676 %************************************************************************
 677 %*                                                                      *
 678                 Wanted constraints
 679
 680      These are forced to be in TcRnTypes because
 681            TcLclEnv mentions WantedConstraints
 682            WantedConstraint mentions CtLoc
 683            CtLoc mentions ErrCtxt
 684            ErrCtxt mentions TcM
 685 %*                                                                      *
 686 v%************************************************************************
 687
 688 \begin{code}
 689 data WantedConstraints
 690   = WC { wc_flat  :: Bag WantedEvVar   -- Unsolved constraints, all wanted
 691        , wc_impl  :: Bag Implication
 692        , wc_insol :: Bag FlavoredEvVar -- Insoluble constraints, can be
 693                                        -- wanted, given, or derived
 694                                        -- See Note [Insoluble constraints]
 695     }
 696
 697 emptyWC :: WantedConstraints
 698 emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
 699
 700 mkFlatWC :: Bag WantedEvVar -> WantedConstraints
 701 mkFlatWC wevs = WC { wc_flat = wevs, wc_impl = emptyBag, wc_insol = emptyBag }
 702
 703 isEmptyWC :: WantedConstraints -> Bool
 704 isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
 705   = isEmptyBag f && isEmptyBag i && isEmptyBag n
 706
 707 insolubleWC :: WantedConstraints -> Bool
 708 -- True if there are any insoluble constraints in the wanted bag
 709 insolubleWC wc = not (isEmptyBag (wc_insol wc))
 710                || anyBag ic_insol (wc_impl wc)
 711
 712 andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
 713 andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
 714       (WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
 715   = WC { wc_flat  = f1 `unionBags` f2
 716        , wc_impl  = i1 `unionBags` i2
 717        , wc_insol = n1 `unionBags` n2 }
 718
 719 addFlats :: WantedConstraints -> Bag WantedEvVar -> WantedConstraints
 720 addFlats wc wevs = wc { wc_flat = wc_flat wc `unionBags` wevs }
 721
 722 addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
 723 addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
 724
 725 instance Outputable WantedConstraints where
 726   ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
 727    = ptext (sLit "WC") <+> braces (vcat
 728         [ if isEmptyBag f then empty else
 729           ptext (sLit "wc_flat =")  <+> pprBag pprWantedEvVar f
 730         , if isEmptyBag i then empty else
 731           ptext (sLit "wc_impl =")  <+> pprBag ppr i
 732         , if isEmptyBag n then empty else
 733           ptext (sLit "wc_insol =") <+> pprBag ppr n ])
 734
 735 pprBag :: (a -> SDoc) -> Bag a -> SDoc
 736 pprBag pp b = foldrBag (($$) . pp) empty b
 737 \end{code}
 738
 739
 740 \begin{code}
 741 data Untouchables = NoUntouchables
 742                   | TouchableRange
 743                           Unique  -- Low end
 744                           Unique  -- High end
 745  -- A TcMetaTyvar is *touchable* iff its unique u satisfies
 746  --   u >= low
 747  --   u < high
 748
 749 instance Outputable Untouchables where
 750   ppr NoUntouchables = ptext (sLit "No untouchables")
 751   ppr (TouchableRange low high) = ptext (sLit "Touchable range:") <+>
 752                                   ppr low <+> char '-' <+> ppr high
 753
 754 isNoUntouchables :: Untouchables -> Bool
 755 isNoUntouchables NoUntouchables      = True
 756 isNoUntouchables (TouchableRange {}) = False
 757
 758 inTouchableRange :: Untouchables -> TcTyVar -> Bool
 759 inTouchableRange NoUntouchables _ = True
 760 inTouchableRange (TouchableRange low high) tv
 761   = uniq >= low && uniq < high
 762   where
 763     uniq = varUnique tv
 764
 765 -- EvVar defined in module Var.lhs:
 766 -- Evidence variables include all *quantifiable* constraints
 767 --   dictionaries
 768 --   implicit parameters
 769 --   coercion variables
 770 \end{code}
 771
 772 %************************************************************************
 773 %*                                                                      *
 774                 Implication constraints
 775 %*                                                                      *
 776 %************************************************************************
 777
 778 \begin{code}
 779 data Implication
 780   = Implic {
 781       ic_untch :: Untouchables, -- Untouchables: unification variables
 782                                 -- free in the environment
 783       ic_env   :: TcTypeEnv,    -- The type environment
 784                                 -- Used only when generating error messages
 785           -- Generally, ic_untch is a superset of tvsof(ic_env)
 786           -- However, we don't zonk ic_env when zonking the Implication
 787           -- Instead we do that when generating a skolem-escape error message
 788
 789       ic_skols  :: TcTyVarSet,   -- Introduced skolems
 790                                  -- See Note [Skolems in an implication]
 791
 792       ic_given  :: [EvVar],      -- Given evidence variables
 793                                  --   (order does not matter)
 794       ic_loc   :: GivenLoc,      -- Binding location of the implication,
 795                                  --   which is also the location of all the
 796                                  --   given evidence variables
 797
 798       ic_wanted :: WantedConstraints,  -- The wanted
 799       ic_insol  :: Bool,               -- True iff insolubleWC ic_wanted is true
 800
 801       ic_binds  :: EvBindsVar   -- Points to the place to fill in the
 802                                 -- abstraction and bindings
 803     }
 804
 805 instance Outputable Implication where
 806   ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given
 807               , ic_wanted = wanted
 808               , ic_binds = binds, ic_loc = loc })
 809    = ptext (sLit "Implic") <+> braces
 810      (sep [ ptext (sLit "Untouchables = ") <+> ppr untch
 811           , ptext (sLit "Skolems = ") <+> ppr skols
 812           , ptext (sLit "Given = ") <+> pprEvVars given
 813           , ptext (sLit "Wanted = ") <+> ppr wanted
 814           , ptext (sLit "Binds = ") <+> ppr binds
 815           , pprSkolInfo (ctLocOrigin loc)
 816           , ppr (ctLocSpan loc) ])
 817 \end{code}
 818
 819 Note [Skolems in an implication]
 820 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 821 The skolems in an implication are not there to perform a skolem escape
 822 check.  That happens because all the environment variables are in the
 823 untouchables, and therefore cannot be unified with anything at all,
 824 let alone the skolems.
 825
 826 Instead, ic_skols is used only when considering floating a constraint
 827 outside the implication in TcSimplify.floatEqualities or
 828 TcSimplify.approximateImplications
 829
 830 Note [Insoluble constraints]
 831 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 832 Some of the errors that we get during canonicalization are best
 833 reported when all constraints have been simplified as much as
 834 possible. For instance, assume that during simplification the
 835 following constraints arise:
 836
 837  [Wanted]   F alpha ~  uf1
 838  [Wanted]   beta ~ uf1 beta
 839
 840 When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail
 841 we will simply see a message:
 842     'Can't construct the infinite type  beta ~ uf1 beta'
 843 and the user has no idea what the uf1 variable is.
 844
 845 Instead our plan is that we will NOT fail immediately, but:
 846     (1) Record the "frozen" error in the ic_insols field
 847     (2) Isolate the offending constraint from the rest of the inerts
 848     (3) Keep on simplifying/canonicalizing
 849
 850 At the end, we will hopefully have substituted uf1 := F alpha, and we
 851 will be able to report a more informative error:
 852     'Can't construct the infinite type beta ~ F alpha beta'
 853
 854 %************************************************************************
 855 %*                                                                      *
 856             EvVarX, WantedEvVar, FlavoredEvVar
 857 %*                                                                      *
 858 %************************************************************************
 859
 860 \begin{code}
 861 data EvVarX a = EvVarX EvVar a
 862      -- An evidence variable with accompanying info
 863
 864 type WantedEvVar   = EvVarX WantedLoc     -- The location where it arose
 865 type FlavoredEvVar = EvVarX CtFlavor
 866
 867 instance Outputable (EvVarX a) where
 868   ppr (EvVarX ev _) = pprEvVarWithType ev
 869   -- If you want to see the associated info,
 870   -- use a more specific printing function
 871
 872 mkEvVarX :: EvVar -> a -> EvVarX a
 873 mkEvVarX = EvVarX
 874
 875 evVarOf :: EvVarX a -> EvVar
 876 evVarOf (EvVarX ev _) = ev
 877
 878 evVarX :: EvVarX a -> a
 879 evVarX (EvVarX _ a) = a
 880
 881 evVarOfPred :: EvVarX a -> PredType
 882 evVarOfPred wev = evVarPred (evVarOf wev)
 883
 884 wantedToFlavored :: WantedEvVar -> FlavoredEvVar
 885 wantedToFlavored (EvVarX v wl) = EvVarX v (Wanted wl)
 886
 887 keepWanted :: Bag FlavoredEvVar -> Bag WantedEvVar
 888 keepWanted flevs
 889   = foldrBag keep_wanted emptyBag flevs
 890     -- Important: use fold*r*Bag to preserve the order of the evidence variables.
 891   where
 892     keep_wanted :: FlavoredEvVar -> Bag WantedEvVar -> Bag WantedEvVar
 893     keep_wanted (EvVarX ev (Wanted wloc)) r = consBag (EvVarX ev wloc) r
 894     keep_wanted _                         r = r
 895 \end{code}
 896
 897
 898 \begin{code}
 899 pprEvVars :: [EvVar] -> SDoc    -- Print with their types
 900 pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)
 901
 902 pprEvVarTheta :: [EvVar] -> SDoc
 903 pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
 904
 905 pprEvVarWithType :: EvVar -> SDoc
 906 pprEvVarWithType v = ppr v <+> dcolon <+> pprPred (evVarPred v)
 907
 908 pprWantedsWithLocs :: WantedConstraints -> SDoc
 909 pprWantedsWithLocs wcs
 910   =  vcat [ pprBag pprWantedEvVarWithLoc (wc_flat wcs)
 911           , pprBag ppr (wc_impl wcs)
 912           , pprBag ppr (wc_insol wcs) ]
 913
 914 pprWantedEvVarWithLoc, pprWantedEvVar :: WantedEvVar -> SDoc
 915 pprWantedEvVarWithLoc (EvVarX v loc) = hang (pprEvVarWithType v)
 916                                           2 (pprArisingAt loc)
 917 pprWantedEvVar        (EvVarX v _)   = pprEvVarWithType v
 918 \end{code}
 919
 920 %************************************************************************
 921 %*                                                                      *
 922             CtLoc
 923 %*                                                                      *
 924 %************************************************************************
 925
 926 \begin{code}
 927 data CtFlavor
 928   = Given GivenLoc GivenKind -- We have evidence for this constraint in TcEvBinds
 929   | Derived WantedLoc        -- Derived's are just hints for unifications
 930   | Wanted WantedLoc         -- We have no evidence bindings for this constraint.
 931
 932 data GivenKind
 933   = GivenOrig   -- Originates in some given, such as signature or pattern match
 934   | GivenSolved -- Is given as result of being solved, maybe provisionally on
 935                 -- some other wanted constraints.
 936
 937 instance Outputable CtFlavor where
 938   ppr (Given _ GivenOrig)   = ptext (sLit "[G]")
 939   ppr (Given _ GivenSolved) = ptext (sLit "[S]") -- Print [S] for Given/Solved's
 940   ppr (Wanted {})           = ptext (sLit "[W]")
 941   ppr (Derived {})          = ptext (sLit "[D]")
 942
 943 pprFlavorArising :: CtFlavor -> SDoc
 944 pprFlavorArising (Derived wl)   = pprArisingAt wl
 945 pprFlavorArising (Wanted  wl)   = pprArisingAt wl
 946 pprFlavorArising (Given gl _)   = pprArisingAt gl
 947
 948 isWanted :: CtFlavor -> Bool
 949 isWanted (Wanted {}) = True
 950 isWanted _           = False
 951
 952 isGivenOrSolved :: CtFlavor -> Bool
 953 isGivenOrSolved (Given {}) = True
 954 isGivenOrSolved _ = False
 955
 956 isGiven_maybe :: CtFlavor -> Maybe GivenKind
 957 isGiven_maybe (Given _ gk) = Just gk
 958 isGiven_maybe _            = Nothing
 959
 960 isDerived :: CtFlavor -> Bool
 961 isDerived (Derived {}) = True
 962 isDerived _            = False
 963 \end{code}
 964
 965 %************************************************************************
 966 %*                                                                      *
 967             CtLoc
 968 %*                                                                      *
 969 %************************************************************************
 970
 971 The 'CtLoc' gives information about where a constraint came from.
 972 This is important for decent error message reporting because
 973 dictionaries don't appear in the original source code.
 974 type will evolve...
 975
 976 \begin{code}
 977 data CtLoc orig = CtLoc orig SrcSpan [ErrCtxt]
 978
 979 type WantedLoc = CtLoc CtOrigin      -- Instantiation for wanted constraints
 980 type GivenLoc  = CtLoc SkolemInfo    -- Instantiation for given constraints
 981
 982 ctLocSpan :: CtLoc o -> SrcSpan
 983 ctLocSpan (CtLoc _ s _) = s
 984
 985 ctLocOrigin :: CtLoc o -> o
 986 ctLocOrigin (CtLoc o _ _) = o
 987
 988 setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
 989 setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
 990
 991 pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig
 992 pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs)
 993
 994 pprArising :: CtOrigin -> SDoc
 995 -- Used for the main, top-level error message
 996 -- We've done special processing for TypeEq and FunDep origins
 997 pprArising (TypeEqOrigin {}) = empty
 998 pprArising FunDepOrigin      = empty
 999 pprArising orig              = text "arising from" <+> ppr orig
1000
1001 pprArisingAt :: Outputable o => CtLoc o -> SDoc
1002 pprArisingAt (CtLoc o s _) = sep [ text "arising from" <+> ppr o
1003                                  , text "at" <+> ppr s]
1004 \end{code}
1005
1006 %************************************************************************
1007 %*                                                                      *
1008                 SkolemInfo
1009 %*                                                                      *
1010 %************************************************************************
1011
1012 \begin{code}
1013 -- SkolemInfo gives the origin of *given* constraints
1014 --   a) type variables are skolemised
1015 --   b) an implication constraint is generated
1016 data SkolemInfo
1017   = SigSkol UserTypeCtxt        -- A skolem that is created by instantiating
1018             Type                -- a programmer-supplied type signature
1019                                 -- Location of the binding site is on the TyVar
1020
1021         -- The rest are for non-scoped skolems
1022   | ClsSkol Class       -- Bound at a class decl
1023   | InstSkol            -- Bound at an instance decl
1024   | DataSkol            -- Bound at a data type declaration
1025   | FamInstSkol         -- Bound at a family instance decl
1026   | PatSkol             -- An existential type variable bound by a pattern for
1027       DataCon           -- a data constructor with an existential type.
1028       (HsMatchContext Name)
1029              -- e.g.   data T = forall a. Eq a => MkT a
1030              --        f (MkT x) = ...
1031              -- The pattern MkT x will allocate an existential type
1032              -- variable for 'a'.
1033
1034   | ArrowSkol           -- An arrow form (see TcArrows)
1035
1036   | IPSkol [IPName Name]  -- Binding site of an implicit parameter
1037
1038   | RuleSkol RuleName   -- The LHS of a RULE
1039
1040   | InferSkol [(Name,TcType)]
1041                         -- We have inferred a type for these (mutually-recursivive)
1042                         -- polymorphic Ids, and are now checking that their RHS
1043                         -- constraints are satisfied.
1044
1045   | BracketSkol         -- Template Haskell bracket
1046
1047   | UnkSkol             -- Unhelpful info (until I improve it)
1048
1049 instance Outputable SkolemInfo where
1050   ppr = pprSkolInfo
1051
1052 pprSkolInfo :: SkolemInfo -> SDoc
1053 -- Complete the sentence "is a rigid type variable bound by..."
1054 pprSkolInfo (SigSkol (FunSigCtxt f) ty)
1055                             = hang (ptext (sLit "the type signature for"))
1056                                  2 (ppr f <+> dcolon <+> ppr ty)
1057 pprSkolInfo (SigSkol cx ty) = hang (pprUserTypeCtxt cx <> colon)
1058                                  2 (ppr ty)
1059 pprSkolInfo (IPSkol ips)    = ptext (sLit "the implicit-parameter bindings for")
1060                               <+> pprWithCommas ppr ips
1061 pprSkolInfo (ClsSkol cls)   = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
1062 pprSkolInfo InstSkol        = ptext (sLit "the instance declaration")
1063 pprSkolInfo DataSkol        = ptext (sLit "the data type declaration")
1064 pprSkolInfo FamInstSkol     = ptext (sLit "the family instance declaration")
1065 pprSkolInfo BracketSkol     = ptext (sLit "a Template Haskell bracket")
1066 pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
1067 pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
1068 pprSkolInfo (PatSkol dc mc)  = sep [ ptext (sLit "a pattern with constructor")
1069                                    , nest 2 $ ppr dc <+> dcolon
1070                                               <+> ppr (dataConUserType dc) <> comma
1071                                   , ptext (sLit "in") <+> pprMatchContext mc ]
1072 pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
1073                                   , vcat [ ppr name <+> dcolon <+> ppr ty
1074                                          | (name,ty) <- ids ]]
1075
1076 -- UnkSkol
1077 -- For type variables the others are dealt with by pprSkolTvBinding.
1078 -- For Insts, these cases should not happen
1079 pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
1080 \end{code}
1081
1082
1083 %************************************************************************
1084 %*                                                                      *
1085             CtOrigin
1086 %*                                                                      *
1087 %************************************************************************
1088
1089 \begin{code}
1090 -- CtOrigin gives the origin of *wanted* constraints
1091 data CtOrigin
1092   = OccurrenceOf Name           -- Occurrence of an overloaded identifier
1093   | AppOrigin                   -- An application of some kind
1094
1095   | SpecPragOrigin Name         -- Specialisation pragma for identifier
1096
1097   | TypeEqOrigin EqOrigin
1098
1099   | IPOccOrigin  (IPName Name)  -- Occurrence of an implicit parameter
1100
1101   | LiteralOrigin (HsOverLit Name)      -- Occurrence of a literal
1102   | NegateOrigin                        -- Occurrence of syntactic negation
1103
1104   | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
1105   | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
1106   | SectionOrigin
1107   | TupleOrigin                        -- (..,..)
1108   | ExprSigOrigin       -- e :: ty
1109   | PatSigOrigin        -- p :: ty
1110   | PatOrigin           -- Instantiating a polytyped pattern at a constructor
1111   | RecordUpdOrigin
1112   | ViewPatOrigin
1113
1114   | ScOrigin            -- Typechecking superclasses of an instance declaration
1115   | DerivOrigin         -- Typechecking deriving
1116   | StandAloneDerivOrigin -- Typechecking stand-alone deriving
1117   | DefaultOrigin       -- Typechecking a default decl
1118   | DoOrigin            -- Arising from a do expression
1119   | MCompOrigin         -- Arising from a monad comprehension
1120   | IfOrigin            -- Arising from an if statement
1121   | ProcOrigin          -- Arising from a proc expression
1122   | AnnOrigin           -- An annotation
1123   | FunDepOrigin
1124
1125 data EqOrigin
1126   = UnifyOrigin
1127        { uo_actual   :: TcType
1128        , uo_expected :: TcType }
1129
1130 instance Outputable CtOrigin where
1131   ppr orig = pprO orig
1132
1133 pprO :: CtOrigin -> SDoc
1134 pprO (OccurrenceOf name)   = hsep [ptext (sLit "a use of"), quotes (ppr name)]
1135 pprO AppOrigin             = ptext (sLit "an application")
1136 pprO (SpecPragOrigin name) = hsep [ptext (sLit "a specialisation pragma for"), quotes (ppr name)]
1137 pprO (IPOccOrigin name)    = hsep [ptext (sLit "a use of implicit parameter"), quotes (ppr name)]
1138 pprO RecordUpdOrigin       = ptext (sLit "a record update")
1139 pprO ExprSigOrigin         = ptext (sLit "an expression type signature")
1140 pprO PatSigOrigin          = ptext (sLit "a pattern type signature")
1141 pprO PatOrigin             = ptext (sLit "a pattern")
1142 pprO ViewPatOrigin         = ptext (sLit "a view pattern")
1143 pprO IfOrigin              = ptext (sLit "an if statement")
1144 pprO (LiteralOrigin lit)   = hsep [ptext (sLit "the literal"), quotes (ppr lit)]
1145 pprO (ArithSeqOrigin seq)  = hsep [ptext (sLit "the arithmetic sequence"), quotes (ppr seq)]
1146 pprO (PArrSeqOrigin seq)   = hsep [ptext (sLit "the parallel array sequence"), quotes (ppr seq)]
1147 pprO SectionOrigin         = ptext (sLit "an operator section")
1148 pprO TupleOrigin           = ptext (sLit "a tuple")
1149 pprO NegateOrigin          = ptext (sLit "a use of syntactic negation")
1150 pprO ScOrigin              = ptext (sLit "the superclasses of an instance declaration")
1151 pprO DerivOrigin           = ptext (sLit "the 'deriving' clause of a data type declaration")
1152 pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
1153 pprO DefaultOrigin         = ptext (sLit "a 'default' declaration")
1154 pprO DoOrigin              = ptext (sLit "a do statement")
1155 pprO MCompOrigin           = ptext (sLit "a statement in a monad comprehension")
1156 pprO ProcOrigin            = ptext (sLit "a proc expression")
1157 pprO (TypeEqOrigin eq)     = ptext (sLit "an equality") <+> ppr eq
1158 pprO AnnOrigin             = ptext (sLit "an annotation")
1159 pprO FunDepOrigin          = ptext (sLit "a functional dependency")
1160
1161 instance Outputable EqOrigin where
1162   ppr (UnifyOrigin t1 t2) = ppr t1 <+> char '~' <+> ppr t2
1163 \end{code}
1164