{-# 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


--------------------------------------------------------------------------- I --

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

--------------------------------------------------------------------------- L --

instance Tree SmLit
instance Lit SmLit

--------------------------------------------------------------------------- M --

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