module GHC.Core.Class (
        Class,
        ClassOpItem,
        ClassATItem(..), ATValidityInfo(..),
        ClassMinimalDef,
        DefMethInfo, pprDefMethInfo,
        FunDep, pprFundeps, pprFunDep,
        mkClass, mkAbstractClass, classTyVars, classArity,
        classKey, className, classATs, classATItems, classTyCon, classMethods,
        classOpItems, classBigSig, classExtraBigSig, classTvsFds, classSCTheta,
        classAllSelIds, classSCSelId, classSCSelIds, classMinimalDef, classHasFds,
        isAbstractClass,
    ) where
import GHC.Prelude
import {-# SOURCE #-} GHC.Core.TyCon    ( TyCon )
import {-# SOURCE #-} GHC.Core.TyCo.Rep ( Type, PredType )
import {-# SOURCE #-} GHC.Core.TyCo.Ppr ( pprType )
import GHC.Types.Var
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Types.Unique
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Data.BooleanFormula (BooleanFormula, mkTrue)
import qualified Data.Data as Data
data Class
  = Class {
        Class -> TyCon
classTyCon :: TyCon,    
                                
                                
        Class -> Name
className :: Name,              
        Class -> Unique
classKey  :: Unique,            
        Class -> [TyVar]
classTyVars  :: [TyVar],        
                                        
           
           
           
           
        Class -> [FunDep TyVar]
classFunDeps :: [FunDep TyVar],  
        Class -> ClassBody
classBody :: ClassBody 
     }
type FunDep a = ([a],[a])
type ClassOpItem = (Id, DefMethInfo)
        
        
type DefMethInfo = Maybe (Name, DefMethSpec Type)
   
   
   
   
   
   
data ClassATItem
  = ATI TyCon         
        (Maybe (Type, ATValidityInfo))
                      
                      
data ATValidityInfo
  = NoATVI               
                         
                         
  | ATVI SrcSpan [Type]  
                         
type ClassMinimalDef = BooleanFormula Name 
data ClassBody
  = AbstractClass
  | ConcreteClass {
        
        
        
        ClassBody -> [PredType]
cls_sc_theta :: [PredType],     
        ClassBody -> [TyVar]
cls_sc_sel_ids :: [Id],          
                                        
                                        
        
        ClassBody -> [ClassATItem]
cls_ats :: [ClassATItem],  
        
        ClassBody -> [ClassOpItem]
cls_ops :: [ClassOpItem],  
        
        ClassBody -> ClassMinimalDef
cls_min_def :: ClassMinimalDef
    }
    
classMinimalDef :: Class -> ClassMinimalDef
classMinimalDef :: Class -> ClassMinimalDef
classMinimalDef Class{ classBody :: Class -> ClassBody
classBody = ConcreteClass{ cls_min_def :: ClassBody -> ClassMinimalDef
cls_min_def = ClassMinimalDef
d } } = ClassMinimalDef
d
classMinimalDef Class
_ = ClassMinimalDef
forall a. BooleanFormula a
mkTrue 
mkClass :: Name -> [TyVar]
        -> [FunDep TyVar]
        -> [PredType] -> [Id]
        -> [ClassATItem]
        -> [ClassOpItem]
        -> ClassMinimalDef
        -> TyCon
        -> Class
mkClass :: Name
-> [TyVar]
-> [FunDep TyVar]
-> [PredType]
-> [TyVar]
-> [ClassATItem]
-> [ClassOpItem]
-> ClassMinimalDef
-> TyCon
-> Class
mkClass Name
cls_name [TyVar]
tyvars [FunDep TyVar]
fds [PredType]
super_classes [TyVar]
superdict_sels [ClassATItem]
at_stuff
        [ClassOpItem]
op_stuff ClassMinimalDef
mindef TyCon
tycon
  = Class { classKey :: Unique
classKey     = Name -> Unique
nameUnique Name
cls_name,
            className :: Name
className    = Name
cls_name,
                
                
            classTyVars :: [TyVar]
classTyVars  = [TyVar]
tyvars,
            classFunDeps :: [FunDep TyVar]
classFunDeps = [FunDep TyVar]
fds,
            classBody :: ClassBody
classBody = ConcreteClass {
                    cls_sc_theta :: [PredType]
cls_sc_theta = [PredType]
super_classes,
                    cls_sc_sel_ids :: [TyVar]
cls_sc_sel_ids = [TyVar]
superdict_sels,
                    cls_ats :: [ClassATItem]
cls_ats  = [ClassATItem]
at_stuff,
                    cls_ops :: [ClassOpItem]
cls_ops  = [ClassOpItem]
op_stuff,
                    cls_min_def :: ClassMinimalDef
cls_min_def = ClassMinimalDef
mindef
                },
            classTyCon :: TyCon
classTyCon   = TyCon
tycon }
mkAbstractClass :: Name -> [TyVar]
        -> [FunDep TyVar]
        -> TyCon
        -> Class
mkAbstractClass :: Name -> [TyVar] -> [FunDep TyVar] -> TyCon -> Class
mkAbstractClass Name
cls_name [TyVar]
tyvars [FunDep TyVar]
fds TyCon
tycon
  = Class { classKey :: Unique
classKey     = Name -> Unique
nameUnique Name
cls_name,
            className :: Name
className    = Name
cls_name,
                
                
            classTyVars :: [TyVar]
classTyVars  = [TyVar]
tyvars,
            classFunDeps :: [FunDep TyVar]
classFunDeps = [FunDep TyVar]
fds,
            classBody :: ClassBody
classBody = ClassBody
AbstractClass,
            classTyCon :: TyCon
classTyCon   = TyCon
tycon }
classArity :: Class -> Arity
classArity :: Class -> Int
classArity Class
clas = [TyVar] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Class -> [TyVar]
classTyVars Class
clas)
        
classAllSelIds :: Class -> [Id]
classAllSelIds :: Class -> [TyVar]
classAllSelIds c :: Class
c@(Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_sc_sel_ids :: ClassBody -> [TyVar]
cls_sc_sel_ids = [TyVar]
sc_sels }})
  = [TyVar]
sc_sels [TyVar] -> [TyVar] -> [TyVar]
forall a. [a] -> [a] -> [a]
++ Class -> [TyVar]
classMethods Class
c
classAllSelIds Class
c = Bool -> [TyVar] -> [TyVar]
forall a. HasCallStack => Bool -> a -> a
assert ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Class -> [TyVar]
classMethods Class
c) ) []
classSCSelIds :: Class -> [Id]
classSCSelIds :: Class -> [TyVar]
classSCSelIds (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_sc_sel_ids :: ClassBody -> [TyVar]
cls_sc_sel_ids = [TyVar]
sc_sels }})
  = [TyVar]
sc_sels
classSCSelIds Class
c = Bool -> [TyVar] -> [TyVar]
forall a. HasCallStack => Bool -> a -> a
assert ([TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Class -> [TyVar]
classMethods Class
c) ) []
classSCSelId :: Class -> Int -> Id
classSCSelId :: Class -> Int -> TyVar
classSCSelId (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_sc_sel_ids :: ClassBody -> [TyVar]
cls_sc_sel_ids = [TyVar]
sc_sels } }) Int
n
  = Bool -> [TyVar] -> [TyVar]
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& [TyVar] -> Int -> Bool
forall a. [a] -> Int -> Bool
lengthExceeds [TyVar]
sc_sels Int
n )
    [TyVar]
sc_sels [TyVar] -> Int -> TyVar
forall a. HasCallStack => [a] -> Int -> a
!! Int
n
classSCSelId Class
c Int
n = String -> SDoc -> TyVar
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"classSCSelId" (Class -> SDoc
forall a. Outputable a => a -> SDoc
ppr Class
c SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n)
classMethods :: Class -> [Id]
classMethods :: Class -> [TyVar]
classMethods (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_ops :: ClassBody -> [ClassOpItem]
cls_ops = [ClassOpItem]
op_stuff } })
  = [TyVar
op_sel | (TyVar
op_sel, DefMethInfo
_) <- [ClassOpItem]
op_stuff]
classMethods Class
_ = []
classOpItems :: Class -> [ClassOpItem]
classOpItems :: Class -> [ClassOpItem]
classOpItems (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_ops :: ClassBody -> [ClassOpItem]
cls_ops = [ClassOpItem]
op_stuff }})
  = [ClassOpItem]
op_stuff
classOpItems Class
_ = []
classATs :: Class -> [TyCon]
classATs :: Class -> [TyCon]
classATs (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_ats :: ClassBody -> [ClassATItem]
cls_ats = [ClassATItem]
at_stuff } })
  = [TyCon
tc | ATI TyCon
tc Maybe (PredType, ATValidityInfo)
_ <- [ClassATItem]
at_stuff]
classATs Class
_ = []
classATItems :: Class -> [ClassATItem]
classATItems :: Class -> [ClassATItem]
classATItems (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_ats :: ClassBody -> [ClassATItem]
cls_ats = [ClassATItem]
at_stuff }})
  = [ClassATItem]
at_stuff
classATItems Class
_ = []
classSCTheta :: Class -> [PredType]
classSCTheta :: Class -> [PredType]
classSCTheta (Class { classBody :: Class -> ClassBody
classBody = ConcreteClass { cls_sc_theta :: ClassBody -> [PredType]
cls_sc_theta = [PredType]
theta_stuff }})
  = [PredType]
theta_stuff
classSCTheta Class
_ = []
classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
classTvsFds Class
c = (Class -> [TyVar]
classTyVars Class
c, Class -> [FunDep TyVar]
classFunDeps Class
c)
classHasFds :: Class -> Bool
classHasFds :: Class -> Bool
classHasFds (Class { classFunDeps :: Class -> [FunDep TyVar]
classFunDeps = [FunDep TyVar]
fds }) = Bool -> Bool
not ([FunDep TyVar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FunDep TyVar]
fds)
classBigSig :: Class -> ([TyVar], [PredType], [Id], [ClassOpItem])
classBigSig :: Class -> ([TyVar], [PredType], [TyVar], [ClassOpItem])
classBigSig (Class {classTyVars :: Class -> [TyVar]
classTyVars = [TyVar]
tyvars,
                    classBody :: Class -> ClassBody
classBody = ClassBody
AbstractClass})
  = ([TyVar]
tyvars, [], [], [])
classBigSig (Class {classTyVars :: Class -> [TyVar]
classTyVars = [TyVar]
tyvars,
                    classBody :: Class -> ClassBody
classBody = ConcreteClass {
                        cls_sc_theta :: ClassBody -> [PredType]
cls_sc_theta = [PredType]
sc_theta,
                        cls_sc_sel_ids :: ClassBody -> [TyVar]
cls_sc_sel_ids = [TyVar]
sc_sels,
                        cls_ops :: ClassBody -> [ClassOpItem]
cls_ops  = [ClassOpItem]
op_stuff
                    }})
  = ([TyVar]
tyvars, [PredType]
sc_theta, [TyVar]
sc_sels, [ClassOpItem]
op_stuff)
classExtraBigSig :: Class -> ([TyVar], [FunDep TyVar], [PredType], [Id], [ClassATItem], [ClassOpItem])
 (Class {classTyVars :: Class -> [TyVar]
classTyVars = [TyVar]
tyvars, classFunDeps :: Class -> [FunDep TyVar]
classFunDeps = [FunDep TyVar]
fundeps,
                         classBody :: Class -> ClassBody
classBody = ClassBody
AbstractClass})
  = ([TyVar]
tyvars, [FunDep TyVar]
fundeps, [], [], [], [])
classExtraBigSig (Class {classTyVars :: Class -> [TyVar]
classTyVars = [TyVar]
tyvars, classFunDeps :: Class -> [FunDep TyVar]
classFunDeps = [FunDep TyVar]
fundeps,
                         classBody :: Class -> ClassBody
classBody = ConcreteClass {
                             cls_sc_theta :: ClassBody -> [PredType]
cls_sc_theta = [PredType]
sc_theta, cls_sc_sel_ids :: ClassBody -> [TyVar]
cls_sc_sel_ids = [TyVar]
sc_sels,
                             cls_ats :: ClassBody -> [ClassATItem]
cls_ats = [ClassATItem]
ats, cls_ops :: ClassBody -> [ClassOpItem]
cls_ops = [ClassOpItem]
op_stuff
                         }})
  = ([TyVar]
tyvars, [FunDep TyVar]
fundeps, [PredType]
sc_theta, [TyVar]
sc_sels, [ClassATItem]
ats, [ClassOpItem]
op_stuff)
isAbstractClass :: Class -> Bool
isAbstractClass :: Class -> Bool
isAbstractClass Class{ classBody :: Class -> ClassBody
classBody = ClassBody
AbstractClass } = Bool
True
isAbstractClass Class
_ = Bool
False
instance Eq Class where
    Class
c1 == :: Class -> Class -> Bool
== Class
c2 = Class -> Unique
classKey Class
c1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
== Class -> Unique
classKey Class
c2
    Class
c1 /= :: Class -> Class -> Bool
/= Class
c2 = Class -> Unique
classKey Class
c1 Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
/= Class -> Unique
classKey Class
c2
instance Uniquable Class where
    getUnique :: Class -> Unique
getUnique Class
c = Class -> Unique
classKey Class
c
instance NamedThing Class where
    getName :: Class -> Name
getName Class
clas = Class -> Name
className Class
clas
instance Outputable Class where
    ppr :: Class -> SDoc
ppr Class
c = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Class -> Name
forall a. NamedThing a => a -> Name
getName Class
c)
pprDefMethInfo :: DefMethInfo -> SDoc
pprDefMethInfo :: DefMethInfo -> SDoc
pprDefMethInfo DefMethInfo
Nothing                  = SDoc
empty   
pprDefMethInfo (Just (Name
n, DefMethSpec PredType
VanillaDM))    = String -> SDoc
text String
"Default method" SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
pprDefMethInfo (Just (Name
n, GenericDM PredType
ty)) = String -> SDoc
text String
"Generic default method"
                                          SDoc -> SDoc -> SDoc
<+> Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> PredType -> SDoc
pprType PredType
ty
pprFundeps :: Outputable a => [FunDep a] -> SDoc
pprFundeps :: forall a. Outputable a => [FunDep a] -> SDoc
pprFundeps []  = SDoc
empty
pprFundeps [FunDep a]
fds = [SDoc] -> SDoc
hsep (SDoc
vbar SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((FunDep a -> SDoc) -> [FunDep a] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map FunDep a -> SDoc
forall a. Outputable a => FunDep a -> SDoc
pprFunDep [FunDep a]
fds))
pprFunDep :: Outputable a => FunDep a -> SDoc
pprFunDep :: forall a. Outputable a => FunDep a -> SDoc
pprFunDep ([a]
us, [a]
vs) = [SDoc] -> SDoc
hsep [[a] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [a]
us, SDoc
arrow, [a] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP [a]
vs]
instance Data.Data Class where
    
    toConstr :: Class -> Constr
toConstr Class
_   = String -> Constr
abstractConstr String
"Class"
    gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Class
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = String -> Constr -> c Class
forall a. HasCallStack => String -> a
error String
"gunfold"
    dataTypeOf :: Class -> DataType
dataTypeOf Class
_ = String -> DataType
mkNoRepType String
"Class"