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