{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
module GHC.Tc.Types.Origin (
  
  UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,
  ReportRedundantConstraints(..), reportRedundantConstraints,
  redundantConstraintsSpan,
  
  SkolemInfo(..), SkolemInfoAnon(..), mkSkolemInfo, getSkolemInfo, pprSigSkolInfo, pprSkolInfo,
  unkSkol, unkSkolAnon,
  
  CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,
  isVisibleOrigin, toInvisibleOrigin,
  pprCtOrigin, isGivenOrigin, isWantedWantedFunDepOrigin,
  isWantedSuperclassOrigin,
  TypedThing(..), TyVarBndrs(..),
  
  isPushCallStackOrigin, callStackOriginFS,
  
  FixedRuntimeRepOrigin(..), FixedRuntimeRepContext(..),
  pprFixedRuntimeRepContext,
  StmtOrigin(..),
  
  FRRArrowContext(..), pprFRRArrowContext,
  ExpectedFunTyOrigin(..), pprExpectedFunTyOrigin, pprExpectedFunTyHerald,
  ) where
import GHC.Prelude
import GHC.Tc.Utils.TcType
import GHC.Hs
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.TyCon
import GHC.Core.InstEnv
import GHC.Core.PatSyn
import GHC.Core.Multiplicity ( scaledThing )
import GHC.Unit.Module
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.Basic
import GHC.Types.SrcLoc
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Stack
import GHC.Utils.Monad
import GHC.Types.Unique
import GHC.Types.Unique.Supply
data UserTypeCtxt
  = FunSigCtxt      
                    
       Name              
       ReportRedundantConstraints
         
         
         
         
         
  | InfSigCtxt Name     
  | ExprSigCtxt         
      ReportRedundantConstraints
  | KindSigCtxt         
  | StandaloneKindSigCtxt  
       Name                
  | TypeAppCtxt         
  | ConArgCtxt Name     
  | TySynCtxt Name      
  | PatSynCtxt Name     
  | PatSigCtxt          
                        
                        
  | RuleSigCtxt FastString Name    
                        
  | ForSigCtxt Name     
  | DefaultDeclCtxt     
  | InstDeclCtxt Bool   
                        
                        
  | SpecInstCtxt        
  | GenSigCtxt          
                        
                        
  | GhciCtxt Bool       
                        
                        
                        
                        
  | ClassSCCtxt Name    
  | SigmaCtxt           
                        
  | DataTyCtxt Name     
                        
  | DerivClauseCtxt     
  | TyVarBndrKindCtxt Name  
  | DataKindCtxt Name   
  | TySynKindCtxt Name  
  | TyFamResKindCtxt Name   
  deriving( UserTypeCtxt -> UserTypeCtxt -> Bool
(UserTypeCtxt -> UserTypeCtxt -> Bool)
-> (UserTypeCtxt -> UserTypeCtxt -> Bool) -> Eq UserTypeCtxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserTypeCtxt -> UserTypeCtxt -> Bool
== :: UserTypeCtxt -> UserTypeCtxt -> Bool
$c/= :: UserTypeCtxt -> UserTypeCtxt -> Bool
/= :: UserTypeCtxt -> UserTypeCtxt -> Bool
Eq ) 
data ReportRedundantConstraints
  = NoRRC            
  | WantRRC SrcSpan  
                     
                     
                     
  deriving( ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
(ReportRedundantConstraints -> ReportRedundantConstraints -> Bool)
-> (ReportRedundantConstraints
    -> ReportRedundantConstraints -> Bool)
-> Eq ReportRedundantConstraints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
== :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
$c/= :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
/= :: ReportRedundantConstraints -> ReportRedundantConstraints -> Bool
Eq )  
reportRedundantConstraints :: ReportRedundantConstraints -> Bool
reportRedundantConstraints :: ReportRedundantConstraints -> Bool
reportRedundantConstraints ReportRedundantConstraints
NoRRC        = Bool
False
reportRedundantConstraints (WantRRC {}) = Bool
True
redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
redundantConstraintsSpan :: UserTypeCtxt -> SrcSpan
redundantConstraintsSpan (FunSigCtxt Name
_ (WantRRC SrcSpan
span)) = SrcSpan
span
redundantConstraintsSpan (ExprSigCtxt (WantRRC SrcSpan
span))  = SrcSpan
span
redundantConstraintsSpan UserTypeCtxt
_ = SrcSpan
noSrcSpan
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt :: UserTypeCtxt -> SDoc
pprUserTypeCtxt (FunSigCtxt Name
n ReportRedundantConstraints
_)  = String -> SDoc
text String
"the type signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (InfSigCtxt Name
n)    = String -> SDoc
text String
"the inferred type for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (RuleSigCtxt FastString
_ Name
n) = String -> SDoc
text String
"the type signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (ExprSigCtxt ReportRedundantConstraints
_)   = String -> SDoc
text String
"an expression type signature"
pprUserTypeCtxt UserTypeCtxt
KindSigCtxt       = String -> SDoc
text String
"a kind signature"
pprUserTypeCtxt (StandaloneKindSigCtxt Name
n) = String -> SDoc
text String
"a standalone kind signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
TypeAppCtxt       = String -> SDoc
text String
"a type argument"
pprUserTypeCtxt (ConArgCtxt Name
c)    = String -> SDoc
text String
"the type of the constructor" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt (TySynCtxt Name
c)     = String -> SDoc
text String
"the RHS of the type synonym" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
PatSigCtxt        = String -> SDoc
text String
"a pattern type signature"
pprUserTypeCtxt (ForSigCtxt Name
n)    = String -> SDoc
text String
"the foreign declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt UserTypeCtxt
DefaultDeclCtxt   = String -> SDoc
text String
"a type in a `default' declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
False) = String -> SDoc
text String
"an instance declaration"
pprUserTypeCtxt (InstDeclCtxt Bool
True)  = String -> SDoc
text String
"a stand-alone deriving instance declaration"
pprUserTypeCtxt UserTypeCtxt
SpecInstCtxt      = String -> SDoc
text String
"a SPECIALISE instance pragma"
pprUserTypeCtxt UserTypeCtxt
GenSigCtxt        = String -> SDoc
text String
"a type expected by the context"
pprUserTypeCtxt (GhciCtxt {})     = String -> SDoc
text String
"a type in a GHCi command"
pprUserTypeCtxt (ClassSCCtxt Name
c)   = String -> SDoc
text String
"the super-classes of class" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
c)
pprUserTypeCtxt UserTypeCtxt
SigmaCtxt         = String -> SDoc
text String
"the context of a polymorphic type"
pprUserTypeCtxt (DataTyCtxt Name
tc)   = String -> SDoc
text String
"the context of the data type declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
tc)
pprUserTypeCtxt (PatSynCtxt Name
n)    = String -> SDoc
text String
"the signature for pattern synonym" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (UserTypeCtxt
DerivClauseCtxt) = String -> SDoc
text String
"a `deriving' clause"
pprUserTypeCtxt (TyVarBndrKindCtxt Name
n) = String -> SDoc
text String
"the kind annotation on the type variable" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (DataKindCtxt Name
n)  = String -> SDoc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TySynKindCtxt Name
n) = String -> SDoc
text String
"the kind annotation on the declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
pprUserTypeCtxt (TyFamResKindCtxt Name
n) = String -> SDoc
text String
"the result kind for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe :: UserTypeCtxt -> Maybe Name
isSigMaybe (FunSigCtxt Name
n ReportRedundantConstraints
_) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ConArgCtxt Name
n)   = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (ForSigCtxt Name
n)   = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe (PatSynCtxt Name
n)   = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
n
isSigMaybe UserTypeCtxt
_                = Maybe Name
forall a. Maybe a
Nothing
data SkolemInfo
  = SkolemInfo
      Unique 
      SkolemInfoAnon 
instance Uniquable SkolemInfo where
  getUnique :: SkolemInfo -> Unique
getUnique (SkolemInfo Unique
u SkolemInfoAnon
_) = Unique
u
data SkolemInfoAnon
  = SigSkol 
            
            
            
       UserTypeCtxt        
       TcType              
       [(Name,TcTyVar)]    
                           
  | SigTypeSkol UserTypeCtxt
                 
                 
  | ForAllSkol  
      TyVarBndrs   
                    
  | DerivSkol Type      
                        
  | InstSkol            
  | FamInstSkol         
  | PatSkol             
      ConLike           
      (HsMatchContext GhcTc)
             
             
             
             
  | IPSkol [HsIPName]   
  | RuleSkol RuleName   
  | InferSkol [(Name,TcType)]
                        
                        
                        
  | BracketSkol         
  | UnifyForAllSkol     
       TcType           
  | TyConSkol TyConFlavour Name  
  | DataConSkol Name    
                        
  | ReifySkol           
  | QuantCtxtSkol       
                        
  | RuntimeUnkSkol      
  | ArrowReboundIfSkol  
  | UnkSkol CallStack
unkSkol :: HasCallStack => SkolemInfo
unkSkol :: HasCallStack => SkolemInfo
unkSkol = Unique -> SkolemInfoAnon -> SkolemInfo
SkolemInfo (Int -> Unique
mkUniqueGrimily Int
0) SkolemInfoAnon
HasCallStack => SkolemInfoAnon
unkSkolAnon
unkSkolAnon :: HasCallStack => SkolemInfoAnon
unkSkolAnon :: HasCallStack => SkolemInfoAnon
unkSkolAnon = CallStack -> SkolemInfoAnon
UnkSkol CallStack
HasCallStack => CallStack
callStack
mkSkolemInfo :: MonadIO m => SkolemInfoAnon -> m SkolemInfo
mkSkolemInfo :: forall (m :: * -> *). MonadIO m => SkolemInfoAnon -> m SkolemInfo
mkSkolemInfo SkolemInfoAnon
sk_anon = do
  Unique
u <- IO Unique -> m Unique
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Unique -> m Unique) -> IO Unique -> m Unique
forall a b. (a -> b) -> a -> b
$! Char -> IO Unique
uniqFromMask Char
's'
  SkolemInfo -> m SkolemInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique -> SkolemInfoAnon -> SkolemInfo
SkolemInfo Unique
u SkolemInfoAnon
sk_anon)
getSkolemInfo :: SkolemInfo -> SkolemInfoAnon
getSkolemInfo :: SkolemInfo -> SkolemInfoAnon
getSkolemInfo (SkolemInfo Unique
_ SkolemInfoAnon
skol_anon) = SkolemInfoAnon
skol_anon
instance Outputable SkolemInfo where
  ppr :: SkolemInfo -> SDoc
ppr (SkolemInfo Unique
_ SkolemInfoAnon
sk_info ) = SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
sk_info
instance Outputable SkolemInfoAnon where
  ppr :: SkolemInfoAnon -> SDoc
ppr = SkolemInfoAnon -> SDoc
pprSkolInfo
pprSkolInfo :: SkolemInfoAnon -> SDoc
pprSkolInfo :: SkolemInfoAnon -> SDoc
pprSkolInfo (SigSkol UserTypeCtxt
cx TcType
ty [(Name, Id)]
_) = UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
cx TcType
ty
pprSkolInfo (SigTypeSkol UserTypeCtxt
cx)  = UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
cx
pprSkolInfo (ForAllSkol TyVarBndrs
tvs)  = String -> SDoc
text String
"an explicit forall" SDoc -> SDoc -> SDoc
<+> TyVarBndrs -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVarBndrs
tvs
pprSkolInfo (IPSkol [HsIPName]
ips)      = String -> SDoc
text String
"the implicit-parameter binding" SDoc -> SDoc -> SDoc
<> [HsIPName] -> SDoc
forall a. [a] -> SDoc
plural [HsIPName]
ips SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for"
                                 SDoc -> SDoc -> SDoc
<+> (HsIPName -> SDoc) -> [HsIPName] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsIPName]
ips
pprSkolInfo (DerivSkol TcType
pred)  = String -> SDoc
text String
"the deriving clause for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred)
pprSkolInfo SkolemInfoAnon
InstSkol          = String -> SDoc
text String
"the instance declaration"
pprSkolInfo SkolemInfoAnon
FamInstSkol       = String -> SDoc
text String
"a family instance declaration"
pprSkolInfo SkolemInfoAnon
BracketSkol       = String -> SDoc
text String
"a Template Haskell bracket"
pprSkolInfo (RuleSkol FastString
name)   = String -> SDoc
text String
"the RULE" SDoc -> SDoc -> SDoc
<+> FastString -> SDoc
pprRuleName FastString
name
pprSkolInfo (PatSkol ConLike
cl HsMatchContext GhcTc
mc)   = [SDoc] -> SDoc
sep [ ConLike -> SDoc
pprPatSkolInfo ConLike
cl
                                    , String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> HsMatchContext GhcTc -> SDoc
forall p.
(Outputable (IdP (NoGhcTc p)), UnXRec (NoGhcTc p)) =>
HsMatchContext p -> SDoc
pprMatchContext HsMatchContext GhcTc
mc ]
pprSkolInfo (InferSkol [(Name, TcType)]
ids)   = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"the inferred type" SDoc -> SDoc -> SDoc
<> [(Name, TcType)] -> SDoc
forall a. [a] -> SDoc
plural [(Name, TcType)]
ids SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"of")
                                   Int
2 ([SDoc] -> SDoc
vcat [ Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
                                           | (Name
name,TcType
ty) <- [(Name, TcType)]
ids ])
pprSkolInfo (UnifyForAllSkol TcType
ty)  = String -> SDoc
text String
"the type" SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
pprSkolInfo (TyConSkol TyConFlavour
flav Name
name) = String -> SDoc
text String
"the" SDoc -> SDoc -> SDoc
<+> TyConFlavour -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyConFlavour
flav SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"declaration for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo (DataConSkol Name
name)    = String -> SDoc
text String
"the type signature for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)
pprSkolInfo SkolemInfoAnon
ReifySkol             = String -> SDoc
text String
"the type being reified"
pprSkolInfo (QuantCtxtSkol {}) = String -> SDoc
text String
"a quantified context"
pprSkolInfo SkolemInfoAnon
RuntimeUnkSkol     = String -> SDoc
text String
"Unknown type from GHCi runtime"
pprSkolInfo SkolemInfoAnon
ArrowReboundIfSkol = String -> SDoc
text String
"the expected type of a rebound if-then-else command"
pprSkolInfo (UnkSkol CallStack
cs) = String -> SDoc
text String
"UnkSkol (please report this as a bug)" SDoc -> SDoc -> SDoc
$$ CallStack -> SDoc
prettyCallStackDoc CallStack
cs
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc
pprSigSkolInfo UserTypeCtxt
ctxt TcType
ty
  = case UserTypeCtxt
ctxt of
       FunSigCtxt Name
f ReportRedundantConstraints
_ -> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"the type signature for:"
                              , Int -> SDoc -> SDoc
nest Int
2 (Name -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc Name
f SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
       PatSynCtxt {}  -> UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt  
       UserTypeCtxt
_              -> [SDoc] -> SDoc
vcat [ UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt SDoc -> SDoc -> SDoc
<> SDoc
colon
                              , Int -> SDoc -> SDoc
nest Int
2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty) ]
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo :: ConLike -> SDoc
pprPatSkolInfo (RealDataCon DataCon
dc)
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes (\Bool
show_linear_types ->
      [SDoc] -> SDoc
sep [ String -> SDoc
text String
"a pattern with constructor:"
          , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
<+> SDoc
dcolon
            SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
pprType (Bool -> DataCon -> TcType
dataConDisplayType Bool
show_linear_types DataCon
dc) SDoc -> SDoc -> SDoc
<> SDoc
comma ])
            
            
            
pprPatSkolInfo (PatSynCon PatSyn
ps)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"a pattern with pattern synonym:"
        , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
ps SDoc -> SDoc -> SDoc
<+> SDoc
dcolon
                   SDoc -> SDoc -> SDoc
<+> PatSyn -> SDoc
pprPatSynType PatSyn
ps SDoc -> SDoc -> SDoc
<> SDoc
comma ]
data TypedThing
  = HsTypeRnThing (HsType GhcRn)
  | TypeThing Type
  | HsExprRnThing (HsExpr GhcRn)
  | NameThing Name
data TyVarBndrs
  = forall flag. OutputableBndrFlag flag 'Renamed =>
      HsTyVarBndrsRn [HsTyVarBndr flag GhcRn]
instance Outputable TypedThing where
  ppr :: TypedThing -> SDoc
ppr (HsTypeRnThing HsType GhcRn
ty) = HsType GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsType GhcRn
ty
  ppr (TypeThing TcType
ty) = TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty
  ppr (HsExprRnThing HsExpr GhcRn
expr) = HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr
  ppr (NameThing Name
name) = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name
instance Outputable TyVarBndrs where
  ppr :: TyVarBndrs -> SDoc
ppr (HsTyVarBndrsRn [HsTyVarBndr flag GhcRn]
bndrs) = [SDoc] -> SDoc
fsep ((HsTyVarBndr flag GhcRn -> SDoc)
-> [HsTyVarBndr flag GhcRn] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map HsTyVarBndr flag GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr [HsTyVarBndr flag GhcRn]
bndrs)
data CtOrigin
  = 
    
    GivenOrigin SkolemInfoAnon
  
  
  
  
  
  
  
  
  | InstSCOrigin ScDepth      
                              
                              
                              
                 TypeSize     
                              
                              
                              
  
  
  
  
  
  
  
  
  
  | OtherSCOrigin ScDepth 
                          
                  SkolemInfoAnon   
                               
  
  | OccurrenceOf Name              
  | OccurrenceOfRecSel RdrName     
  | AppOrigin                      
  | SpecPragOrigin UserTypeCtxt    
                                   
  | TypeEqOrigin { CtOrigin -> TcType
uo_actual   :: TcType
                 , CtOrigin -> TcType
uo_expected :: TcType
                 , CtOrigin -> Maybe TypedThing
uo_thing    :: Maybe TypedThing
                       
                 , CtOrigin -> Bool
uo_visible  :: Bool
                       
                       
                       
                 }
  | KindEqOrigin
      TcType TcType             
      CtOrigin                  
      (Maybe TypeOrKind)        
  | IPOccOrigin  HsIPName       
  | OverLabelOrigin FastString  
  | LiteralOrigin (HsOverLit GhcRn)     
  | NegateOrigin                        
  | ArithSeqOrigin (ArithSeqInfo GhcRn) 
  | AssocFamPatOrigin   
                        
                        
                        
  | SectionOrigin
  | HasFieldOrigin FastString
  | TupleOrigin         
  | ExprSigOrigin       
  | PatSigOrigin        
  | PatOrigin           
  | ProvCtxtOrigin      
        (PatSynBind GhcRn GhcRn) 
                                 
  | RecordUpdOrigin
  | ViewPatOrigin
  
  
  
  
  
  | ScOrigin TypeSize
  | DerivClauseOrigin   
                        
  | DerivOriginDC DataCon Int Bool
      
      
      
      
      
      
      
  | DerivOriginCoerce Id Type Type Bool
                        
                        
  | StandAloneDerivOrigin 
                          
                          
                          
                          
  | DefaultOrigin       
  | DoOrigin            
  | DoPatOrigin (LPat GhcRn) 
                             
  | MCompOrigin         
  | MCompPatOrigin (LPat GhcRn) 
                                
  | ProcOrigin          
  | ArrowCmdOrigin      
  | AnnOrigin           
  | FunDepOrigin1       
        PredType CtOrigin RealSrcSpan      
        PredType CtOrigin RealSrcSpan      
  | FunDepOrigin2       
        PredType CtOrigin   
        PredType SrcSpan    
        
        
  | InjTFOrigin1    
      PredType CtOrigin RealSrcSpan    
      PredType CtOrigin RealSrcSpan    
  | ExprHoleOrigin (Maybe OccName)   
  | TypeHoleOrigin OccName   
  | PatCheckOrigin      
  | ListOrigin          
  | IfThenElseOrigin    
  | BracketOrigin       
  | StaticOrigin        
  | Shouldn'tHappenOrigin String
                            
  | GhcBug20076             
  
  
  
  
  | InstProvidedOrigin
      Module  
      ClsInst 
  | NonLinearPatternOrigin
  | UsageEnvironmentOf Name
  | CycleBreakerOrigin
      CtOrigin   
      
  | FRROrigin
      FixedRuntimeRepOrigin
  | WantedSuperclassOrigin PredType CtOrigin
        
        
        
  | InstanceSigOrigin   
      Name   
      Type   
      Type   
  | AmbiguityCheckOrigin UserTypeCtxt
type ScDepth = Int
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin :: CtOrigin -> Bool
isVisibleOrigin (TypeEqOrigin { uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis }) = Bool
vis
isVisibleOrigin (KindEqOrigin TcType
_ TcType
_ CtOrigin
sub_orig Maybe TypeOrKind
_)       = CtOrigin -> Bool
isVisibleOrigin CtOrigin
sub_orig
isVisibleOrigin CtOrigin
_                                   = Bool
True
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin :: CtOrigin -> CtOrigin
toInvisibleOrigin orig :: CtOrigin
orig@(TypeEqOrigin {}) = CtOrigin
orig { uo_visible :: Bool
uo_visible = Bool
False }
toInvisibleOrigin CtOrigin
orig                   = CtOrigin
orig
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin :: CtOrigin -> Bool
isGivenOrigin (GivenOrigin {})              = Bool
True
isGivenOrigin (InstSCOrigin {})             = Bool
True
isGivenOrigin (OtherSCOrigin {})            = Bool
True
isGivenOrigin (CycleBreakerOrigin CtOrigin
o)        = CtOrigin -> Bool
isGivenOrigin CtOrigin
o
isGivenOrigin CtOrigin
_                             = Bool
False
isWantedWantedFunDepOrigin :: CtOrigin -> Bool
isWantedWantedFunDepOrigin :: CtOrigin -> Bool
isWantedWantedFunDepOrigin (FunDepOrigin1 TcType
_ CtOrigin
orig1 RealSrcSpan
_ TcType
_ CtOrigin
orig2 RealSrcSpan
_)
  = Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig2)
isWantedWantedFunDepOrigin (InjTFOrigin1 TcType
_ CtOrigin
orig1 RealSrcSpan
_ TcType
_ CtOrigin
orig2 RealSrcSpan
_)
  = Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig1) Bool -> Bool -> Bool
&& Bool -> Bool
not (CtOrigin -> Bool
isGivenOrigin CtOrigin
orig2)
isWantedWantedFunDepOrigin CtOrigin
_ = Bool
False
isWantedSuperclassOrigin :: CtOrigin -> Bool
isWantedSuperclassOrigin :: CtOrigin -> Bool
isWantedSuperclassOrigin (WantedSuperclassOrigin {}) = Bool
True
isWantedSuperclassOrigin CtOrigin
_                           = Bool
False
instance Outputable CtOrigin where
  ppr :: CtOrigin -> SDoc
ppr = CtOrigin -> SDoc
pprCtOrigin
ctoHerald :: SDoc
ctoHerald :: SDoc
ctoHerald = String -> SDoc
text String
"arising from"
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin
lexprCtOrigin (L SrcSpanAnnA
_ HsExpr GhcRn
e) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin :: HsExpr GhcRn -> CtOrigin
exprCtOrigin (HsVar XVar GhcRn
_ (L SrcSpanAnnN
_ Name
name)) = Name -> CtOrigin
OccurrenceOf Name
name
exprCtOrigin (HsGetField XGetField GhcRn
_ LHsExpr GhcRn
_ (L SrcAnn NoEpAnns
_ DotFieldOcc GhcRn
f)) = FastString -> CtOrigin
HasFieldOrigin (GenLocated SrcSpanAnnN FastString -> FastString
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN FastString -> FastString)
-> GenLocated SrcSpanAnnN FastString -> FastString
forall a b. (a -> b) -> a -> b
$ DotFieldOcc GhcRn -> XRec GhcRn FastString
forall p. DotFieldOcc p -> XRec p FastString
dfoLabel DotFieldOcc GhcRn
f)
exprCtOrigin (HsUnboundVar {})    = String -> CtOrigin
Shouldn'tHappenOrigin String
"unbound variable"
exprCtOrigin (HsRecSel XRecSel GhcRn
_ FieldOcc GhcRn
f)       = RdrName -> CtOrigin
OccurrenceOfRecSel (GenLocated SrcSpanAnnN RdrName -> RdrName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnN RdrName -> RdrName)
-> GenLocated SrcSpanAnnN RdrName -> RdrName
forall a b. (a -> b) -> a -> b
$ FieldOcc GhcRn -> XRec GhcRn RdrName
forall pass. FieldOcc pass -> XRec pass RdrName
foLabel FieldOcc GhcRn
f)
exprCtOrigin (HsOverLabel XOverLabel GhcRn
_ FastString
l)    = FastString -> CtOrigin
OverLabelOrigin FastString
l
exprCtOrigin (ExplicitList {})    = CtOrigin
ListOrigin
exprCtOrigin (HsIPVar XIPVar GhcRn
_ HsIPName
ip)       = HsIPName -> CtOrigin
IPOccOrigin HsIPName
ip
exprCtOrigin (HsOverLit XOverLitE GhcRn
_ HsOverLit GhcRn
lit)    = HsOverLit GhcRn -> CtOrigin
LiteralOrigin HsOverLit GhcRn
lit
exprCtOrigin (HsLit {})           = String -> CtOrigin
Shouldn'tHappenOrigin String
"concrete literal"
exprCtOrigin (HsLam XLam GhcRn
_ MatchGroup GhcRn (LHsExpr GhcRn)
matches)    = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsLamCase XLamCase GhcRn
_ LamCaseVariant
_ MatchGroup GhcRn (LHsExpr GhcRn)
ms)   = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
ms
exprCtOrigin (HsApp XApp GhcRn
_ LHsExpr GhcRn
e1 LHsExpr GhcRn
_)       = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (HsAppType XAppTypeE GhcRn
_ LHsExpr GhcRn
e1 LHsWcType (NoGhcTc GhcRn)
_)   = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e1
exprCtOrigin (OpApp XOpApp GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
op LHsExpr GhcRn
_)     = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
op
exprCtOrigin (NegApp XNegApp GhcRn
_ LHsExpr GhcRn
e SyntaxExpr GhcRn
_)       = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsPar XPar GhcRn
_ LHsToken "(" GhcRn
_ LHsExpr GhcRn
e LHsToken ")" GhcRn
_)      = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsProjection XProjection GhcRn
_ NonEmpty (XRec GhcRn (DotFieldOcc GhcRn))
_)   = CtOrigin
SectionOrigin
exprCtOrigin (SectionL XSectionL GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_)     = CtOrigin
SectionOrigin
exprCtOrigin (SectionR XSectionR GhcRn
_ LHsExpr GhcRn
_ LHsExpr GhcRn
_)     = CtOrigin
SectionOrigin
exprCtOrigin (ExplicitTuple {})   = String -> CtOrigin
Shouldn'tHappenOrigin String
"explicit tuple"
exprCtOrigin ExplicitSum{}        = String -> CtOrigin
Shouldn'tHappenOrigin String
"explicit sum"
exprCtOrigin (HsCase XCase GhcRn
_ LHsExpr GhcRn
_ MatchGroup GhcRn (LHsExpr GhcRn)
matches) = MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin MatchGroup GhcRn (LHsExpr GhcRn)
matches
exprCtOrigin (HsIf {})           = CtOrigin
IfThenElseOrigin
exprCtOrigin (HsMultiIf XMultiIf GhcRn
_ [LGRHS GhcRn (LHsExpr GhcRn)]
rhs)   = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
rhs
exprCtOrigin (HsLet XLet GhcRn
_ LHsToken "let" GhcRn
_ HsLocalBinds GhcRn
_ LHsToken "in" GhcRn
_ LHsExpr GhcRn
e)   = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsDo {})           = CtOrigin
DoOrigin
exprCtOrigin (RecordCon {})      = String -> CtOrigin
Shouldn'tHappenOrigin String
"record construction"
exprCtOrigin (RecordUpd {})      = CtOrigin
RecordUpdOrigin
exprCtOrigin (ExprWithTySig {})  = CtOrigin
ExprSigOrigin
exprCtOrigin (ArithSeq {})       = String -> CtOrigin
Shouldn'tHappenOrigin String
"arithmetic sequence"
exprCtOrigin (HsPragE XPragE GhcRn
_ HsPragE GhcRn
_ LHsExpr GhcRn
e)     = LHsExpr GhcRn -> CtOrigin
lexprCtOrigin LHsExpr GhcRn
e
exprCtOrigin (HsTypedBracket {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH typed bracket"
exprCtOrigin (HsUntypedBracket {}) = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH untyped bracket"
exprCtOrigin (HsSpliceE {})      = String -> CtOrigin
Shouldn'tHappenOrigin String
"TH splice"
exprCtOrigin (HsProc {})         = String -> CtOrigin
Shouldn'tHappenOrigin String
"proc"
exprCtOrigin (HsStatic {})       = String -> CtOrigin
Shouldn'tHappenOrigin String
"static expression"
exprCtOrigin (XExpr (HsExpanded HsExpr GhcRn
a HsExpr GhcRn
_)) = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
a
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
matchesCtOrigin (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = XRec GhcRn [LMatch GhcRn (LHsExpr GhcRn)]
alts })
  | L SrcSpanAnnL
_ [L SrcSpanAnnA
_ Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match] <- XRec GhcRn [LMatch GhcRn (LHsExpr GhcRn)]
alts
  , Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhss } <- Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match
  = GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin GRHSs GhcRn (LHsExpr GhcRn)
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhss
  | Bool
otherwise
  = String -> CtOrigin
Shouldn'tHappenOrigin String
"multi-way match"
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin
grhssCtOrigin (GRHSs { grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssGRHSs = [LGRHS GhcRn (LHsExpr GhcRn)]
lgrhss }) = [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
lgrhss
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin
lGRHSCtOrigin [L SrcAnn NoEpAnns
_ (GRHS XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
_ [GuardLStmt GhcRn]
_ (L SrcSpanAnnA
_ HsExpr GhcRn
e))] = HsExpr GhcRn -> CtOrigin
exprCtOrigin HsExpr GhcRn
e
lGRHSCtOrigin [LGRHS GhcRn (LHsExpr GhcRn)]
_ = String -> CtOrigin
Shouldn'tHappenOrigin String
"multi-way GRHS"
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin :: CtOrigin -> SDoc
pprCtOrigin (GivenOrigin SkolemInfoAnon
sk)     = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfoAnon -> SDoc
forall a. Outputable a => a -> SDoc
ppr SkolemInfoAnon
sk
pprCtOrigin (InstSCOrigin {})    = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfoAnon -> SDoc
pprSkolInfo SkolemInfoAnon
InstSkol   
pprCtOrigin (OtherSCOrigin Int
_ SkolemInfoAnon
si) = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> SkolemInfoAnon -> SDoc
pprSkolInfo SkolemInfoAnon
si
pprCtOrigin (SpecPragOrigin UserTypeCtxt
ctxt)
  = case UserTypeCtxt
ctxt of
       FunSigCtxt Name
n ReportRedundantConstraints
_ -> String -> SDoc
text String
"for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n)
       UserTypeCtxt
SpecInstCtxt   -> String -> SDoc
text String
"a SPECIALISE INSTANCE pragma"
       UserTypeCtxt
_              -> String -> SDoc
text String
"a SPECIALISE pragma"  
pprCtOrigin (FunDepOrigin1 TcType
pred1 CtOrigin
orig1 RealSrcSpan
loc1 TcType
pred2 CtOrigin
orig2 RealSrcSpan
loc2)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a functional dependency between constraints:")
       Int
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1)) Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc1)
               , SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2)) Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig2 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc2) ])
pprCtOrigin (FunDepOrigin2 TcType
pred1 CtOrigin
orig1 TcType
pred2 SrcSpan
loc2)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a functional dependency between:")
       Int
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"constraint" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1))
                    Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 )
               , SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"instance" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2))
                    Int
2 (String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr SrcSpan
loc2) ])
pprCtOrigin (InjTFOrigin1 TcType
pred1 CtOrigin
orig1 RealSrcSpan
loc1 TcType
pred2 CtOrigin
orig2 RealSrcSpan
loc2)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"reasoning about an injective type family using constraints:")
       Int
2 ([SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred1)) Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig1 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc1)
               , SDoc -> Int -> SDoc -> SDoc
hang (SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
pred2)) Int
2 (CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig2 SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at" SDoc -> SDoc -> SDoc
<+> RealSrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
ppr RealSrcSpan
loc2) ])
pprCtOrigin CtOrigin
AssocFamPatOrigin
  = String -> SDoc
text String
"when matching a family LHS with its class instance head"
pprCtOrigin (TypeEqOrigin { uo_actual :: CtOrigin -> TcType
uo_actual = TcType
t1, uo_expected :: CtOrigin -> TcType
uo_expected =  TcType
t2, uo_visible :: CtOrigin -> Bool
uo_visible = Bool
vis })
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a type equality" SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (SDoc -> SDoc
brackets (Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
vis)))
       Int
2 ([SDoc] -> SDoc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
char Char
'~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2])
pprCtOrigin (KindEqOrigin TcType
t1 TcType
t2 CtOrigin
_ Maybe TypeOrKind
_)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a kind equality arising from")
       Int
2 ([SDoc] -> SDoc
sep [TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t1, Char -> SDoc
char Char
'~', TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
t2])
pprCtOrigin (DerivOriginDC DataCon
dc Int
n Bool
_)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
n
          SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"field of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc))
       Int
2 (SDoc -> SDoc
parens (String -> SDoc
text String
"type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Scaled TcType -> TcType
forall a. Scaled a -> a
scaledThing Scaled TcType
ty))))
  where
    ty :: Scaled TcType
ty = DataCon -> [Scaled TcType]
dataConOrigArgTys DataCon
dc [Scaled TcType] -> Int -> Scaled TcType
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
pprCtOrigin (DerivOriginCoerce Id
meth TcType
ty1 TcType
ty2 Bool
_)
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the coercion of the method" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Id -> SDoc
forall a. Outputable a => a -> SDoc
ppr Id
meth))
       Int
2 ([SDoc] -> SDoc
sep [ String -> SDoc
text String
"from type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty1)
              , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"to type" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
ty2) ])
pprCtOrigin (DoPatOrigin LPat GhcRn
pat)
    = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a do statement"
      SDoc -> SDoc -> SDoc
$$
      String -> SDoc
text String
"with the failable pattern" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat)
pprCtOrigin (MCompPatOrigin LPat GhcRn
pat)
    = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep [ String -> SDoc
text String
"the failable pattern"
           , SDoc -> SDoc
quotes (GenLocated SrcSpanAnnA (Pat GhcRn) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
pat)
           , String -> SDoc
text String
"in a statement in a monad comprehension" ]
pprCtOrigin (Shouldn'tHappenOrigin String
note)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"<< This should not appear in error messages. If you see this"
         , String -> SDoc
text String
"in an error message, please report a bug mentioning"
             SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
note) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"at"
         , String -> SDoc
text String
"https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>"
         ]
pprCtOrigin CtOrigin
GhcBug20076
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"GHC Bug #20076 <https://gitlab.haskell.org/ghc/ghc/-/issues/20076>"
         , String -> SDoc
text String
"Assuming you have a partial type signature, you can avoid this error"
         , String -> SDoc
text String
"by either adding an extra-constraints wildcard (like `(..., _) => ...`,"
         , String -> SDoc
text String
"with the underscore at the end of the constraint), or by avoiding the"
         , String -> SDoc
text String
"use of a simplifiable constraint in your partial type signature." ]
pprCtOrigin (ProvCtxtOrigin PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id = (L SrcSpanAnnN
_ Name
name) })
  = SDoc -> Int -> SDoc -> SDoc
hang (SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the \"provided\" constraints claimed by")
       Int
2 (String -> SDoc
text String
"the signature of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name))
pprCtOrigin (InstProvidedOrigin Module
mod ClsInst
cls_inst)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"arising when attempting to show that"
         , ClsInst -> SDoc
forall a. Outputable a => a -> SDoc
ppr ClsInst
cls_inst
         , String -> SDoc
text String
"is provided by" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
mod)]
pprCtOrigin (CycleBreakerOrigin CtOrigin
orig)
  = CtOrigin -> SDoc
pprCtOrigin CtOrigin
orig
pprCtOrigin (FRROrigin {})
  = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a representation-polymorphism check"
pprCtOrigin (WantedSuperclassOrigin TcType
subclass_pred CtOrigin
subclass_orig)
  = [SDoc] -> SDoc
sep [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a superclass required to satisfy" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
subclass_pred) SDoc -> SDoc -> SDoc
<> SDoc
comma
        , CtOrigin -> SDoc
pprCtOrigin CtOrigin
subclass_orig ]
pprCtOrigin (InstanceSigOrigin Name
method_name TcType
sig_type TcType
orig_method_type)
  = [SDoc] -> SDoc
vcat [ SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the check that an instance signature is more general"
         , String -> SDoc
text String
"than the type of the method (instantiated for this instance)"
         , SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"instance signature:")
              Int
2 (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
method_name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
sig_type)
         , SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"instantiated method type:")
              Int
2 (TcType -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcType
orig_method_type) ]
pprCtOrigin (AmbiguityCheckOrigin UserTypeCtxt
ctxt)
  = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"a type ambiguity check for" SDoc -> SDoc -> SDoc
$$
    UserTypeCtxt -> SDoc
pprUserTypeCtxt UserTypeCtxt
ctxt
pprCtOrigin CtOrigin
simple_origin
  = SDoc
ctoHerald SDoc -> SDoc -> SDoc
<+> HasCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
simple_origin
pprCtO :: HasCallStack => CtOrigin -> SDoc
pprCtO :: HasCallStack => CtOrigin -> SDoc
pprCtO (OccurrenceOf Name
name)   = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"a use of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name)]
pprCtO (OccurrenceOfRecSel RdrName
name) = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"a use of", SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
name)]
pprCtO CtOrigin
AppOrigin             = String -> SDoc
text String
"an application"
pprCtO (IPOccOrigin HsIPName
name)    = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"a use of implicit parameter", SDoc -> SDoc
quotes (HsIPName -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPName
name)]
pprCtO (OverLabelOrigin FastString
l)   = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"the overloaded label"
                                    ,SDoc -> SDoc
quotes (Char -> SDoc
char Char
'#' SDoc -> SDoc -> SDoc
<> FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
l)]
pprCtO CtOrigin
RecordUpdOrigin       = String -> SDoc
text String
"a record update"
pprCtO CtOrigin
ExprSigOrigin         = String -> SDoc
text String
"an expression type signature"
pprCtO CtOrigin
PatSigOrigin          = String -> SDoc
text String
"a pattern type signature"
pprCtO CtOrigin
PatOrigin             = String -> SDoc
text String
"a pattern"
pprCtO CtOrigin
ViewPatOrigin         = String -> SDoc
text String
"a view pattern"
pprCtO (LiteralOrigin HsOverLit GhcRn
lit)   = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"the literal", SDoc -> SDoc
quotes (HsOverLit GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsOverLit GhcRn
lit)]
pprCtO (ArithSeqOrigin ArithSeqInfo GhcRn
seq)  = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"the arithmetic sequence", SDoc -> SDoc
quotes (ArithSeqInfo GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr ArithSeqInfo GhcRn
seq)]
pprCtO CtOrigin
SectionOrigin         = String -> SDoc
text String
"an operator section"
pprCtO (HasFieldOrigin FastString
f)    = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"selecting the field", SDoc -> SDoc
quotes (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
f)]
pprCtO CtOrigin
AssocFamPatOrigin     = String -> SDoc
text String
"the LHS of a family instance"
pprCtO CtOrigin
TupleOrigin           = String -> SDoc
text String
"a tuple"
pprCtO CtOrigin
NegateOrigin          = String -> SDoc
text String
"a use of syntactic negation"
pprCtO (ScOrigin TypeSize
n)          = String -> SDoc
text String
"the superclasses of an instance declaration"
                               SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
whenPprDebug (SDoc -> SDoc
parens (TypeSize -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypeSize
n))
pprCtO CtOrigin
DerivClauseOrigin     = String -> SDoc
text String
"the 'deriving' clause of a data type declaration"
pprCtO CtOrigin
StandAloneDerivOrigin = String -> SDoc
text String
"a 'deriving' declaration"
pprCtO CtOrigin
DefaultOrigin         = String -> SDoc
text String
"a 'default' declaration"
pprCtO CtOrigin
DoOrigin              = String -> SDoc
text String
"a do statement"
pprCtO CtOrigin
MCompOrigin           = String -> SDoc
text String
"a statement in a monad comprehension"
pprCtO CtOrigin
ProcOrigin            = String -> SDoc
text String
"a proc expression"
pprCtO CtOrigin
ArrowCmdOrigin        = String -> SDoc
text String
"an arrow command"
pprCtO CtOrigin
AnnOrigin             = String -> SDoc
text String
"an annotation"
pprCtO (ExprHoleOrigin Maybe OccName
Nothing)    = String -> SDoc
text String
"an expression hole"
pprCtO (ExprHoleOrigin (Just OccName
occ)) = String -> SDoc
text String
"a use of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
pprCtO (TypeHoleOrigin OccName
occ)  = String -> SDoc
text String
"a use of wildcard" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
occ)
pprCtO CtOrigin
PatCheckOrigin        = String -> SDoc
text String
"a pattern-match completeness check"
pprCtO CtOrigin
ListOrigin            = String -> SDoc
text String
"an overloaded list"
pprCtO CtOrigin
IfThenElseOrigin      = String -> SDoc
text String
"an if-then-else expression"
pprCtO CtOrigin
StaticOrigin          = String -> SDoc
text String
"a static form"
pprCtO CtOrigin
NonLinearPatternOrigin = String -> SDoc
text String
"a non-linear pattern"
pprCtO (UsageEnvironmentOf Name
x) = [SDoc] -> SDoc
hsep [String -> SDoc
text String
"multiplicity of", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
x)]
pprCtO CtOrigin
BracketOrigin         = String -> SDoc
text String
"a quotation bracket"
pprCtO (GivenOrigin {})             = String -> SDoc
text String
"a given constraint"
pprCtO (InstSCOrigin {})            = String -> SDoc
text String
"the superclass of an instance constraint"
pprCtO (OtherSCOrigin {})           = String -> SDoc
text String
"the superclass of a given constraint"
pprCtO (SpecPragOrigin {})          = String -> SDoc
text String
"a SPECIALISE pragma"
pprCtO (FunDepOrigin1 {})           = String -> SDoc
text String
"a functional dependency"
pprCtO (FunDepOrigin2 {})           = String -> SDoc
text String
"a functional dependency"
pprCtO (InjTFOrigin1 {})            = String -> SDoc
text String
"an injective type family"
pprCtO (TypeEqOrigin {})            = String -> SDoc
text String
"a type equality"
pprCtO (KindEqOrigin {})            = String -> SDoc
text String
"a kind equality"
pprCtO (DerivOriginDC {})           = String -> SDoc
text String
"a deriving clause"
pprCtO (DerivOriginCoerce {})       = String -> SDoc
text String
"a derived method"
pprCtO (DoPatOrigin {})             = String -> SDoc
text String
"a do statement"
pprCtO (MCompPatOrigin {})          = String -> SDoc
text String
"a monad comprehension pattern"
pprCtO (Shouldn'tHappenOrigin String
note) = String -> SDoc
text String
note
pprCtO (ProvCtxtOrigin {})          = String -> SDoc
text String
"a provided constraint"
pprCtO (InstProvidedOrigin {})      = String -> SDoc
text String
"a provided constraint"
pprCtO (CycleBreakerOrigin CtOrigin
orig)    = HasCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
orig
pprCtO (FRROrigin {})               = String -> SDoc
text String
"a representation-polymorphism check"
pprCtO CtOrigin
GhcBug20076                  = String -> SDoc
text String
"GHC Bug #20076"
pprCtO (WantedSuperclassOrigin {})  = String -> SDoc
text String
"a superclass constraint"
pprCtO (InstanceSigOrigin {})       = String -> SDoc
text String
"a type signature in an instance"
pprCtO (AmbiguityCheckOrigin {})    = String -> SDoc
text String
"a type ambiguity check"
isPushCallStackOrigin :: CtOrigin -> Bool
isPushCallStackOrigin :: CtOrigin -> Bool
isPushCallStackOrigin (IPOccOrigin {}) = Bool
False
isPushCallStackOrigin CtOrigin
_                = Bool
True
callStackOriginFS :: CtOrigin -> FastString
callStackOriginFS :: CtOrigin -> FastString
callStackOriginFS (OccurrenceOf Name
fun) = OccName -> FastString
occNameFS (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
fun)
callStackOriginFS CtOrigin
orig               = String -> FastString
mkFastString (SDoc -> String
showSDocUnsafe (HasCallStack => CtOrigin -> SDoc
CtOrigin -> SDoc
pprCtO CtOrigin
orig))
data FixedRuntimeRepOrigin
  = FixedRuntimeRepOrigin
    { FixedRuntimeRepOrigin -> TcType
frr_type    :: Type
       
       
    , FixedRuntimeRepOrigin -> FixedRuntimeRepContext
frr_context :: FixedRuntimeRepContext
      
    }
data FixedRuntimeRepContext
  
  
  
  = FRRRecordUpdate !RdrName !(HsExpr GhcTc)
  
  
  
  | FRRBinder !Name
  
  
  
  | FRRPatBind
  
  
  
  | FRRPatSynArg
  
  
  
  
  | FRRCase
  
  
  
  
  
  
  
  
  | FRRDataConArg !ExprOrPat !DataCon !Int
  
  
  
  
  | FRRNoBindingResArg !Id !Int
  
  
  
  | FRRTupleArg !Int
  
  
  
  | FRRTupleSection !Int
  
  
  
  | FRRUnboxedSum
  
  
  
  
  | FRRBodyStmt !StmtOrigin !Int
  
  
  
  
  | FRRBodyStmtGuard
  
  
  
  
  | FRRBindStmt !StmtOrigin
  
  
  
  | FRRBindStmtGuard
  
  
  
  | FRRArrow !FRRArrowContext
  
  
  
  
  | FRRExpectedFunTy
      !ExpectedFunTyOrigin
      !Int
        
pprFixedRuntimeRepContext :: FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext :: FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext (FRRRecordUpdate RdrName
lbl HsExpr GhcTc
_arg)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The record update at field"
        , SDoc -> SDoc
quotes (RdrName -> SDoc
forall a. Outputable a => a -> SDoc
ppr RdrName
lbl) ]
pprFixedRuntimeRepContext (FRRBinder Name
binder)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The binder"
        , SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
binder) ]
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRPatBind
  = String -> SDoc
text String
"The pattern binding"
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRPatSynArg
  = String -> SDoc
text String
"The pattern synonym argument pattern"
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRCase
  = String -> SDoc
text String
"The scrutinee of the case statement"
pprFixedRuntimeRepContext (FRRDataConArg ExprOrPat
expr_or_pat DataCon
con Int
i)
  = String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> SDoc
what
  where
    arg, what :: SDoc
    arg :: SDoc
arg = case ExprOrPat
expr_or_pat of
      ExprOrPat
Expression -> String -> SDoc
text String
"argument"
      ExprOrPat
Pattern    -> String -> SDoc
text String
"pattern"
    what :: SDoc
what
      | DataCon -> Bool
isNewDataCon DataCon
con
      = String -> SDoc
text String
"newtype constructor" SDoc -> SDoc -> SDoc
<+> SDoc
arg
      | Bool
otherwise
      = String -> SDoc
text String
"data constructor" SDoc -> SDoc -> SDoc
<+> SDoc
arg SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"position"
pprFixedRuntimeRepContext (FRRNoBindingResArg Id
fn Int
i)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"Unsaturated use of a representation-polymorphic primitive function."
         , String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"argument of" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Name -> SDoc) -> Name -> SDoc
forall a b. (a -> b) -> a -> b
$ Id -> Name
forall a. NamedThing a => a -> Name
getName Id
fn) ]
pprFixedRuntimeRepContext (FRRTupleArg Int
i)
  = String -> SDoc
text String
"The tuple argument in" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"position"
pprFixedRuntimeRepContext (FRRTupleSection Int
i)
  = String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"component of the tuple section"
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRUnboxedSum
  = String -> SDoc
text String
"The unboxed sum"
pprFixedRuntimeRepContext (FRRBodyStmt StmtOrigin
stmtOrig Int
i)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"argument to (>>)" SDoc -> SDoc -> SDoc
<> SDoc
comma
         , String -> SDoc
text String
"arising from the" SDoc -> SDoc -> SDoc
<+> StmtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtOrigin
stmtOrig SDoc -> SDoc -> SDoc
<> SDoc
comma ]
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRBodyStmtGuard
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The argument to" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (String -> SDoc
text String
"guard") SDoc -> SDoc -> SDoc
<> SDoc
comma
         , String -> SDoc
text String
"arising from the" SDoc -> SDoc -> SDoc
<+> StmtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtOrigin
MonadComprehension SDoc -> SDoc -> SDoc
<> SDoc
comma ]
pprFixedRuntimeRepContext (FRRBindStmt StmtOrigin
stmtOrig)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The first argument to (>>=)" SDoc -> SDoc -> SDoc
<> SDoc
comma
         , String -> SDoc
text String
"arising from the" SDoc -> SDoc -> SDoc
<+> StmtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr StmtOrigin
stmtOrig SDoc -> SDoc -> SDoc
<> SDoc
comma ]
pprFixedRuntimeRepContext FixedRuntimeRepContext
FRRBindStmtGuard
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The body of the bind statement" ]
pprFixedRuntimeRepContext (FRRArrow FRRArrowContext
arrowContext)
  = FRRArrowContext -> SDoc
pprFRRArrowContext FRRArrowContext
arrowContext
pprFixedRuntimeRepContext (FRRExpectedFunTy ExpectedFunTyOrigin
funTyOrig Int
arg_pos)
  = ExpectedFunTyOrigin -> Int -> SDoc
pprExpectedFunTyOrigin ExpectedFunTyOrigin
funTyOrig Int
arg_pos
instance Outputable FixedRuntimeRepContext where
  ppr :: FixedRuntimeRepContext -> SDoc
ppr = FixedRuntimeRepContext -> SDoc
pprFixedRuntimeRepContext
data StmtOrigin
  = MonadComprehension
  | DoNotation
instance Outputable StmtOrigin where
  ppr :: StmtOrigin -> SDoc
ppr StmtOrigin
MonadComprehension = String -> SDoc
text String
"monad comprehension"
  ppr StmtOrigin
DoNotation         = SDoc -> SDoc
quotes ( String -> SDoc
text String
"do" ) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"statement"
data FRRArrowContext
  
  
  
  = ArrowCmdResTy !(HsCmd GhcRn)
  
  
  
  
  | ArrowCmdApp !(HsCmd GhcRn) !(HsExpr GhcRn)
  
  
  
  
  | ArrowCmdArrApp !(HsExpr GhcRn) !(HsExpr GhcRn) !HsArrAppType
  
  
  
  
  | ArrowCmdCase
  
  
  
  
  | ArrowFun !(HsExpr GhcRn)
pprFRRArrowContext :: FRRArrowContext -> SDoc
pprFRRArrowContext :: FRRArrowContext -> SDoc
pprFRRArrowContext (ArrowCmdResTy HsCmd GhcRn
cmd)
  = [SDoc] -> SDoc
vcat [ SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"The arrow command") Int
2 (SDoc -> SDoc
quotes (HsCmd GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcRn
cmd)) ]
pprFRRArrowContext (ArrowCmdApp HsCmd GhcRn
fun HsExpr GhcRn
arg)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The argument in the arrow command application of"
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc
quotes (HsCmd GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsCmd GhcRn
fun))
         , String -> SDoc
text String
"to"
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
arg)) ]
pprFRRArrowContext (ArrowCmdArrApp HsExpr GhcRn
fun HsExpr GhcRn
arg HsArrAppType
ho_app)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The function in the" SDoc -> SDoc -> SDoc
<+> HsArrAppType -> SDoc
pprHsArrType HsArrAppType
ho_app SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"of"
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
fun))
         , String -> SDoc
text String
"to"
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
arg)) ]
pprFRRArrowContext FRRArrowContext
ArrowCmdCase
  = String -> SDoc
text String
"The scrutinee of the arrow case command"
pprFRRArrowContext (ArrowFun HsExpr GhcRn
fun)
  = [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The return type of the arrow function"
         , Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
fun)) ]
instance Outputable FRRArrowContext where
  ppr :: FRRArrowContext -> SDoc
ppr = FRRArrowContext -> SDoc
pprFRRArrowContext
data ExpectedFunTyOrigin
  
  
  
  
  = ExpectedFunTySyntaxOp
    !CtOrigin
    !(HsExpr GhcRn)
      
  
  
  
  
  | ExpectedFunTyViewPat
    !(HsExpr GhcRn)
      
  
  
  
  
  | forall (p :: Pass)
      . (OutputableBndrId p)
      => ExpectedFunTyArg
          !TypedThing
            
          !(HsExpr (GhcPass p))
            
  
  
  
  
  
  | ExpectedFunTyMatches
      !TypedThing
        
      !(MatchGroup GhcRn (LHsExpr GhcRn))
       
  
  
  
  
  | ExpectedFunTyLam
      !(MatchGroup GhcRn (LHsExpr GhcRn))
  
  
  
  
  | ExpectedFunTyLamCase
      LamCaseVariant
      !(HsExpr GhcRn)
       
pprExpectedFunTyOrigin :: ExpectedFunTyOrigin
                       -> Int 
                       -> SDoc
pprExpectedFunTyOrigin :: ExpectedFunTyOrigin -> Int -> SDoc
pprExpectedFunTyOrigin ExpectedFunTyOrigin
funTy_origin Int
i =
  case ExpectedFunTyOrigin
funTy_origin of
    ExpectedFunTySyntaxOp CtOrigin
orig HsExpr GhcRn
op ->
      [SDoc] -> SDoc
vcat [ [SDoc] -> SDoc
sep [ SDoc
the_arg_of
                 , String -> SDoc
text String
"the rebindable syntax operator"
                 , SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
op) ]
           , Int -> SDoc -> SDoc
nest Int
2 (CtOrigin -> SDoc
forall a. Outputable a => a -> SDoc
ppr CtOrigin
orig) ]
    ExpectedFunTyViewPat HsExpr GhcRn
expr ->
      [SDoc] -> SDoc
vcat [ SDoc
the_arg_of SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"the view pattern"
           , Int -> SDoc -> SDoc
nest Int
2 (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr) ]
    ExpectedFunTyArg TypedThing
fun HsExpr (GhcPass p)
arg ->
      [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The argument"
          , SDoc -> SDoc
quotes (HsExpr (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr (GhcPass p)
arg)
          , String -> SDoc
text String
"of"
          , SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun) ]
    ExpectedFunTyMatches TypedThing
fun (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts })
      | [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
      -> SDoc
the_arg_of SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun)
      | Bool
otherwise
      -> String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"pattern in the equation" SDoc -> SDoc -> SDoc
<> [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> SDoc
forall a. [a] -> SDoc
plural [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
     SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun)
    ExpectedFunTyLam {} -> SDoc -> SDoc
binder_of (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"lambda"
    ExpectedFunTyLamCase LamCaseVariant
lc_variant HsExpr GhcRn
_ -> SDoc -> SDoc
binder_of (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ LamCaseVariant -> SDoc
lamCaseKeyword LamCaseVariant
lc_variant
  where
    the_arg_of :: SDoc
    the_arg_of :: SDoc
the_arg_of = String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
speakNth Int
i SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"argument of"
    binder_of :: SDoc -> SDoc
    binder_of :: SDoc -> SDoc
binder_of SDoc
what = String -> SDoc
text String
"The binder of the" SDoc -> SDoc -> SDoc
<+> SDoc
what SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"expression"
pprExpectedFunTyHerald :: ExpectedFunTyOrigin -> SDoc
pprExpectedFunTyHerald :: ExpectedFunTyOrigin -> SDoc
pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {})
  = String -> SDoc
text String
"This rebindable syntax expects a function with"
pprExpectedFunTyHerald (ExpectedFunTyViewPat {})
  = String -> SDoc
text String
"A view pattern expression expects"
pprExpectedFunTyHerald (ExpectedFunTyArg TypedThing
fun HsExpr (GhcPass p)
_)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The function" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun)
        , String -> SDoc
text String
"is applied to" ]
pprExpectedFunTyHerald (ExpectedFunTyMatches TypedThing
fun (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L SrcSpanAnnL
_ [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts }))
  = String -> SDoc
text String
"The equation" SDoc -> SDoc -> SDoc
<> [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> SDoc
forall a. [a] -> SDoc
plural [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TypedThing -> SDoc
forall a. Outputable a => a -> SDoc
ppr TypedThing
fun) SDoc -> SDoc -> SDoc
<+> [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> SDoc
forall a. [a] -> SDoc
hasOrHave [GenLocated
   SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
alts
pprExpectedFunTyHerald (ExpectedFunTyLam MatchGroup GhcRn (LHsExpr GhcRn)
match)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The lambda expression" SDoc -> SDoc -> SDoc
<+>
                   SDoc -> SDoc
quotes (Depth -> SDoc -> SDoc
pprSetDepth (Int -> Depth
PartWay Int
1) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                           MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
forall (idR :: Pass) body.
(OutputableBndrId idR, Outputable body) =>
MatchGroup (GhcPass idR) body -> SDoc
pprMatches MatchGroup GhcRn (LHsExpr GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
match)
        
        , String -> SDoc
text String
"has" ]
pprExpectedFunTyHerald (ExpectedFunTyLamCase LamCaseVariant
_ HsExpr GhcRn
expr)
  = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"The function" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (HsExpr GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcRn
expr)
        , String -> SDoc
text String
"requires" ]