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 Id       ( evVarPred )
  66 import Class    ( Class )
  67 import DataCon  ( DataCon, dataConUserType )
  68 import TcType
  69 import Annotations
  70 import InstEnv
  71 import FamInstEnv
  72 import IOEnv
  73 import RdrName
  74 import Name
  75 import NameEnv
  76 import NameSet
  77 import Var
  78 import VarEnv
  79 import Module
  80 import SrcLoc
  81 import VarSet
  82 import ErrUtils
  83 import UniqFM
  84 import UniqSupply
  85 import Unique
  86 import BasicTypes
  87 import Bag
  88 import Outputable
  89 import ListSetOps
  90 import FastString
  91
  92 import Data.Set (Set)
  93 \end{code}
  94
  95
  96 %************************************************************************
  97 %*                                                                      *
  98                Standard monad definition for TcRn
  99     All the combinators for the monad can be found in TcRnMonad
 100 %*                                                                      *
 101 %************************************************************************
 102
 103 The monad itself has to be defined here, because it is mentioned by ErrCtxt
 104
 105 \begin{code}
 106 type TcRef a     = IORef a
 107 type TcId        = Id                   -- Type may be a TcType  DV: WHAT??????????
 108 type TcIdSet     = IdSet
 109
 110
 111 type TcRnIf a b c = IOEnv (Env a b) c
 112 type IfM lcl a  = TcRnIf IfGblEnv lcl a         -- Iface stuff
 113
 114 type IfG a  = IfM () a                          -- Top level
 115 type IfL a  = IfM IfLclEnv a                    -- Nested
 116 type TcRn a = TcRnIf TcGblEnv TcLclEnv a
 117 type RnM  a = TcRn a            -- Historical
 118 type TcM  a = TcRn a            -- Historical
 119 \end{code}
 120
 121 Representation of type bindings to uninstantiated meta variables used during
 122 constraint solving.
 123
 124 \begin{code}
 125 data TcTyVarBind = TcTyVarBind TcTyVar TcType
 126
 127 type TcTyVarBinds = Bag TcTyVarBind
 128
 129 instance Outputable TcTyVarBind where
 130   ppr (TcTyVarBind tv ty) = ppr tv <+> text ":=" <+> ppr ty
 131 \end{code}
 132
 133
 134 %************************************************************************
 135 %*                                                                      *
 136                 The main environment types
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 \begin{code}
 141 data Env gbl lcl        -- Changes as we move into an expression
 142   = Env {
 143         env_top  :: HscEnv,     -- Top-level stuff that never changes
 144                                 -- Includes all info about imported things
 145
 146         env_us   :: {-# UNPACK #-} !(IORef UniqSupply),
 147                                 -- Unique supply for local varibles
 148
 149         env_gbl  :: gbl,        -- Info about things defined at the top level
 150                                 -- of the module being compiled
 151
 152         env_lcl  :: lcl         -- Nested stuff; changes as we go into
 153     }
 154
 155 -- TcGblEnv describes the top-level of the module at the
 156 -- point at which the typechecker is finished work.
 157 -- It is this structure that is handed on to the desugarer
 158
 159 data TcGblEnv
 160   = TcGblEnv {
 161         tcg_mod     :: Module,         -- ^ Module being compiled
 162         tcg_src     :: HscSource,
 163           -- ^ What kind of module (regular Haskell, hs-boot, ext-core)
 164
 165         tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming
 166         tcg_default :: Maybe [Type],
 167           -- ^ Types used for defaulting. @Nothing@ => no @default@ decl
 168
 169         tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module
 170         tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module
 171
 172         tcg_type_env :: TypeEnv,
 173           -- ^ Global type env for the module we are compiling now.  All
 174           -- TyCons and Classes (for this module) end up in here right away,
 175           -- along with their derived constructors, selectors.
 176           --
 177           -- (Ids defined in this module start in the local envt, though they
 178           --  move to the global envt during zonking)
 179
 180         tcg_type_env_var :: TcRef TypeEnv,
 181                 -- Used only to initialise the interface-file
 182                 -- typechecker in initIfaceTcRn, so that it can see stuff
 183                 -- bound in this module when dealing with hi-boot recursions
 184                 -- Updated at intervals (e.g. after dealing with types and classes)
 185
 186         tcg_inst_env     :: InstEnv,
 187           -- ^ Instance envt for /home-package/ modules; Includes the dfuns in
 188           -- tcg_insts
 189         tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
 190
 191                 -- Now a bunch of things about this module that are simply
 192                 -- accumulated, but never consulted until the end.
 193                 -- Nevertheless, it's convenient to accumulate them along
 194                 -- with the rest of the info from this module.
 195         tcg_exports :: [AvailInfo],     -- ^ What is exported
 196         tcg_imports :: ImportAvails,
 197           -- ^ Information about what was imported from where, including
 198           -- things bound in this module.
 199
 200         tcg_dus :: DefUses,
 201           -- ^ What is defined in this module and what is used.
 202           -- The latter is used to generate
 203           --
 204           --  (a) version tracking; no need to recompile if these things have
 205           --      not changed version stamp
 206           --
 207           --  (b) unused-import info
 208
 209         tcg_keep :: TcRef NameSet,
 210           -- ^ Locally-defined top-level names to keep alive.
 211           --
 212           -- "Keep alive" means give them an Exported flag, so that the
 213           -- simplifier does not discard them as dead code, and so that they
 214           -- are exposed in the interface file (but not to export to the
 215           -- user).
 216           --
 217           -- Some things, like dict-fun Ids and default-method Ids are "born"
 218           -- with the Exported flag on, for exactly the above reason, but some
 219           -- we only discover as we go.  Specifically:
 220           --
 221           --   * The to/from functions for generic data types
 222           --
 223           --   * Top-level variables appearing free in the RHS of an orphan
 224           --     rule
 225           --
 226           --   * Top-level variables appearing free in a TH bracket
 227
 228         tcg_th_used :: TcRef Bool,
 229           -- ^ @True@ <=> Template Haskell syntax used.
 230           --
 231           -- We need this so that we can generate a dependency on the
 232           -- Template Haskell package, becuase the desugarer is going
 233           -- to emit loads of references to TH symbols.  The reference
 234           -- is implicit rather than explicit, so we have to zap a
 235           -- mutable variable.
 236
 237         tcg_dfun_n  :: TcRef OccSet,
 238           -- ^ Allows us to choose unique DFun names.
 239
 240         -- The next fields accumulate the payload of the module
 241         -- The binds, rules and foreign-decl fiels are collected
 242         -- initially in un-zonked form and are finally zonked in tcRnSrcDecls
 243
 244         tcg_rn_exports :: Maybe [Located (IE Name)],
 245         tcg_rn_imports :: [LImportDecl Name],
 246                 -- Keep the renamed imports regardless.  They are not
 247                 -- voluminous and are needed if you want to report unused imports
 248
 249         tcg_used_rdrnames :: TcRef (Set RdrName),
 250                 -- The set of used *imported* (not locally-defined) RdrNames
 251                 -- Used only to report unused import declarations
 252
 253         tcg_rn_decls :: Maybe (HsGroup Name),
 254           -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed
 255           -- decls.
 256
 257         tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings
 258         tcg_binds     :: LHsBinds Id,       -- Value bindings in this module
 259         tcg_sigs      :: NameSet,           -- ...Top-level names that *lack* a signature
 260         tcg_imp_specs :: [LTcSpecPrag],     -- ...SPECIALISE prags for imported Ids
 261         tcg_warns     :: Warnings,          -- ...Warnings and deprecations
 262         tcg_anns      :: [Annotation],      -- ...Annotations
 263         tcg_insts     :: [Instance],        -- ...Instances
 264         tcg_fam_insts :: [FamInst],         -- ...Family instances
 265         tcg_rules     :: [LRuleDecl Id],    -- ...Rules
 266         tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
 267         tcg_vects     :: [LVectDecl Id],    -- ...Vectorisation declarations
 268
 269         tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs
 270         tcg_hpc       :: AnyHpcUsage,        -- ^ @True@ if any part of the
 271                                              --  prog uses hpc instrumentation.
 272
 273         tcg_main      :: Maybe Name          -- ^ The Name of the main
 274                                              -- function, if this module is
 275                                              -- the main module.
 276     }
 277
 278 data RecFieldEnv
 279   = RecFields (NameEnv [Name])  -- Maps a constructor name *in this module*
 280                                 -- to the fields for that constructor
 281               NameSet           -- Set of all fields declared *in this module*;
 282                                 -- used to suppress name-shadowing complaints
 283                                 -- when using record wild cards
 284                                 -- E.g.  let fld = e in C {..}
 285         -- This is used when dealing with ".." notation in record
 286         -- construction and pattern matching.
 287         -- The FieldEnv deals *only* with constructors defined in *this*
 288         -- module.  For imported modules, we get the same info from the
 289         -- TypeEnv
 290 \end{code}
 291
 292 %************************************************************************
 293 %*                                                                      *
 294                 The interface environments
 295               Used when dealing with IfaceDecls
 296 %*                                                                      *
 297 %************************************************************************
 298
 299 \begin{code}
 300 data IfGblEnv
 301   = IfGblEnv {
 302         -- The type environment for the module being compiled,
 303         -- in case the interface refers back to it via a reference that
 304         -- was originally a hi-boot file.
 305         -- We need the module name so we can test when it's appropriate
 306         -- to look in this env.
 307         if_rec_types :: Maybe (Module, IfG TypeEnv)
 308                 -- Allows a read effect, so it can be in a mutable
 309                 -- variable; c.f. handling the external package type env
 310                 -- Nothing => interactive stuff, no loops possible
 311     }
 312
 313 data IfLclEnv
 314   = IfLclEnv {
 315         -- The module for the current IfaceDecl
 316         -- So if we see   f = \x -> x
 317         -- it means M.f = \x -> x, where M is the if_mod
 318         if_mod :: Module,
 319
 320         -- The field is used only for error reporting
 321         -- if (say) there's a Lint error in it
 322         if_loc :: SDoc,
 323                 -- Where the interface came from:
 324                 --      .hi file, or GHCi state, or ext core
 325                 -- plus which bit is currently being examined
 326
 327         if_tv_env  :: UniqFM TyVar,     -- Nested tyvar bindings
 328                                         -- (and coercions)
 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      These are forced to be in TcRnTypes because
 680            TcLclEnv mentions WantedConstraints
 681            WantedConstraint mentions CtLoc
 682            CtLoc mentions ErrCtxt
 683            ErrCtxt mentions TcM
 684 %*                                                                      *
 685 v%************************************************************************
 686
 687 \begin{code}
 688 data WantedConstraints
 689   = WC { wc_flat  :: Bag WantedEvVar   -- Unsolved constraints, all wanted
 690        , wc_impl  :: Bag Implication
 691        , wc_insol :: Bag FlavoredEvVar -- Insoluble constraints, can be
 692                                        -- wanted, given, or derived
 693                                        -- See Note [Insoluble constraints]
 694     }
 695
 696 emptyWC :: WantedConstraints
 697 emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
 698
 699 mkFlatWC :: Bag WantedEvVar -> WantedConstraints
 700 mkFlatWC wevs = WC { wc_flat = wevs, wc_impl = emptyBag, wc_insol = emptyBag }
 701
 702 isEmptyWC :: WantedConstraints -> Bool
 703 isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
 704   = isEmptyBag f && isEmptyBag i && isEmptyBag n
 705
 706 insolubleWC :: WantedConstraints -> Bool
 707 -- True if there are any insoluble constraints in the wanted bag
 708 insolubleWC wc = not (isEmptyBag (wc_insol wc))
 709                || anyBag ic_insol (wc_impl wc)
 710
 711 andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
 712 andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
 713       (WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
 714   = WC { wc_flat  = f1 `unionBags` f2
 715        , wc_impl  = i1 `unionBags` i2
 716        , wc_insol = n1 `unionBags` n2 }
 717
 718 addFlats :: WantedConstraints -> Bag WantedEvVar -> WantedConstraints
 719 addFlats wc wevs = wc { wc_flat = wc_flat wc `unionBags` wevs }
 720
 721 addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
 722 addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
 723
 724 instance Outputable WantedConstraints where
 725   ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
 726    = ptext (sLit "WC") <+> braces (vcat
 727         [ if isEmptyBag f then empty else
 728           ptext (sLit "wc_flat =")  <+> pprBag pprWantedEvVar f
 729         , if isEmptyBag i then empty else
 730           ptext (sLit "wc_impl =")  <+> pprBag ppr i
 731         , if isEmptyBag n then empty else
 732           ptext (sLit "wc_insol =") <+> pprBag ppr n ])
 733
 734 pprBag :: (a -> SDoc) -> Bag a -> SDoc
 735 pprBag pp b = foldrBag (($$) . pp) empty b
 736 \end{code}
 737
 738
 739 \begin{code}
 740 data Untouchables = NoUntouchables
 741                   | TouchableRange
 742                           Unique  -- Low end
 743                           Unique  -- High end
 744  -- A TcMetaTyvar is *touchable* iff its unique u satisfies
 745  --   u >= low
 746  --   u < high
 747
 748 instance Outputable Untouchables where
 749   ppr NoUntouchables = ptext (sLit "No untouchables")
 750   ppr (TouchableRange low high) = ptext (sLit "Touchable range:") <+>
 751                                   ppr low <+> char '-' <+> ppr high
 752
 753 isNoUntouchables :: Untouchables -> Bool
 754 isNoUntouchables NoUntouchables      = True
 755 isNoUntouchables (TouchableRange {}) = False
 756
 757 inTouchableRange :: Untouchables -> TcTyVar -> Bool
 758 inTouchableRange NoUntouchables _ = True
 759 inTouchableRange (TouchableRange low high) tv
 760   = uniq >= low && uniq < high
 761   where
 762     uniq = varUnique tv
 763
 764 -- EvVar defined in module Var.lhs:
 765 -- Evidence variables include all *quantifiable* constraints
 766 --   dictionaries
 767 --   implicit parameters
 768 --   coercion variables
 769 \end{code}
 770
 771 %************************************************************************
 772 %*                                                                      *
 773                 Implication constraints
 774 %*                                                                      *
 775 %************************************************************************
 776
 777 \begin{code}
 778 data Implication
 779   = Implic {
 780       ic_untch :: Untouchables, -- Untouchables: unification variables
 781                                 -- free in the environment
 782       ic_env   :: TcTypeEnv,    -- The type environment
 783                                 -- Used only when generating error messages
 784           -- Generally, ic_untch is a superset of tvsof(ic_env)
 785           -- However, we don't zonk ic_env when zonking the Implication
 786           -- Instead we do that when generating a skolem-escape error message
 787
 788       ic_skols  :: TcTyVarSet,   -- Introduced skolems
 789                                  -- See Note [Skolems in an implication]
 790
 791       ic_given  :: [EvVar],      -- Given evidence variables
 792                                  --   (order does not matter)
 793       ic_loc   :: GivenLoc,      -- Binding location of the implication,
 794                                  --   which is also the location of all the
 795                                  --   given evidence variables
 796
 797       ic_wanted :: WantedConstraints,  -- The wanted
 798       ic_insol  :: Bool,               -- True iff insolubleWC ic_wanted is true
 799
 800       ic_binds  :: EvBindsVar   -- Points to the place to fill in the
 801                                 -- abstraction and bindings
 802     }
 803
 804 instance Outputable Implication where
 805   ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given
 806               , ic_wanted = wanted
 807               , ic_binds = binds, ic_loc = loc })
 808    = ptext (sLit "Implic") <+> braces
 809      (sep [ ptext (sLit "Untouchables = ") <+> ppr untch
 810           , ptext (sLit "Skolems = ") <+> ppr skols
 811           , ptext (sLit "Given = ") <+> pprEvVars given
 812           , ptext (sLit "Wanted = ") <+> ppr wanted
 813           , ptext (sLit "Binds = ") <+> ppr binds
 814           , pprSkolInfo (ctLocOrigin loc)
 815           , ppr (ctLocSpan loc) ])
 816 \end{code}
 817
 818 Note [Skolems in an implication]
 819 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 820 The skolems in an implication are not there to perform a skolem escape
 821 check.  That happens because all the environment variables are in the
 822 untouchables, and therefore cannot be unified with anything at all,
 823 let alone the skolems.
 824
 825 Instead, ic_skols is used only when considering floating a constraint
 826 outside the implication in TcSimplify.floatEqualities or
 827 TcSimplify.approximateImplications
 828
 829 Note [Insoluble constraints]
 830 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 831 Some of the errors that we get during canonicalization are best
 832 reported when all constraints have been simplified as much as
 833 possible. For instance, assume that during simplification the
 834 following constraints arise:
 835
 836  [Wanted]   F alpha ~  uf1
 837  [Wanted]   beta ~ uf1 beta
 838
 839 When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail
 840 we will simply see a message:
 841     'Can't construct the infinite type  beta ~ uf1 beta'
 842 and the user has no idea what the uf1 variable is.
 843
 844 Instead our plan is that we will NOT fail immediately, but:
 845     (1) Record the "frozen" error in the ic_insols field
 846     (2) Isolate the offending constraint from the rest of the inerts
 847     (3) Keep on simplifying/canonicalizing
 848
 849 At the end, we will hopefully have substituted uf1 := F alpha, and we
 850 will be able to report a more informative error:
 851     'Can't construct the infinite type beta ~ F alpha beta'
 852
 853 %************************************************************************
 854 %*                                                                      *
 855             EvVarX, WantedEvVar, FlavoredEvVar
 856 %*                                                                      *
 857 %************************************************************************
 858
 859 \begin{code}
 860 data EvVarX a = EvVarX EvVar a
 861      -- An evidence variable with accompanying info
 862
 863 type WantedEvVar   = EvVarX WantedLoc     -- The location where it arose
 864 type FlavoredEvVar = EvVarX CtFlavor
 865
 866 instance Outputable (EvVarX a) where
 867   ppr (EvVarX ev _) = pprEvVarWithType ev
 868   -- If you want to see the associated info,
 869   -- use a more specific printing function
 870
 871 mkEvVarX :: EvVar -> a -> EvVarX a
 872 mkEvVarX = EvVarX
 873
 874 evVarOf :: EvVarX a -> EvVar
 875 evVarOf (EvVarX ev _) = ev
 876
 877 evVarX :: EvVarX a -> a
 878 evVarX (EvVarX _ a) = a
 879
 880 evVarOfPred :: EvVarX a -> PredType
 881 evVarOfPred wev = evVarPred (evVarOf wev)
 882
 883 wantedToFlavored :: WantedEvVar -> FlavoredEvVar
 884 wantedToFlavored (EvVarX v wl) = EvVarX v (Wanted wl)
 885
 886 keepWanted :: Bag FlavoredEvVar -> Bag WantedEvVar
 887 keepWanted flevs
 888   = foldrBag keep_wanted emptyBag flevs
 889     -- Important: use fold*r*Bag to preserve the order of the evidence variables.
 890   where
 891     keep_wanted :: FlavoredEvVar -> Bag WantedEvVar -> Bag WantedEvVar
 892     keep_wanted (EvVarX ev (Wanted wloc)) r = consBag (EvVarX ev wloc) r
 893     keep_wanted _                         r = r
 894 \end{code}
 895
 896
 897 \begin{code}
 898 pprEvVars :: [EvVar] -> SDoc    -- Print with their types
 899 pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)
 900
 901 pprEvVarTheta :: [EvVar] -> SDoc
 902 pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
 903
 904 pprEvVarWithType :: EvVar -> SDoc
 905 pprEvVarWithType v = ppr v <+> dcolon <+> pprPredTy (evVarPred v)
 906
 907 pprWantedsWithLocs :: WantedConstraints -> SDoc
 908 pprWantedsWithLocs wcs
 909   =  vcat [ pprBag pprWantedEvVarWithLoc (wc_flat wcs)
 910           , pprBag ppr (wc_impl wcs)
 911           , pprBag ppr (wc_insol wcs) ]
 912
 913 pprWantedEvVarWithLoc, pprWantedEvVar :: WantedEvVar -> SDoc
 914 pprWantedEvVarWithLoc (EvVarX v loc) = hang (pprEvVarWithType v)
 915                                           2 (pprArisingAt loc)
 916 pprWantedEvVar        (EvVarX v _)   = pprEvVarWithType v
 917 \end{code}
 918
 919 %************************************************************************
 920 %*                                                                      *
 921             CtLoc
 922 %*                                                                      *
 923 %************************************************************************
 924
 925 \begin{code}
 926 data CtFlavor
 927   = Given   GivenLoc  -- We have evidence for this constraint in TcEvBinds
 928   | Derived WantedLoc
 929                       -- We have evidence for this constraint in TcEvBinds;
 930                       --   *however* this evidence can contain wanteds, so
 931                       --   it's valid only provisionally to the solution of
 932                       --   these wanteds
 933   | Wanted WantedLoc  -- We have no evidence bindings for this constraint.
 934
 935 -- data DerivedOrig = DerSC | DerInst | DerSelf
 936 -- Deriveds are either superclasses of other wanteds or deriveds, or partially
 937 -- solved wanteds from instances, or 'self' dictionaries containing yet wanted
 938 -- superclasses.
 939
 940 instance Outputable CtFlavor where
 941   ppr (Given {})   = ptext (sLit "[G]")
 942   ppr (Wanted {})  = ptext (sLit "[W]")
 943   ppr (Derived {}) = ptext (sLit "[D]")
 944 pprFlavorArising :: CtFlavor -> SDoc
 945 pprFlavorArising (Derived wl )  = pprArisingAt wl
 946 pprFlavorArising (Wanted  wl)   = pprArisingAt wl
 947 pprFlavorArising (Given gl)     = pprArisingAt gl
 948
 949 isWanted :: CtFlavor -> Bool
 950 isWanted (Wanted {}) = True
 951 isWanted _           = False
 952
 953 isGiven :: CtFlavor -> Bool
 954 isGiven (Given {}) = True
 955 isGiven _          = False
 956
 957 isDerived :: CtFlavor -> Bool
 958 isDerived (Derived {}) = True
 959 isDerived _            = False
 960 \end{code}
 961
 962 %************************************************************************
 963 %*                                                                      *
 964             CtLoc
 965 %*                                                                      *
 966 %************************************************************************
 967
 968 The 'CtLoc' gives information about where a constraint came from.
 969 This is important for decent error message reporting because
 970 dictionaries don't appear in the original source code.
 971 type will evolve...
 972
 973 \begin{code}
 974 data CtLoc orig = CtLoc orig SrcSpan [ErrCtxt]
 975
 976 type WantedLoc = CtLoc CtOrigin      -- Instantiation for wanted constraints
 977 type GivenLoc  = CtLoc SkolemInfo    -- Instantiation for given constraints
 978
 979 ctLocSpan :: CtLoc o -> SrcSpan
 980 ctLocSpan (CtLoc _ s _) = s
 981
 982 ctLocOrigin :: CtLoc o -> o
 983 ctLocOrigin (CtLoc o _ _) = o
 984
 985 setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
 986 setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
 987
 988 pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig
 989 pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs)
 990
 991 pprArising :: CtOrigin -> SDoc
 992 -- Used for the main, top-level error message
 993 -- We've done special processing for TypeEq and FunDep origins
 994 pprArising (TypeEqOrigin {}) = empty
 995 pprArising FunDepOrigin      = empty
 996 pprArising orig              = text "arising from" <+> ppr orig
 997
 998 pprArisingAt :: Outputable o => CtLoc o -> SDoc
 999 pprArisingAt (CtLoc o s _) = sep [ text "arising from" <+> ppr o
1000                                  , text "at" <+> ppr s]
1001 \end{code}
1002
1003 %************************************************************************
1004 %*                                                                      *
1005                 SkolemInfo
1006 %*                                                                      *
1007 %************************************************************************
1008
1009 \begin{code}
1010 -- SkolemInfo gives the origin of *given* constraints
1011 --   a) type variables are skolemised
1012 --   b) an implication constraint is generated
1013 data SkolemInfo
1014   = SigSkol UserTypeCtxt        -- A skolem that is created by instantiating
1015             Type                -- a programmer-supplied type signature
1016                                 -- Location of the binding site is on the TyVar
1017
1018         -- The rest are for non-scoped skolems
1019   | ClsSkol Class       -- Bound at a class decl
1020   | InstSkol            -- Bound at an instance decl
1021   | DataSkol            -- Bound at a data type declaration
1022   | FamInstSkol         -- Bound at a family instance decl
1023   | PatSkol             -- An existential type variable bound by a pattern for
1024       DataCon           -- a data constructor with an existential type.
1025       (HsMatchContext Name)
1026              -- e.g.   data T = forall a. Eq a => MkT a
1027              --        f (MkT x) = ...
1028              -- The pattern MkT x will allocate an existential type
1029              -- variable for 'a'.
1030
1031   | ArrowSkol           -- An arrow form (see TcArrows)
1032
1033   | IPSkol [IPName Name]  -- Binding site of an implicit parameter
1034
1035   | RuleSkol RuleName   -- The LHS of a RULE
1036
1037   | InferSkol [(Name,TcType)]
1038                         -- We have inferred a type for these (mutually-recursivive)
1039                         -- polymorphic Ids, and are now checking that their RHS
1040                         -- constraints are satisfied.
1041
1042   | BracketSkol         -- Template Haskell bracket
1043
1044   | UnkSkol             -- Unhelpful info (until I improve it)
1045
1046 instance Outputable SkolemInfo where
1047   ppr = pprSkolInfo
1048
1049 pprSkolInfo :: SkolemInfo -> SDoc
1050 -- Complete the sentence "is a rigid type variable bound by..."
1051 pprSkolInfo (SigSkol (FunSigCtxt f) ty)
1052                             = hang (ptext (sLit "the type signature for"))
1053                                  2 (ppr f <+> dcolon <+> ppr ty)
1054 pprSkolInfo (SigSkol cx ty) = hang (pprUserTypeCtxt cx <> colon)
1055                                  2 (ppr ty)
1056 pprSkolInfo (IPSkol ips)    = ptext (sLit "the implicit-parameter bindings for")
1057                               <+> pprWithCommas ppr ips
1058 pprSkolInfo (ClsSkol cls)   = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
1059 pprSkolInfo InstSkol        = ptext (sLit "the instance declaration")
1060 pprSkolInfo DataSkol        = ptext (sLit "the data type declaration")
1061 pprSkolInfo FamInstSkol     = ptext (sLit "the family instance declaration")
1062 pprSkolInfo BracketSkol     = ptext (sLit "a Template Haskell bracket")
1063 pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
1064 pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
1065 pprSkolInfo (PatSkol dc mc)  = sep [ ptext (sLit "a pattern with constructor")
1066                                    , nest 2 $ ppr dc <+> dcolon
1067                                               <+> ppr (dataConUserType dc) <> comma
1068                                   , ptext (sLit "in") <+> pprMatchContext mc ]
1069 pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
1070                                   , vcat [ ppr name <+> dcolon <+> ppr ty
1071                                          | (name,ty) <- ids ]]
1072
1073 -- UnkSkol
1074 -- For type variables the others are dealt with by pprSkolTvBinding.
1075 -- For Insts, these cases should not happen
1076 pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
1077 \end{code}
1078
1079
1080 %************************************************************************
1081 %*                                                                      *
1082             CtOrigin
1083 %*                                                                      *
1084 %************************************************************************
1085
1086 \begin{code}
1087 -- CtOrigin gives the origin of *wanted* constraints
1088 data CtOrigin
1089   = OccurrenceOf Name           -- Occurrence of an overloaded identifier
1090   | AppOrigin                   -- An application of some kind
1091
1092   | SpecPragOrigin Name         -- Specialisation pragma for identifier
1093
1094   | TypeEqOrigin EqOrigin
1095
1096   | IPOccOrigin  (IPName Name)  -- Occurrence of an implicit parameter
1097
1098   | LiteralOrigin (HsOverLit Name)      -- Occurrence of a literal
1099   | NegateOrigin                        -- Occurrence of syntactic negation
1100
1101   | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
1102   | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
1103   | SectionOrigin
1104   | TupleOrigin                        -- (..,..)
1105   | ExprSigOrigin       -- e :: ty
1106   | PatSigOrigin        -- p :: ty
1107   | PatOrigin           -- Instantiating a polytyped pattern at a constructor
1108   | RecordUpdOrigin
1109   | ViewPatOrigin
1110
1111   | ScOrigin            -- Typechecking superclasses of an instance declaration
1112   | DerivOrigin         -- Typechecking deriving
1113   | StandAloneDerivOrigin -- Typechecking stand-alone deriving
1114   | DefaultOrigin       -- Typechecking a default decl
1115   | DoOrigin            -- Arising from a do expression
1116   | MCompOrigin         -- Arising from a monad comprehension
1117   | IfOrigin            -- Arising from an if statement
1118   | ProcOrigin          -- Arising from a proc expression
1119   | AnnOrigin           -- An annotation
1120   | FunDepOrigin
1121
1122 data EqOrigin
1123   = UnifyOrigin
1124        { uo_actual   :: TcType
1125        , uo_expected :: TcType }
1126
1127 instance Outputable CtOrigin where
1128   ppr orig = pprO orig
1129
1130 pprO :: CtOrigin -> SDoc
1131 pprO (OccurrenceOf name)   = hsep [ptext (sLit "a use of"), quotes (ppr name)]
1132 pprO AppOrigin             = ptext (sLit "an application")
1133 pprO (SpecPragOrigin name) = hsep [ptext (sLit "a specialisation pragma for"), quotes (ppr name)]
1134 pprO (IPOccOrigin name)    = hsep [ptext (sLit "a use of implicit parameter"), quotes (ppr name)]
1135 pprO RecordUpdOrigin       = ptext (sLit "a record update")
1136 pprO ExprSigOrigin         = ptext (sLit "an expression type signature")
1137 pprO PatSigOrigin          = ptext (sLit "a pattern type signature")
1138 pprO PatOrigin             = ptext (sLit "a pattern")
1139 pprO ViewPatOrigin         = ptext (sLit "a view pattern")
1140 pprO IfOrigin              = ptext (sLit "an if statement")
1141 pprO (LiteralOrigin lit)   = hsep [ptext (sLit "the literal"), quotes (ppr lit)]
1142 pprO (ArithSeqOrigin seq)  = hsep [ptext (sLit "the arithmetic sequence"), quotes (ppr seq)]
1143 pprO (PArrSeqOrigin seq)   = hsep [ptext (sLit "the parallel array sequence"), quotes (ppr seq)]
1144 pprO SectionOrigin         = ptext (sLit "an operator section")
1145 pprO TupleOrigin           = ptext (sLit "a tuple")
1146 pprO NegateOrigin          = ptext (sLit "a use of syntactic negation")
1147 pprO ScOrigin              = ptext (sLit "the superclasses of an instance declaration")
1148 pprO DerivOrigin           = ptext (sLit "the 'deriving' clause of a data type declaration")
1149 pprO StandAloneDerivOrigin = ptext (sLit "a 'deriving' declaration")
1150 pprO DefaultOrigin         = ptext (sLit "a 'default' declaration")
1151 pprO DoOrigin              = ptext (sLit "a do statement")
1152 pprO MCompOrigin           = ptext (sLit "a statement in a monad comprehension")
1153 pprO ProcOrigin            = ptext (sLit "a proc expression")
1154 pprO (TypeEqOrigin eq)     = ptext (sLit "an equality") <+> ppr eq
1155 pprO AnnOrigin             = ptext (sLit "an annotation")
1156 pprO FunDepOrigin          = ptext (sLit "a functional dependency")
1157
1158 instance Outputable EqOrigin where
1159   ppr (UnifyOrigin t1 t2) = ppr t1 <+> char '~' <+> ppr t2
1160 \end{code}
1161