never executed always true always false
    1 
    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.
    9 module GHC.Tc.Types.Origin (
   10   -- UserTypeCtxt
   11   UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,
   12   ReportRedundantConstraints(..), reportRedundantConstraints,
   13   redundantConstraintsSpan,
   14 
   15   -- SkolemInfo
   16   SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,
   17 
   18   -- CtOrigin
   19   CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
   20   isVisibleOrigin, toInvisibleOrigin,
   21   pprCtOrigin, isGivenOrigin,
   22 
   23   -- CtOrigin and CallStack
   24   isPushCallStackOrigin, callStackOriginFS,
   25   -- FixedRuntimeRep origin
   26   FRROrigin(..), pprFRROrigin,
   27   StmtOrigin(..),
   28 
   29   -- Arrow command origin
   30   FRRArrowOrigin(..), pprFRRArrowOrigin,
   31   -- HsWrapper WpFun origin
   32   WpFunOrigin(..), pprWpFunOrigin,
   33 
   34   ) where
   35 
   36 import GHC.Prelude
   37 import GHC.Utils.Misc (HasCallStack)
   38 
   39 import GHC.Tc.Utils.TcType
   40 
   41 import GHC.Hs
   42 
   43 import GHC.Core.DataCon
   44 import GHC.Core.ConLike
   45 import GHC.Core.TyCon
   46 import GHC.Core.InstEnv
   47 import GHC.Core.PatSyn
   48 import GHC.Core.Multiplicity ( scaledThing )
   49 
   50 import GHC.Unit.Module
   51 import GHC.Types.Id
   52 import GHC.Types.Name
   53 import GHC.Types.Name.Reader
   54 import GHC.Types.Basic
   55 import GHC.Types.SrcLoc
   56 
   57 import GHC.Data.FastString
   58 
   59 import GHC.Utils.Outputable
   60 import GHC.Utils.Panic
   61 import GHC.Utils.Trace
   62 
   63 {- *********************************************************************
   64 *                                                                      *
   65           UserTypeCtxt
   66 *                                                                      *
   67 ********************************************************************* -}
   68 
   69 -------------------------------------
   70 -- | UserTypeCtxt describes the origin of the polymorphic type
   71 -- in the places where we need an expression to have that type
   72 data UserTypeCtxt
   73   = FunSigCtxt      -- Function type signature, when checking the type
   74                     -- Also used for types in SPECIALISE pragmas
   75        Name              -- Name of the function
   76        ReportRedundantConstraints
   77          -- This is usually 'WantRCC', but 'NoRCC' for
   78          --   * Record selectors (not important here)
   79          --   * Class and instance methods.  Here the code may legitimately
   80          --     be more polymorphic than the signature generated from the
   81          --     class declaration
   82 
   83   | InfSigCtxt Name     -- Inferred type for function
   84   | ExprSigCtxt         -- Expression type signature
   85       ReportRedundantConstraints
   86   | KindSigCtxt         -- Kind signature
   87   | StandaloneKindSigCtxt  -- Standalone kind signature
   88        Name                -- Name of the type/class
   89   | TypeAppCtxt         -- Visible type application
   90   | ConArgCtxt Name     -- Data constructor argument
   91   | TySynCtxt Name      -- RHS of a type synonym decl
   92   | PatSynCtxt Name     -- Type sig for a pattern synonym
   93   | PatSigCtxt          -- Type sig in pattern
   94                         --   eg  f (x::t) = ...
   95                         --   or  (x::t, y) = e
   96   | RuleSigCtxt Name    -- LHS of a RULE forall
   97                         --    RULE "foo" forall (x :: a -> a). f (Just x) = ...
   98   | ForSigCtxt Name     -- Foreign import or export signature
   99   | DefaultDeclCtxt     -- Types in a default declaration
  100   | InstDeclCtxt Bool   -- An instance declaration
  101                         --    True:  stand-alone deriving
  102                         --    False: vanilla instance declaration
  103   | SpecInstCtxt        -- SPECIALISE instance pragma
  104   | GenSigCtxt          -- Higher-rank or impredicative situations
  105                         -- e.g. (f e) where f has a higher-rank type
  106                         -- We might want to elaborate this
  107   | GhciCtxt Bool       -- GHCi command :kind <type>
  108                         -- The Bool indicates if we are checking the outermost
  109                         -- type application.
  110                         -- See Note [Unsaturated type synonyms in GHCi] in
  111                         -- GHC.Tc.Validity.
  112 
  113   | ClassSCCtxt Name    -- Superclasses of a class
  114   | SigmaCtxt           -- Theta part of a normal for-all type
  115                         --      f :: <S> => a -> a
  116   | DataTyCtxt Name     -- The "stupid theta" part of a data decl
  117                         --      data <S> => T a = MkT a
  118   | DerivClauseCtxt     -- A 'deriving' clause
  119   | TyVarBndrKindCtxt Name  -- The kind of a type variable being bound
  120   | DataKindCtxt Name   -- The kind of a data/newtype (instance)
  121   | TySynKindCtxt Name  -- The kind of the RHS of a type synonym
  122   | TyFamResKindCtxt Name   -- The result kind of a type family
  123 
  124 -- | Report Redundant Constraints.
  125 data ReportRedundantConstraints
  126   = NoRRC            -- ^ Don't report redundant constraints
  127   | WantRRC SrcSpan  -- ^ Report redundant constraints, and here
  128                      -- is the SrcSpan for the constraints
  129                      -- E.g. f :: (Eq a, Ord b) => blah
  130                      -- The span is for the (Eq a, Ord b)
  131 
  132 reportRedundantConstraints :: ReportRedundantConstraints -> Bool
  133 reportRedundantConstraints NoRRC        = False
  134 reportRedundantConstraints (WantRRC {}) = True
  135 
  136 redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
  137 redundantConstraintsSpan (FunSigCtxt _ (WantRRC span)) = span
  138 redundantConstraintsSpan (ExprSigCtxt (WantRRC span))  = span
  139 redundantConstraintsSpan _ = noSrcSpan
  140 
  141 {-
  142 -- Notes re TySynCtxt
  143 -- We allow type synonyms that aren't types; e.g.  type List = []
  144 --
  145 -- If the RHS mentions tyvars that aren't in scope, we'll
  146 -- quantify over them:
  147 --      e.g.    type T = a->a
  148 -- will become  type T = forall a. a->a
  149 --
  150 -- With gla-exts that's right, but for H98 we should complain.
  151 -}
  152 
  153 
  154 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
  155 pprUserTypeCtxt (FunSigCtxt n _)  = text "the type signature for" <+> quotes (ppr n)
  156 pprUserTypeCtxt (InfSigCtxt n)    = text "the inferred type for" <+> quotes (ppr n)
  157 pprUserTypeCtxt (RuleSigCtxt n)   = text "the type signature for" <+> quotes (ppr n)
  158 pprUserTypeCtxt (ExprSigCtxt _)   = text "an expression type signature"
  159 pprUserTypeCtxt KindSigCtxt       = text "a kind signature"
  160 pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n)
  161 pprUserTypeCtxt TypeAppCtxt       = text "a type argument"
  162 pprUserTypeCtxt (ConArgCtxt c)    = text "the type of the constructor" <+> quotes (ppr c)
  163 pprUserTypeCtxt (TySynCtxt c)     = text "the RHS of the type synonym" <+> quotes (ppr c)
  164 pprUserTypeCtxt PatSigCtxt        = text "a pattern type signature"
  165 pprUserTypeCtxt (ForSigCtxt n)    = text "the foreign declaration for" <+> quotes (ppr n)
  166 pprUserTypeCtxt DefaultDeclCtxt   = text "a type in a `default' declaration"
  167 pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration"
  168 pprUserTypeCtxt (InstDeclCtxt True)  = text "a stand-alone deriving instance declaration"
  169 pprUserTypeCtxt SpecInstCtxt      = text "a SPECIALISE instance pragma"
  170 pprUserTypeCtxt GenSigCtxt        = text "a type expected by the context"
  171 pprUserTypeCtxt (GhciCtxt {})     = text "a type in a GHCi command"
  172 pprUserTypeCtxt (ClassSCCtxt c)   = text "the super-classes of class" <+> quotes (ppr c)
  173 pprUserTypeCtxt SigmaCtxt         = text "the context of a polymorphic type"
  174 pprUserTypeCtxt (DataTyCtxt tc)   = text "the context of the data type declaration for" <+> quotes (ppr tc)
  175 pprUserTypeCtxt (PatSynCtxt n)    = text "the signature for pattern synonym" <+> quotes (ppr n)
  176 pprUserTypeCtxt (DerivClauseCtxt) = text "a `deriving' clause"
  177 pprUserTypeCtxt (TyVarBndrKindCtxt n) = text "the kind annotation on the type variable" <+> quotes (ppr n)
  178 pprUserTypeCtxt (DataKindCtxt n)  = text "the kind annotation on the declaration for" <+> quotes (ppr n)
  179 pprUserTypeCtxt (TySynKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n)
  180 pprUserTypeCtxt (TyFamResKindCtxt n) = text "the result kind for" <+> quotes (ppr n)
  181 
  182 isSigMaybe :: UserTypeCtxt -> Maybe Name
  183 isSigMaybe (FunSigCtxt n _) = Just n
  184 isSigMaybe (ConArgCtxt n)   = Just n
  185 isSigMaybe (ForSigCtxt n)   = Just n
  186 isSigMaybe (PatSynCtxt n)   = Just n
  187 isSigMaybe _                = Nothing
  188 
  189 {-
  190 ************************************************************************
  191 *                                                                      *
  192                 SkolemInfo
  193 *                                                                      *
  194 ************************************************************************
  195 -}
  196 
  197 -- SkolemInfo gives the origin of *given* constraints
  198 --   a) type variables are skolemised
  199 --   b) an implication constraint is generated
  200 data SkolemInfo
  201   = SigSkol -- A skolem that is created by instantiating
  202             -- a programmer-supplied type signature
  203             -- Location of the binding site is on the TyVar
  204             -- See Note [SigSkol SkolemInfo]
  205        UserTypeCtxt        -- What sort of signature
  206        TcType              -- Original type signature (before skolemisation)
  207        [(Name,TcTyVar)]    -- Maps the original name of the skolemised tyvar
  208                            -- to its instantiated version
  209 
  210   | SigTypeSkol UserTypeCtxt
  211                  -- like SigSkol, but when we're kind-checking the *type*
  212                  -- hence, we have less info
  213 
  214   | ForAllSkol  -- Bound by a user-written "forall".
  215        SDoc        -- Shows just the binders, used when reporting a bad telescope
  216                    -- See Note [Checking telescopes] in GHC.Tc.Types.Constraint
  217 
  218   | DerivSkol Type      -- Bound by a 'deriving' clause;
  219                         -- the type is the instance we are trying to derive
  220 
  221   | InstSkol            -- Bound at an instance decl
  222   | InstSC TypeSize     -- A "given" constraint obtained by superclass selection.
  223                         -- If (C ty1 .. tyn) is the largest class from
  224                         --    which we made a superclass selection in the chain,
  225                         --    then TypeSize = sizeTypes [ty1, .., tyn]
  226                         -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance
  227 
  228   | FamInstSkol         -- Bound at a family instance decl
  229   | PatSkol             -- An existential type variable bound by a pattern for
  230       ConLike           -- a data constructor with an existential type.
  231       (HsMatchContext GhcTc)
  232              -- e.g.   data T = forall a. Eq a => MkT a
  233              --        f (MkT x) = ...
  234              -- The pattern MkT x will allocate an existential type
  235              -- variable for 'a'.
  236 
  237   | IPSkol [HsIPName]   -- Binding site of an implicit parameter
  238 
  239   | RuleSkol RuleName   -- The LHS of a RULE
  240 
  241   | InferSkol [(Name,TcType)]
  242                         -- We have inferred a type for these (mutually-recursivive)
  243                         -- polymorphic Ids, and are now checking that their RHS
  244                         -- constraints are satisfied.
  245 
  246   | BracketSkol         -- Template Haskell bracket
  247 
  248   | UnifyForAllSkol     -- We are unifying two for-all types
  249        TcType           -- The instantiated type *inside* the forall
  250 
  251   | TyConSkol TyConFlavour Name  -- bound in a type declaration of the given flavour
  252 
  253   | DataConSkol Name    -- bound as an existential in a Haskell98 datacon decl or
  254                         -- as any variable in a GADT datacon decl
  255 
  256   | ReifySkol           -- Bound during Template Haskell reification
  257 
  258   | QuantCtxtSkol       -- Quantified context, e.g.
  259                         --   f :: forall c. (forall a. c a => c [a]) => blah
  260 
  261   | RuntimeUnkSkol      -- Runtime skolem from the GHCi debugger      #14628
  262 
  263   | UnkSkol             -- Unhelpful info (until I improve it)
  264 
  265 instance Outputable SkolemInfo where
  266   ppr = pprSkolInfo
  267 
  268 pprSkolInfo :: SkolemInfo -> SDoc
  269 -- Complete the sentence "is a rigid type variable bound by..."
  270 pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty
  271 pprSkolInfo (SigTypeSkol cx)  = pprUserTypeCtxt cx
  272 pprSkolInfo (ForAllSkol tvs)  = text "an explicit forall" <+> tvs
  273 pprSkolInfo (IPSkol ips)      = text "the implicit-parameter binding" <> plural ips <+> text "for"
  274                                  <+> pprWithCommas ppr ips
  275 pprSkolInfo (DerivSkol pred)  = text "the deriving clause for" <+> quotes (ppr pred)
  276 pprSkolInfo InstSkol          = text "the instance declaration"
  277 pprSkolInfo (InstSC n)        = text "the instance declaration" <> whenPprDebug (parens (ppr n))
  278 pprSkolInfo FamInstSkol       = text "a family instance declaration"
  279 pprSkolInfo BracketSkol       = text "a Template Haskell bracket"
  280 pprSkolInfo (RuleSkol name)   = text "the RULE" <+> pprRuleName name
  281 pprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl
  282                                     , text "in" <+> pprMatchContext mc ]
  283 pprSkolInfo (InferSkol ids)   = hang (text "the inferred type" <> plural ids <+> text "of")
  284                                    2 (vcat [ ppr name <+> dcolon <+> ppr ty
  285                                            | (name,ty) <- ids ])
  286 pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty
  287 pprSkolInfo (TyConSkol flav name) = text "the" <+> ppr flav <+> text "declaration for" <+> quotes (ppr name)
  288 pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name)
  289 pprSkolInfo ReifySkol         = text "the type being reified"
  290 
  291 pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context"
  292 pprSkolInfo RuntimeUnkSkol     = text "Unknown type from GHCi runtime"
  293 
  294 -- UnkSkol
  295 -- For type variables the others are dealt with by pprSkolTvBinding.
  296 -- For Insts, these cases should not happen
  297 pprSkolInfo UnkSkol = warnPprTrace True (text "pprSkolInfo: UnkSkol") $ text "UnkSkol"
  298 
  299 pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
  300 -- The type is already tidied
  301 pprSigSkolInfo ctxt ty
  302   = case ctxt of
  303        FunSigCtxt f _ -> vcat [ text "the type signature for:"
  304                               , nest 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) ]
  305        PatSynCtxt {}  -> pprUserTypeCtxt ctxt  -- See Note [Skolem info for pattern synonyms]
  306        _              -> vcat [ pprUserTypeCtxt ctxt <> colon
  307                               , nest 2 (ppr ty) ]
  308 
  309 pprPatSkolInfo :: ConLike -> SDoc
  310 pprPatSkolInfo (RealDataCon dc)
  311   = sdocOption sdocLinearTypes (\show_linear_types ->
  312       sep [ text "a pattern with constructor:"
  313           , nest 2 $ ppr dc <+> dcolon
  314             <+> pprType (dataConDisplayType show_linear_types dc) <> comma ])
  315             -- pprType prints forall's regardless of -fprint-explicit-foralls
  316             -- which is what we want here, since we might be saying
  317             -- type variable 't' is bound by ...
  318 
  319 pprPatSkolInfo (PatSynCon ps)
  320   = sep [ text "a pattern with pattern synonym:"
  321         , nest 2 $ ppr ps <+> dcolon
  322                    <+> pprPatSynType ps <> comma ]
  323 
  324 {- Note [Skolem info for pattern synonyms]
  325 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  326 For pattern synonym SkolemInfo we have
  327    SigSkol (PatSynCtxt p) ty _
  328 but the type 'ty' is not very helpful.  The full pattern-synonym type
  329 has the provided and required pieces, which it is inconvenient to
  330 record and display here. So we simply don't display the type at all,
  331 contenting ourselves with just the name of the pattern synonym, which
  332 is fine.  We could do more, but it doesn't seem worth it.
  333 
  334 Note [SigSkol SkolemInfo]
  335 ~~~~~~~~~~~~~~~~~~~~~~~~~
  336 Suppose we skolemise a type
  337    f :: forall a. Eq a => forall b. b -> a
  338 Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated
  339       a' -> b' -> a.
  340 But when, in an error message, we report that "b is a rigid type
  341 variable bound by the type signature for f", we want to show the foralls
  342 in the right place.  So we proceed as follows:
  343 
  344 * In SigSkol we record
  345     - the original signature forall a. a -> forall b. b -> a
  346     - the instantiation mapping [a :-> a', b :-> b']
  347 
  348 * Then when tidying in GHC.Tc.Utils.TcMType.tidySkolemInfo, we first tidy a' to
  349   whatever it tidies to, say a''; and then we walk over the type
  350   replacing the binder a by the tidied version a'', to give
  351        forall a''. Eq a'' => forall b''. b'' -> a''
  352   We need to do this under (=>) arrows, to match what topSkolemise
  353   does.
  354 
  355 * Typically a'' will have a nice pretty name like "a", but the point is
  356   that the foral-bound variables of the signature we report line up with
  357   the instantiated skolems lying  around in other types.
  358 
  359 
  360 ************************************************************************
  361 *                                                                      *
  362             CtOrigin
  363 *                                                                      *
  364 ************************************************************************
  365 -}
  366 
  367 data CtOrigin
  368   = GivenOrigin SkolemInfo
  369 
  370   -- All the others are for *wanted* constraints
  371   | OccurrenceOf Name              -- Occurrence of an overloaded identifier
  372   | OccurrenceOfRecSel RdrName     -- Occurrence of a record selector
  373   | AppOrigin                      -- An application of some kind
  374 
  375   | SpecPragOrigin UserTypeCtxt    -- Specialisation pragma for
  376                                    -- function or instance
  377 
  378   | TypeEqOrigin { uo_actual   :: TcType
  379                  , uo_expected :: TcType
  380                  , uo_thing    :: Maybe SDoc
  381                        -- ^ The thing that has type "actual"
  382                  , uo_visible  :: Bool
  383                        -- ^ Is at least one of the three elements above visible?
  384                        -- (Errors from the polymorphic subsumption check are considered
  385                        -- visible.) Only used for prioritizing error messages.
  386                  }
  387 
  388   | KindEqOrigin
  389       TcType TcType             -- A kind equality arising from unifying these two types
  390       CtOrigin                  -- originally arising from this
  391       (Maybe TypeOrKind)        -- the level of the eq this arises from
  392 
  393   | IPOccOrigin  HsIPName       -- Occurrence of an implicit parameter
  394   | OverLabelOrigin FastString  -- Occurrence of an overloaded label
  395 
  396   | LiteralOrigin (HsOverLit GhcRn)     -- Occurrence of a literal
  397   | NegateOrigin                        -- Occurrence of syntactic negation
  398 
  399   | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc
  400   | AssocFamPatOrigin   -- When matching the patterns of an associated
  401                         -- family instance with that of its parent class
  402   | SectionOrigin
  403   | HasFieldOrigin FastString
  404   | TupleOrigin         -- (..,..)
  405   | ExprSigOrigin       -- e :: ty
  406   | PatSigOrigin        -- p :: ty
  407   | PatOrigin           -- Instantiating a polytyped pattern at a constructor
  408   | ProvCtxtOrigin      -- The "provided" context of a pattern synonym signature
  409         (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in
  410                                  -- particular the name and the right-hand side
  411   | RecordUpdOrigin
  412   | ViewPatOrigin
  413 
  414   | ScOrigin TypeSize   -- Typechecking superclasses of an instance declaration
  415                         -- If the instance head is C ty1 .. tyn
  416                         --    then TypeSize = sizeTypes [ty1, .., tyn]
  417                         -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance
  418 
  419   | DerivClauseOrigin   -- Typechecking a deriving clause (as opposed to
  420                         -- standalone deriving).
  421   | DerivOriginDC DataCon Int Bool
  422       -- Checking constraints arising from this data con and field index. The
  423       -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if
  424       -- standalong deriving (with a wildcard constraint) is being used. This
  425       -- is used to inform error messages on how to recommended fixes (e.g., if
  426       -- the argument is True, then don't recommend "use standalone deriving",
  427       -- but rather "fill in the wildcard constraint yourself").
  428       -- See Note [Inferring the instance context] in GHC.Tc.Deriv.Infer
  429   | DerivOriginCoerce Id Type Type Bool
  430                         -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from
  431                         -- `ty1` to `ty2`.
  432   | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for
  433                           -- constraints coming from a wildcard constraint,
  434                           -- e.g., deriving instance _ => Eq (Foo a)
  435                           -- See Note [Inferring the instance context]
  436                           -- in GHC.Tc.Deriv.Infer
  437   | DefaultOrigin       -- Typechecking a default decl
  438   | DoOrigin            -- Arising from a do expression
  439   | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in
  440                              -- a do expression
  441   | MCompOrigin         -- Arising from a monad comprehension
  442   | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a
  443                                 -- monad comprehension
  444   | ProcOrigin          -- Arising from a proc expression
  445   | ArrowCmdOrigin      -- Arising from an arrow command
  446   | AnnOrigin           -- An annotation
  447 
  448   | FunDepOrigin1       -- A functional dependency from combining
  449         PredType CtOrigin RealSrcSpan      -- This constraint arising from ...
  450         PredType CtOrigin RealSrcSpan      -- and this constraint arising from ...
  451 
  452   | FunDepOrigin2       -- A functional dependency from combining
  453         PredType CtOrigin   -- This constraint arising from ...
  454         PredType SrcSpan    -- and this top-level instance
  455         -- We only need a CtOrigin on the first, because the location
  456         -- is pinned on the entire error message
  457 
  458   | ExprHoleOrigin OccName   -- from an expression hole
  459   | TypeHoleOrigin OccName   -- from a type hole (partial type signature)
  460   | PatCheckOrigin      -- normalisation of a type during pattern-match checking
  461   | ListOrigin          -- An overloaded list
  462   | IfThenElseOrigin    -- An if-then-else expression
  463   | BracketOrigin       -- An overloaded quotation bracket
  464   | StaticOrigin        -- A static form
  465   | Shouldn'tHappenOrigin String
  466                             -- the user should never see this one,
  467                             -- unless ImpredicativeTypes is on, where all
  468                             -- bets are off
  469 
  470   -- | Testing whether the constraint associated with an instance declaration
  471   -- in a signature file is satisfied upon instantiation.
  472   --
  473   -- Test cases: backpack/should_fail/bkpfail{11,43}.bkp
  474   | InstProvidedOrigin
  475       Module  -- ^ Module in which the instance was declared
  476       ClsInst -- ^ The declared typeclass instance
  477 
  478   | NonLinearPatternOrigin
  479   | UsageEnvironmentOf Name
  480 
  481   | CycleBreakerOrigin
  482       CtOrigin   -- origin of the original constraint
  483       -- See Detail (7) of Note [Type variable cycles] in GHC.Tc.Solver.Canonical
  484   | FixedRuntimeRepOrigin
  485       !Type -- ^ The type being checked for representation polymorphism.
  486             -- We record it here for access in 'GHC.Tc.Errors.mkFRRErr'.
  487       !FRROrigin
  488 
  489 -- An origin is visible if the place where the constraint arises is manifest
  490 -- in user code. Currently, all origins are visible except for invisible
  491 -- TypeEqOrigins. This is used when choosing which error of
  492 -- several to report
  493 isVisibleOrigin :: CtOrigin -> Bool
  494 isVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis
  495 isVisibleOrigin (KindEqOrigin _ _ sub_orig _)       = isVisibleOrigin sub_orig
  496 isVisibleOrigin _                                   = True
  497 
  498 -- Converts a visible origin to an invisible one, if possible. Currently,
  499 -- this works only for TypeEqOrigin
  500 toInvisibleOrigin :: CtOrigin -> CtOrigin
  501 toInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False }
  502 toInvisibleOrigin orig                   = orig
  503 
  504 isGivenOrigin :: CtOrigin -> Bool
  505 isGivenOrigin (GivenOrigin {})              = True
  506 isGivenOrigin (FunDepOrigin1 _ o1 _ _ o2 _) = isGivenOrigin o1 && isGivenOrigin o2
  507 isGivenOrigin (FunDepOrigin2 _ o1 _ _)      = isGivenOrigin o1
  508 isGivenOrigin (CycleBreakerOrigin o)        = isGivenOrigin o
  509 isGivenOrigin _                             = False
  510 
  511 instance Outputable CtOrigin where
  512   ppr = pprCtOrigin
  513 
  514 ctoHerald :: SDoc
  515 ctoHerald = text "arising from"
  516 
  517 -- | Extract a suitable CtOrigin from a HsExpr
  518 lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
  519 lexprCtOrigin (L _ e) = exprCtOrigin e
  520 
  521 exprCtOrigin :: HsExpr GhcRn -> CtOrigin
  522 exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name
  523 exprCtOrigin (HsGetField _ _ (L _ f)) = HasFieldOrigin (unLoc $ dfoLabel f)
  524 exprCtOrigin (HsUnboundVar {})    = Shouldn'tHappenOrigin "unbound variable"
  525 exprCtOrigin (HsRecSel _ f)       = OccurrenceOfRecSel (unLoc $ foLabel f)
  526 exprCtOrigin (HsOverLabel _ l)    = OverLabelOrigin l
  527 exprCtOrigin (ExplicitList {})    = ListOrigin
  528 exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip
  529 exprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit
  530 exprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin "concrete literal"
  531 exprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches
  532 exprCtOrigin (HsLamCase _ ms)     = matchesCtOrigin ms
  533 exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1
  534 exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1
  535 exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op
  536 exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e
  537 exprCtOrigin (HsPar _ _ e _)      = lexprCtOrigin e
  538 exprCtOrigin (HsProjection _ _)   = SectionOrigin
  539 exprCtOrigin (SectionL _ _ _)     = SectionOrigin
  540 exprCtOrigin (SectionR _ _ _)     = SectionOrigin
  541 exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"
  542 exprCtOrigin ExplicitSum{}        = Shouldn'tHappenOrigin "explicit sum"
  543 exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches
  544 exprCtOrigin (HsIf {})           = IfThenElseOrigin
  545 exprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs
  546 exprCtOrigin (HsLet _ _ _ _ e)   = lexprCtOrigin e
  547 exprCtOrigin (HsDo {})           = DoOrigin
  548 exprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin "record construction"
  549 exprCtOrigin (RecordUpd {})      = RecordUpdOrigin
  550 exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin
  551 exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"
  552 exprCtOrigin (HsPragE _ _ e)     = lexprCtOrigin e
  553 exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"
  554 exprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin "HsRnBracketOut"
  555 exprCtOrigin (HsTcBracketOut {})= panic "exprCtOrigin HsTcBracketOut"
  556 exprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin "TH splice"
  557 exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"
  558 exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"
  559 exprCtOrigin (XExpr (HsExpanded a _)) = exprCtOrigin a
  560 
  561 -- | Extract a suitable CtOrigin from a MatchGroup
  562 matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
  563 matchesCtOrigin (MG { mg_alts = alts })
  564   | L _ [L _ match] <- alts
  565   , Match { m_grhss = grhss } <- match
  566   = grhssCtOrigin grhss
  567 
  568   | otherwise
  569   = Shouldn'tHappenOrigin "multi-way match"
  570 
  571 -- | Extract a suitable CtOrigin from guarded RHSs
  572 grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
  573 grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss
  574 
  575 -- | Extract a suitable CtOrigin from a list of guarded RHSs
  576 lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
  577 lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e
  578 lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS"
  579 
  580 pprCtOrigin :: CtOrigin -> SDoc
  581 -- "arising from ..."
  582 -- Not an instance of Outputable because of the "arising from" prefix
  583 pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk
  584 
  585 pprCtOrigin (SpecPragOrigin ctxt)
  586   = case ctxt of
  587        FunSigCtxt n _ -> text "for" <+> quotes (ppr n)
  588        SpecInstCtxt   -> text "a SPECIALISE INSTANCE pragma"
  589        _              -> text "a SPECIALISE pragma"  -- Never happens I think
  590 
  591 pprCtOrigin (FunDepOrigin1 pred1 orig1 loc1 pred2 orig2 loc2)
  592   = hang (ctoHerald <+> text "a functional dependency between constraints:")
  593        2 (vcat [ hang (quotes (ppr pred1)) 2 (pprCtOrigin orig1 <+> text "at" <+> ppr loc1)
  594                , hang (quotes (ppr pred2)) 2 (pprCtOrigin orig2 <+> text "at" <+> ppr loc2) ])
  595 
  596 pprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2)
  597   = hang (ctoHerald <+> text "a functional dependency between:")
  598        2 (vcat [ hang (text "constraint" <+> quotes (ppr pred1))
  599                     2 (pprCtOrigin orig1 )
  600                , hang (text "instance" <+> quotes (ppr pred2))
  601                     2 (text "at" <+> ppr loc2) ])
  602 
  603 pprCtOrigin AssocFamPatOrigin
  604   = text "when matching a family LHS with its class instance head"
  605 
  606 pprCtOrigin (TypeEqOrigin { uo_actual = t1, uo_expected =  t2, uo_visible = vis })
  607   = text "a type equality" <> brackets (ppr vis) <+> sep [ppr t1, char '~', ppr t2]
  608 
  609 pprCtOrigin (KindEqOrigin t1 t2 _ _)
  610   = hang (ctoHerald <+> text "a kind equality arising from")
  611        2 (sep [ppr t1, char '~', ppr t2])
  612 
  613 pprCtOrigin (DerivOriginDC dc n _)
  614   = hang (ctoHerald <+> text "the" <+> speakNth n
  615           <+> text "field of" <+> quotes (ppr dc))
  616        2 (parens (text "type" <+> quotes (ppr (scaledThing ty))))
  617   where
  618     ty = dataConOrigArgTys dc !! (n-1)
  619 
  620 pprCtOrigin (DerivOriginCoerce meth ty1 ty2 _)
  621   = hang (ctoHerald <+> text "the coercion of the method" <+> quotes (ppr meth))
  622        2 (sep [ text "from type" <+> quotes (ppr ty1)
  623               , nest 2 $ text "to type" <+> quotes (ppr ty2) ])
  624 
  625 pprCtOrigin (DoPatOrigin pat)
  626     = ctoHerald <+> text "a do statement"
  627       $$
  628       text "with the failable pattern" <+> quotes (ppr pat)
  629 
  630 pprCtOrigin (MCompPatOrigin pat)
  631     = ctoHerald <+> hsep [ text "the failable pattern"
  632            , quotes (ppr pat)
  633            , text "in a statement in a monad comprehension" ]
  634 
  635 pprCtOrigin (Shouldn'tHappenOrigin note)
  636   = sdocOption sdocImpredicativeTypes $ \case
  637       True  -> text "a situation created by impredicative types"
  638       False -> vcat [ text "<< This should not appear in error messages. If you see this"
  639                     , text "in an error message, please report a bug mentioning"
  640                         <+> quotes (text note) <+> text "at"
  641                     , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>"
  642                     ]
  643 
  644 pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })
  645   = hang (ctoHerald <+> text "the \"provided\" constraints claimed by")
  646        2 (text "the signature of" <+> quotes (ppr name))
  647 
  648 pprCtOrigin (InstProvidedOrigin mod cls_inst)
  649   = vcat [ text "arising when attempting to show that"
  650          , ppr cls_inst
  651          , text "is provided by" <+> quotes (ppr mod)]
  652 
  653 pprCtOrigin (CycleBreakerOrigin orig)
  654   = pprCtOrigin orig
  655 
  656 pprCtOrigin (FixedRuntimeRepOrigin _ frrOrig)
  657   -- We ignore the type argument, as we would prefer
  658   -- to report all types that don't have a fixed runtime representation at once,
  659   -- in 'GHC.Tc.Errors.mkFRRErr'.
  660   = pprFRROrigin frrOrig
  661 
  662 pprCtOrigin simple_origin
  663   = ctoHerald <+> pprCtO simple_origin
  664 
  665 -- | Short one-liners
  666 pprCtO :: HasCallStack => CtOrigin -> SDoc
  667 pprCtO (OccurrenceOf name)   = hsep [text "a use of", quotes (ppr name)]
  668 pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)]
  669 pprCtO AppOrigin             = text "an application"
  670 pprCtO (IPOccOrigin name)    = hsep [text "a use of implicit parameter", quotes (ppr name)]
  671 pprCtO (OverLabelOrigin l)   = hsep [text "the overloaded label"
  672                                     ,quotes (char '#' <> ppr l)]
  673 pprCtO RecordUpdOrigin       = text "a record update"
  674 pprCtO ExprSigOrigin         = text "an expression type signature"
  675 pprCtO PatSigOrigin          = text "a pattern type signature"
  676 pprCtO PatOrigin             = text "a pattern"
  677 pprCtO ViewPatOrigin         = text "a view pattern"
  678 pprCtO (LiteralOrigin lit)   = hsep [text "the literal", quotes (ppr lit)]
  679 pprCtO (ArithSeqOrigin seq)  = hsep [text "the arithmetic sequence", quotes (ppr seq)]
  680 pprCtO SectionOrigin         = text "an operator section"
  681 pprCtO (HasFieldOrigin f)    = hsep [text "selecting the field", quotes (ppr f)]
  682 pprCtO AssocFamPatOrigin     = text "the LHS of a family instance"
  683 pprCtO TupleOrigin           = text "a tuple"
  684 pprCtO NegateOrigin          = text "a use of syntactic negation"
  685 pprCtO (ScOrigin n)          = text "the superclasses of an instance declaration"
  686                                <> whenPprDebug (parens (ppr n))
  687 pprCtO DerivClauseOrigin     = text "the 'deriving' clause of a data type declaration"
  688 pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration"
  689 pprCtO DefaultOrigin         = text "a 'default' declaration"
  690 pprCtO DoOrigin              = text "a do statement"
  691 pprCtO MCompOrigin           = text "a statement in a monad comprehension"
  692 pprCtO ProcOrigin            = text "a proc expression"
  693 pprCtO ArrowCmdOrigin        = text "an arrow command"
  694 pprCtO AnnOrigin             = text "an annotation"
  695 pprCtO (ExprHoleOrigin occ)  = text "a use of" <+> quotes (ppr occ)
  696 pprCtO (TypeHoleOrigin occ)  = text "a use of wildcard" <+> quotes (ppr occ)
  697 pprCtO PatCheckOrigin        = text "a pattern-match completeness check"
  698 pprCtO ListOrigin            = text "an overloaded list"
  699 pprCtO IfThenElseOrigin      = text "an if-then-else expression"
  700 pprCtO StaticOrigin          = text "a static form"
  701 pprCtO NonLinearPatternOrigin = text "a non-linear pattern"
  702 pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)]
  703 pprCtO BracketOrigin         = text "a quotation bracket"
  704 
  705 -- These ones are handled by pprCtOrigin, but we nevertheless sometimes
  706 -- get here via callStackOriginFS, when doing ambiguity checks
  707 -- A bit silly, but no great harm
  708 pprCtO (GivenOrigin {})             = text "a given constraint"
  709 pprCtO (SpecPragOrigin {})          = text "a SPECIALISE pragma"
  710 pprCtO (FunDepOrigin1 {})           = text "a functional dependency"
  711 pprCtO (FunDepOrigin2 {})           = text "a functional dependency"
  712 pprCtO (TypeEqOrigin {})            = text "a type equality"
  713 pprCtO (KindEqOrigin {})            = text "a kind equality"
  714 pprCtO (DerivOriginDC {})           = text "a deriving clause"
  715 pprCtO (DerivOriginCoerce {})       = text "a derived method"
  716 pprCtO (DoPatOrigin {})             = text "a do statement"
  717 pprCtO (MCompPatOrigin {})          = text "a monad comprehension pattern"
  718 pprCtO (Shouldn'tHappenOrigin note) = text note
  719 pprCtO (ProvCtxtOrigin {})          = text "a provided constraint"
  720 pprCtO (InstProvidedOrigin {})      = text "a provided constraint"
  721 pprCtO (CycleBreakerOrigin orig)    = pprCtO orig
  722 pprCtO (FixedRuntimeRepOrigin {})   = text "a representation polymorphism check"
  723 
  724 {- *********************************************************************
  725 *                                                                      *
  726              CallStacks and CtOrigin
  727 
  728     See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence
  729 *                                                                      *
  730 ********************************************************************* -}
  731 
  732 isPushCallStackOrigin :: CtOrigin -> Bool
  733 -- Do we want to solve this IP constraint directly (return False)
  734 -- or push the call site (return True)
  735 -- See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence
  736 isPushCallStackOrigin (IPOccOrigin {}) = False
  737 isPushCallStackOrigin _                = True
  738 
  739 
  740 callStackOriginFS :: CtOrigin -> FastString
  741 -- This is the string that appears in the CallStack
  742 callStackOriginFS (OccurrenceOf fun) = occNameFS (getOccName fun)
  743 callStackOriginFS orig               = mkFastString (showSDocUnsafe (pprCtO orig))
  744 
  745 {-
  746 ************************************************************************
  747 *                                                                      *
  748             Checking for representation polymorphism
  749 *                                                                      *
  750 ************************************************************************
  751 
  752 Note [Reporting representation-polymorphism errors]
  753 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  754 When we emit a 'Concrete#' Wanted constraint using GHC.Tc.Utils.Concrete.hasFixedRuntimeRep,
  755 we provide a 'CtOrigin' using the 'FixedRuntimeRepOrigin' constructor of,
  756 which keeps track of two things:
  757   - the type which we want to ensure has a fixed runtime representation,
  758   - the 'FRROrigin' explaining the nature of the check, e.g. a pattern,
  759     a function application, a record update, ...
  760 
  761 If the constraint goes unsolved, we report it as follows:
  762   - we detect that the unsolved Wanted is a Concrete# constraint in
  763     GHC.Tc.Errors.reportWanteds using is_FRR,
  764   - we assemble an error message in GHC.Tc.Errors.mkFRRErr.
  765 
  766 For example, if we try to write the program
  767 
  768   foo :: forall r1 r2 (a :: TYPE r1) (b :: TYPE r2). a -> b -> ()
  769   foo x y = ()
  770 
  771 we will get two unsolved Concrete# wanted constraints, namely
  772 'Concrete# r1' and 'Concrete# r2', and their 'CtOrigin's will be:
  773 
  774   FixedRuntimeRepOrigin a (FRRVarPattern x)
  775   FixedRuntimeRepOrigin b (FRRVarPattern y)
  776 
  777 These constraints will be processed in tandem by mkFRRErr,
  778 producing an error message of the form:
  779 
  780   Representation-polymorphic types are not allowed here.
  781     * The variable 'x' bound by the pattern
  782       does not have a fixed runtime representation:
  783         a :: TYPE r1
  784     * The variable 'y' bound by the pattern
  785       does not have a fixed runtime representation:
  786         b :: TYPE r2
  787 -}
  788 
  789 -- | Where are we checking that a type has a fixed runtime representation?
  790 -- Equivalently: what is the origin of an emitted 'Concrete#' constraint?
  791 data FRROrigin
  792 
  793   -- | Function arguments must have a fixed runtime representation.
  794   --
  795   -- Test case: RepPolyApp.
  796   = FRRApp !(HsExpr GhcRn)
  797 
  798   -- | Record fields in record updates must have a fixed runtime representation.
  799   --
  800   -- Test case: RepPolyRecordUpdate.
  801   | FRRRecordUpdate !RdrName !(HsExpr GhcRn)
  802 
  803   -- | Variable binders must have a fixed runtime representation.
  804   --
  805   -- Test cases: LevPolyLet, RepPolyPatBind.
  806   | FRRBinder !Name
  807 
  808   -- | The type of a pattern in a match group must have a fixed runtime representation.
  809   --
  810   -- This rules out:
  811   --   - individual patterns which don't have a fixed runtime representation,
  812   --   - a representation-polymorphic empty case statement,
  813   --   - representation-polymorphic GADT pattern matches
  814   --     in which individual pattern types have a fixed runtime representation.
  815   --
  816   -- Test cases: RepPolyRecordPattern, RepPolyUnboxedPatterns,
  817   --             RepPolyBinder, RepPolyWildcardPattern, RepPolyMatch,
  818   --             RepPolyNPlusK, RepPolyPatBind, T20426.
  819   | FRRMatch !(HsMatchContext GhcTc) !Int
  820 
  821   -- | An instantiation of a newtype/data constructor in which
  822   -- one of the remaining arguments types does not have a fixed runtime representation.
  823   --
  824   -- Test case: UnliftedNewtypesLevityBinder.
  825   | FRRDataConArg !DataCon !Int
  826 
  827   -- | An instantiation of an 'Id' with no binding (e.g. `coerce`, `unsafeCoerce#`)
  828   -- in which one of the remaining arguments types does not have a fixed runtime representation.
  829   --
  830   -- Test cases: RepPolyWrappedVar, T14561, UnliftedNewtypesCoerceFail.
  831   | FRRNoBindingResArg !Id !Int
  832 
  833   -- | Arguments to unboxed tuples must have fixed runtime representations.
  834   --
  835   -- Test case: RepPolyTuple.
  836   | FRRTupleArg !Int
  837 
  838   -- | Tuple sections must have a fixed runtime representation.
  839   --
  840   -- Test case: RepPolyTupleSection.
  841   | FRRTupleSection !Int
  842 
  843   -- | Unboxed sums must have a fixed runtime representation.
  844   --
  845   -- Test cases: RepPolySum.
  846   | FRRUnboxedSum
  847 
  848   -- | The body of a @do@ expression or a monad comprehension must
  849   -- have a fixed runtime representation.
  850   --
  851   -- Test cases: RepPolyDoBody{1,2}, RepPolyMcBody.
  852   | FRRBodyStmt !StmtOrigin !Int
  853 
  854   -- | Arguments to a guard in a monad comprehesion must have
  855   -- a fixed runtime representation.
  856   --
  857   -- Test case: RepPolyMcGuard.
  858   | FRRBodyStmtGuard
  859 
  860   -- | Arguments to `(>>=)` arising from a @do@ expression
  861   -- or a monad comprehension must have a fixed runtime representation.
  862   --
  863   -- Test cases: RepPolyDoBind, RepPolyMcBind.
  864   | FRRBindStmt !StmtOrigin
  865 
  866   -- | A value bound by a pattern guard must have a fixed runtime representation.
  867   --
  868   -- Test cases: none.
  869   | FRRBindStmtGuard
  870 
  871   -- | A representation-polymorphism check arising from arrow notation.
  872   --
  873   -- See 'FRRArrowOrigin' for more details.
  874   | FRRArrow !FRRArrowOrigin
  875 
  876   -- | A representation-polymorphic check arising from an 'HsWrapper'.
  877   --
  878   -- See 'WpFunOrigin' for more details.
  879   | FRRWpFun !WpFunOrigin
  880 
  881 -- | Print the context for a @FixedRuntimeRep@ representation-polymorphism check.
  882 --
  883 -- Note that this function does not include the specific 'RuntimeRep'
  884 -- which is not fixed. That information is added by 'GHC.Tc.Errors.mkFRRErr'.
  885 pprFRROrigin :: FRROrigin -> SDoc
  886 pprFRROrigin (FRRApp arg)
  887   = sep [ text "The function argument"
  888         , nest 2 $ quotes (ppr arg)
  889         , text "does not have a fixed runtime representation"]
  890 pprFRROrigin (FRRRecordUpdate lbl _arg)
  891   = hsep [ text "The record update at field"
  892          , quotes (ppr lbl)
  893          , text "does not have a fixed runtime representation"]
  894 pprFRROrigin (FRRBinder binder)
  895   = hsep [ text "The binder"
  896          , quotes (ppr binder)
  897          , text "does not have a fixed runtime representation"]
  898 pprFRROrigin (FRRMatch matchCtxt i)
  899   = vcat [ text "The type of the" <+> speakNth i <+> text "pattern in the" <+> pprMatchContextNoun matchCtxt
  900          , text "does not have a fixed runtime representation"]
  901 pprFRROrigin (FRRDataConArg con i)
  902   = sep [ text "The" <+> what
  903         , text "does not have a fixed runtime representation"]
  904   where
  905     what :: SDoc
  906     what
  907       | isNewDataCon con
  908       = text "newtype constructor argument"
  909       | otherwise
  910       = text "data constructor argument in" <+> speakNth i <+> text "position"
  911 pprFRROrigin (FRRNoBindingResArg fn i)
  912   = vcat [ text "Unsaturated use of a representation-polymorphic primitive function."
  913          , text "The" <+> speakNth i <+> text "argument of" <+> quotes (ppr $ getName fn)
  914          , text "does not have a fixed runtime representation" ]
  915 pprFRROrigin (FRRTupleArg i)
  916   = hsep [ text "The tuple argument in" <+> speakNth i <+> text "position"
  917          , text "does not have a fixed runtime representation"]
  918 pprFRROrigin (FRRTupleSection i)
  919   = hsep [ text "The tuple section does not have a fixed runtime representation"
  920          , text "in the" <+> speakNth i <+> text "position" ]
  921 pprFRROrigin FRRUnboxedSum
  922   = hsep [ text "The unboxed sum result type"
  923          , text "does not have a fixed runtime representation"]
  924 pprFRROrigin (FRRBodyStmt stmtOrig i)
  925   = vcat [ text "The" <+> speakNth i <+> text "argument to (>>)" <> comma
  926          , text "arising from the" <+> ppr stmtOrig <> comma
  927          , text "does not have a fixed runtime representation" ]
  928 pprFRROrigin FRRBodyStmtGuard
  929   = vcat [ text "The argument to" <+> quotes (text "guard") <> comma
  930          , text "arising from the" <+> ppr MonadComprehension <> comma
  931          , text "does not have a fixed runtime representation" ]
  932 pprFRROrigin (FRRBindStmt stmtOrig)
  933   = vcat [ text "The first argument to (>>=)" <> comma
  934          , text "arising from the" <+> ppr stmtOrig <> comma
  935          , text "does not have a fixed runtime representation" ]
  936 pprFRROrigin FRRBindStmtGuard
  937   = hsep [ text "The return type of the bind statement"
  938          , text "does not have a fixed runtime representation" ]
  939 pprFRROrigin (FRRArrow arrowOrig)
  940   = pprFRRArrowOrigin arrowOrig
  941 pprFRROrigin (FRRWpFun wpFunOrig)
  942   = pprWpFunOrigin wpFunOrig
  943 
  944 instance Outputable FRROrigin where
  945   ppr = pprFRROrigin
  946 
  947 -- | Are we in a @do@ expression or a monad comprehension?
  948 --
  949 -- This datatype is only used to report this context to the user in error messages.
  950 data StmtOrigin
  951   = MonadComprehension
  952   | DoNotation
  953 
  954 instance Outputable StmtOrigin where
  955   ppr MonadComprehension = text "monad comprehension"
  956   ppr DoNotation         = quotes ( text "do" ) <+> text "statement"
  957 
  958 {- *********************************************************************
  959 *                                                                      *
  960                        FixedRuntimeRep: arrows
  961 *                                                                      *
  962 ********************************************************************* -}
  963 
  964 -- | While typechecking arrow notation, in which context
  965 -- did a representation polymorphism check arise?
  966 --
  967 -- See 'FRROrigin' for more general origins of representation polymorphism checks.
  968 data FRRArrowOrigin
  969 
  970   -- | The result of an arrow command does not have a fixed runtime representation.
  971   --
  972   -- Test case: RepPolyArrowCmd.
  973   = ArrowCmdResTy !(HsCmd GhcRn)
  974 
  975   -- | The argument to an arrow in an arrow command application does not have
  976   -- a fixed runtime representation.
  977   --
  978   -- Test cases: none.
  979   | ArrowCmdApp !(HsCmd GhcRn) !(HsExpr GhcRn)
  980 
  981   -- | A function in an arrow application does not have
  982   -- a fixed runtime representation.
  983   --
  984   -- Test cases: none.
  985   | ArrowCmdArrApp !(HsExpr GhcRn) !(HsExpr GhcRn) !HsArrAppType
  986 
  987   -- | A pattern in an arrow command abstraction does not have
  988   -- a fixed runtime representation.
  989   --
  990   -- Test cases: none.
  991   | ArrowCmdLam !Int
  992 
  993   -- | The overall type of an arrow proc expression does not have
  994   -- a fixed runtime representation.
  995   --
  996   -- Test case: RepPolyArrowFun.
  997   | ArrowFun !(HsExpr GhcRn)
  998 
  999 pprFRRArrowOrigin :: FRRArrowOrigin -> SDoc
 1000 pprFRRArrowOrigin (ArrowCmdResTy cmd)
 1001   = vcat [ hang (text "The arrow command") 2 (quotes (ppr cmd))
 1002          , text "does not have a fixed runtime representation" ]
 1003 pprFRRArrowOrigin (ArrowCmdApp fun arg)
 1004   = vcat [ text "In the arrow command application of"
 1005          , nest 2 (quotes (ppr fun))
 1006          , text "to"
 1007          , nest 2 (quotes (ppr arg)) <> comma
 1008          , text "the argument does not have a fixed runtime representation" ]
 1009 pprFRRArrowOrigin (ArrowCmdArrApp fun arg ho_app)
 1010   = vcat [ text "In the" <+> pprHsArrType ho_app <+> text "of"
 1011          , nest 2 (quotes (ppr fun))
 1012          , text "to"
 1013          , nest 2 (quotes (ppr arg)) <> comma
 1014          , text "the function does not have a fixed runtime representation" ]
 1015 pprFRRArrowOrigin (ArrowCmdLam i)
 1016   = vcat [ text "The" <+> speakNth i <+> text "pattern of the arrow command abstraction"
 1017          , text "does not have a fixed runtime representation" ]
 1018 pprFRRArrowOrigin (ArrowFun fun)
 1019   = vcat [ text "The return type of the arrow function"
 1020          , nest 2 (quotes (ppr fun))
 1021          , text "does not have a fixed runtime representation" ]
 1022 
 1023 instance Outputable FRRArrowOrigin where
 1024   ppr = pprFRRArrowOrigin
 1025 
 1026 {- *********************************************************************
 1027 *                                                                      *
 1028               FixedRuntimeRep: HsWrapper WpFun origin
 1029 *                                                                      *
 1030 ********************************************************************* -}
 1031 
 1032 -- | While typechecking a 'WpFun' 'HsWrapper', in which context
 1033 -- did a representation polymorphism check arise?
 1034 --
 1035 -- See 'FRROrigin' for more general origins of representation polymorphism checks.
 1036 data WpFunOrigin
 1037   = WpFunSyntaxOp !CtOrigin
 1038   | WpFunViewPat  !(HsExpr GhcRn)
 1039   | WpFunFunTy    !Type
 1040   | WpFunFunExpTy !ExpType
 1041 
 1042 pprWpFunOrigin :: WpFunOrigin -> SDoc
 1043 pprWpFunOrigin (WpFunSyntaxOp orig)
 1044   = vcat [ text "When checking a rebindable syntax operator arising from"
 1045          , nest 2 (ppr orig) ]
 1046 pprWpFunOrigin (WpFunViewPat expr)
 1047   = vcat [ text "When checking the view pattern function:"
 1048          , nest 2 (ppr expr) ]
 1049 pprWpFunOrigin (WpFunFunTy fun_ty)
 1050   = vcat [ text "When inferring the argument type of a function with type"
 1051          , nest 2 (ppr fun_ty) ]
 1052 pprWpFunOrigin (WpFunFunExpTy fun_ty)
 1053   = vcat [ text "When inferring the argument type of a function with expected type"
 1054          , nest 2 (ppr fun_ty) ]
 1055 
 1056 instance Outputable WpFunOrigin where
 1057   ppr = pprWpFunOrigin