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_hetMetLevel  :: [TyVar],    -- The current environment classifier level (list-of-names)
 377         tcl_env  :: TcTypeEnv,    -- The local type environment: Ids and
 378                                   -- TyVars defined in this module
 379
 380         tcl_tyvars :: TcRef TcTyVarSet, -- The "global tyvars"
 381                         -- Namely, the in-scope TyVars bound in tcl_env,
 382                         -- plus the tyvars mentioned in the types of Ids bound
 383                         -- in tcl_lenv.
 384                         -- Why mutable? see notes with tcGetGlobalTyVars
 385
 386         tcl_lie   :: TcRef WantedConstraints,    -- Place to accumulate type constraints
 387
 388         -- TcMetaTyVars have
 389         tcl_meta  :: TcRef Unique,  -- The next free unique for TcMetaTyVars
 390                                     -- Guaranteed to be allocated linearly
 391         tcl_untch :: Unique         -- Any TcMetaTyVar with
 392                                     --     unique >= tcl_untch is touchable
 393                                     --     unique <  tcl_untch is untouchable
 394     }
 395
 396 type TcTypeEnv = NameEnv TcTyThing
 397
 398
 399 {- Note [Given Insts]
 400    ~~~~~~~~~~~~~~~~~~
 401 Because of GADTs, we have to pass inwards the Insts provided by type signatures
 402 and existential contexts. Consider
 403         data T a where { T1 :: b -> b -> T [b] }
 404         f :: Eq a => T a -> Bool
 405         f (T1 x y) = [x]==[y]
 406
 407 The constructor T1 binds an existential variable 'b', and we need Eq [b].
 408 Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we
 409 pass it inwards.
 410
 411 -}
 412
 413 ---------------------------
 414 -- Template Haskell stages and levels
 415 ---------------------------
 416
 417 data ThStage    -- See Note [Template Haskell state diagram] in TcSplice
 418   = Splice      -- Top-level splicing
 419                 -- This code will be run *at compile time*;
 420                 --   the result replaces the splice
 421                 -- Binding level = 0
 422
 423   | Comp        -- Ordinary Haskell code
 424                 -- Binding level = 1
 425
 426   | Brack                       -- Inside brackets
 427       ThStage                   --   Binding level = level(stage) + 1
 428       (TcRef [PendingSplice])   --   Accumulate pending splices here
 429       (TcRef WantedConstraints) --     and type constraints here
 430
 431 topStage, topAnnStage, topSpliceStage :: ThStage
 432 topStage       = Comp
 433 topAnnStage    = Splice
 434 topSpliceStage = Splice
 435
 436 instance Outputable ThStage where
 437    ppr Splice        = text "Splice"
 438    ppr Comp          = text "Comp"
 439    ppr (Brack s _ _) = text "Brack" <> parens (ppr s)
 440
 441 type ThLevel = Int
 442         -- See Note [Template Haskell levels] in TcSplice
 443         -- Incremented when going inside a bracket,
 444         -- decremented when going inside a splice
 445         -- NB: ThLevel is one greater than the 'n' in Fig 2 of the
 446         --     original "Template meta-programming for Haskell" paper
 447
 448 impLevel, outerLevel :: ThLevel
 449 impLevel = 0    -- Imported things; they can be used inside a top level splice
 450 outerLevel = 1  -- Things defined outside brackets
 451 -- NB: Things at level 0 are not *necessarily* imported.
 452 --      eg  $( \b -> ... )   here b is bound at level 0
 453 --
 454 -- For example:
 455 --      f = ...
 456 --      g1 = $(map ...)         is OK
 457 --      g2 = $(f ...)           is not OK; because we havn't compiled f yet
 458
 459 thLevel :: ThStage -> ThLevel
 460 thLevel Splice        = 0
 461 thLevel Comp          = 1
 462 thLevel (Brack s _ _) = thLevel s + 1
 463
 464 ---------------------------
 465 -- Arrow-notation context
 466 ---------------------------
 467
 468 {-
 469 In arrow notation, a variable bound by a proc (or enclosed let/kappa)
 470 is not in scope to the left of an arrow tail (-<) or the head of (|..|).
 471 For example
 472
 473         proc x -> (e1 -< e2)
 474
 475 Here, x is not in scope in e1, but it is in scope in e2.  This can get
 476 a bit complicated:
 477
 478         let x = 3 in
 479         proc y -> (proc z -> e1) -< e2
 480
 481 Here, x and z are in scope in e1, but y is not.  We implement this by
 482 recording the environment when passing a proc (using newArrowScope),
 483 and returning to that (using escapeArrowScope) on the left of -< and the
 484 head of (|..|).
 485 -}
 486
 487 data ArrowCtxt
 488   = NoArrowCtxt
 489   | ArrowCtxt (Env TcGblEnv TcLclEnv)
 490
 491 -- Record the current environment (outside a proc)
 492 newArrowScope :: TcM a -> TcM a
 493 newArrowScope
 494   = updEnv $ \env ->
 495         env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } }
 496
 497 -- Return to the stored environment (from the enclosing proc)
 498 escapeArrowScope :: TcM a -> TcM a
 499 escapeArrowScope
 500   = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
 501         NoArrowCtxt -> env
 502         ArrowCtxt env' -> env'
 503
 504 ---------------------------
 505 -- TcTyThing
 506 ---------------------------
 507
 508 data TcTyThing
 509   = AGlobal TyThing             -- Used only in the return type of a lookup
 510
 511   | ATcId   {           -- Ids defined in this module; may not be fully zonked
 512         tct_id    :: TcId,
 513         tct_level :: ThLevel,
 514         tct_hetMetLevel :: [TyVar]
 515     }
 516
 517   | ATyVar  Name TcType         -- The type to which the lexically scoped type vaiable
 518                                 -- is currently refined. We only need the Name
 519                                 -- for error-message purposes; it is the corresponding
 520                                 -- Name in the domain of the envt
 521
 522   | AThing  TcKind              -- Used temporarily, during kind checking, for the
 523                                 --      tycons and clases in this recursive group
 524
 525 instance Outputable TcTyThing where     -- Debugging only
 526    ppr (AGlobal g)      = pprTyThing g
 527    ppr elt@(ATcId {})   = text "Identifier" <>
 528                           brackets (ppr (tct_id elt) <> dcolon
 529                                  <> ppr (varType (tct_id elt)) <> comma
 530                                  <+> ppr (tct_level elt)
 531                                  <+> ppr (tct_hetMetLevel elt))
 532    ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
 533    ppr (AThing k)       = text "AThing" <+> ppr k
 534
 535 pprTcTyThingCategory :: TcTyThing -> SDoc
 536 pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
 537 pprTcTyThingCategory (ATyVar {})     = ptext (sLit "Type variable")
 538 pprTcTyThingCategory (ATcId {})      = ptext (sLit "Local identifier")
 539 pprTcTyThingCategory (AThing {})     = ptext (sLit "Kinded thing")
 540 \end{code}
 541
 542 \begin{code}
 543 type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, Message))
 544         -- Monadic so that we have a chance
 545         -- to deal with bound type variables just before error
 546         -- message construction
 547
 548         -- Bool:  True <=> this is a landmark context; do not
 549         --                 discard it when trimming for display
 550 \end{code}
 551
 552
 553 %************************************************************************
 554 %*                                                                      *
 555         Operations over ImportAvails
 556 %*                                                                      *
 557 %************************************************************************
 558
 559 \begin{code}
 560 -- | 'ImportAvails' summarises what was imported from where, irrespective of
 561 -- whether the imported things are actually used or not.  It is used:
 562 --
 563 --  * when processing the export list,
 564 --
 565 --  * when constructing usage info for the interface file,
 566 --
 567 --  * to identify the list of directly imported modules for initialisation
 568 --    purposes and for optimised overlap checking of family instances,
 569 --
 570 --  * when figuring out what things are really unused
 571 --
 572 data ImportAvails
 573    = ImportAvails {
 574         imp_mods :: ModuleEnv [(ModuleName, Bool, SrcSpan)],
 575           -- ^ Domain is all directly-imported modules
 576           -- The 'ModuleName' is what the module was imported as, e.g. in
 577           -- @
 578           --     import Foo as Bar
 579           -- @
 580           -- it is @Bar@.
 581           --
 582           -- The 'Bool' means:
 583           --
 584           --  - @True@ => import was @import Foo ()@
 585           --
 586           --  - @False@ => import was some other form
 587           --
 588           -- Used
 589           --
 590           --   (a) to help construct the usage information in the interface
 591           --       file; if we import somethign we need to recompile if the
 592           --       export version changes
 593           --
 594           --   (b) to specify what child modules to initialise
 595           --
 596           -- We need a full ModuleEnv rather than a ModuleNameEnv here,
 597           -- because we might be importing modules of the same name from
 598           -- different packages. (currently not the case, but might be in the
 599           -- future).
 600
 601         imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),
 602           -- ^ Home-package modules needed by the module being compiled
 603           --
 604           -- It doesn't matter whether any of these dependencies
 605           -- are actually /used/ when compiling the module; they
 606           -- are listed if they are below it at all.  For
 607           -- example, suppose M imports A which imports X.  Then
 608           -- compiling M might not need to consult X.hi, but X
 609           -- is still listed in M's dependencies.
 610
 611         imp_dep_pkgs :: [PackageId],
 612           -- ^ Packages needed by the module being compiled, whether directly,
 613           -- or via other modules in this package, or via modules imported
 614           -- from other packages.
 615
 616         imp_orphs :: [Module],
 617           -- ^ Orphan modules below us in the import tree (and maybe including
 618           -- us for imported modules)
 619
 620         imp_finsts :: [Module]
 621           -- ^ Family instance modules below us in the import tree (and maybe
 622           -- including us for imported modules)
 623       }
 624
 625 mkModDeps :: [(ModuleName, IsBootInterface)]
 626           -> ModuleNameEnv (ModuleName, IsBootInterface)
 627 mkModDeps deps = foldl add emptyUFM deps
 628                where
 629                  add env elt@(m,_) = addToUFM env m elt
 630
 631 emptyImportAvails :: ImportAvails
 632 emptyImportAvails = ImportAvails { imp_mods     = emptyModuleEnv,
 633                                    imp_dep_mods = emptyUFM,
 634                                    imp_dep_pkgs = [],
 635                                    imp_orphs    = [],
 636                                    imp_finsts   = [] }
 637
 638 plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
 639 plusImportAvails
 640   (ImportAvails { imp_mods = mods1,
 641                   imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,
 642                   imp_orphs = orphs1, imp_finsts = finsts1 })
 643   (ImportAvails { imp_mods = mods2,
 644                   imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,
 645                   imp_orphs = orphs2, imp_finsts = finsts2 })
 646   = ImportAvails { imp_mods     = plusModuleEnv_C (++) mods1 mods2,
 647                    imp_dep_mods = plusUFM_C plus_mod_dep dmods1 dmods2,
 648                    imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
 649                    imp_orphs    = orphs1 `unionLists` orphs2,
 650                    imp_finsts   = finsts1 `unionLists` finsts2 }
 651   where
 652     plus_mod_dep (m1, boot1) (m2, boot2)
 653         = WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
 654                 -- Check mod-names match
 655           (m1, boot1 && boot2)  -- If either side can "see" a non-hi-boot interface, use that
 656 \end{code}
 657
 658 %************************************************************************
 659 %*                                                                      *
 660 \subsection{Where from}
 661 %*                                                                      *
 662 %************************************************************************
 663
 664 The @WhereFrom@ type controls where the renamer looks for an interface file
 665
 666 \begin{code}
 667 data WhereFrom
 668   = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})
 669   | ImportBySystem                      -- Non user import.
 670
 671 instance Outputable WhereFrom where
 672   ppr (ImportByUser is_boot) | is_boot     = ptext (sLit "{- SOURCE -}")
 673                              | otherwise   = empty
 674   ppr ImportBySystem                       = ptext (sLit "{- SYSTEM -}")
 675 \end{code}
 676
 677
 678 %************************************************************************
 679 %*                                                                      *
 680                 Wanted constraints
 681
 682      These are forced to be in TcRnTypes because
 683            TcLclEnv mentions WantedConstraints
 684            WantedConstraint mentions CtLoc
 685            CtLoc mentions ErrCtxt
 686            ErrCtxt mentions TcM
 687 %*                                                                      *
 688 v%************************************************************************
 689
 690 \begin{code}
 691 data WantedConstraints
 692   = WC { wc_flat  :: Bag WantedEvVar   -- Unsolved constraints, all wanted
 693        , wc_impl  :: Bag Implication
 694        , wc_insol :: Bag FlavoredEvVar -- Insoluble constraints, can be
 695                                        -- wanted, given, or derived
 696                                        -- See Note [Insoluble constraints]
 697     }
 698
 699 emptyWC :: WantedConstraints
 700 emptyWC = WC { wc_flat = emptyBag, wc_impl = emptyBag, wc_insol = emptyBag }
 701
 702 mkFlatWC :: Bag WantedEvVar -> WantedConstraints
 703 mkFlatWC wevs = WC { wc_flat = wevs, wc_impl = emptyBag, wc_insol = emptyBag }
 704
 705 isEmptyWC :: WantedConstraints -> Bool
 706 isEmptyWC (WC { wc_flat = f, wc_impl = i, wc_insol = n })
 707   = isEmptyBag f && isEmptyBag i && isEmptyBag n
 708
 709 insolubleWC :: WantedConstraints -> Bool
 710 -- True if there are any insoluble constraints in the wanted bag
 711 insolubleWC wc = not (isEmptyBag (wc_insol wc))
 712                || anyBag ic_insol (wc_impl wc)
 713
 714 andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints
 715 andWC (WC { wc_flat = f1, wc_impl = i1, wc_insol = n1 })
 716       (WC { wc_flat = f2, wc_impl = i2, wc_insol = n2 })
 717   = WC { wc_flat  = f1 `unionBags` f2
 718        , wc_impl  = i1 `unionBags` i2
 719        , wc_insol = n1 `unionBags` n2 }
 720
 721 addFlats :: WantedConstraints -> Bag WantedEvVar -> WantedConstraints
 722 addFlats wc wevs = wc { wc_flat = wc_flat wc `unionBags` wevs }
 723
 724 addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints
 725 addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }
 726
 727 instance Outputable WantedConstraints where
 728   ppr (WC {wc_flat = f, wc_impl = i, wc_insol = n})
 729    = ptext (sLit "WC") <+> braces (vcat
 730         [ if isEmptyBag f then empty else
 731           ptext (sLit "wc_flat =")  <+> pprBag pprWantedEvVar f
 732         , if isEmptyBag i then empty else
 733           ptext (sLit "wc_impl =")  <+> pprBag ppr i
 734         , if isEmptyBag n then empty else
 735           ptext (sLit "wc_insol =") <+> pprBag ppr n ])
 736
 737 pprBag :: (a -> SDoc) -> Bag a -> SDoc
 738 pprBag pp b = foldrBag (($$) . pp) empty b
 739 \end{code}
 740
 741
 742 \begin{code}
 743 data Untouchables = NoUntouchables
 744                   | TouchableRange
 745                           Unique  -- Low end
 746                           Unique  -- High end
 747  -- A TcMetaTyvar is *touchable* iff its unique u satisfies
 748  --   u >= low
 749  --   u < high
 750
 751 instance Outputable Untouchables where
 752   ppr NoUntouchables = ptext (sLit "No untouchables")
 753   ppr (TouchableRange low high) = ptext (sLit "Touchable range:") <+>
 754                                   ppr low <+> char '-' <+> ppr high
 755
 756 isNoUntouchables :: Untouchables -> Bool
 757 isNoUntouchables NoUntouchables      = True
 758 isNoUntouchables (TouchableRange {}) = False
 759
 760 inTouchableRange :: Untouchables -> TcTyVar -> Bool
 761 inTouchableRange NoUntouchables _ = True
 762 inTouchableRange (TouchableRange low high) tv
 763   = uniq >= low && uniq < high
 764   where
 765     uniq = varUnique tv
 766
 767 -- EvVar defined in module Var.lhs:
 768 -- Evidence variables include all *quantifiable* constraints
 769 --   dictionaries
 770 --   implicit parameters
 771 --   coercion variables
 772 \end{code}
 773
 774 %************************************************************************
 775 %*                                                                      *
 776                 Implication constraints
 777 %*                                                                      *
 778 %************************************************************************
 779
 780 \begin{code}
 781 data Implication
 782   = Implic {
 783       ic_untch :: Untouchables, -- Untouchables: unification variables
 784                                 -- free in the environment
 785       ic_env   :: TcTypeEnv,    -- The type environment
 786                                 -- Used only when generating error messages
 787           -- Generally, ic_untch is a superset of tvsof(ic_env)
 788           -- However, we don't zonk ic_env when zonking the Implication
 789           -- Instead we do that when generating a skolem-escape error message
 790
 791       ic_skols  :: TcTyVarSet,   -- Introduced skolems
 792                                  -- See Note [Skolems in an implication]
 793
 794       ic_given  :: [EvVar],      -- Given evidence variables
 795                                  --   (order does not matter)
 796       ic_loc   :: GivenLoc,      -- Binding location of the implication,
 797                                  --   which is also the location of all the
 798                                  --   given evidence variables
 799
 800       ic_wanted :: WantedConstraints,  -- The wanted
 801       ic_insol  :: Bool,               -- True iff insolubleWC ic_wanted is true
 802
 803       ic_binds  :: EvBindsVar   -- Points to the place to fill in the
 804                                 -- abstraction and bindings
 805     }
 806
 807 instance Outputable Implication where
 808   ppr (Implic { ic_untch = untch, ic_skols = skols, ic_given = given
 809               , ic_wanted = wanted
 810               , ic_binds = binds, ic_loc = loc })
 811    = ptext (sLit "Implic") <+> braces
 812      (sep [ ptext (sLit "Untouchables = ") <+> ppr untch
 813           , ptext (sLit "Skolems = ") <+> ppr skols
 814           , ptext (sLit "Given = ") <+> pprEvVars given
 815           , ptext (sLit "Wanted = ") <+> ppr wanted
 816           , ptext (sLit "Binds = ") <+> ppr binds
 817           , pprSkolInfo (ctLocOrigin loc)
 818           , ppr (ctLocSpan loc) ])
 819 \end{code}
 820
 821 Note [Skolems in an implication]
 822 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 823 The skolems in an implication are not there to perform a skolem escape
 824 check.  That happens because all the environment variables are in the
 825 untouchables, and therefore cannot be unified with anything at all,
 826 let alone the skolems.
 827
 828 Instead, ic_skols is used only when considering floating a constraint
 829 outside the implication in TcSimplify.floatEqualities or
 830 TcSimplify.approximateImplications
 831
 832 Note [Insoluble constraints]
 833 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 834 Some of the errors that we get during canonicalization are best
 835 reported when all constraints have been simplified as much as
 836 possible. For instance, assume that during simplification the
 837 following constraints arise:
 838
 839  [Wanted]   F alpha ~  uf1
 840  [Wanted]   beta ~ uf1 beta
 841
 842 When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail
 843 we will simply see a message:
 844     'Can't construct the infinite type  beta ~ uf1 beta'
 845 and the user has no idea what the uf1 variable is.
 846
 847 Instead our plan is that we will NOT fail immediately, but:
 848     (1) Record the "frozen" error in the ic_insols field
 849     (2) Isolate the offending constraint from the rest of the inerts
 850     (3) Keep on simplifying/canonicalizing
 851
 852 At the end, we will hopefully have substituted uf1 := F alpha, and we
 853 will be able to report a more informative error:
 854     'Can't construct the infinite type beta ~ F alpha beta'
 855
 856 %************************************************************************
 857 %*                                                                      *
 858             EvVarX, WantedEvVar, FlavoredEvVar
 859 %*                                                                      *
 860 %************************************************************************
 861
 862 \begin{code}
 863 data EvVarX a = EvVarX EvVar a
 864      -- An evidence variable with accompanying info
 865
 866 type WantedEvVar   = EvVarX WantedLoc     -- The location where it arose
 867 type FlavoredEvVar = EvVarX CtFlavor
 868
 869 instance Outputable (EvVarX a) where
 870   ppr (EvVarX ev _) = pprEvVarWithType ev
 871   -- If you want to see the associated info,
 872   -- use a more specific printing function
 873
 874 mkEvVarX :: EvVar -> a -> EvVarX a
 875 mkEvVarX = EvVarX
 876
 877 evVarOf :: EvVarX a -> EvVar
 878 evVarOf (EvVarX ev _) = ev
 879
 880 evVarX :: EvVarX a -> a
 881 evVarX (EvVarX _ a) = a
 882
 883 evVarOfPred :: EvVarX a -> PredType
 884 evVarOfPred wev = evVarPred (evVarOf wev)
 885
 886 wantedToFlavored :: WantedEvVar -> FlavoredEvVar
 887 wantedToFlavored (EvVarX v wl) = EvVarX v (Wanted wl)
 888
 889 keepWanted :: Bag FlavoredEvVar -> Bag WantedEvVar
 890 keepWanted flevs
 891   = foldrBag keep_wanted emptyBag flevs
 892     -- Important: use fold*r*Bag to preserve the order of the evidence variables.
 893   where
 894     keep_wanted :: FlavoredEvVar -> Bag WantedEvVar -> Bag WantedEvVar
 895     keep_wanted (EvVarX ev (Wanted wloc)) r = consBag (EvVarX ev wloc) r
 896     keep_wanted _                         r = r
 897 \end{code}
 898
 899
 900 \begin{code}
 901 pprEvVars :: [EvVar] -> SDoc    -- Print with their types
 902 pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)
 903
 904 pprEvVarTheta :: [EvVar] -> SDoc
 905 pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)
 906
 907 pprEvVarWithType :: EvVar -> SDoc
 908 pprEvVarWithType v = ppr v <+> dcolon <+> pprPred (evVarPred v)
 909
 910 pprWantedsWithLocs :: WantedConstraints -> SDoc
 911 pprWantedsWithLocs wcs
 912   =  vcat [ pprBag pprWantedEvVarWithLoc (wc_flat wcs)
 913           , pprBag ppr (wc_impl wcs)
 914           , pprBag ppr (wc_insol wcs) ]
 915
 916 pprWantedEvVarWithLoc, pprWantedEvVar :: WantedEvVar -> SDoc
 917 pprWantedEvVarWithLoc (EvVarX v loc) = hang (pprEvVarWithType v)
 918                                           2 (pprArisingAt loc)
 919 pprWantedEvVar        (EvVarX v _)   = pprEvVarWithType v
 920 \end{code}
 921
 922 %************************************************************************
 923 %*                                                                      *
 924             CtLoc
 925 %*                                                                      *
 926 %************************************************************************
 927
 928 \begin{code}
 929 data CtFlavor
 930   = Given   GivenLoc  -- We have evidence for this constraint in TcEvBinds
 931   | Derived WantedLoc
 932                       -- We have evidence for this constraint in TcEvBinds;
 933                       --   *however* this evidence can contain wanteds, so
 934                       --   it's valid only provisionally to the solution of
 935                       --   these wanteds
 936   | Wanted WantedLoc  -- We have no evidence bindings for this constraint.
 937
 938 -- data DerivedOrig = DerSC | DerInst | DerSelf
 939 -- Deriveds are either superclasses of other wanteds or deriveds, or partially
 940 -- solved wanteds from instances, or 'self' dictionaries containing yet wanted
 941 -- superclasses.
 942
 943 instance Outputable CtFlavor where
 944   ppr (Given {})   = ptext (sLit "[G]")
 945   ppr (Wanted {})  = ptext (sLit "[W]")
 946   ppr (Derived {}) = ptext (sLit "[D]")
 947 pprFlavorArising :: CtFlavor -> SDoc
 948 pprFlavorArising (Derived wl )  = pprArisingAt wl
 949 pprFlavorArising (Wanted  wl)   = pprArisingAt wl
 950 pprFlavorArising (Given gl)     = pprArisingAt gl
 951
 952 isWanted :: CtFlavor -> Bool
 953 isWanted (Wanted {}) = True
 954 isWanted _           = False
 955
 956 isGiven :: CtFlavor -> Bool
 957 isGiven (Given {}) = True
 958 isGiven _          = False
 959
 960 isDerived :: CtFlavor -> Bool
 961 isDerived (Derived {}) = True
 962 isDerived _            = False
 963 \end{code}
 964
 965 %************************************************************************
 966 %*                                                                      *
 967             CtLoc
 968 %*                                                                      *
 969 %************************************************************************
 970
 971 The 'CtLoc' gives information about where a constraint came from.
 972 This is important for decent error message reporting because
 973 dictionaries don't appear in the original source code.
 974 type will evolve...
 975
 976 \begin{code}
 977 data CtLoc orig = CtLoc orig SrcSpan [ErrCtxt]
 978
 979 type WantedLoc = CtLoc CtOrigin      -- Instantiation for wanted constraints
 980 type GivenLoc  = CtLoc SkolemInfo    -- Instantiation for given constraints
 981
 982 ctLocSpan :: CtLoc o -> SrcSpan
 983 ctLocSpan (CtLoc _ s _) = s
 984
 985 ctLocOrigin :: CtLoc o -> o
 986 ctLocOrigin (CtLoc o _ _) = o
 987
 988 setCtLocOrigin :: CtLoc o -> o' -> CtLoc o'
 989 setCtLocOrigin (CtLoc _ s c) o = CtLoc o s c
 990
 991 pushErrCtxt :: orig -> ErrCtxt -> CtLoc orig -> CtLoc orig
 992 pushErrCtxt o err (CtLoc _ s errs) = CtLoc o s (err:errs)
 993
 994 pprArising :: CtOrigin -> SDoc
 995 -- Used for the main, top-level error message
 996 -- We've done special processing for TypeEq and FunDep origins
 997 pprArising (TypeEqOrigin {}) = empty
 998 pprArising FunDepOrigin      = empty
 999 pprArising orig              = text "arising from" <+> ppr orig
1000
1001 pprArisingAt :: Outputable o => CtLoc o -> SDoc
1002 pprArisingAt (CtLoc o s _) = sep [ text "arising from" <+> ppr o
1003                                  , text "at" <+> ppr s]
1004 \end{code}
1005
1006 %************************************************************************
1007 %*                                                                      *
1008                 SkolemInfo
1009 %*                                                                      *
1010 %************************************************************************
1011
1012 \begin{code}
1013 -- SkolemInfo gives the origin of *given* constraints
1014 --   a) type variables are skolemised
1015 --   b) an implication constraint is generated
1016 data SkolemInfo
1017   = SigSkol UserTypeCtxt        -- A skolem that is created by instantiating
1018             Type                -- a programmer-supplied type signature
1019                                 -- Location of the binding site is on the TyVar
1020
1021         -- The rest are for non-scoped skolems
1022   | ClsSkol Class       -- Bound at a class decl
1023   | InstSkol            -- Bound at an instance decl
1024   | DataSkol            -- Bound at a data type declaration
1025   | FamInstSkol         -- Bound at a family instance decl
1026   | PatSkol             -- An existential type variable bound by a pattern for
1027       DataCon           -- a data constructor with an existential type.
1028       (HsMatchContext Name)
1029              -- e.g.   data T = forall a. Eq a => MkT a
1030              --        f (MkT x) = ...
1031              -- The pattern MkT x will allocate an existential type
1032              -- variable for 'a'.
1033
1034   | ArrowSkol           -- An arrow form (see TcArrows)
1035
1036   | IPSkol [IPName Name]  -- Binding site of an implicit parameter
1037
1038   | RuleSkol RuleName   -- The LHS of a RULE
1039
1040   | InferSkol [(Name,TcType)]
1041                         -- We have inferred a type for these (mutually-recursivive)
1042                         -- polymorphic Ids, and are now checking that their RHS
1043                         -- constraints are satisfied.
1044
1045   | BracketSkol         -- Template Haskell bracket
1046
1047   | UnkSkol             -- Unhelpful info (until I improve it)
1048
1049 instance Outputable SkolemInfo where
1050   ppr = pprSkolInfo
1051
1052 pprSkolInfo :: SkolemInfo -> SDoc
1053 -- Complete the sentence "is a rigid type variable bound by..."
1054 pprSkolInfo (SigSkol (FunSigCtxt f) ty)
1055                             = hang (ptext (sLit "the type signature for"))
1056                                  2 (ppr f <+> dcolon <+> ppr ty)
1057 pprSkolInfo (SigSkol cx ty) = hang (pprUserTypeCtxt cx <> colon)
1058                                  2 (ppr ty)
1059 pprSkolInfo (IPSkol ips)    = ptext (sLit "the implicit-parameter bindings for")
1060                               <+> pprWithCommas ppr ips
1061 pprSkolInfo (ClsSkol cls)   = ptext (sLit "the class declaration for") <+> quotes (ppr cls)
1062 pprSkolInfo InstSkol        = ptext (sLit "the instance declaration")
1063 pprSkolInfo DataSkol        = ptext (sLit "the data type declaration")
1064 pprSkolInfo FamInstSkol     = ptext (sLit "the family instance declaration")
1065 pprSkolInfo BracketSkol     = ptext (sLit "a Template Haskell bracket")
1066 pprSkolInfo (RuleSkol name) = ptext (sLit "the RULE") <+> doubleQuotes (ftext name)
1067 pprSkolInfo ArrowSkol       = ptext (sLit "the arrow form")
1068 pprSkolInfo (PatSkol dc mc)  = sep [ ptext (sLit "a pattern with constructor")
1069                                    , nest 2 $ ppr dc <+> dcolon
1070                                               <+> ppr (dataConUserType dc) <> comma
1071                                   , ptext (sLit "in") <+> pprMatchContext mc ]
1072 pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
1073                                   , vcat [ ppr name <+> dcolon <+> ppr ty
1074                                          | (name,ty) <- ids ]]
1075
1076 -- UnkSkol
1077 -- For type variables the others are dealt with by pprSkolTvBinding.
1078 -- For Insts, these cases should not happen
1079 pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) ptext (sLit "UnkSkol")
1080 \end{code}
1081
1082
1083 %************************************************************************
1084 %*                                                                      *
1085             CtOrigin
1086 %*                                                                      *
1087 %************************************************************************
1088
1089 \begin{code}
1090 -- CtOrigin gives the origin of *wanted* constraints
1091 data CtOrigin
1092   = OccurrenceOf Name           -- Occurrence of an overloaded identifier
1093   | AppOrigin                   -- An application of some kind
1094
1095   | SpecPragOrigin Name         -- Specialisation pragma for identifier
1096
1097   | TypeEqOrigin EqOrigin
1098
1099   | IPOccOrigin  (IPName Name)  -- Occurrence of an implicit parameter
1100
1101   | LiteralOrigin (HsOverLit Name)      -- Occurrence of a literal
1102   | NegateOrigin                        -- Occurrence of syntactic negation
1103
1104   | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
1105   | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
1106   | SectionOrigin
1107   | TupleOrigin                        -- (..,..)
1108   | ExprSigOrigin       -- e :: ty
1109   | PatSigOrigin        -- p :: ty
1110   | PatOrigin           -- Instantiating a polytyped pattern at a constructor
1111   | RecordUpdOrigin
1112   | ViewPatOrigin
1113
1114   | ScOrigin            -- Typechecking superclasses of an instance declaration
1115   | DerivOrigin         -- Typechecking deriving
1116   | StandAloneDerivOrigin -- Typechecking stand-alone deriving
1117   | DefaultOrigin       -- Typechecking a default decl
1118   | DoOrigin            -- Arising from a do expression
1119   | 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