{-# LANGUAGE FlexibleInstances #-}
module Parser.TypeInstance (
) where
import Control.Applicative ((<|>))
import Base.GeneralType
import Base.Mergeable (mergeAll,mergeAny)
import Base.Positional
import Parser.Common
import Parser.TextParser hiding ((<|>),single)
import Types.TypeInstance
instance ParseFromSource GeneralInstance where
sourceParser :: TextParser GeneralInstance
sourceParser = TextParser GeneralInstance
single forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser GeneralInstance
allT forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser GeneralInstance
anyT forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser GeneralInstance
intersectOrUnion where
allT :: TextParser GeneralInstance
allT = forall a. String -> TextParser a -> TextParser a
labeled String
"all" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwAll
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bounded a => a
minBound
anyT :: TextParser GeneralInstance
anyT = forall a. String -> TextParser a -> TextParser a
labeled String
"any" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwAny
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Bounded a => a
maxBound
intersectOrUnion :: TextParser GeneralInstance
intersectOrUnion = forall a. String -> TextParser a -> TextParser a
labeled String
"union or intersection" forall a b. (a -> b) -> a -> b
$ do
forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"["
GeneralInstance
t1 <- forall a. String -> TextParser a -> TextParser a
labeled String
"type" forall a b. (a -> b) -> a -> b
$ forall a. ParseFromSource a => TextParser a
sourceParser
GeneralInstance
t <- forall {b}.
(ParseFromSource b, Mergeable b) =>
b -> ParsecT CompilerMessage String Identity b
intersect GeneralInstance
t1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {b}.
(ParseFromSource b, Mergeable b) =>
b -> ParsecT CompilerMessage String Identity b
union GeneralInstance
t1
forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ String -> TextParser ()
string_ String
"]"
forall (m :: * -> *) a. Monad m => a -> m a
return GeneralInstance
t
intersect :: b -> ParsecT CompilerMessage String Identity b
intersect b
t1 = do
[b]
ts <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"&") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. String -> TextParser a -> TextParser a
labeled String
"type" forall a. ParseFromSource a => TextParser a
sourceParser)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAll (b
t1forall a. a -> [a] -> [a]
:[b]
ts)
union :: b -> ParsecT CompilerMessage String Identity b
union b
t1 = do
[b]
ts <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall a. TextParser a -> TextParser a
sepAfter (String -> TextParser ()
string_ String
"|") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. String -> TextParser a -> TextParser a
labeled String
"type" forall a. ParseFromSource a => TextParser a
sourceParser)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). (Mergeable a, Foldable f) => f a -> a
mergeAny (b
t1forall a. a -> [a] -> [a]
:[b]
ts)
single :: TextParser GeneralInstance
single = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. (Eq a, Ord a) => a -> GeneralType a
singleType forall a. ParseFromSource a => TextParser a
sourceParser
instance ParseFromSource ValueType where
sourceParser :: TextParser ValueType
sourceParser = do
StorageType
r <- ParsecT CompilerMessage String Identity StorageType
getWeak forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity StorageType
getOptional forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT CompilerMessage String Identity StorageType
getRequired
GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ StorageType -> GeneralInstance -> ValueType
ValueType StorageType
r GeneralInstance
t
where
getWeak :: ParsecT CompilerMessage String Identity StorageType
getWeak = forall a. String -> TextParser a -> TextParser a
labeled String
"weak" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwWeak
forall (m :: * -> *) a. Monad m => a -> m a
return StorageType
WeakValue
getOptional :: ParsecT CompilerMessage String Identity StorageType
getOptional = forall a. String -> TextParser a -> TextParser a
labeled String
"optional" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwOptional
forall (m :: * -> *) a. Monad m => a -> m a
return StorageType
OptionalValue
getRequired :: ParsecT CompilerMessage String Identity StorageType
getRequired = forall (m :: * -> *) a. Monad m => a -> m a
return StorageType
RequiredValue
instance ParseFromSource CategoryName where
sourceParser :: TextParser CategoryName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"type name" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
noKeywords
Char
b <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar
String
e <- forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> CategoryName
box (Char
bforall a. a -> [a] -> [a]
:String
e)
where
box :: String -> CategoryName
box String
n
| String
n forall a. Eq a => a -> a -> Bool
== String
"Bool" = CategoryName
BuiltinBool
| String
n forall a. Eq a => a -> a -> Bool
== String
"Char" = CategoryName
BuiltinChar
| String
n forall a. Eq a => a -> a -> Bool
== String
"CharBuffer" = CategoryName
BuiltinCharBuffer
| String
n forall a. Eq a => a -> a -> Bool
== String
"Int" = CategoryName
BuiltinInt
| String
n forall a. Eq a => a -> a -> Bool
== String
"Float" = CategoryName
BuiltinFloat
| String
n forall a. Eq a => a -> a -> Bool
== String
"String" = CategoryName
BuiltinString
| String
n forall a. Eq a => a -> a -> Bool
== String
"Pointer" = CategoryName
BuiltinPointer
| String
n forall a. Eq a => a -> a -> Bool
== String
"Identifier" = CategoryName
BuiltinIdentifier
| String
n forall a. Eq a => a -> a -> Bool
== String
"Formatted" = CategoryName
BuiltinFormatted
| String
n forall a. Eq a => a -> a -> Bool
== String
"Order" = CategoryName
BuiltinOrder
| String
n forall a. Eq a => a -> a -> Bool
== String
"Testcase" = CategoryName
BuiltinTestcase
| Bool
otherwise = String -> CategoryName
CategoryName String
n
instance ParseFromSource ParamName where
sourceParser :: TextParser ParamName
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"param name" forall a b. (a -> b) -> a -> b
$ TextParser ParamName
self forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser ParamName
custom where
self :: TextParser ParamName
self = do
TextParser ()
paramSelf
forall (m :: * -> *) a. Monad m => a -> m a
return ParamName
ParamSelf
custom :: TextParser ParamName
custom = do
TextParser ()
noKeywords
Char -> TextParser ()
char_ Char
'#'
Char
b <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
lowerChar
String
e <- forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> ParamName
ParamName (Char
'#'forall a. a -> [a] -> [a]
:Char
bforall a. a -> [a] -> [a]
:String
e)
instance ParseFromSource TypeInstance where
sourceParser :: TextParser TypeInstance
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"type instance" forall a b. (a -> b) -> a -> b
$ do
CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
[GeneralInstance]
as <- forall a. String -> TextParser a -> TextParser a
labeled String
"type args" forall a b. (a -> b) -> a -> b
$ TextParser [GeneralInstance]
args forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> TypeInstance
TypeInstance CategoryName
n (forall a. [a] -> Positional a
Positional [GeneralInstance]
as)
where
args :: TextParser [GeneralInstance]
args = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"<")
(forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
">")
(forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
","))
instance ParseFromSource DefinesInstance where
sourceParser :: TextParser DefinesInstance
sourceParser = forall a. String -> TextParser a -> TextParser a
labeled String
"type instance" forall a b. (a -> b) -> a -> b
$ do
CategoryName
n <- forall a. ParseFromSource a => TextParser a
sourceParser
[GeneralInstance]
as <- forall a. String -> TextParser a -> TextParser a
labeled String
"type args" forall a b. (a -> b) -> a -> b
$ TextParser [GeneralInstance]
args forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CategoryName -> InstanceParams -> DefinesInstance
DefinesInstance CategoryName
n (forall a. [a] -> Positional a
Positional [GeneralInstance]
as)
where
args :: TextParser [GeneralInstance]
args = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
"<")
(forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
">")
(forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepBy forall a. ParseFromSource a => TextParser a
sourceParser (forall a. TextParser a -> TextParser a
sepAfter forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string String
","))
instance ParseFromSource TypeInstanceOrParam where
sourceParser :: TextParser TypeInstanceOrParam
sourceParser = TextParser TypeInstanceOrParam
inst forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeInstanceOrParam
param where
param :: TextParser TypeInstanceOrParam
param = forall a. String -> TextParser a -> TextParser a
labeled String
"param" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> ParamName -> TypeInstanceOrParam
JustParamName Bool
False) forall a. ParseFromSource a => TextParser a
sourceParser
inst :: TextParser TypeInstanceOrParam
inst = forall a. String -> TextParser a -> TextParser a
labeled String
"type instance" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeInstance -> TypeInstanceOrParam
JustTypeInstance forall a. ParseFromSource a => TextParser a
sourceParser
instance ParseFromSource TypeFilter where
sourceParser :: TextParser TypeFilter
sourceParser = TextParser TypeFilter
requires forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeFilter
allows forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeFilter
defines forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextParser TypeFilter
immutable where
requires :: TextParser TypeFilter
requires = forall a. String -> TextParser a -> TextParser a
labeled String
"requires filter" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwRequires
GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilterDirection -> GeneralInstance -> TypeFilter
TypeFilter FilterDirection
FilterRequires GeneralInstance
t
allows :: TextParser TypeFilter
allows = forall a. String -> TextParser a -> TextParser a
labeled String
"allows filter" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwAllows
GeneralInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilterDirection -> GeneralInstance -> TypeFilter
TypeFilter FilterDirection
FilterAllows GeneralInstance
t
defines :: TextParser TypeFilter
defines = forall a. String -> TextParser a -> TextParser a
labeled String
"defines filter" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwDefines
DefinesInstance
t <- forall a. ParseFromSource a => TextParser a
sourceParser
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DefinesInstance -> TypeFilter
DefinesFilter DefinesInstance
t
immutable :: TextParser TypeFilter
immutable = forall a. String -> TextParser a -> TextParser a
labeled String
"immutable filter" forall a b. (a -> b) -> a -> b
$ do
TextParser ()
kwImmutable
forall (m :: * -> *) a. Monad m => a -> m a
return TypeFilter
ImmutableFilter