1{- 2 3Describes the provenance of types as they flow through the type-checker. 4The datatypes here are mainly used for error message generation. 5 6-} 7 8{-# LANGUAGE CPP #-} 9 10module TcOrigin ( 11 -- UserTypeCtxt 12 UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe, 13 14 -- SkolemInfo 15 SkolemInfo(..), pprSigSkolInfo, pprSkolInfo, 16 17 -- CtOrigin 18 CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin, 19 isVisibleOrigin, toInvisibleOrigin, 20 pprCtOrigin, isGivenOrigin 21 22 ) where 23 24#include "GhclibHsVersions.h" 25 26import GhcPrelude 27 28import TcType 29 30import GHC.Hs 31 32import Id 33import DataCon 34import ConLike 35import TyCon 36import InstEnv 37import PatSyn 38 39import Module 40import Name 41import RdrName 42import qualified GHC.LanguageExtensions as LangExt 43import DynFlags 44 45import SrcLoc 46import FastString 47import Outputable 48import BasicTypes 49 50{- ********************************************************************* 51* * 52 UserTypeCtxt 53* * 54********************************************************************* -} 55 56------------------------------------- 57-- | UserTypeCtxt describes the origin of the polymorphic type 58-- in the places where we need an expression to have that type 59data UserTypeCtxt 60 = FunSigCtxt -- Function type signature, when checking the type 61 -- Also used for types in SPECIALISE pragmas 62 Name -- Name of the function 63 Bool -- True <=> report redundant constraints 64 -- This is usually True, but False for 65 -- * Record selectors (not important here) 66 -- * Class and instance methods. Here 67 -- the code may legitimately be more 68 -- polymorphic than the signature 69 -- generated from the class 70 -- declaration 71 72 | InfSigCtxt Name -- Inferred type for function 73 | ExprSigCtxt -- Expression type signature 74 | KindSigCtxt -- Kind signature 75 | StandaloneKindSigCtxt -- Standalone kind signature 76 Name -- Name of the type/class 77 | TypeAppCtxt -- Visible type application 78 | ConArgCtxt Name -- Data constructor argument 79 | TySynCtxt Name -- RHS of a type synonym decl 80 | PatSynCtxt Name -- Type sig for a pattern synonym 81 | PatSigCtxt -- Type sig in pattern 82 -- eg f (x::t) = ... 83 -- or (x::t, y) = e 84 | RuleSigCtxt Name -- LHS of a RULE forall 85 -- RULE "foo" forall (x :: a -> a). f (Just x) = ... 86 | ResSigCtxt -- Result type sig 87 -- f x :: t = .... 88 | ForSigCtxt Name -- Foreign import or export signature 89 | DefaultDeclCtxt -- Types in a default declaration 90 | InstDeclCtxt Bool -- An instance declaration 91 -- True: stand-alone deriving 92 -- False: vanilla instance declaration 93 | SpecInstCtxt -- SPECIALISE instance pragma 94 | ThBrackCtxt -- Template Haskell type brackets [t| ... |] 95 | GenSigCtxt -- Higher-rank or impredicative situations 96 -- e.g. (f e) where f has a higher-rank type 97 -- We might want to elaborate this 98 | GhciCtxt Bool -- GHCi command :kind <type> 99 -- The Bool indicates if we are checking the outermost 100 -- type application. 101 -- See Note [Unsaturated type synonyms in GHCi] in 102 -- TcValidity. 103 104 | ClassSCCtxt Name -- Superclasses of a class 105 | SigmaCtxt -- Theta part of a normal for-all type 106 -- f :: <S> => a -> a 107 | DataTyCtxt Name -- The "stupid theta" part of a data decl 108 -- data <S> => T a = MkT a 109 | DerivClauseCtxt -- A 'deriving' clause 110 | TyVarBndrKindCtxt Name -- The kind of a type variable being bound 111 | DataKindCtxt Name -- The kind of a data/newtype (instance) 112 | TySynKindCtxt Name -- The kind of the RHS of a type synonym 113 | TyFamResKindCtxt Name -- The result kind of a type family 114 115{- 116-- Notes re TySynCtxt 117-- We allow type synonyms that aren't types; e.g. type List = [] 118-- 119-- If the RHS mentions tyvars that aren't in scope, we'll 120-- quantify over them: 121-- e.g. type T = a->a 122-- will become type T = forall a. a->a 123-- 124-- With gla-exts that's right, but for H98 we should complain. 125-} 126 127 128pprUserTypeCtxt :: UserTypeCtxt -> SDoc 129pprUserTypeCtxt (FunSigCtxt n _) = text "the type signature for" <+> quotes (ppr n) 130pprUserTypeCtxt (InfSigCtxt n) = text "the inferred type for" <+> quotes (ppr n) 131pprUserTypeCtxt (RuleSigCtxt n) = text "a RULE for" <+> quotes (ppr n) 132pprUserTypeCtxt ExprSigCtxt = text "an expression type signature" 133pprUserTypeCtxt KindSigCtxt = text "a kind signature" 134pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n) 135pprUserTypeCtxt TypeAppCtxt = text "a type argument" 136pprUserTypeCtxt (ConArgCtxt c) = text "the type of the constructor" <+> quotes (ppr c) 137pprUserTypeCtxt (TySynCtxt c) = text "the RHS of the type synonym" <+> quotes (ppr c) 138pprUserTypeCtxt ThBrackCtxt = text "a Template Haskell quotation [t|...|]" 139pprUserTypeCtxt PatSigCtxt = text "a pattern type signature" 140pprUserTypeCtxt ResSigCtxt = text "a result type signature" 141pprUserTypeCtxt (ForSigCtxt n) = text "the foreign declaration for" <+> quotes (ppr n) 142pprUserTypeCtxt DefaultDeclCtxt = text "a type in a `default' declaration" 143pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration" 144pprUserTypeCtxt (InstDeclCtxt True) = text "a stand-alone deriving instance declaration" 145pprUserTypeCtxt SpecInstCtxt = text "a SPECIALISE instance pragma" 146pprUserTypeCtxt GenSigCtxt = text "a type expected by the context" 147pprUserTypeCtxt (GhciCtxt {}) = text "a type in a GHCi command" 148pprUserTypeCtxt (ClassSCCtxt c) = text "the super-classes of class" <+> quotes (ppr c) 149pprUserTypeCtxt SigmaCtxt = text "the context of a polymorphic type" 150pprUserTypeCtxt (DataTyCtxt tc) = text "the context of the data type declaration for" <+> quotes (ppr tc) 151pprUserTypeCtxt (PatSynCtxt n) = text "the signature for pattern synonym" <+> quotes (ppr n) 152pprUserTypeCtxt (DerivClauseCtxt) = text "a `deriving' clause" 153pprUserTypeCtxt (TyVarBndrKindCtxt n) = text "the kind annotation on the type variable" <+> quotes (ppr n) 154pprUserTypeCtxt (DataKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n) 155pprUserTypeCtxt (TySynKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n) 156pprUserTypeCtxt (TyFamResKindCtxt n) = text "the result kind for" <+> quotes (ppr n) 157 158isSigMaybe :: UserTypeCtxt -> Maybe Name 159isSigMaybe (FunSigCtxt n _) = Just n 160isSigMaybe (ConArgCtxt n) = Just n 161isSigMaybe (ForSigCtxt n) = Just n 162isSigMaybe (PatSynCtxt n) = Just n 163isSigMaybe _ = Nothing 164 165{- 166************************************************************************ 167* * 168 SkolemInfo 169* * 170************************************************************************ 171-} 172 173-- SkolemInfo gives the origin of *given* constraints 174-- a) type variables are skolemised 175-- b) an implication constraint is generated 176data SkolemInfo 177 = SigSkol -- A skolem that is created by instantiating 178 -- a programmer-supplied type signature 179 -- Location of the binding site is on the TyVar 180 -- See Note [SigSkol SkolemInfo] 181 UserTypeCtxt -- What sort of signature 182 TcType -- Original type signature (before skolemisation) 183 [(Name,TcTyVar)] -- Maps the original name of the skolemised tyvar 184 -- to its instantiated version 185 186 | SigTypeSkol UserTypeCtxt 187 -- like SigSkol, but when we're kind-checking the *type* 188 -- hence, we have less info 189 190 | ForAllSkol SDoc -- Bound by a user-written "forall". 191 192 | DerivSkol Type -- Bound by a 'deriving' clause; 193 -- the type is the instance we are trying to derive 194 195 | InstSkol -- Bound at an instance decl 196 | InstSC TypeSize -- A "given" constraint obtained by superclass selection. 197 -- If (C ty1 .. tyn) is the largest class from 198 -- which we made a superclass selection in the chain, 199 -- then TypeSize = sizeTypes [ty1, .., tyn] 200 -- See Note [Solving superclass constraints] in TcInstDcls 201 202 | FamInstSkol -- Bound at a family instance decl 203 | PatSkol -- An existential type variable bound by a pattern for 204 ConLike -- a data constructor with an existential type. 205 (HsMatchContext Name) 206 -- e.g. data T = forall a. Eq a => MkT a 207 -- f (MkT x) = ... 208 -- The pattern MkT x will allocate an existential type 209 -- variable for 'a'. 210 211 | ArrowSkol -- An arrow form (see TcArrows) 212 213 | IPSkol [HsIPName] -- Binding site of an implicit parameter 214 215 | RuleSkol RuleName -- The LHS of a RULE 216 217 | InferSkol [(Name,TcType)] 218 -- We have inferred a type for these (mutually-recursivive) 219 -- polymorphic Ids, and are now checking that their RHS 220 -- constraints are satisfied. 221 222 | BracketSkol -- Template Haskell bracket 223 224 | UnifyForAllSkol -- We are unifying two for-all types 225 TcType -- The instantiated type *inside* the forall 226 227 | TyConSkol TyConFlavour Name -- bound in a type declaration of the given flavour 228 229 | DataConSkol Name -- bound as an existential in a Haskell98 datacon decl or 230 -- as any variable in a GADT datacon decl 231 232 | ReifySkol -- Bound during Template Haskell reification 233 234 | QuantCtxtSkol -- Quantified context, e.g. 235 -- f :: forall c. (forall a. c a => c [a]) => blah 236 237 | UnkSkol -- Unhelpful info (until I improve it) 238 239instance Outputable SkolemInfo where 240 ppr = pprSkolInfo 241 242pprSkolInfo :: SkolemInfo -> SDoc 243-- Complete the sentence "is a rigid type variable bound by..." 244pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty 245pprSkolInfo (SigTypeSkol cx) = pprUserTypeCtxt cx 246pprSkolInfo (ForAllSkol doc) = quotes doc 247pprSkolInfo (IPSkol ips) = text "the implicit-parameter binding" <> plural ips <+> text "for" 248 <+> pprWithCommas ppr ips 249pprSkolInfo (DerivSkol pred) = text "the deriving clause for" <+> quotes (ppr pred) 250pprSkolInfo InstSkol = text "the instance declaration" 251pprSkolInfo (InstSC n) = text "the instance declaration" <> whenPprDebug (parens (ppr n)) 252pprSkolInfo FamInstSkol = text "a family instance declaration" 253pprSkolInfo BracketSkol = text "a Template Haskell bracket" 254pprSkolInfo (RuleSkol name) = text "the RULE" <+> pprRuleName name 255pprSkolInfo ArrowSkol = text "an arrow form" 256pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl 257 , text "in" <+> pprMatchContext mc ] 258pprSkolInfo (InferSkol ids) = hang (text "the inferred type" <> plural ids <+> text "of") 259 2 (vcat [ ppr name <+> dcolon <+> ppr ty 260 | (name,ty) <- ids ]) 261pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty 262pprSkolInfo (TyConSkol flav name) = text "the" <+> ppr flav <+> text "declaration for" <+> quotes (ppr name) 263pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name) 264pprSkolInfo ReifySkol = text "the type being reified" 265 266pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context" 267 268-- UnkSkol 269-- For type variables the others are dealt with by pprSkolTvBinding. 270-- For Insts, these cases should not happen 271pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol" 272 273pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc 274-- The type is already tidied 275pprSigSkolInfo ctxt ty 276 = case ctxt of 277 FunSigCtxt f _ -> vcat [ text "the type signature for:" 278 , nest 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) ] 279 PatSynCtxt {} -> pprUserTypeCtxt ctxt -- See Note [Skolem info for pattern synonyms] 280 _ -> vcat [ pprUserTypeCtxt ctxt <> colon 281 , nest 2 (ppr ty) ] 282 283pprPatSkolInfo :: ConLike -> SDoc 284pprPatSkolInfo (RealDataCon dc) 285 = sep [ text "a pattern with constructor:" 286 , nest 2 $ ppr dc <+> dcolon 287 <+> pprType (dataConUserType dc) <> comma ] 288 -- pprType prints forall's regardless of -fprint-explicit-foralls 289 -- which is what we want here, since we might be saying 290 -- type variable 't' is bound by ... 291 292pprPatSkolInfo (PatSynCon ps) 293 = sep [ text "a pattern with pattern synonym:" 294 , nest 2 $ ppr ps <+> dcolon 295 <+> pprPatSynType ps <> comma ] 296 297{- Note [Skolem info for pattern synonyms] 298~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 299For pattern synonym SkolemInfo we have 300 SigSkol (PatSynCtxt p) ty _ 301but the type 'ty' is not very helpful. The full pattern-synonym type 302has the provided and required pieces, which it is inconvenient to 303record and display here. So we simply don't display the type at all, 304contenting outselves with just the name of the pattern synonym, which 305is fine. We could do more, but it doesn't seem worth it. 306 307Note [SigSkol SkolemInfo] 308~~~~~~~~~~~~~~~~~~~~~~~~~ 309Suppose we (deeply) skolemise a type 310 f :: forall a. a -> forall b. b -> a 311Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated 312 a' -> b' -> a. 313But when, in an error message, we report that "b is a rigid type 314variable bound by the type signature for f", we want to show the foralls 315in the right place. So we proceed as follows: 316 317* In SigSkol we record 318 - the original signature forall a. a -> forall b. b -> a 319 - the instantiation mapping [a :-> a', b :-> b'] 320 321* Then when tidying in TcMType.tidySkolemInfo, we first tidy a' to 322 whatever it tidies to, say a''; and then we walk over the type 323 replacing the binder a by the tidied version a'', to give 324 forall a''. a'' -> forall b''. b'' -> a'' 325 We need to do this under function arrows, to match what deeplySkolemise 326 does. 327 328* Typically a'' will have a nice pretty name like "a", but the point is 329 that the foral-bound variables of the signature we report line up with 330 the instantiated skolems lying around in other types. 331 332 333************************************************************************ 334* * 335 CtOrigin 336* * 337************************************************************************ 338-} 339 340data CtOrigin 341 = GivenOrigin SkolemInfo 342 343 -- All the others are for *wanted* constraints 344 | OccurrenceOf Name -- Occurrence of an overloaded identifier 345 | OccurrenceOfRecSel RdrName -- Occurrence of a record selector 346 | AppOrigin -- An application of some kind 347 348 | SpecPragOrigin UserTypeCtxt -- Specialisation pragma for 349 -- function or instance 350 351 | TypeEqOrigin { uo_actual :: TcType 352 , uo_expected :: TcType 353 , uo_thing :: Maybe SDoc 354 -- ^ The thing that has type "actual" 355 , uo_visible :: Bool 356 -- ^ Is at least one of the three elements above visible? 357 -- (Errors from the polymorphic subsumption check are considered 358 -- visible.) Only used for prioritizing error messages. 359 } 360 361 | KindEqOrigin -- See Note [Equalities with incompatible kinds] in TcCanonical. 362 TcType (Maybe TcType) -- A kind equality arising from unifying these two types 363 CtOrigin -- originally arising from this 364 (Maybe TypeOrKind) -- the level of the eq this arises from 365 366 | IPOccOrigin HsIPName -- Occurrence of an implicit parameter 367 | OverLabelOrigin FastString -- Occurrence of an overloaded label 368 369 | LiteralOrigin (HsOverLit GhcRn) -- Occurrence of a literal 370 | NegateOrigin -- Occurrence of syntactic negation 371 372 | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc 373 | AssocFamPatOrigin -- When matching the patterns of an associated 374 -- family instance with that of its parent class 375 | SectionOrigin 376 | TupleOrigin -- (..,..) 377 | ExprSigOrigin -- e :: ty 378 | PatSigOrigin -- p :: ty 379 | PatOrigin -- Instantiating a polytyped pattern at a constructor 380 | ProvCtxtOrigin -- The "provided" context of a pattern synonym signature 381 (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in 382 -- particular the name and the right-hand side 383 | RecordUpdOrigin 384 | ViewPatOrigin 385 386 | ScOrigin TypeSize -- Typechecking superclasses of an instance declaration 387 -- If the instance head is C ty1 .. tyn 388 -- then TypeSize = sizeTypes [ty1, .., tyn] 389 -- See Note [Solving superclass constraints] in TcInstDcls 390 391 | DerivClauseOrigin -- Typechecking a deriving clause (as opposed to 392 -- standalone deriving). 393 | DerivOriginDC DataCon Int Bool 394 -- Checking constraints arising from this data con and field index. The 395 -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if 396 -- standalong deriving (with a wildcard constraint) is being used. This 397 -- is used to inform error messages on how to recommended fixes (e.g., if 398 -- the argument is True, then don't recommend "use standalone deriving", 399 -- but rather "fill in the wildcard constraint yourself"). 400 -- See Note [Inferring the instance context] in TcDerivInfer 401 | DerivOriginCoerce Id Type Type Bool 402 -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from 403 -- `ty1` to `ty2`. 404 | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for 405 -- constraints coming from a wildcard constraint, 406 -- e.g., deriving instance _ => Eq (Foo a) 407 -- See Note [Inferring the instance context] 408 -- in TcDerivInfer 409 | DefaultOrigin -- Typechecking a default decl 410 | DoOrigin -- Arising from a do expression 411 | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in 412 -- a do expression 413 | MCompOrigin -- Arising from a monad comprehension 414 | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a 415 -- monad comprehension 416 | IfOrigin -- Arising from an if statement 417 | ProcOrigin -- Arising from a proc expression 418 | AnnOrigin -- An annotation 419 420 | FunDepOrigin1 -- A functional dependency from combining 421 PredType CtOrigin RealSrcSpan -- This constraint arising from ... 422 PredType CtOrigin RealSrcSpan -- and this constraint arising from ... 423 424 | FunDepOrigin2 -- A functional dependency from combining 425 PredType CtOrigin -- This constraint arising from ... 426 PredType SrcSpan -- and this top-level instance 427 -- We only need a CtOrigin on the first, because the location 428 -- is pinned on the entire error message 429 430 | HoleOrigin 431 | UnboundOccurrenceOf OccName 432 | ListOrigin -- An overloaded list 433 | StaticOrigin -- A static form 434 | FailablePattern (LPat GhcTcId) -- A failable pattern in do-notation for the 435 -- MonadFail Proposal (MFP). Obsolete when 436 -- actual desugaring to MonadFail.fail is 437 -- live. 438 | Shouldn'tHappenOrigin String 439 -- the user should never see this one, 440 -- unless ImpredicativeTypes is on, where all 441 -- bets are off 442 | InstProvidedOrigin Module ClsInst 443 -- Skolem variable arose when we were testing if an instance 444 -- is solvable or not. 445-- An origin is visible if the place where the constraint arises is manifest 446-- in user code. Currently, all origins are visible except for invisible 447-- TypeEqOrigins. This is used when choosing which error of 448-- several to report 449isVisibleOrigin :: CtOrigin -> Bool 450isVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis 451isVisibleOrigin (KindEqOrigin _ _ sub_orig _) = isVisibleOrigin sub_orig 452isVisibleOrigin _ = True 453 454-- Converts a visible origin to an invisible one, if possible. Currently, 455-- this works only for TypeEqOrigin 456toInvisibleOrigin :: CtOrigin -> CtOrigin 457toInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False } 458toInvisibleOrigin orig = orig 459 460isGivenOrigin :: CtOrigin -> Bool 461isGivenOrigin (GivenOrigin {}) = True 462isGivenOrigin (FunDepOrigin1 _ o1 _ _ o2 _) = isGivenOrigin o1 && isGivenOrigin o2 463isGivenOrigin (FunDepOrigin2 _ o1 _ _) = isGivenOrigin o1 464isGivenOrigin _ = False 465 466instance Outputable CtOrigin where 467 ppr = pprCtOrigin 468 469ctoHerald :: SDoc 470ctoHerald = text "arising from" 471 472-- | Extract a suitable CtOrigin from a HsExpr 473lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin 474lexprCtOrigin (L _ e) = exprCtOrigin e 475 476exprCtOrigin :: HsExpr GhcRn -> CtOrigin 477exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name 478exprCtOrigin (HsUnboundVar _ uv) = UnboundOccurrenceOf (unboundVarOcc uv) 479exprCtOrigin (HsConLikeOut {}) = panic "exprCtOrigin HsConLikeOut" 480exprCtOrigin (HsRecFld _ f) = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f) 481exprCtOrigin (HsOverLabel _ _ l) = OverLabelOrigin l 482exprCtOrigin (HsIPVar _ ip) = IPOccOrigin ip 483exprCtOrigin (HsOverLit _ lit) = LiteralOrigin lit 484exprCtOrigin (HsLit {}) = Shouldn'tHappenOrigin "concrete literal" 485exprCtOrigin (HsLam _ matches) = matchesCtOrigin matches 486exprCtOrigin (HsLamCase _ ms) = matchesCtOrigin ms 487exprCtOrigin (HsApp _ e1 _) = lexprCtOrigin e1 488exprCtOrigin (HsAppType _ e1 _) = lexprCtOrigin e1 489exprCtOrigin (OpApp _ _ op _) = lexprCtOrigin op 490exprCtOrigin (NegApp _ e _) = lexprCtOrigin e 491exprCtOrigin (HsPar _ e) = lexprCtOrigin e 492exprCtOrigin (SectionL _ _ _) = SectionOrigin 493exprCtOrigin (SectionR _ _ _) = SectionOrigin 494exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple" 495exprCtOrigin ExplicitSum{} = Shouldn'tHappenOrigin "explicit sum" 496exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches 497exprCtOrigin (HsIf _ (Just syn) _ _ _) = exprCtOrigin (syn_expr syn) 498exprCtOrigin (HsIf {}) = Shouldn'tHappenOrigin "if expression" 499exprCtOrigin (HsMultiIf _ rhs) = lGRHSCtOrigin rhs 500exprCtOrigin (HsLet _ _ e) = lexprCtOrigin e 501exprCtOrigin (HsDo {}) = DoOrigin 502exprCtOrigin (ExplicitList {}) = Shouldn'tHappenOrigin "list" 503exprCtOrigin (RecordCon {}) = Shouldn'tHappenOrigin "record construction" 504exprCtOrigin (RecordUpd {}) = Shouldn'tHappenOrigin "record update" 505exprCtOrigin (ExprWithTySig {}) = ExprSigOrigin 506exprCtOrigin (ArithSeq {}) = Shouldn'tHappenOrigin "arithmetic sequence" 507exprCtOrigin (HsSCC _ _ _ e) = lexprCtOrigin e 508exprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e 509exprCtOrigin (HsBracket {}) = Shouldn'tHappenOrigin "TH bracket" 510exprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin "HsRnBracketOut" 511exprCtOrigin (HsTcBracketOut {})= panic "exprCtOrigin HsTcBracketOut" 512exprCtOrigin (HsSpliceE {}) = Shouldn'tHappenOrigin "TH splice" 513exprCtOrigin (HsProc {}) = Shouldn'tHappenOrigin "proc" 514exprCtOrigin (HsStatic {}) = Shouldn'tHappenOrigin "static expression" 515exprCtOrigin (HsTick _ _ e) = lexprCtOrigin e 516exprCtOrigin (HsBinTick _ _ _ e) = lexprCtOrigin e 517exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e 518exprCtOrigin (HsWrap {}) = panic "exprCtOrigin HsWrap" 519exprCtOrigin (XExpr nec) = noExtCon nec 520 521-- | Extract a suitable CtOrigin from a MatchGroup 522matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin 523matchesCtOrigin (MG { mg_alts = alts }) 524 | L _ [L _ match] <- alts 525 , Match { m_grhss = grhss } <- match 526 = grhssCtOrigin grhss 527 528 | otherwise 529 = Shouldn'tHappenOrigin "multi-way match" 530matchesCtOrigin (XMatchGroup nec) = noExtCon nec 531 532-- | Extract a suitable CtOrigin from guarded RHSs 533grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin 534grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss 535grhssCtOrigin (XGRHSs nec) = noExtCon nec 536 537-- | Extract a suitable CtOrigin from a list of guarded RHSs 538lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin 539lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e 540lGRHSCtOrigin [L _ (XGRHS nec)] = noExtCon nec 541lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS" 542 543pprCtOrigin :: CtOrigin -> SDoc 544-- "arising from ..." 545-- Not an instance of Outputable because of the "arising from" prefix 546pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk 547 548pprCtOrigin (SpecPragOrigin ctxt) 549 = case ctxt of 550 FunSigCtxt n _ -> text "for" <+> quotes (ppr n) 551 SpecInstCtxt -> text "a SPECIALISE INSTANCE pragma" 552 _ -> text "a SPECIALISE pragma" -- Never happens I think 553 554pprCtOrigin (FunDepOrigin1 pred1 orig1 loc1 pred2 orig2 loc2) 555 = hang (ctoHerald <+> text "a functional dependency between constraints:") 556 2 (vcat [ hang (quotes (ppr pred1)) 2 (pprCtOrigin orig1 <+> text "at" <+> ppr loc1) 557 , hang (quotes (ppr pred2)) 2 (pprCtOrigin orig2 <+> text "at" <+> ppr loc2) ]) 558 559pprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2) 560 = hang (ctoHerald <+> text "a functional dependency between:") 561 2 (vcat [ hang (text "constraint" <+> quotes (ppr pred1)) 562 2 (pprCtOrigin orig1 ) 563 , hang (text "instance" <+> quotes (ppr pred2)) 564 2 (text "at" <+> ppr loc2) ]) 565 566pprCtOrigin (KindEqOrigin t1 (Just t2) _ _) 567 = hang (ctoHerald <+> text "a kind equality arising from") 568 2 (sep [ppr t1, char '~', ppr t2]) 569 570pprCtOrigin AssocFamPatOrigin 571 = text "when matching a family LHS with its class instance head" 572 573pprCtOrigin (KindEqOrigin t1 Nothing _ _) 574 = hang (ctoHerald <+> text "a kind equality when matching") 575 2 (ppr t1) 576 577pprCtOrigin (UnboundOccurrenceOf name) 578 = ctoHerald <+> text "an undeclared identifier" <+> quotes (ppr name) 579 580pprCtOrigin (DerivOriginDC dc n _) 581 = hang (ctoHerald <+> text "the" <+> speakNth n 582 <+> text "field of" <+> quotes (ppr dc)) 583 2 (parens (text "type" <+> quotes (ppr ty))) 584 where 585 ty = dataConOrigArgTys dc !! (n-1) 586 587pprCtOrigin (DerivOriginCoerce meth ty1 ty2 _) 588 = hang (ctoHerald <+> text "the coercion of the method" <+> quotes (ppr meth)) 589 2 (sep [ text "from type" <+> quotes (ppr ty1) 590 , nest 2 $ text "to type" <+> quotes (ppr ty2) ]) 591 592pprCtOrigin (DoPatOrigin pat) 593 = ctoHerald <+> text "a do statement" 594 $$ 595 text "with the failable pattern" <+> quotes (ppr pat) 596 597pprCtOrigin (MCompPatOrigin pat) 598 = ctoHerald <+> hsep [ text "the failable pattern" 599 , quotes (ppr pat) 600 , text "in a statement in a monad comprehension" ] 601pprCtOrigin (FailablePattern pat) 602 = ctoHerald <+> text "the failable pattern" <+> quotes (ppr pat) 603 $$ 604 text "(this will become an error in a future GHC release)" 605 606pprCtOrigin (Shouldn'tHappenOrigin note) 607 = sdocWithDynFlags $ \dflags -> 608 if xopt LangExt.ImpredicativeTypes dflags 609 then text "a situation created by impredicative types" 610 else 611 vcat [ text "<< This should not appear in error messages. If you see this" 612 , text "in an error message, please report a bug mentioning" <+> quotes (text note) <+> text "at" 613 , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>" ] 614 615pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) }) 616 = hang (ctoHerald <+> text "the \"provided\" constraints claimed by") 617 2 (text "the signature of" <+> quotes (ppr name)) 618 619pprCtOrigin (InstProvidedOrigin mod cls_inst) 620 = vcat [ text "arising when attempting to show that" 621 , ppr cls_inst 622 , text "is provided by" <+> quotes (ppr mod)] 623 624pprCtOrigin simple_origin 625 = ctoHerald <+> pprCtO simple_origin 626 627-- | Short one-liners 628pprCtO :: CtOrigin -> SDoc 629pprCtO (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)] 630pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] 631pprCtO AppOrigin = text "an application" 632pprCtO (IPOccOrigin name) = hsep [text "a use of implicit parameter", quotes (ppr name)] 633pprCtO (OverLabelOrigin l) = hsep [text "the overloaded label" 634 ,quotes (char '#' <> ppr l)] 635pprCtO RecordUpdOrigin = text "a record update" 636pprCtO ExprSigOrigin = text "an expression type signature" 637pprCtO PatSigOrigin = text "a pattern type signature" 638pprCtO PatOrigin = text "a pattern" 639pprCtO ViewPatOrigin = text "a view pattern" 640pprCtO IfOrigin = text "an if expression" 641pprCtO (LiteralOrigin lit) = hsep [text "the literal", quotes (ppr lit)] 642pprCtO (ArithSeqOrigin seq) = hsep [text "the arithmetic sequence", quotes (ppr seq)] 643pprCtO SectionOrigin = text "an operator section" 644pprCtO AssocFamPatOrigin = text "the LHS of a famly instance" 645pprCtO TupleOrigin = text "a tuple" 646pprCtO NegateOrigin = text "a use of syntactic negation" 647pprCtO (ScOrigin n) = text "the superclasses of an instance declaration" 648 <> whenPprDebug (parens (ppr n)) 649pprCtO DerivClauseOrigin = text "the 'deriving' clause of a data type declaration" 650pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration" 651pprCtO DefaultOrigin = text "a 'default' declaration" 652pprCtO DoOrigin = text "a do statement" 653pprCtO MCompOrigin = text "a statement in a monad comprehension" 654pprCtO ProcOrigin = text "a proc expression" 655pprCtO (TypeEqOrigin t1 t2 _ _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2] 656pprCtO AnnOrigin = text "an annotation" 657pprCtO HoleOrigin = text "a use of" <+> quotes (text "_") 658pprCtO ListOrigin = text "an overloaded list" 659pprCtO StaticOrigin = text "a static form" 660pprCtO _ = panic "pprCtOrigin" 661