{-# LANGUAGE AllowAmbiguousTypes #-}
module HaScalaM.Types.Base where
import Data.Int (Int8, Int16, Int64)
import HaScalaM.Classes.Base
import HaScalaM.Classes.Term
import HaScalaM.Classes
data SmAnnotM m n t' t ac i where
SmAnnotM :: Init m n t' t ac i => { forall m n t' t ac i. SmAnnotM m n t' t ac i -> i
initA :: i } -> SmAnnotM m n t' t ac i
data SmCtorSecondaryS m n p t' t pc ac i s where
SmCtorSecondaryS :: ( ParamClauseT m n p t' t pc
, Init m n t' t ac i
, Stat s
) => { forall m n p t' t pc ac i s.
SmCtorSecondaryS m n p t' t pc ac i s -> [m]
modsCSS :: [m]
, forall m n p t' t pc ac i s.
SmCtorSecondaryS m n p t' t pc ac i s -> n
nameCSS :: n
, forall m n p t' t pc ac i s.
SmCtorSecondaryS m n p t' t pc ac i s -> [pc]
paramsClausesCSS :: [pc]
, forall m n p t' t pc ac i s.
SmCtorSecondaryS m n p t' t pc ac i s -> i
initCSS :: i
, forall m n p t' t pc ac i s.
SmCtorSecondaryS m n p t' t pc ac i s -> [s]
statsCSS :: [s] } -> SmCtorSecondaryS m n p t' t pc ac i s
data SmLit where
SmBooleanL :: { SmLit -> Bool
valueBL :: Bool } -> SmLit
SmByteL :: { SmLit -> Int8
valueByL :: Int8 } -> SmLit
SmCharL :: { SmLit -> Char
valueChL :: Char } -> SmLit
SmDoubleL :: { SmLit -> Double
valueDL :: Double } -> SmLit
SmFloatL :: { SmLit -> Float
valueFL :: Float } -> SmLit
SmIntL :: { SmLit -> Int
valueIL :: Int } -> SmLit
SmLongL :: { SmLit -> Int64
valueLL :: Int64 } -> SmLit
SmNullL :: SmLit
SmShortL :: { SmLit -> Int16
valueShL :: Int16 } -> SmLit
SmStringL :: { SmLit -> String
valueSL :: String } -> SmLit
SmSymbolL :: { SmLit -> Symbol
valueSyL :: Symbol } -> SmLit
SmUnitL :: SmLit
data SmModM where
SmAbstractM :: SmModM
SmCaseM :: SmModM
SmCovariantM :: Variant m => SmModM
SmContravariantM :: Variant m => SmModM
SmErasedM :: SmModM
SmFinalM :: SmModM
SmImplicitM :: ParamsType m => SmModM
SmInfixM :: SmModM
SmInlineM :: SmModM
SmLazyM :: SmModM
SmOpaqueM :: SmModM
SmOpenM :: SmModM
SmOverrideM :: SmModM
SmSealedM :: SmModM
SmSuperM :: SmModM
SmTransparentM :: SmModM
SmUsingM :: (ArgsType m, ParamsType m) => SmModM
SmValParamM :: SmModM
SmVarParamM :: SmModM
data SmAccessM r where
SmPrivateM :: Ref r => { forall r. SmAccessM r -> r
withinPrivAM :: r } -> SmAccessM r
SmProtectedM :: Ref r => { forall r. SmAccessM r -> r
withinProtAM :: r } -> SmAccessM r
data SmNameN where
SmAnonymousN :: SmNameN
SmIndeterminateN :: { SmNameN -> String
valueNI :: String } -> SmNameN
SmPlaceholderN :: SmNameN
SmThisN :: SmNameN
newtype Symbol = Symbol { Symbol -> String
name :: String }