{-# LANGUAGE AllowAmbiguousTypes #-}
module HaScalaM.Types.Term where
import HaScalaM.Classes
import HaScalaM.Classes.Base
import HaScalaM.Classes.Enums
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
data SmApplyT m t ac where
SmApplyT :: ArgClauseT m t ac => { forall m t ac. SmApplyT m t ac -> t
funAppT :: t
, forall m t ac. SmApplyT m t ac -> ac
argClauseAppT :: ac } -> SmApplyT m t ac
SmApplyUsingT :: ArgClauseT m t ac => { forall m t ac. SmApplyT m t ac -> t
funAppUT :: t
, forall m t ac. SmApplyT m t ac -> ac
argClauseAppUT :: ac } -> SmApplyT m t ac
data SmApplyInfixT m tn t t' ac' ac where
SmApplyInfixT :: ( NameT tn
, ArgClauseT' t' ac'
, ArgClauseT m t ac
) => { forall tn t' ac' m t ac. SmApplyInfixT m tn t t' ac' ac -> t
lhsAppIxT :: t
, forall tn t' ac' m t ac. SmApplyInfixT m tn t t' ac' ac -> tn
opAppIxT :: tn
, forall tn t' ac' m t ac. SmApplyInfixT m tn t t' ac' ac -> ac'
t'argClauseAppIx'T :: ac'
, forall tn t' ac' m t ac. SmApplyInfixT m tn t t' ac' ac -> ac
argClauseAppIxT :: ac } -> SmApplyInfixT m tn t t' ac' ac
data SmApplyType'T t t' ac' where
SmApplyType'T :: ( Term t
, ArgClauseT' t' ac'
) => { forall t t' ac'. SmApplyType'T t t' ac' -> t
funAppT'T :: t
, forall t t' ac'. SmApplyType'T t t' ac' -> ac'
t'argClauseAppT'T :: ac' } -> SmApplyType'T t t' ac'
data SmAssignT t where
SmAssignT :: Term t => { forall t. SmAssignT t -> t
lhsAT :: t
, forall t. SmAssignT t -> t
rhsAT :: t } -> SmAssignT t
data SmBlockT s where
SmBlockT :: Stat s => { forall s. SmBlockT s -> [s]
statsBlT :: [s] } -> SmBlockT s
data SmContextFunctionT m n p t' t pc where
SmContextFunctionT :: ParamClauseT m n p t' t pc => { forall m n p t' t pc. SmContextFunctionT m n p t' t pc -> pc
paramClauseCFT :: pc
, forall m n p t' t pc. SmContextFunctionT m n p t' t pc -> t
bodyCFT :: t } -> SmContextFunctionT m n p t' t pc
data SmDoT t where
SmDoT :: Term t => { forall t. SmDoT t -> t
bodyDT :: t
, forall t. SmDoT t -> t
exprDT :: t } -> SmDoT t
data SmForT e t where
SmForT :: ( Enumerator e
, Term t
) => { forall e t. SmForT e t -> [e]
enumsFDT :: [e]
, forall e t. SmForT e t -> t
bodyFDT :: t } -> SmForT e t
data SmForYieldT e t where
SmForYieldT :: ( Enumerator e
, Term t
) => { forall e t. SmForYieldT e t -> [e]
enumsFYT :: [e]
, forall e t. SmForYieldT e t -> t
bodyFYT :: t } -> SmForYieldT e t
data SmFunctionT m n p t' t pc where
SmFunctionT :: ParamClauseT m n p t' t pc => { forall m n p t' t pc. SmFunctionT m n p t' t pc -> pc
paramClauseFT :: pc
, forall m n p t' t pc. SmFunctionT m n p t' t pc -> t
bodyFT :: t } -> SmFunctionT m n p t' t pc
data SmIfT m t where
SmIfT :: ( Mod m
, Term t
) => { forall m t. SmIfT m t -> t
condIfT :: t
, forall m t. SmIfT m t -> t
thenpIfT :: t
, forall m t. SmIfT m t -> t
elsepIfT :: t
, forall m t. SmIfT m t -> [m]
mods :: [m] } -> SmIfT m t
data SmMatchT p t ct where
SmMatchT :: Case p t ct => { forall p t ct. SmMatchT p t ct -> t
exprMT :: t
, forall p t ct. SmMatchT p t ct -> [ct]
casesMT :: [ct] } -> SmMatchT p t ct
data SmNewAnonymousT m n t' t ac i p s e where
SmNewAnonymousT :: Template m n t' t ac i p s e => { forall m n t' t ac i p s e.
SmNewAnonymousT m n t' t ac i p s e -> e
templNAT :: e } -> SmNewAnonymousT m n t' t ac i p s e
data SmPartialFunctionT p t ct where
SmPartialFunctionT :: Case p t ct => { forall p t ct. SmPartialFunctionT p t ct -> [ct]
casesPFT :: [ct] } -> SmPartialFunctionT p t ct
data SmPolyFunctionT m n p' t' b' pc' t where
SmPolyFunctionT :: ( ParamClauseT' m n p' t' b' pc'
, Term t
) => { forall m n p' t' b' pc' t.
SmPolyFunctionT m n p' t' b' pc' t -> pc'
t'ParamClausePFT :: pc'
, forall m n p' t' b' pc' t. SmPolyFunctionT m n p' t' b' pc' t -> t
bodyPFT :: t } -> SmPolyFunctionT m n p' t' b' pc' t
data SmTryT p t ct where
SmTryT :: Case p t ct => { forall p t ct. SmTryT p t ct -> t
exprTT :: t
, forall p t ct. SmTryT p t ct -> [ct]
catchpTT :: [ct]
, forall p t ct. SmTryT p t ct -> Maybe t
finallypTT :: Maybe t } -> SmTryT p t ct
data SmTupleT t where
SmTupleT :: Term t => { forall t. SmTupleT t -> [t]
argsTT :: [t] } -> SmTupleT t
data SmWhileT t where
SmWhileT :: Term t => { forall t. SmWhileT t -> t
exprWT :: t
, forall t. SmWhileT t -> t
bodyWT :: t } -> SmWhileT t