{-# LANGUAGE TypeFamilies #-}
module HaScalaM.Instances.Tilde where
import HaScalaM.Classes
import HaScalaM.Classes.Base
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
import HaScalaM.Types.Tilde
instance ParamClauseT m n p t' t pc => Tree (SmCtorPrimary m n p t' t pc)
instance ParamClauseT m n p t' t pc => Ctor (SmCtorPrimary m n p t' t pc)
instance ParamClauseT m n p t' t pc => WithParamClauses m n p t' t pc (SmCtorPrimary m n p t' t pc)
where paramClauses :: SmCtorPrimary m n p t' t pc -> [pc]
paramClauses (SmCtorPrimary [m]
_ n
_ [pc]
pcs) = [pc]
pcs
instance ( m ~ SmMod
, n ~ SmName
, p ~ SmParamT m n t' t
, t' ~ SmType'
, t ~ SmTerm
, pc ~ SmParamClauseT m n p t' t
, ParamClauseT m n p t' t pc
) => Primary m n p t' t pc (SmCtorPrimary m n p t' t pc)
where mods :: SmCtorPrimary m n p t' t pc -> [m]
mods (SmCtorPrimary [m]
ms n
_ [pc]
_) = [m]
ms
instance Tree SmMod
instance Mod SmMod
instance ArgsType SmMod
instance ParamsType SmMod
instance Variant SmMod
instance ( ParamClauseT' m n p' t' b' pc'
, ParamClauseT m n p t' t pc
) => Tree (SmParamClauseGroup m n p p' t' b' t pc pc')
instance ( m ~ SmMod
, n ~ SmName
, p ~ SmParamT m n t' t
, p' ~ SmParamT' m n t' b'
, t' ~ SmType'
, b' ~ SmBounds' t'
, t ~ SmTerm
, pc ~ SmParamClauseT m n p t' t
, pc' ~ SmParamClauseT' m n p' t' b'
, ParamClauseT' m n p' t' b' pc'
, ParamClauseT m n p t' t pc
) => ParamClauseGroup m n p p' t' b' t pc pc' (SmParamClauseGroup m n p p' t' b' t pc pc')
where
t'paramClause' :: SmParamClauseGroup m n p p' t' b' t pc pc' -> pc'
t'paramClause' (SmParamClauseGroup pc'
t'pc [pc]
_) = pc'
t'pc
paramClauses' :: SmParamClauseGroup m n p p' t' b' t pc pc' -> [pc]
paramClauses' (SmParamClauseGroup pc'
_ [pc]
pcs) = [pc]
pcs
instance ( Name n
, Type' t'
) => Tree (SmSelf n t')
instance ( Name n
, Type' t'
) => Member n (SmSelf n t')
where name :: SmSelf n t' -> n
name (SmSelf n
n Maybe t'
_) = n
n
instance ( Name n
, Type' t'
) => WithDeclTpeOpt t' (SmSelf n t')
where decltpeOpt :: SmSelf n t' -> Maybe t'
decltpeOpt (SmSelf n
_ Maybe t'
dt) = Maybe t'
dt
instance ( n ~ SmName
, t' ~ SmType'
, Name n
, Type' t'
) => Self n t' (SmSelf n t')
instance Stat s => Tree (SmSource s)
instance ( s ~ SmStat
, Stat s
) => Source s (SmSource s)
where stats' :: SmSource s -> [s]
stats' (SmSource [s]
ss) = [s]
ss
instance ( Init m n t' t ac i
, Stat s
, Self n t' p
) => Tree (SmTemplate m n t' t ac i p s)
instance ( m ~ SmMod
, n ~ SmName
, t' ~ SmType'
, t ~ SmTerm
, ac ~ SmArgClauseT m t
, i ~ SmInit m n t' t ac
, s ~ SmStat
, p ~ SmSelf n t'
, Init m n t' t ac i
, Stat s
, Self n t' p
) => Template m n t' t ac i p s (SmTemplate m n t' t ac i p s)
where early :: SmTemplate m n t' t ac i p s -> [s]
early (SmTemplate [s]
ss [i]
_ p
_ [s]
_ [t']
_) = [s]
ss
inits :: SmTemplate m n t' t ac i p s -> [i]
inits (SmTemplate [s]
_ [i]
is p
_ [s]
_ [t']
_) = [i]
is
self :: SmTemplate m n t' t ac i p s -> p
self (SmTemplate [s]
_ [i]
_ p
s [s]
_ [t']
_) = p
s
stats :: SmTemplate m n t' t ac i p s -> [s]
stats (SmTemplate [s]
_ [i]
_ p
_ [s]
ss [t']
_) = [s]
ss
derives :: SmTemplate m n t' t ac i p s -> [t']
derives (SmTemplate [s]
_ [i]
_ p
_ [s]
_ [t']
t's) = [t']
t's