{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Tc.TyCl.Class
   ( tcClassSigs
   , tcClassDecl2
   , findMethodBind
   , instantiateMethod
   , tcClassMinimalDef
   , HsSigFun
   , mkHsSigFun
   , badMethodErr
   , instDeclCtxt1
   , instDeclCtxt2
   , instDeclCtxt3
   , tcATDefault
   , substATBndrs
   )
where
import GHC.Prelude
import GHC.Hs
import GHC.Tc.Errors.Types
import GHC.Tc.Gen.Sig
import GHC.Tc.Types.Evidence ( idHsWrapper )
import GHC.Tc.Gen.Bind
import GHC.Tc.Utils.Env
import GHC.Tc.Utils.Unify
import GHC.Tc.Utils.Instantiate( tcSuperSkolTyVars )
import GHC.Tc.Gen.HsType
import GHC.Tc.Utils.TcMType
import GHC.Core.Type     ( extendTvSubstWithClone, piResultTys )
import GHC.Core.Predicate
import GHC.Core.Multiplicity
import GHC.Tc.Types.Origin
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.Monad
import GHC.Tc.TyCl.Build( TcMethInfo )
import GHC.Core.Class
import GHC.Core.Coercion ( pprCoAxiom )
import GHC.Driver.Session
import GHC.Tc.Instance.Family
import GHC.Core.FamInstEnv
import GHC.Types.Error
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Name.Set
import GHC.Types.Var
import GHC.Types.Var.Env ( lookupVarEnv )
import GHC.Types.SourceFile (HscSource(..))
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Types.SrcLoc
import GHC.Core.TyCon
import GHC.Data.Maybe
import GHC.Types.Basic
import GHC.Data.Bag
import GHC.Data.BooleanFormula
import Control.Monad
import Data.List ( mapAccumL, partition )
illegalHsigDefaultMethod :: Name -> TcRnMessage
illegalHsigDefaultMethod :: Name -> TcRnMessage
illegalHsigDefaultMethod Name
n = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
text String
"Illegal default method(s) in class definition of" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"in hsig file"
tcClassSigs :: Name                
            -> [LSig GhcRn]
            -> LHsBinds GhcRn
            -> TcM [TcMethInfo]    
tcClassSigs :: Name
-> [LSig (GhcPass 'Renamed)]
-> LHsBinds (GhcPass 'Renamed)
-> TcM [TcMethInfo]
tcClassSigs Name
clas [LSig (GhcPass 'Renamed)]
sigs LHsBinds (GhcPass 'Renamed)
def_methods
  = do { String -> SDoc -> TcRn ()
traceTc String
"tcClassSigs 1" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas)
       ; [(Name, (SrcSpan, Type))]
gen_dm_prs <- (Located
   ([GenLocated SrcSpanAnnN Name],
    GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
 -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))])
-> [Located
      ([GenLocated SrcSpanAnnN Name],
       GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((([GenLocated SrcSpanAnnN Name],
  GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
 -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))])
-> Located
     ([GenLocated SrcSpanAnnN Name],
      GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
forall a b. (a -> TcM b) -> Located a -> TcM b
addLocM ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
([GenLocated SrcSpanAnnN Name],
 GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
tc_gen_sig) [Located
   ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))]
[Located
   ([GenLocated SrcSpanAnnN Name],
    GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))]
gen_sigs
       ; let gen_dm_env :: NameEnv (SrcSpan, Type)
             gen_dm_env :: NameEnv (SrcSpan, Type)
gen_dm_env = [(Name, (SrcSpan, Type))] -> NameEnv (SrcSpan, Type)
forall a. [(Name, a)] -> NameEnv a
mkNameEnv [(Name, (SrcSpan, Type))]
gen_dm_prs
       ; [TcMethInfo]
op_info <- (Located
   ([GenLocated SrcSpanAnnN Name],
    GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
 -> TcM [TcMethInfo])
-> [Located
      ([GenLocated SrcSpanAnnN Name],
       GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))]
-> TcM [TcMethInfo]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((([GenLocated SrcSpanAnnN Name],
  GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
 -> TcM [TcMethInfo])
-> Located
     ([GenLocated SrcSpanAnnN Name],
      GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> TcM [TcMethInfo]
forall a b. (a -> TcM b) -> Located a -> TcM b
addLocM (NameEnv (SrcSpan, Type)
-> ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
-> TcM [TcMethInfo]
tc_sig NameEnv (SrcSpan, Type)
gen_dm_env)) [Located
   ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))]
[Located
   ([GenLocated SrcSpanAnnN Name],
    GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))]
vanilla_sigs
       ; let op_names :: NameSet
op_names = [Name] -> NameSet
mkNameSet [ Name
n | (Name
n,Type
_,Maybe (DefMethSpec (SrcSpan, Type))
_) <- [TcMethInfo]
op_info ]
       ; [IOEnv (Env TcGblEnv TcLclEnv) Any] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) Any
forall a. TcRnMessage -> TcM a
failWithTc (Name -> Name -> TcRnMessage
forall a. Outputable a => a -> Name -> TcRnMessage
badMethodErr Name
clas Name
n)
                   | Name
n <- [Name]
dm_bind_names, Bool -> Bool
not (Name
n Name -> NameSet -> Bool
`elemNameSet` NameSet
op_names) ]
                   
       ; TcGblEnv
tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
       ; if TcGblEnv -> HscSource
tcg_src TcGblEnv
tcg_env HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsigFile
            then
               
               
               
               
               Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> Bool
forall a. Bag a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null LHsBinds (GhcPass 'Renamed)
Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
def_methods)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
                TcRnMessage -> TcRn ()
forall a. TcRnMessage -> TcM a
failWithTc (Name -> TcRnMessage
illegalHsigDefaultMethod Name
clas)
            else
               
               [IOEnv (Env TcGblEnv TcLclEnv) Any] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) Any
forall a. TcRnMessage -> TcM a
failWithTc (Name -> Name -> TcRnMessage
forall a. Outputable a => a -> Name -> TcRnMessage
badGenericMethod Name
clas Name
n)
                         | (Name
n,(SrcSpan, Type)
_) <- [(Name, (SrcSpan, Type))]
gen_dm_prs, Bool -> Bool
not (Name
n Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
dm_bind_names) ]
       ; String -> SDoc -> TcRn ()
traceTc String
"tcClassSigs 2" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
clas)
       ; [TcMethInfo] -> TcM [TcMethInfo]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [TcMethInfo]
op_info }
  where
    vanilla_sigs :: [Located ([LocatedN Name], LHsSigType GhcRn)] 
    vanilla_sigs :: [Located
   ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))]
vanilla_sigs = [SrcSpan
-> ([GenLocated SrcSpanAnnN Name],
    GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> Located
     ([GenLocated SrcSpanAnnN Name],
      GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) ([LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
nm,LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
ty) | L SrcSpanAnnA
loc (ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
False [LIdP (GhcPass 'Renamed)]
nm LHsSigType (GhcPass 'Renamed)
ty) <- [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs]
    gen_sigs :: [Located ([LocatedN Name], LHsSigType GhcRn)] 
    gen_sigs :: [Located
   ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))]
gen_sigs     = [SrcSpan
-> ([GenLocated SrcSpanAnnN Name],
    GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> Located
     ([GenLocated SrcSpanAnnN Name],
      GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
loc) ([LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
nm,LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
ty) | L SrcSpanAnnA
loc (ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
True  [LIdP (GhcPass 'Renamed)]
nm LHsSigType (GhcPass 'Renamed)
ty) <- [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
sigs]
    dm_bind_names :: [Name] 
    dm_bind_names :: [Name]
dm_bind_names = [Name
op | L SrcSpanAnnA
_ (FunBind {fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
_ Name
op}) <- Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall a. Bag a -> [a]
bagToList LHsBinds (GhcPass 'Renamed)
Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
def_methods]
    tc_sig :: NameEnv (SrcSpan, Type) -> ([LocatedN Name], LHsSigType GhcRn)
           -> TcM [TcMethInfo]
    tc_sig :: NameEnv (SrcSpan, Type)
-> ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
-> TcM [TcMethInfo]
tc_sig NameEnv (SrcSpan, Type)
gen_dm_env ([GenLocated SrcSpanAnnN Name]
op_names, LHsSigType (GhcPass 'Renamed)
op_hs_ty)
      = do { String -> SDoc -> TcRn ()
traceTc String
"ClsSig 1" ([GenLocated SrcSpanAnnN Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnN Name]
op_names)
           ; Type
op_ty <- [GenLocated SrcSpanAnnN Name]
-> LHsSigType (GhcPass 'Renamed) -> TcM Type
tcClassSigType [GenLocated SrcSpanAnnN Name]
op_names LHsSigType (GhcPass 'Renamed)
op_hs_ty
                   
           ; String -> SDoc -> TcRn ()
traceTc String
"ClsSig 2" ([GenLocated SrcSpanAnnN Name] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [GenLocated SrcSpanAnnN Name]
op_names SDoc -> SDoc -> SDoc
$$ Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
op_ty)
           ; [TcMethInfo] -> TcM [TcMethInfo]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Name
op_name, Type
op_ty, Name -> Maybe (DefMethSpec (SrcSpan, Type))
f Name
op_name) | L SrcSpanAnnN
_ Name
op_name <- [GenLocated SrcSpanAnnN Name]
op_names ] }
           where
             f :: Name -> Maybe (DefMethSpec (SrcSpan, Type))
f Name
nm | Just (SrcSpan, Type)
lty <- NameEnv (SrcSpan, Type) -> Name -> Maybe (SrcSpan, Type)
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv (SrcSpan, Type)
gen_dm_env Name
nm = DefMethSpec (SrcSpan, Type) -> Maybe (DefMethSpec (SrcSpan, Type))
forall a. a -> Maybe a
Just ((SrcSpan, Type) -> DefMethSpec (SrcSpan, Type)
forall ty. ty -> DefMethSpec ty
GenericDM (SrcSpan, Type)
lty)
                  | Name
nm Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
dm_bind_names                 = DefMethSpec (SrcSpan, Type) -> Maybe (DefMethSpec (SrcSpan, Type))
forall a. a -> Maybe a
Just DefMethSpec (SrcSpan, Type)
forall ty. DefMethSpec ty
VanillaDM
                  | Bool
otherwise                               = Maybe (DefMethSpec (SrcSpan, Type))
forall a. Maybe a
Nothing
    tc_gen_sig :: ([LocatedN Name], LHsSigType GhcRn)
                      -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))] 
    tc_gen_sig :: ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
tc_gen_sig ([GenLocated SrcSpanAnnN Name]
op_names, LHsSigType (GhcPass 'Renamed)
gen_hs_ty)
      = do { Type
gen_op_ty <- [GenLocated SrcSpanAnnN Name]
-> LHsSigType (GhcPass 'Renamed) -> TcM Type
tcClassSigType [GenLocated SrcSpanAnnN Name]
op_names LHsSigType (GhcPass 'Renamed)
gen_hs_ty
           ; [(Name, (SrcSpan, Type))]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ (Name
op_name, (SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
loc, Type
gen_op_ty))
                                                 | L SrcSpanAnnN
loc Name
op_name <- [GenLocated SrcSpanAnnN Name]
op_names ] }
tcClassDecl2 :: LTyClDecl GhcRn          
             -> TcM (LHsBinds GhcTc)
tcClassDecl2 :: LTyClDecl (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc)
tcClassDecl2 (L SrcSpanAnnA
_ (ClassDecl {tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP (GhcPass 'Renamed)
class_name, tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig (GhcPass 'Renamed)]
sigs,
                                tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBinds (GhcPass 'Renamed)
default_binds}))
  = TcM (LHsBinds GhcTc)
-> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
forall r. TcRn r -> TcRn r -> TcRn r
recoverM (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall (idL :: Pass) idR. LHsBindsLR (GhcPass idL) idR
emptyLHsBinds) (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
-> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
forall a b. (a -> b) -> a -> b
$
    SrcSpan -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan (GenLocated SrcSpanAnnN Name -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
class_name) (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
-> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
forall a b. (a -> b) -> a -> b
$
    do  { Class
clas <- LocatedA Name -> TcM Class
tcLookupLocatedClass (GenLocated SrcSpanAnnN Name -> LocatedA Name
forall a. LocatedN a -> LocatedA a
n2l LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
class_name)
        
        
        
        
        
        
        
        
        ; SkolemInfo
skol_info <- SkolemInfoAnon -> IOEnv (Env TcGblEnv TcLclEnv) SkolemInfo
forall (m :: * -> *). MonadIO m => SkolemInfoAnon -> m SkolemInfo
mkSkolemInfo (TyConFlavour -> Name -> SkolemInfoAnon
TyConSkol TyConFlavour
ClassFlavour (GenLocated SrcSpanAnnN Name -> Name
forall a. NamedThing a => a -> Name
getName LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
class_name))
        ; TcLevel
tc_lvl    <- TcM TcLevel
getTcLevel
        ; let ([TcId]
tyvars, [Type]
_, [TcId]
_, [ClassOpItem]
op_items) = Class -> ([TcId], [Type], [TcId], [ClassOpItem])
classBigSig Class
clas
              prag_fn :: TcPragEnv
prag_fn = [LSig (GhcPass 'Renamed)]
-> LHsBinds (GhcPass 'Renamed) -> TcPragEnv
mkPragEnv [LSig (GhcPass 'Renamed)]
sigs LHsBinds (GhcPass 'Renamed)
default_binds
              sig_fn :: HsSigFun
sig_fn  = [LSig (GhcPass 'Renamed)] -> HsSigFun
mkHsSigFun [LSig (GhcPass 'Renamed)]
sigs
              (TCvSubst
_skol_subst, [TcId]
clas_tyvars) = TcLevel -> SkolemInfo -> [TcId] -> (TCvSubst, [TcId])
tcSuperSkolTyVars TcLevel
tc_lvl SkolemInfo
skol_info [TcId]
tyvars
                    
                    
              pred :: Type
pred = Class -> [Type] -> Type
mkClassPred Class
clas ([TcId] -> [Type]
mkTyVarTys [TcId]
clas_tyvars)
        ; TcId
this_dict <- Type -> TcRnIf TcGblEnv TcLclEnv TcId
forall gbl lcl. Type -> TcRnIf gbl lcl TcId
newEvVar Type
pred
        ; let tc_item :: ClassOpItem -> TcM (LHsBinds GhcTc)
tc_item = Class
-> [TcId]
-> TcId
-> LHsBinds (GhcPass 'Renamed)
-> HsSigFun
-> TcPragEnv
-> ClassOpItem
-> TcM (LHsBinds GhcTc)
tcDefMeth Class
clas [TcId]
clas_tyvars TcId
this_dict
                                  LHsBinds (GhcPass 'Renamed)
default_binds HsSigFun
sig_fn TcPragEnv
prag_fn
        ; [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
dm_binds <- [TcId]
-> TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
-> TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
forall r. [TcId] -> TcM r -> TcM r
tcExtendTyVarEnv [TcId]
clas_tyvars (TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
 -> TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))])
-> TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
-> TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
forall a b. (a -> b) -> a -> b
$
                      (ClassOpItem
 -> IOEnv
      (Env TcGblEnv TcLclEnv)
      (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))))
-> [ClassOpItem]
-> TcM [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ClassOpItem -> TcM (LHsBinds GhcTc)
ClassOpItem
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
tc_item [ClassOpItem]
op_items
        ; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a. [Bag a] -> Bag a
unionManyBags [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))]
dm_binds) }
tcClassDecl2 LTyClDecl (GhcPass 'Renamed)
d = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcClassDecl2" (GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LTyClDecl (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (TyClDecl (GhcPass 'Renamed))
d)
tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn
          -> HsSigFun -> TcPragEnv -> ClassOpItem
          -> TcM (LHsBinds GhcTc)
tcDefMeth :: Class
-> [TcId]
-> TcId
-> LHsBinds (GhcPass 'Renamed)
-> HsSigFun
-> TcPragEnv
-> ClassOpItem
-> TcM (LHsBinds GhcTc)
tcDefMeth Class
_ [TcId]
_ TcId
_ LHsBinds (GhcPass 'Renamed)
_ HsSigFun
_ TcPragEnv
prag_fn (TcId
sel_id, Maybe (Name, DefMethSpec Type)
Nothing)
  = do { 
         (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> TcRn ())
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))] -> TcRn ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Sig (GhcPass 'Renamed) -> TcRn ())
-> GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed)) -> TcRn ()
forall a b ann.
(a -> TcM b) -> GenLocated (SrcSpanAnn' ann) a -> TcM b
addLocMA (TcId -> Sig (GhcPass 'Renamed) -> TcRn ()
badDmPrag TcId
sel_id))
               (TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
lookupPragEnv TcPragEnv
prag_fn (TcId -> Name
idName TcId
sel_id))
       ; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a. Bag a
emptyBag }
tcDefMeth Class
clas [TcId]
tyvars TcId
this_dict LHsBinds (GhcPass 'Renamed)
binds_in HsSigFun
hs_sig_fn TcPragEnv
prag_fn
          (TcId
sel_id, Just (Name
dm_name, DefMethSpec Type
dm_spec))
  | Just (L SrcSpanAnnA
bind_loc HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
dm_bind, SrcSpan
bndr_loc, [LSig (GhcPass 'Renamed)]
prags) <- Name
-> LHsBinds (GhcPass 'Renamed)
-> TcPragEnv
-> Maybe
     (LHsBind (GhcPass 'Renamed), SrcSpan, [LSig (GhcPass 'Renamed)])
findMethodBind Name
sel_name LHsBinds (GhcPass 'Renamed)
binds_in TcPragEnv
prag_fn
  = do { 
         
         
         
         
         
         
         
         
         
         TcId
global_dm_id  <- Name -> TcRnIf TcGblEnv TcLclEnv TcId
tcLookupId Name
dm_name
       ; TcId
global_dm_id  <- TcId -> [LSig (GhcPass 'Renamed)] -> TcRnIf TcGblEnv TcLclEnv TcId
addInlinePrags TcId
global_dm_id [LSig (GhcPass 'Renamed)]
prags
       ; Name
local_dm_name <- OccName -> SrcSpan -> TcM Name
newNameAt (Name -> OccName
forall a. NamedThing a => a -> OccName
getOccName Name
sel_name) SrcSpan
bndr_loc
            
            
       ; [LTcSpecPrag]
spec_prags <- TcM [LTcSpecPrag] -> TcM [LTcSpecPrag]
forall a. TcM a -> TcM a
discardConstraints (TcM [LTcSpecPrag] -> TcM [LTcSpecPrag])
-> TcM [LTcSpecPrag] -> TcM [LTcSpecPrag]
forall a b. (a -> b) -> a -> b
$
                       TcId -> [LSig (GhcPass 'Renamed)] -> TcM [LTcSpecPrag]
tcSpecPrags TcId
global_dm_id [LSig (GhcPass 'Renamed)]
prags
       ; let dia :: TcRnMessage
dia = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
               DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic DiagnosticReason
WarningWithoutFlag [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
                (String -> SDoc
text String
"Ignoring SPECIALISE pragmas on default method" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
sel_name))
       ; Bool -> TcRnMessage -> TcRn ()
diagnosticTc (Bool -> Bool
not ([LTcSpecPrag] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTcSpecPrag]
spec_prags)) TcRnMessage
dia
       ; let hs_ty :: GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
hs_ty = HsSigFun
hs_sig_fn Name
sel_name
                     Maybe (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
forall a. Maybe a -> a -> a
`orElse` String
-> SDoc -> GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tc_dm" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
sel_name)
             
             
             
             
             
             
             
             
             
             local_dm_ty :: Type
local_dm_ty = Class -> TcId -> [Type] -> Type
instantiateMethod Class
clas TcId
global_dm_id ([TcId] -> [Type]
mkTyVarTys [TcId]
tyvars)
             lm_bind :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
lm_bind     = HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
dm_bind { fun_id :: LIdP (GhcPass 'Renamed)
fun_id = SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpanAnnA -> SrcSpanAnnN
forall a. SrcSpanAnn' a -> SrcSpanAnnN
la2na SrcSpanAnnA
bind_loc) Name
local_dm_name }
                             
                             
             warn_redundant :: ReportRedundantConstraints
warn_redundant = case DefMethSpec Type
dm_spec of
                                GenericDM {} -> LHsSigType (GhcPass 'Renamed) -> ReportRedundantConstraints
lhsSigTypeContextSpan LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
hs_ty
                                DefMethSpec Type
VanillaDM    -> ReportRedundantConstraints
NoRRC
                
                
                
             ctxt :: UserTypeCtxt
ctxt = Name -> ReportRedundantConstraints -> UserTypeCtxt
FunSigCtxt Name
sel_name ReportRedundantConstraints
warn_redundant
       ; let local_dm_id :: TcId
local_dm_id = (() :: Constraint) => Name -> Type -> Type -> TcId
Name -> Type -> Type -> TcId
mkLocalId Name
local_dm_name Type
Many Type
local_dm_ty
             local_dm_sig :: TcIdSigInfo
local_dm_sig = CompleteSig { sig_bndr :: TcId
sig_bndr = TcId
local_dm_id
                                        , sig_ctxt :: UserTypeCtxt
sig_ctxt  = UserTypeCtxt
ctxt
                                        , sig_loc :: SrcSpan
sig_loc   = GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
hs_ty }
       ; (TcEvBinds
ev_binds, (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
tc_bind, [TcId]
_))
               <- SkolemInfoAnon
-> [TcId]
-> [TcId]
-> TcM (LHsBinds GhcTc, [TcId])
-> TcM (TcEvBinds, (LHsBinds GhcTc, [TcId]))
forall result.
SkolemInfoAnon
-> [TcId] -> [TcId] -> TcM result -> TcM (TcEvBinds, result)
checkConstraints SkolemInfoAnon
skol_info [TcId]
tyvars [TcId
this_dict] (TcM (LHsBinds GhcTc, [TcId])
 -> TcM (TcEvBinds, (LHsBinds GhcTc, [TcId])))
-> TcM (LHsBinds GhcTc, [TcId])
-> TcM (TcEvBinds, (LHsBinds GhcTc, [TcId]))
forall a b. (a -> b) -> a -> b
$
                  TcPragEnv
-> TcIdSigInfo
-> LHsBind (GhcPass 'Renamed)
-> TcM (LHsBinds GhcTc, [TcId])
tcPolyCheck TcPragEnv
NameEnv [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
no_prag_fn TcIdSigInfo
local_dm_sig
                              (SrcSpanAnnA
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
bind_loc HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
lm_bind)
       ; let export :: ABExport
export = ABE { abe_poly :: TcId
abe_poly  = TcId
global_dm_id
                          , abe_mono :: TcId
abe_mono  = TcId
local_dm_id
                          , abe_wrap :: HsWrapper
abe_wrap  = HsWrapper
idHsWrapper
                          , abe_prags :: TcSpecPrags
abe_prags = TcSpecPrags
IsDefaultMethod }
             full_bind :: HsBindLR GhcTc GhcTc
full_bind = XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall idL idR. XXHsBindsLR idL idR -> HsBindLR idL idR
XHsBindsLR (XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc)
-> XXHsBindsLR GhcTc GhcTc -> HsBindLR GhcTc GhcTc
forall a b. (a -> b) -> a -> b
$
                         AbsBinds { abs_tvs :: [TcId]
abs_tvs      = [TcId]
tyvars
                                  , abs_ev_vars :: [TcId]
abs_ev_vars  = [TcId
this_dict]
                                  , abs_exports :: [ABExport]
abs_exports  = [ABExport
export]
                                  , abs_ev_binds :: [TcEvBinds]
abs_ev_binds = [TcEvBinds
ev_binds]
                                  , abs_binds :: LHsBinds GhcTc
abs_binds    = LHsBinds GhcTc
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
tc_bind
                                  , abs_sig :: Bool
abs_sig      = Bool
True }
       ; Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc))
forall a. a -> Bag a
unitBag (SrcSpanAnnA
-> HsBindLR GhcTc GhcTc
-> GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
bind_loc HsBindLR GhcTc GhcTc
full_bind)) }
  | Bool
otherwise = String
-> SDoc
-> IOEnv
     (Env TcGblEnv TcLclEnv)
     (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcTc GhcTc)))
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcDefMeth" (TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
sel_id)
  where
    skol_info :: SkolemInfoAnon
skol_info = TyConFlavour -> Name -> SkolemInfoAnon
TyConSkol TyConFlavour
ClassFlavour (Class -> Name
forall a. NamedThing a => a -> Name
getName Class
clas)
    sel_name :: Name
sel_name = TcId -> Name
idName TcId
sel_id
    no_prag_fn :: TcPragEnv
no_prag_fn = TcPragEnv
emptyPragEnv   
                                
tcClassMinimalDef :: Name -> [LSig GhcRn] -> [TcMethInfo] -> TcM ClassMinimalDef
tcClassMinimalDef :: Name
-> [LSig (GhcPass 'Renamed)] -> [TcMethInfo] -> TcM ClassMinimalDef
tcClassMinimalDef Name
_clas [LSig (GhcPass 'Renamed)]
sigs [TcMethInfo]
op_info
  = case [LSig (GhcPass 'Renamed)] -> Maybe ClassMinimalDef
findMinimalDef [LSig (GhcPass 'Renamed)]
sigs of
      Maybe ClassMinimalDef
Nothing -> ClassMinimalDef -> TcM ClassMinimalDef
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ClassMinimalDef
defMindef
      Just ClassMinimalDef
mindef -> do
        
        
        
        
        TcGblEnv
tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
        
        
        Bool -> TcRn () -> TcRn ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TcGblEnv -> HscSource
tcg_src TcGblEnv
tcg_env HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
/= HscSource
HsigFile) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
forall a b. (a -> b) -> a -> b
$
            Maybe ClassMinimalDef -> (ClassMinimalDef -> TcRn ()) -> TcRn ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenIsJust ((Name -> Bool) -> ClassMinimalDef -> Maybe ClassMinimalDef
forall a.
Eq a =>
(a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)
isUnsatisfied (ClassMinimalDef
mindef ClassMinimalDef -> Name -> Bool
forall a. Eq a => BooleanFormula a -> a -> Bool
`impliesAtom`) ClassMinimalDef
defMindef) ((ClassMinimalDef -> TcRn ()) -> TcRn ())
-> (ClassMinimalDef -> TcRn ()) -> TcRn ()
forall a b. (a -> b) -> a -> b
$
                       (\ClassMinimalDef
bf -> TcRnMessage -> TcRn ()
addDiagnosticTc (ClassMinimalDef -> TcRnMessage
warningMinimalDefIncomplete ClassMinimalDef
bf))
        ClassMinimalDef -> TcM ClassMinimalDef
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return ClassMinimalDef
mindef
  where
    
    defMindef :: ClassMinimalDef
    defMindef :: ClassMinimalDef
defMindef = [LBooleanFormula Name] -> ClassMinimalDef
forall a. Eq a => [LBooleanFormula a] -> BooleanFormula a
mkAnd [ ClassMinimalDef -> LBooleanFormula Name
forall a an. a -> LocatedAn an a
noLocA (Name -> ClassMinimalDef
forall a. a -> BooleanFormula a
mkVar Name
name)
                      | (Name
name, Type
_, Maybe (DefMethSpec (SrcSpan, Type))
Nothing) <- [TcMethInfo]
op_info ]
instantiateMethod :: Class -> TcId -> [TcType] -> TcType
instantiateMethod :: Class -> TcId -> [Type] -> Type
instantiateMethod Class
clas TcId
sel_id [Type]
inst_tys
  = Bool -> Type -> Type
forall a. HasCallStack => Bool -> a -> a
assert Bool
ok_first_pred Type
local_meth_ty
  where
    rho_ty :: Type
rho_ty = (() :: Constraint) => Type -> [Type] -> Type
Type -> [Type] -> Type
piResultTys (TcId -> Type
idType TcId
sel_id) [Type]
inst_tys
    (Type
first_pred, Type
local_meth_ty) = Type -> Maybe (Type, Type)
tcSplitPredFunTy_maybe Type
rho_ty
                Maybe (Type, Type) -> (Type, Type) -> (Type, Type)
forall a. Maybe a -> a -> a
`orElse` String -> SDoc -> (Type, Type)
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tcInstanceMethod" (TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
sel_id)
    ok_first_pred :: Bool
ok_first_pred = case Type -> Maybe (Class, [Type])
getClassPredTys_maybe Type
first_pred of
                      Just (Class
clas1, [Type]
_tys) -> Class
clas Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
clas1
                      Maybe (Class, [Type])
Nothing -> Bool
False
              
              
type HsSigFun = Name -> Maybe (LHsSigType GhcRn)
mkHsSigFun :: [LSig GhcRn] -> HsSigFun
mkHsSigFun :: [LSig (GhcPass 'Renamed)] -> HsSigFun
mkHsSigFun [LSig (GhcPass 'Renamed)]
sigs = NameEnv (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> Name
-> Maybe (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
env
  where
    env :: NameEnv (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
env = (LSig (GhcPass 'Renamed)
 -> Maybe
      ([GenLocated SrcSpanAnnN Name],
       GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))))
-> [LSig (GhcPass 'Renamed)]
-> NameEnv (GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
forall a.
(LSig (GhcPass 'Renamed)
 -> Maybe ([GenLocated SrcSpanAnnN Name], a))
-> [LSig (GhcPass 'Renamed)] -> NameEnv a
mkHsSigEnv LSig (GhcPass 'Renamed)
-> Maybe
     ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
LSig (GhcPass 'Renamed)
-> Maybe
     ([GenLocated SrcSpanAnnN Name],
      GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
get_classop_sig [LSig (GhcPass 'Renamed)]
sigs
    get_classop_sig :: LSig GhcRn -> Maybe ([LocatedN Name], LHsSigType GhcRn)
    get_classop_sig :: LSig (GhcPass 'Renamed)
-> Maybe
     ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
get_classop_sig  (L SrcSpanAnnA
_ (ClassOpSig XClassOpSig (GhcPass 'Renamed)
_ Bool
_ [LIdP (GhcPass 'Renamed)]
ns LHsSigType (GhcPass 'Renamed)
hs_ty)) = ([GenLocated SrcSpanAnnN Name],
 GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
-> Maybe
     ([GenLocated SrcSpanAnnN Name],
      GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
forall a. a -> Maybe a
Just ([LIdP (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnN Name]
ns, LHsSigType (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed))
hs_ty)
    get_classop_sig  LSig (GhcPass 'Renamed)
_                               = Maybe
  ([GenLocated SrcSpanAnnN Name], LHsSigType (GhcPass 'Renamed))
Maybe
  ([GenLocated SrcSpanAnnN Name],
   GenLocated SrcSpanAnnA (HsSigType (GhcPass 'Renamed)))
forall a. Maybe a
Nothing
findMethodBind  :: Name                 
                -> LHsBinds GhcRn       
                -> TcPragEnv
                -> Maybe (LHsBind GhcRn, SrcSpan, [LSig GhcRn])
                
                
                
findMethodBind :: Name
-> LHsBinds (GhcPass 'Renamed)
-> TcPragEnv
-> Maybe
     (LHsBind (GhcPass 'Renamed), SrcSpan, [LSig (GhcPass 'Renamed)])
findMethodBind Name
sel_name LHsBinds (GhcPass 'Renamed)
binds TcPragEnv
prag_fn
  = (Maybe
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
    SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
 -> Maybe
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
 -> Maybe
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]))
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
-> Bag
     (Maybe
        (GenLocated
           SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
         SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]))
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
forall b a. (b -> a -> b) -> b -> Bag a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
   SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus Maybe
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
   SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
forall a. Maybe a
Nothing ((GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
 -> Maybe
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]))
-> Bag
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> Bag
     (Maybe
        (GenLocated
           SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
         SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]))
forall a b. (a -> b) -> Bag a -> Bag b
mapBag GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
f LHsBinds (GhcPass 'Renamed)
Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
binds)
  where
    prags :: [LSig (GhcPass 'Renamed)]
prags    = TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
lookupPragEnv TcPragEnv
prag_fn Name
sel_name
    f :: GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
f bind :: GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind@(L SrcSpanAnnA
_ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = L SrcSpanAnnN
bndr_loc Name
op_name }))
      | Name
op_name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
sel_name
             = (GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
 SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
-> Maybe
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
forall a. a -> Maybe a
Just (GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
bndr_loc, [LSig (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
prags)
    f GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_other = Maybe
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
   SrcSpan, [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))])
forall a. Maybe a
Nothing
findMinimalDef :: [LSig GhcRn] -> Maybe ClassMinimalDef
findMinimalDef :: [LSig (GhcPass 'Renamed)] -> Maybe ClassMinimalDef
findMinimalDef = [Maybe ClassMinimalDef] -> Maybe ClassMinimalDef
forall (f :: * -> *) a. Foldable f => f (Maybe a) -> Maybe a
firstJusts ([Maybe ClassMinimalDef] -> Maybe ClassMinimalDef)
-> ([GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
    -> [Maybe ClassMinimalDef])
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
-> Maybe ClassMinimalDef
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
 -> Maybe ClassMinimalDef)
-> [GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))]
-> [Maybe ClassMinimalDef]
forall a b. (a -> b) -> [a] -> [b]
map LSig (GhcPass 'Renamed) -> Maybe ClassMinimalDef
GenLocated SrcSpanAnnA (Sig (GhcPass 'Renamed))
-> Maybe ClassMinimalDef
toMinimalDef
  where
    toMinimalDef :: LSig GhcRn -> Maybe ClassMinimalDef
    toMinimalDef :: LSig (GhcPass 'Renamed) -> Maybe ClassMinimalDef
toMinimalDef (L SrcSpanAnnA
_ (MinimalSig XMinimalSig (GhcPass 'Renamed)
_ SourceText
_ (L SrcSpanAnnL
_ BooleanFormula (LIdP (GhcPass 'Renamed))
bf))) = ClassMinimalDef -> Maybe ClassMinimalDef
forall a. a -> Maybe a
Just ((GenLocated SrcSpanAnnN Name -> Name)
-> BooleanFormula (GenLocated SrcSpanAnnN Name) -> ClassMinimalDef
forall a b. (a -> b) -> BooleanFormula a -> BooleanFormula b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
unLoc BooleanFormula (LIdP (GhcPass 'Renamed))
BooleanFormula (GenLocated SrcSpanAnnN Name)
bf)
    toMinimalDef LSig (GhcPass 'Renamed)
_                               = Maybe ClassMinimalDef
forall a. Maybe a
Nothing
badMethodErr :: Outputable a => a -> Name -> TcRnMessage
badMethodErr :: forall a. Outputable a => a -> Name -> TcRnMessage
badMethodErr a
clas Name
op
  = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
hsep [String -> SDoc
text String
"Class", SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
clas),
          String -> SDoc
text String
"does not have a method", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
op)]
badGenericMethod :: Outputable a => a -> Name -> TcRnMessage
badGenericMethod :: forall a. Outputable a => a -> Name -> TcRnMessage
badGenericMethod a
clas Name
op
  = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
hsep [String -> SDoc
text String
"Class", SDoc -> SDoc
quotes (a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
clas),
          String -> SDoc
text String
"has a generic-default signature without a binding", SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
op)]
badDmPrag :: TcId -> Sig GhcRn -> TcM ()
badDmPrag :: TcId -> Sig (GhcPass 'Renamed) -> TcRn ()
badDmPrag TcId
sel_id Sig (GhcPass 'Renamed)
prag
  = TcRnMessage -> TcRn ()
addErrTc (DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainError [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
text String
"The" SDoc -> SDoc -> SDoc
<+> Sig (GhcPass 'Renamed) -> SDoc
forall name. Sig name -> SDoc
hsSigDoc Sig (GhcPass 'Renamed)
prag SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"for default method"
              SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (TcId -> SDoc
forall a. Outputable a => a -> SDoc
ppr TcId
sel_id)
              SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"lacks an accompanying binding")
warningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage
warningMinimalDefIncomplete :: ClassMinimalDef -> TcRnMessage
warningMinimalDefIncomplete ClassMinimalDef
mindef
  = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$ DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic DiagnosticReason
WarningWithoutFlag [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
  [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"The MINIMAL pragma does not require:"
         , Int -> SDoc -> SDoc
nest Int
2 (ClassMinimalDef -> SDoc
forall a. Outputable a => BooleanFormula a -> SDoc
pprBooleanFormulaNice ClassMinimalDef
mindef)
         , String -> SDoc
text String
"but there is no default implementation." ]
instDeclCtxt1 :: LHsSigType GhcRn -> SDoc
instDeclCtxt1 :: LHsSigType (GhcPass 'Renamed) -> SDoc
instDeclCtxt1 LHsSigType (GhcPass 'Renamed)
hs_inst_ty
  = SDoc -> SDoc
inst_decl_ctxt (GenLocated SrcSpanAnnA (HsType (GhcPass 'Renamed)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LHsSigType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
getLHsInstDeclHead LHsSigType (GhcPass 'Renamed)
hs_inst_ty))
instDeclCtxt2 :: Type -> SDoc
instDeclCtxt2 :: Type -> SDoc
instDeclCtxt2 Type
dfun_ty
  = Class -> [Type] -> SDoc
instDeclCtxt3 Class
cls [Type]
tys
  where
    ([TcId]
_,[Type]
_,Class
cls,[Type]
tys) = Type -> ([TcId], [Type], Class, [Type])
tcSplitDFunTy Type
dfun_ty
instDeclCtxt3 :: Class -> [Type] -> SDoc
instDeclCtxt3 :: Class -> [Type] -> SDoc
instDeclCtxt3 Class
cls [Type]
cls_tys
  = SDoc -> SDoc
inst_decl_ctxt (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Class -> [Type] -> Type
mkClassPred Class
cls [Type]
cls_tys))
inst_decl_ctxt :: SDoc -> SDoc
inst_decl_ctxt :: SDoc -> SDoc
inst_decl_ctxt SDoc
doc = SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"In the instance declaration for")
                        Int
2 (SDoc -> SDoc
quotes SDoc
doc)
tcATDefault :: SrcSpan
            -> TCvSubst
            -> NameSet
            -> ClassATItem
            -> TcM [FamInst]
tcATDefault :: SrcSpan -> TCvSubst -> NameSet -> ClassATItem -> TcM [FamInst]
tcATDefault SrcSpan
loc TCvSubst
inst_subst NameSet
defined_ats (ATI TyCon
fam_tc Maybe (Type, ATValidityInfo)
defs)
  
  | TyCon -> Name
tyConName TyCon
fam_tc Name -> NameSet -> Bool
`elemNameSet` NameSet
defined_ats
  = [FamInst] -> TcM [FamInst]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
  
   
   
   
  | Just (Type
rhs_ty, ATValidityInfo
_loc) <- Maybe (Type, ATValidityInfo)
defs
  = do { let (TCvSubst
subst', [Type]
pat_tys') = TCvSubst -> [TcId] -> (TCvSubst, [Type])
substATBndrs TCvSubst
inst_subst (TyCon -> [TcId]
tyConTyVars TyCon
fam_tc)
             rhs' :: Type
rhs'     = TCvSubst -> Type -> Type
substTyUnchecked TCvSubst
subst' Type
rhs_ty
             tcv' :: [TcId]
tcv' = [Type] -> [TcId]
tyCoVarsOfTypesList [Type]
pat_tys'
             ([TcId]
tv', [TcId]
cv') = (TcId -> Bool) -> [TcId] -> ([TcId], [TcId])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition TcId -> Bool
isTyVar [TcId]
tcv'
             tvs' :: [TcId]
tvs'     = [TcId] -> [TcId]
scopedSort [TcId]
tv'
             cvs' :: [TcId]
cvs'     = [TcId] -> [TcId]
scopedSort [TcId]
cv'
       ; Name
rep_tc_name <- GenLocated SrcSpanAnnN Name -> [Type] -> TcM Name
newFamInstTyConName (SrcSpanAnnN -> Name -> GenLocated SrcSpanAnnN Name
forall l e. l -> e -> GenLocated l e
L (SrcSpan -> SrcSpanAnnN
forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan SrcSpan
loc) (TyCon -> Name
tyConName TyCon
fam_tc)) [Type]
pat_tys'
       ; let axiom :: CoAxiom Unbranched
axiom = Role
-> Name
-> [TcId]
-> [TcId]
-> [TcId]
-> TyCon
-> [Type]
-> Type
-> CoAxiom Unbranched
mkSingleCoAxiom Role
Nominal Name
rep_tc_name [TcId]
tvs' [] [TcId]
cvs'
                                     TyCon
fam_tc [Type]
pat_tys' Type
rhs'
           
           
           
           
       ; String -> SDoc -> TcRn ()
traceTc String
"mk_deflt_at_instance" ([SDoc] -> SDoc
vcat [ TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
fam_tc, Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
rhs_ty
                                              , CoAxiom Unbranched -> SDoc
forall (br :: BranchFlag). CoAxiom br -> SDoc
pprCoAxiom CoAxiom Unbranched
axiom ])
       ; FamInst
fam_inst <- FamFlavor -> CoAxiom Unbranched -> TcM FamInst
newFamInst FamFlavor
SynFamilyInst CoAxiom Unbranched
axiom
       ; [FamInst] -> TcM [FamInst]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [FamInst
fam_inst] }
   
  | Bool
otherwise  
  = do { Name -> TcRn ()
warnMissingAT (TyCon -> Name
tyConName TyCon
fam_tc)
       ; [FamInst] -> TcM [FamInst]
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return [] }
substATBndrs :: TCvSubst -> [TyVar] -> (TCvSubst, [Type])
substATBndrs :: TCvSubst -> [TcId] -> (TCvSubst, [Type])
substATBndrs = (TCvSubst -> TcId -> (TCvSubst, Type))
-> TCvSubst -> [TcId] -> (TCvSubst, [Type])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL TCvSubst -> TcId -> (TCvSubst, Type)
substATBndr
  where
    substATBndr :: TCvSubst -> TyVar -> (TCvSubst, Type)
    substATBndr :: TCvSubst -> TcId -> (TCvSubst, Type)
substATBndr TCvSubst
subst TcId
tc_tv
        
      | Just Type
ty <- VarEnv Type -> TcId -> Maybe Type
forall a. VarEnv a -> TcId -> Maybe a
lookupVarEnv (TCvSubst -> VarEnv Type
getTvSubstEnv TCvSubst
subst) TcId
tc_tv
      = (TCvSubst
subst, Type
ty)
        
      | Bool
otherwise
      = (TCvSubst -> TcId -> TcId -> TCvSubst
extendTvSubstWithClone TCvSubst
subst TcId
tc_tv TcId
tc_tv', TcId -> Type
mkTyVarTy TcId
tc_tv')
      where
        tc_tv' :: TcId
tc_tv' = (Type -> Type) -> TcId -> TcId
updateTyVarKind ((() :: Constraint) => TCvSubst -> Type -> Type
TCvSubst -> Type -> Type
substTy TCvSubst
subst) TcId
tc_tv
warnMissingAT :: Name -> TcM ()
warnMissingAT :: Name -> TcRn ()
warnMissingAT Name
name
  = do { Bool
warn <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
woptM WarningFlag
Opt_WarnMissingMethods
       ; String -> SDoc -> TcRn ()
traceTc String
"warn" (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
warn)
       ; HscSource
hsc_src <- (TcGblEnv -> HscSource)
-> TcRnIf TcGblEnv TcLclEnv TcGblEnv
-> IOEnv (Env TcGblEnv TcLclEnv) HscSource
forall a b.
(a -> b)
-> IOEnv (Env TcGblEnv TcLclEnv) a
-> IOEnv (Env TcGblEnv TcLclEnv) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TcGblEnv -> HscSource
tcg_src TcRnIf TcGblEnv TcLclEnv TcGblEnv
forall gbl lcl. TcRnIf gbl lcl gbl
getGblEnv
       
       
       
       ; let dia :: TcRnMessage
dia = DiagnosticMessage -> TcRnMessage
forall a. (Diagnostic a, Typeable a) => a -> TcRnMessage
TcRnUnknownMessage (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage -> TcRnMessage
forall a b. (a -> b) -> a -> b
$
               DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (WarningFlag -> DiagnosticReason
WarningWithFlag WarningFlag
Opt_WarnMissingMethods) [GhcHint]
noHints (SDoc -> DiagnosticMessage) -> SDoc -> DiagnosticMessage
forall a b. (a -> b) -> a -> b
$
                 (String -> SDoc
text String
"No explicit" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"associated type"
                                     SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"or default declaration for"
                                     SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
quotes (Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
name))
       ; Bool -> TcRnMessage -> TcRn ()
diagnosticTc  (Bool
warn Bool -> Bool -> Bool
&& HscSource
hsc_src HscSource -> HscSource -> Bool
forall a. Eq a => a -> a -> Bool
== HscSource
HsSrcFile) TcRnMessage
dia
                       }