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