{-# LANGUAGE TypeFamilies #-}
module HaScalaM.Instances.Stat.Defn where
import Data.Maybe (listToMaybe)
import HaScalaM.Classes
import HaScalaM.Classes.Base
import HaScalaM.Classes.Pat
import HaScalaM.Classes.Stat
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
import HaScalaM.Types.Stat
import HaScalaM.Types.Tilde
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Tree (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Defn (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Member t'n (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
where name :: SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e -> t'n
name (SmClassS [m]
_ t'n
n pc'
_ c
_ e
_) = t'n
n
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => MemberT' t'n (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithMods m (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
where mods :: SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e -> [m]
mods (SmClassS [m]
ms t'n
_ pc'
_ c
_ e
_) = [m]
ms
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithT'ParamClause m n p' t' b' pc' (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
where t'paramClause :: SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e -> pc'
t'paramClause (SmClassS [m]
_ t'n
_ pc'
t'pc c
_ e
_) = pc'
t'pc
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithCtor m n p t' t pc c (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
where ctor :: SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e -> c
ctor (SmClassS [m]
_ t'n
_ pc'
_ c
c e
_) = c
c
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithTemplate m n t' t ac i f s e (SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e)
where templ :: SmClassS m n t'n p p' t' b' t pc pc' c ac i f s e -> e
templ (SmClassS [m]
_ t'n
_ pc'
_ c
_ e
e) = e
e
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => Tree (SmDefS m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => Defn (SmDefS m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => Member tn (SmDefS m n tn p p' t' b' t pc pc' g)
where name :: SmDefS m n tn p p' t' b' t pc pc' g -> tn
name (SmDefS [m]
_ tn
n [g]
_ Maybe t'
_ t
_) = tn
n
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => MemberT tn (SmDefS m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithMods m (SmDefS m n tn p p' t' b' t pc pc' g)
where mods :: SmDefS m n tn p p' t' b' t pc pc' g -> [m]
mods (SmDefS [m]
ms tn
_ [g]
_ Maybe t'
_ t
_) = [m]
ms
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauses m n p t' t pc (SmDefS m n tn p p' t' b' t pc pc' g)
where paramClauses :: SmDefS m n tn p p' t' b' t pc pc' g -> [pc]
paramClauses (SmDefS [m]
_ tn
_ [g]
gs Maybe t'
_ t
_) = case [g] -> Maybe g
forall a. [a] -> Maybe a
listToMaybe [g]
gs
of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
Maybe g
Nothing -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmDefS m n tn p p' t' b' t pc pc' g)
where paramClauseGroup :: SmDefS m n tn p p' t' b' t pc pc' g -> Maybe g
paramClauseGroup (SmDefS [m]
_ tn
_ [g]
gs Maybe t'
_ t
_) = [g] -> Maybe g
forall a. [a] -> Maybe a
listToMaybe [g]
gs
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauseGroups m n p p' t' b' t pc pc' g (SmDefS m n tn p p' t' b' t pc pc' g)
where paramClauseGroups :: SmDefS m n tn p p' t' b' t pc pc' g -> [g]
paramClauseGroups (SmDefS [m]
_ tn
_ [g]
gs Maybe t'
_ t
_) = [g]
gs
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithDeclTpeOpt t' (SmDefS m n tn p p' t' b' t pc pc' g)
where decltpe' :: SmDefS m n tn p p' t' b' t pc pc' g -> Maybe t'
decltpe' (SmDefS [m]
_ tn
_ [g]
_ Maybe t'
dt t
_) = Maybe t'
dt
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithBody t (SmDefS m n tn p p' t' b' t pc pc' g)
where body :: SmDefS m n tn p p' t' b' t pc pc' g -> t
body (SmDefS [m]
_ tn
_ [g]
_ Maybe t'
_ t
b) = t
b
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Tree (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Defn (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Member t'n (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
where name :: SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e -> t'n
name (SmEnumS [m]
_ t'n
n pc'
_ c
_ e
_) = t'n
n
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => MemberT' t'n (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithMods m (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
where mods :: SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e -> [m]
mods (SmEnumS [m]
ms t'n
_ pc'
_ c
_ e
_) = [m]
ms
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithT'ParamClause m n p' t' b' pc' (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
where t'paramClause :: SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e -> pc'
t'paramClause (SmEnumS [m]
_ t'n
_ pc'
t'pc c
_ e
_) = pc'
t'pc
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithCtor m n p t' t pc c (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
where ctor :: SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e -> c
ctor (SmEnumS [m]
_ t'n
_ pc'
_ c
c e
_) = c
c
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithTemplate m n t' t ac i f s e (SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e)
where templ :: SmEnumS m n t'n p p' t' b' t pc pc' c ac i f s e -> e
templ (SmEnumS [m]
_ t'n
_ pc'
_ c
_ e
e) = e
e
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => Tree (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => Defn (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => Member tn (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
where name :: SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i -> tn
name (SmEnumCaseS [m]
_ tn
n pc'
_ c
_ [i]
_) = tn
n
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => MemberT tn (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => WithMods m (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
where mods :: SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i -> [m]
mods (SmEnumCaseS [m]
ms tn
_ pc'
_ c
_ [i]
_) = [m]
ms
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => WithT'ParamClause m n p' t' b' pc' (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
where t'paramClause :: SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i -> pc'
t'paramClause (SmEnumCaseS [m]
_ tn
_ pc'
t'pc c
_ [i]
_) = pc'
t'pc
instance ( NameT tn
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Init m n t' t ac i
) => WithCtor m n p t' t pc c (SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i)
where ctor :: SmEnumCaseS m n tn p p' t' b' t pc pc' c ac i -> c
ctor (SmEnumCaseS [m]
_ tn
_ pc'
_ c
c [i]
_) = c
c
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Stat s
) => Tree (SmExtensionGroupS m n p p' t' b' t pc pc' s g)
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Stat s
) => Defn (SmExtensionGroupS m n p p' t' b' t pc pc' s g)
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, ParamClauseGroup m n p p' t' b' t pc pc' g
, Stat s
) => WithParamClauses m n p t' t pc (SmExtensionGroupS m n p p' t' b' t pc pc' s g)
where paramClauses :: SmExtensionGroupS m n p p' t' b' t pc pc' s g -> [pc]
paramClauses (SmExtensionGroupS Maybe g
pcg s
_) = case Maybe g
pcg
of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
Maybe g
Nothing -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, ParamClauseGroup m n p p' t' b' t pc pc' g
, Stat s
) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmExtensionGroupS m n p p' t' b' t pc pc' s g)
where paramClauseGroup :: SmExtensionGroupS m n p p' t' b' t pc pc' s g -> Maybe g
paramClauseGroup (SmExtensionGroupS Maybe g
pcg s
_) = Maybe g
pcg
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Stat s
) => WithBody s (SmExtensionGroupS m n p p' t' b' t pc pc' s g)
where body :: SmExtensionGroupS m n p p' t' b' t pc pc' s g -> s
body (SmExtensionGroupS Maybe g
_ s
b) = s
b
instance ParamClauseGroup m n p p' t' b' t pc pc' g => Tree (SmGivenAliasS m n p p' t' b' t pc pc' g)
instance ParamClauseGroup m n p p' t' b' t pc pc' g => Defn (SmGivenAliasS m n p p' t' b' t pc pc' g)
instance ParamClauseGroup m n p p' t' b' t pc pc' g => WithMods m (SmGivenAliasS m n p p' t' b' t pc pc' g)
where mods :: SmGivenAliasS m n p p' t' b' t pc pc' g -> [m]
mods (SmGivenAliasS [m]
ms n
_ Maybe g
_ t'
_ t
_) = [m]
ms
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauses m n p t' t pc (SmGivenAliasS m n p p' t' b' t pc pc' g)
where paramClauses :: SmGivenAliasS m n p p' t' b' t pc pc' g -> [pc]
paramClauses (SmGivenAliasS [m]
_ n
_ Maybe g
pcg t'
_ t
_) = case Maybe g
pcg
of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
Maybe g
Nothing -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmGivenAliasS m n p p' t' b' t pc pc' g)
where paramClauseGroup :: SmGivenAliasS m n p p' t' b' t pc pc' g -> Maybe g
paramClauseGroup (SmGivenAliasS [m]
_ n
_ Maybe g
pcg t'
_ t
_) = Maybe g
pcg
instance ParamClauseGroup m n p p' t' b' t pc pc' g => WithDeclTpe t' (SmGivenAliasS m n p p' t' b' t pc pc' g)
where decltpe :: SmGivenAliasS m n p p' t' b' t pc pc' g -> t'
decltpe (SmGivenAliasS [m]
_ n
_ Maybe g
_ t'
dt t
_) = t'
dt
instance ParamClauseGroup m n p p' t' b' t pc pc' g => WithBody t (SmGivenAliasS m n p p' t' b' t pc pc' g)
where body :: SmGivenAliasS m n p p' t' b' t pc pc' g -> t
body (SmGivenAliasS [m]
_ n
_ Maybe g
_ t'
_ t
b) = t
b
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Template m n t' t ac i f s e
) => Tree (SmGivenS m n p p' t' b' t pc pc' ac i f s e g)
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Template m n t' t ac i f s e
) => Defn (SmGivenS m n p p' t' b' t pc pc' ac i f s e g)
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Template m n t' t ac i f s e
) => WithMods m (SmGivenS m n p p' t' b' t pc pc' ac i f s e g)
where mods :: SmGivenS m n p p' t' b' t pc pc' ac i f s e g -> [m]
mods (SmGivenS [m]
ms n
_ Maybe g
_ e
_) = [m]
ms
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, ParamClauseGroup m n p p' t' b' t pc pc' g
, Template m n t' t ac i f s e
) => WithParamClauses m n p t' t pc (SmGivenS m n p p' t' b' t pc pc' ac i f s e g)
where paramClauses :: SmGivenS m n p p' t' b' t pc pc' ac i f s e g -> [pc]
paramClauses (SmGivenS [m]
_ n
_ Maybe g
pcg e
_) = case Maybe g
pcg
of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
Maybe g
Nothing -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, ParamClauseGroup m n p p' t' b' t pc pc' g
, Template m n t' t ac i f s e
) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmGivenS m n p p' t' b' t pc pc' ac i f s e g)
where paramClauseGroup :: SmGivenS m n p p' t' b' t pc pc' ac i f s e g -> Maybe g
paramClauseGroup (SmGivenS [m]
_ n
_ Maybe g
pcg e
_) = Maybe g
pcg
instance ( ParamClauseGroup m n p p' t' b' t pc pc' g
, Template m n t' t ac i f s e
) => WithTemplate m n t' t ac i f s e (SmGivenS m n p p' t' b' t pc pc' ac i f s e g)
where templ :: SmGivenS m n p p' t' b' t pc pc' ac i f s e g -> e
templ (SmGivenS [m]
_ n
_ Maybe g
_ e
e) = e
e
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => Tree (SmMacroS m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => Defn (SmMacroS m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => Member tn (SmMacroS m n tn p p' t' b' t pc pc' g)
where name :: SmMacroS m n tn p p' t' b' t pc pc' g -> tn
name (SmMacroS [m]
_ tn
n [g]
_ Maybe t'
_ t
_) = tn
n
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => MemberT tn (SmMacroS m n tn p p' t' b' t pc pc' g)
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithMods m (SmMacroS m n tn p p' t' b' t pc pc' g)
where mods :: SmMacroS m n tn p p' t' b' t pc pc' g -> [m]
mods (SmMacroS [m]
ms tn
_ [g]
_ Maybe t'
_ t
_) = [m]
ms
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauses m n p t' t pc (SmMacroS m n tn p p' t' b' t pc pc' g)
where paramClauses :: SmMacroS m n tn p p' t' b' t pc pc' g -> [pc]
paramClauses (SmMacroS [m]
_ tn
_ [g]
gs Maybe t'
_ t
_) = case [g] -> Maybe g
forall a. [a] -> Maybe a
listToMaybe [g]
gs
of Just (SmParamClauseGroup pc'
_ [pc]
pcs) -> [pc]
pcs
Maybe g
Nothing -> []
instance ( g ~ SmParamClauseGroup m n p p' t' b' t pc pc'
, NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauseGroup m n p p' t' b' t pc pc' g (SmMacroS m n tn p p' t' b' t pc pc' g)
where paramClauseGroup :: SmMacroS m n tn p p' t' b' t pc pc' g -> Maybe g
paramClauseGroup (SmMacroS [m]
_ tn
_ [g]
gs Maybe t'
_ t
_) = [g] -> Maybe g
forall a. [a] -> Maybe a
listToMaybe [g]
gs
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithParamClauseGroups m n p p' t' b' t pc pc' g (SmMacroS m n tn p p' t' b' t pc pc' g)
where paramClauseGroups :: SmMacroS m n tn p p' t' b' t pc pc' g -> [g]
paramClauseGroups (SmMacroS [m]
_ tn
_ [g]
gs Maybe t'
_ t
_) = [g]
gs
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithDeclTpeOpt t' (SmMacroS m n tn p p' t' b' t pc pc' g)
where decltpe' :: SmMacroS m n tn p p' t' b' t pc pc' g -> Maybe t'
decltpe' (SmMacroS [m]
_ tn
_ [g]
_ Maybe t'
dt t
_) = Maybe t'
dt
instance ( NameT tn
, ParamClauseGroup m n p p' t' b' t pc pc' g
) => WithBody t (SmMacroS m n tn p p' t' b' t pc pc' g)
where body :: SmMacroS m n tn p p' t' b' t pc pc' g -> t
body (SmMacroS [m]
_ tn
_ [g]
_ Maybe t'
_ t
b) = t
b
instance ( NameT tn
, Template m n t' t ac i p s e
) => Tree (SmObjectS m n tn p t' t ac i s e)
instance ( NameT tn
, Template m n t' t ac i p s e
) => Defn (SmObjectS m n tn p t' t ac i s e)
instance ( NameT tn
, Template m n t' t ac i p s e
) => Member tn (SmObjectS m n tn p t' t ac i s e)
where name :: SmObjectS m n tn p t' t ac i s e -> tn
name (SmObjectS [m]
_ tn
n e
_) = tn
n
instance ( NameT tn
, Template m n t' t ac i p s e
) => MemberT tn (SmObjectS m n tn p t' t ac i s e)
instance ( NameT tn
, Template m n t' t ac i p s e
) => WithMods m (SmObjectS m n tn p t' t ac i s e)
where mods :: SmObjectS m n tn p t' t ac i s e -> [m]
mods (SmObjectS [m]
ms tn
_ e
_) = [m]
ms
instance ( NameT tn
, Template m n t' t ac i p s e
) => WithTemplate m n t' t ac i p s e (SmObjectS m n tn p t' t ac i s e)
where templ :: SmObjectS m n tn p t' t ac i s e -> e
templ (SmObjectS [m]
_ tn
_ e
e) = e
e
instance ( Mod m
, NameT tn
) => Tree (SmRepeatedEnumCase m tn)
instance ( Mod m
, NameT tn
) => Defn (SmRepeatedEnumCase m tn)
instance ( Mod m
, NameT tn
) => WithMods m (SmRepeatedEnumCase m tn)
where mods :: SmRepeatedEnumCase m tn -> [m]
mods (SmRepeatedEnumCase [m]
ms [tn]
_) = [m]
ms
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Tree (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Defn (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => Member t'n (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
where name :: SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e -> t'n
name (SmTraitS [m]
_ t'n
n pc'
_ c
_ e
_) = t'n
n
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => MemberT' t'n (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithMods m (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
where mods :: SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e -> [m]
mods (SmTraitS [m]
ms t'n
_ pc'
_ c
_ e
_) = [m]
ms
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithT'ParamClause m n p' t' b' pc' (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
where t'paramClause :: SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e -> pc'
t'paramClause (SmTraitS [m]
_ t'n
_ pc'
t'pc c
_ e
_) = pc'
t'pc
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithCtor m n p t' t pc c (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
where ctor :: SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e -> c
ctor (SmTraitS [m]
_ t'n
_ pc'
_ c
c e
_) = c
c
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
, Primary m n p t' t pc c
, Template m n t' t ac i f s e
) => WithTemplate m n t' t ac i f s e (SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e)
where templ :: SmTraitS m n t'n p p' t' b' t pc pc' c ac i f s e -> e
templ (SmTraitS [m]
_ t'n
_ pc'
_ c
_ e
e) = e
e
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => Tree (SmTypeS m n t'n p' t' b' pc')
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => Decl (SmTypeS m n t'n p' t' b' pc')
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => WithT'ParamClause m n p' t' b' pc' (SmTypeS m n t'n p' t' b' pc')
where t'paramClause :: SmTypeS m n t'n p' t' b' pc' -> pc'
t'paramClause (SmTypeS [m]
_ t'n
_ pc'
t'pc t'
_ b'
_) = pc'
t'pc
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => WithMods m (SmTypeS m n t'n p' t' b' pc')
where mods :: SmTypeS m n t'n p' t' b' pc' -> [m]
mods (SmTypeS [m]
ms t'n
_ pc'
_ t'
_ b'
_) = [m]
ms
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => Member t'n (SmTypeS m n t'n p' t' b' pc')
where name :: SmTypeS m n t'n p' t' b' pc' -> t'n
name (SmTypeS [m]
_ t'n
n pc'
_ t'
_ b'
_) = t'n
n
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => MemberT' t'n (SmTypeS m n t'n p' t' b' pc')
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => Type'Def m n t'n p' t' b' pc' (SmTypeS m n t'n p' t' b' pc')
where bounds' :: SmTypeS m n t'n p' t' b' pc' -> b'
bounds' (SmTypeS [m]
_ t'n
_ pc'
_ t'
_ b'
b's) = b'
b's
instance ( NameT' t'n
, ParamClauseT' m n p' t' b' pc'
) => WithBody t' (SmTypeS m n t'n p' t' b' pc')
where body :: SmTypeS m n t'n p' t' b' pc' -> t'
body (SmTypeS [m]
_ t'n
_ pc'
_ t'
b' b'
_) = t'
b'
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => Tree (SmValS m p t' t)
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => Defn (SmValS m p t' t)
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithMods m (SmValS m p t' t)
where mods :: SmValS m p t' t -> [m]
mods (SmValS [m]
ms [p]
_ Maybe t'
_ t
_) = [m]
ms
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithPats p (SmValS m p t' t)
where pats :: SmValS m p t' t -> [p]
pats (SmValS [m]
_ [p]
ps Maybe t'
_ t
_) = [p]
ps
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithDeclTpeOpt t' (SmValS m p t' t)
where decltpe' :: SmValS m p t' t -> Maybe t'
decltpe' (SmValS [m]
_ [p]
_ Maybe t'
dt t
_) = Maybe t'
dt
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithBody t (SmValS m p t' t)
where body :: SmValS m p t' t -> t
body (SmValS [m]
_ [p]
_ Maybe t'
_ t
b) = t
b
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => Tree (SmVarS m p t' t)
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => Defn (SmVarS m p t' t)
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithMods m (SmVarS m p t' t)
where mods :: SmVarS m p t' t -> [m]
mods (SmVarS [m]
ms [p]
_ Maybe t'
_ t
_) = [m]
ms
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithPats p (SmVarS m p t' t)
where pats :: SmVarS m p t' t -> [p]
pats (SmVarS [m]
_ [p]
ps Maybe t'
_ t
_) = [p]
ps
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithDeclTpeOpt t' (SmVarS m p t' t)
where decltpe' :: SmVarS m p t' t -> Maybe t'
decltpe' (SmVarS [m]
_ [p]
_ Maybe t'
dt t
_) = Maybe t'
dt
instance ( Mod m
, Pat p
, Type' t'
, Term t
) => WithBody t (SmVarS m p t' t)
where body :: SmVarS m p t' t -> t
body (SmVarS [m]
_ [p]
_ Maybe t'
_ t
b) = t
b