{-# LANGUAGE TypeFamilies #-}
module HaScalaM.Instances.Base where
import HaScalaM.Classes
import HaScalaM.Classes.Base
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
import HaScalaM.Types.Base
import HaScalaM.Types.Tilde
instance ( Name n
, Type' t'
, ArgClauseT m t ac
) => Tree (SmInit m n t' t ac)
instance ( m ~ SmMod
, n ~ SmName
, t' ~ SmType'
, ac ~ SmArgClauseT m t
, Name n
, Type' t'
, ArgClauseT m t ac
) => Init m n t' t ac (SmInit m n t' t ac)
where tpe :: SmInit m n t' t ac -> t'
tpe (SmInit t'
t n
_ [ac]
_) = t'
t
name' :: SmInit m n t' t ac -> n
name' (SmInit t'
_ n
n [ac]
_) = n
n
argClauses :: SmInit m n t' t ac -> [ac]
argClauses (SmInit t'
_ n
_ [ac]
as) = [ac]
as
instance Tree SmLit
instance Lit SmLit
instance Tree SmModM
instance Ref r => Tree (SmAccessM r)
instance Ref r => WithWithin r (SmAccessM r)
where within :: SmAccessM r -> r
within (SmPrivateM r
r) = r
r
within (SmProtectedM r
r) = r
r