{-# LANGUAGE AllowAmbiguousTypes #-}
module HaScalaM.Types.Type where
import HaScalaM.Classes.Base
import HaScalaM.Classes.Term
import HaScalaM.Classes.Type
data SmApplyT' t' ac' where
SmApplyT' :: ArgClauseT' t' ac' => { forall t' ac'. SmApplyT' t' ac' -> t'
tpeAT' :: t'
, forall t' ac'. SmApplyT' t' ac' -> ac'
argClauseAT' :: ac' } -> SmApplyT' t' ac'
data SmApplyInfixT' t'n t' where
SmApplyInfixT' :: ( NameT' t'n
, Type' t'
) => { forall t'n t'. SmApplyInfixT' t'n t' -> t'
lhsAIxT' :: t'
, forall t'n t'. SmApplyInfixT' t'n t' -> t'n
opAIxT' :: t'n
, forall t'n t'. SmApplyInfixT' t'n t' -> t'
rhsAIxT' :: t' } -> SmApplyInfixT' t'n t'
data SmContextFunctionT' t' where
SmContextFunctionT' :: Type' t' => { forall t'. SmContextFunctionT' t' -> FuncParamClause' t'
paramClauseCFT' :: FuncParamClause' t'
, forall t'. SmContextFunctionT' t' -> t'
resCFT' :: t' } -> SmContextFunctionT' t'
data SmExistentialT' t' s where
SmExistentialT' :: ( Type' t'
, Stat s
) => { forall t' s. SmExistentialT' t' s -> t'
tpeET' :: t'
, forall t' s. SmExistentialT' t' s -> [s]
statsET' :: [s] } -> SmExistentialT' t' s
data SmFunctionT' t' where
SmFunctionT' :: Type' t' => { forall t'. SmFunctionT' t' -> FuncParamClause' t'
paramClauseFT' :: FuncParamClause' t'
, forall t'. SmFunctionT' t' -> t'
resFT' :: t' } -> SmFunctionT' t'
data SmLambdaT' m n p' t' b' pc' where
SmLambdaT' :: ParamClauseT' m n p' t' b' pc' => { forall m n p' t' b' pc'. SmLambdaT' m n p' t' b' pc' -> pc'
t'paramClauseLT' :: pc'
, forall m n p' t' b' pc'. SmLambdaT' m n p' t' b' pc' -> t'
tpeLT' :: t' } -> SmLambdaT' m n p' t' b' pc'
data SmMacroT' t where
SmMacroT' :: Term t => { forall t. SmMacroT' t -> t
bodyMcrT' :: t } -> SmMacroT' t
data SmMatchT' t' ct where
SmMatchT' :: Type'Case t' ct => { forall t' ct. SmMatchT' t' ct -> t'
tpeMtchT' :: t'
, forall t' ct. SmMatchT' t' ct -> [ct]
casesMtchT' :: [ct] } -> SmMatchT' t' ct
data SmPolyFunctionT' m n p' t' b' pc' where
SmPolyFunctionT' :: ParamClauseT' m n p' t' b' pc' => { forall m n p' t' b' pc'. SmPolyFunctionT' m n p' t' b' pc' -> pc'
t'ParamClausePFT' :: pc'
, forall m n p' t' b' pc'. SmPolyFunctionT' m n p' t' b' pc' -> t'
bodyPFT' :: t' } -> SmPolyFunctionT' m n p' t' b' pc'
data SmRefineT' t' s where
SmRefineT' :: ( Type' t'
, Stat s
) => { forall t' s. SmRefineT' t' s -> Maybe t'
tpeRfT' :: Maybe t'
, forall t' s. SmRefineT' t' s -> [s]
statsRfT' :: [s] } -> SmRefineT' t' s
data SmTupleT' t' where
SmTupleT' :: Type' t' => { forall t'. SmTupleT' t' -> [t']
argsTT' :: [t'] } -> SmTupleT' t'
data SmVarT' t'n where
SmVarT' :: NameT' t'n => { forall t'n. SmVarT' t'n -> t'n
nameVT' :: t'n } -> SmVarT' t'n