{-# Language StandaloneDeriving, DeriveDataTypeable, FlexibleContexts, UndecidableInstances, FlexibleInstances #-}
module Language.Javascript.JMacro.Types (
  JType(..), Constraint(..), JLocalType, VarRef, anyType, parseType, runTypeParser
  ) where

import Control.Applicative hiding ((<|>))
import Data.Char

import Data.Maybe(fromMaybe)

import Text.ParserCombinators.Parsec
import Text.Parsec.Prim hiding (runParser, try)
import Text.ParserCombinators.Parsec.Language(emptyDef)
import qualified Text.ParserCombinators.Parsec.Token as P

import qualified Data.Map as M
import Data.Map (Map)
import Data.Set (Set)
import Data.Generics

type VarRef = (Maybe String, Int)

-- sum types for list/record, map/record

data JType = JTNum
           | JTString
           | JTBool
           | JTStat
           | JTFunc [JType] (JType)
           | JTList JType
           | JTMap  JType
           | JTRecord JType (Map String JType)
           | JTRigid VarRef (Set Constraint)
           | JTImpossible
           | JTFree VarRef
           | JTForall [VarRef] JType
             deriving (JType -> JType -> Bool
(JType -> JType -> Bool) -> (JType -> JType -> Bool) -> Eq JType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JType -> JType -> Bool
$c/= :: JType -> JType -> Bool
== :: JType -> JType -> Bool
$c== :: JType -> JType -> Bool
Eq, Eq JType
Eq JType
-> (JType -> JType -> Ordering)
-> (JType -> JType -> Bool)
-> (JType -> JType -> Bool)
-> (JType -> JType -> Bool)
-> (JType -> JType -> Bool)
-> (JType -> JType -> JType)
-> (JType -> JType -> JType)
-> Ord JType
JType -> JType -> Bool
JType -> JType -> Ordering
JType -> JType -> JType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JType -> JType -> JType
$cmin :: JType -> JType -> JType
max :: JType -> JType -> JType
$cmax :: JType -> JType -> JType
>= :: JType -> JType -> Bool
$c>= :: JType -> JType -> Bool
> :: JType -> JType -> Bool
$c> :: JType -> JType -> Bool
<= :: JType -> JType -> Bool
$c<= :: JType -> JType -> Bool
< :: JType -> JType -> Bool
$c< :: JType -> JType -> Bool
compare :: JType -> JType -> Ordering
$ccompare :: JType -> JType -> Ordering
$cp1Ord :: Eq JType
Ord, ReadPrec [JType]
ReadPrec JType
Int -> ReadS JType
ReadS [JType]
(Int -> ReadS JType)
-> ReadS [JType]
-> ReadPrec JType
-> ReadPrec [JType]
-> Read JType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JType]
$creadListPrec :: ReadPrec [JType]
readPrec :: ReadPrec JType
$creadPrec :: ReadPrec JType
readList :: ReadS [JType]
$creadList :: ReadS [JType]
readsPrec :: Int -> ReadS JType
$creadsPrec :: Int -> ReadS JType
Read, Int -> JType -> ShowS
[JType] -> ShowS
JType -> String
(Int -> JType -> ShowS)
-> (JType -> String) -> ([JType] -> ShowS) -> Show JType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JType] -> ShowS
$cshowList :: [JType] -> ShowS
show :: JType -> String
$cshow :: JType -> String
showsPrec :: Int -> JType -> ShowS
$cshowsPrec :: Int -> JType -> ShowS
Show, Typeable, Typeable JType
DataType
Constr
Typeable JType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JType -> c JType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JType)
-> (JType -> Constr)
-> (JType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JType))
-> ((forall b. Data b => b -> b) -> JType -> JType)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r)
-> (forall u. (forall d. Data d => d -> u) -> JType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JType -> m JType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JType -> m JType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JType -> m JType)
-> Data JType
JType -> DataType
JType -> Constr
(forall b. Data b => b -> b) -> JType -> JType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JType -> c JType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JType -> u
forall u. (forall d. Data d => d -> u) -> JType -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JType -> m JType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JType -> m JType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JType -> c JType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JType)
$cJTForall :: Constr
$cJTFree :: Constr
$cJTImpossible :: Constr
$cJTRigid :: Constr
$cJTRecord :: Constr
$cJTMap :: Constr
$cJTList :: Constr
$cJTFunc :: Constr
$cJTStat :: Constr
$cJTBool :: Constr
$cJTString :: Constr
$cJTNum :: Constr
$tJType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JType -> m JType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JType -> m JType
gmapMp :: (forall d. Data d => d -> m d) -> JType -> m JType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JType -> m JType
gmapM :: (forall d. Data d => d -> m d) -> JType -> m JType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JType -> m JType
gmapQi :: Int -> (forall d. Data d => d -> u) -> JType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JType -> u
gmapQ :: (forall d. Data d => d -> u) -> JType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JType -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> JType -> r
gmapT :: (forall b. Data b => b -> b) -> JType -> JType
$cgmapT :: (forall b. Data b => b -> b) -> JType -> JType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JType)
dataTypeOf :: JType -> DataType
$cdataTypeOf :: JType -> DataType
toConstr :: JType -> Constr
$ctoConstr :: JType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JType -> c JType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JType -> c JType
$cp1Data :: Typeable JType
Data)

data Constraint = Sub JType
                | Super JType
                  deriving (Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c== :: Constraint -> Constraint -> Bool
Eq, Eq Constraint
Eq Constraint
-> (Constraint -> Constraint -> Ordering)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Constraint)
-> (Constraint -> Constraint -> Constraint)
-> Ord Constraint
Constraint -> Constraint -> Bool
Constraint -> Constraint -> Ordering
Constraint -> Constraint -> Constraint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Constraint -> Constraint -> Constraint
$cmin :: Constraint -> Constraint -> Constraint
max :: Constraint -> Constraint -> Constraint
$cmax :: Constraint -> Constraint -> Constraint
>= :: Constraint -> Constraint -> Bool
$c>= :: Constraint -> Constraint -> Bool
> :: Constraint -> Constraint -> Bool
$c> :: Constraint -> Constraint -> Bool
<= :: Constraint -> Constraint -> Bool
$c<= :: Constraint -> Constraint -> Bool
< :: Constraint -> Constraint -> Bool
$c< :: Constraint -> Constraint -> Bool
compare :: Constraint -> Constraint -> Ordering
$ccompare :: Constraint -> Constraint -> Ordering
$cp1Ord :: Eq Constraint
Ord, ReadPrec [Constraint]
ReadPrec Constraint
Int -> ReadS Constraint
ReadS [Constraint]
(Int -> ReadS Constraint)
-> ReadS [Constraint]
-> ReadPrec Constraint
-> ReadPrec [Constraint]
-> Read Constraint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Constraint]
$creadListPrec :: ReadPrec [Constraint]
readPrec :: ReadPrec Constraint
$creadPrec :: ReadPrec Constraint
readList :: ReadS [Constraint]
$creadList :: ReadS [Constraint]
readsPrec :: Int -> ReadS Constraint
$creadsPrec :: Int -> ReadS Constraint
Read, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> String
$cshow :: Constraint -> String
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show, Typeable, Typeable Constraint
DataType
Constr
Typeable Constraint
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Constraint -> c Constraint)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Constraint)
-> (Constraint -> Constr)
-> (Constraint -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Constraint))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Constraint))
-> ((forall b. Data b => b -> b) -> Constraint -> Constraint)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Constraint -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Constraint -> r)
-> (forall u. (forall d. Data d => d -> u) -> Constraint -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Constraint -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Constraint -> m Constraint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Constraint -> m Constraint)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Constraint -> m Constraint)
-> Data Constraint
Constraint -> DataType
Constraint -> Constr
(forall b. Data b => b -> b) -> Constraint -> Constraint
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constraint)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constraint)
$cSuper :: Constr
$cSub :: Constr
$tConstraint :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Constraint -> m Constraint
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
gmapMp :: (forall d. Data d => d -> m d) -> Constraint -> m Constraint
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
gmapM :: (forall d. Data d => d -> m d) -> Constraint -> m Constraint
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Constraint -> m Constraint
gmapQi :: Int -> (forall d. Data d => d -> u) -> Constraint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
gmapQ :: (forall d. Data d => d -> u) -> Constraint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Constraint -> r
gmapT :: (forall b. Data b => b -> b) -> Constraint -> Constraint
$cgmapT :: (forall b. Data b => b -> b) -> Constraint -> Constraint
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constraint)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Constraint)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Constraint)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Constraint)
dataTypeOf :: Constraint -> DataType
$cdataTypeOf :: Constraint -> DataType
toConstr :: Constraint -> Constr
$ctoConstr :: Constraint -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Constraint
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Constraint -> c Constraint
$cp1Data :: Typeable Constraint
Data)
{-
                 | Choice Constraint Constraint
                 | GLB (Set JType)
                 | LUB (Set JType)
-}
type JLocalType = ([(VarRef,Constraint)], JType)

type TypeParserState = (Int, Map String Int)

type TypeParser a = CharParser TypeParserState a

typLang :: P.LanguageDef TypeParserState
typLang :: LanguageDef TypeParserState
typLang = LanguageDef TypeParserState
forall st. LanguageDef st
emptyDef {
           reservedNames :: [String]
P.reservedNames = [String
"()",String
"->"],
           reservedOpNames :: [String]
P.reservedOpNames = [String
"()",String
"->",String
"::"],
           identLetter :: ParsecT String TypeParserState Identity Char
P.identLetter = ParsecT String TypeParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT String TypeParserState Identity Char
-> ParsecT String TypeParserState Identity Char
-> ParsecT String TypeParserState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String TypeParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_$",
           identStart :: ParsecT String TypeParserState Identity Char
P.identStart  = ParsecT String TypeParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT String TypeParserState Identity Char
-> ParsecT String TypeParserState Identity Char
-> ParsecT String TypeParserState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String TypeParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_$"
          }

lexer :: P.TokenParser TypeParserState
lexer :: TokenParser TypeParserState
lexer = LanguageDef TypeParserState -> TokenParser TypeParserState
forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
P.makeTokenParser LanguageDef TypeParserState
typLang

reservedOp :: String -> TypeParser ()
parens, braces, brackets, lexeme :: TypeParser a -> TypeParser a
identifier :: TypeParser String
commaSep, commaSep1 :: TypeParser a -> TypeParser [a]
parens :: TypeParser a -> TypeParser a
parens    = TokenParser TypeParserState
-> forall a.
   ParsecT String TypeParserState Identity a
   -> ParsecT String TypeParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.parens TokenParser TypeParserState
lexer
braces :: TypeParser a -> TypeParser a
braces    = TokenParser TypeParserState
-> forall a.
   ParsecT String TypeParserState Identity a
   -> ParsecT String TypeParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.braces TokenParser TypeParserState
lexer
brackets :: TypeParser a -> TypeParser a
brackets  = TokenParser TypeParserState
-> forall a.
   ParsecT String TypeParserState Identity a
   -> ParsecT String TypeParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.brackets TokenParser TypeParserState
lexer
identifier :: TypeParser String
identifier= TokenParser TypeParserState -> TypeParser String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
P.identifier TokenParser TypeParserState
lexer
reservedOp :: String -> TypeParser ()
reservedOp= TokenParser TypeParserState -> String -> TypeParser ()
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m ()
P.reservedOp TokenParser TypeParserState
lexer
commaSep1 :: TypeParser a -> TypeParser [a]
commaSep1 = TokenParser TypeParserState
-> forall a.
   ParsecT String TypeParserState Identity a
   -> ParsecT String TypeParserState Identity [a]
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m [a]
P.commaSep1 TokenParser TypeParserState
lexer
commaSep :: TypeParser a -> TypeParser [a]
commaSep  = TokenParser TypeParserState
-> forall a.
   ParsecT String TypeParserState Identity a
   -> ParsecT String TypeParserState Identity [a]
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m [a]
P.commaSep  TokenParser TypeParserState
lexer

lexeme :: TypeParser a -> TypeParser a
lexeme    = TokenParser TypeParserState
-> forall a.
   ParsecT String TypeParserState Identity a
   -> ParsecT String TypeParserState Identity a
forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
P.lexeme TokenParser TypeParserState
lexer

parseType :: String -> Either ParseError JType
parseType :: String -> Either ParseError JType
parseType String
s = GenParser Char TypeParserState JType
-> TypeParserState -> String -> String -> Either ParseError JType
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser Char TypeParserState JType
anyType (Int
0,Map String Int
forall k a. Map k a
M.empty) String
"" String
s

parseConstrainedType :: String -> Either ParseError JLocalType
parseConstrainedType :: String -> Either ParseError JLocalType
parseConstrainedType String
s = GenParser Char TypeParserState JLocalType
-> TypeParserState
-> String
-> String
-> Either ParseError JLocalType
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser Char TypeParserState JLocalType
constrainedType (Int
0,Map String Int
forall k a. Map k a
M.empty) String
"" String
s

runTypeParser :: CharParser a JLocalType
runTypeParser :: CharParser a JLocalType
runTypeParser = TypeParserState
-> GenParser Char TypeParserState JLocalType
-> CharParser a JLocalType
forall (m :: * -> *) st s a st'.
(Functor m, Monad m) =>
st -> ParsecT s st m a -> ParsecT s st' m a
withLocalState (Int
0,Map String Int
forall k a. Map k a
M.empty) (GenParser Char TypeParserState JLocalType
-> GenParser Char TypeParserState JLocalType
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char TypeParserState JLocalType
-> GenParser Char TypeParserState JLocalType
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
parens GenParser Char TypeParserState JLocalType
constrainedType) GenParser Char TypeParserState JLocalType
-> GenParser Char TypeParserState JLocalType
-> GenParser Char TypeParserState JLocalType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JLocalType
constrainedType) -- anyType

withLocalState :: (Functor m, Monad m) => st -> ParsecT s st m a -> ParsecT s st' m a
withLocalState :: st -> ParsecT s st m a -> ParsecT s st' m a
withLocalState st
initState ParsecT s st m a
subParser = (State s st' -> m (Consumed (m (Reply s st' a))))
-> ParsecT s st' m a
forall (m :: * -> *) s u a.
Monad m =>
(State s u -> m (Consumed (m (Reply s u a)))) -> ParsecT s u m a
mkPT ((State s st' -> m (Consumed (m (Reply s st' a))))
 -> ParsecT s st' m a)
-> (State s st' -> m (Consumed (m (Reply s st' a))))
-> ParsecT s st' m a
forall a b. (a -> b) -> a -> b
$
    \(State s
input SourcePos
pos st'
otherState) -> st' -> Consumed (m (Reply s st a)) -> Consumed (m (Reply s st' a))
forall (f :: * -> *) (f :: * -> *) u s u a.
(Functor f, Functor f) =>
u -> f (f (Reply s u a)) -> f (f (Reply s u a))
fixState st'
otherState (Consumed (m (Reply s st a)) -> Consumed (m (Reply s st' a)))
-> m (Consumed (m (Reply s st a)))
-> m (Consumed (m (Reply s st' a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s st m a -> State s st -> m (Consumed (m (Reply s st a)))
forall (m :: * -> *) s u a.
Monad m =>
ParsecT s u m a -> State s u -> m (Consumed (m (Reply s u a)))
runParsecT ParsecT s st m a
subParser (s -> SourcePos -> st -> State s st
forall s u. s -> SourcePos -> u -> State s u
State s
input SourcePos
pos st
initState)
      where
        fixState :: u -> f (f (Reply s u a)) -> f (f (Reply s u a))
fixState u
s f (f (Reply s u a))
res = ((f (Reply s u a) -> f (Reply s u a))
-> f (f (Reply s u a)) -> f (f (Reply s u a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f (Reply s u a) -> f (Reply s u a))
 -> f (f (Reply s u a)) -> f (f (Reply s u a)))
-> ((Reply s u a -> Reply s u a)
    -> f (Reply s u a) -> f (Reply s u a))
-> (Reply s u a -> Reply s u a)
-> f (f (Reply s u a))
-> f (f (Reply s u a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Reply s u a -> Reply s u a) -> f (Reply s u a) -> f (Reply s u a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Reply s u a -> Reply s u a
forall s u a. Reply s u a -> Reply s u a
go f (f (Reply s u a))
res
            where go :: Reply s u a -> Reply s u a
go (Ok a
a (State s
input SourcePos
pos u
_localState) ParseError
pe) = a -> State s u -> ParseError -> Reply s u a
forall s u a. a -> State s u -> ParseError -> Reply s u a
Ok a
a (s -> SourcePos -> u -> State s u
forall s u. s -> SourcePos -> u -> State s u
State s
input SourcePos
pos u
s) ParseError
pe
                  go (Error ParseError
e) = (ParseError -> Reply s u a
forall s u a. ParseError -> Reply s u a
Error ParseError
e)



constrainedType :: TypeParser JLocalType
constrainedType :: GenParser Char TypeParserState JLocalType
constrainedType = do
  Maybe [(VarRef, Constraint)]
c <- GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
-> GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([(VarRef, Constraint)] -> Maybe [(VarRef, Constraint)]
forall a. a -> Maybe a
Just ([(VarRef, Constraint)] -> Maybe [(VarRef, Constraint)])
-> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
-> GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String TypeParserState Identity [(VarRef, Constraint)]
constraintHead ParsecT String TypeParserState Identity [(VarRef, Constraint)]
-> TypeParser ()
-> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> TypeParser ()
reservedOp String
"=>")) GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
-> GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
-> GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe [(VarRef, Constraint)]
-> GenParser Char TypeParserState (Maybe [(VarRef, Constraint)])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [(VarRef, Constraint)]
forall a. Maybe a
Nothing
  JType
t <- GenParser Char TypeParserState JType
anyType
  JLocalType -> GenParser Char TypeParserState JLocalType
forall (m :: * -> *) a. Monad m => a -> m a
return ([(VarRef, Constraint)]
-> Maybe [(VarRef, Constraint)] -> [(VarRef, Constraint)]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [(VarRef, Constraint)]
c, JType
t)

--do we need to read supertype constraints, i.e. subtype constraints which have the freevar on the right??
constraintHead :: TypeParser [(VarRef,Constraint)]
constraintHead :: ParsecT String TypeParserState Identity [(VarRef, Constraint)]
constraintHead = ParsecT String TypeParserState Identity [(VarRef, Constraint)]
-> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
parens ParsecT String TypeParserState Identity [(VarRef, Constraint)]
go ParsecT String TypeParserState Identity [(VarRef, Constraint)]
-> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
-> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
go
    where go :: ParsecT String TypeParserState Identity [(VarRef, Constraint)]
go = TypeParser (VarRef, Constraint)
-> ParsecT String TypeParserState Identity [(VarRef, Constraint)]
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity [a]
commaSep1 TypeParser (VarRef, Constraint)
constraint
          constraint :: TypeParser (VarRef, Constraint)
constraint = do
            VarRef
r <- String -> TypeParser VarRef
freeVarRef (String -> TypeParser VarRef)
-> TypeParser String -> TypeParser VarRef
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeParser String
identifier
            JType -> Constraint
c <- (String -> TypeParser ()
reservedOp String
"<:" TypeParser ()
-> ParsecT String TypeParserState Identity (JType -> Constraint)
-> ParsecT String TypeParserState Identity (JType -> Constraint)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((JType -> Constraint)
-> ParsecT String TypeParserState Identity (JType -> Constraint)
forall (m :: * -> *) a. Monad m => a -> m a
return JType -> Constraint
Sub)) ParsecT String TypeParserState Identity (JType -> Constraint)
-> ParsecT String TypeParserState Identity (JType -> Constraint)
-> ParsecT String TypeParserState Identity (JType -> Constraint)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                 (String -> TypeParser ()
reservedOp String
":>" TypeParser ()
-> ParsecT String TypeParserState Identity (JType -> Constraint)
-> ParsecT String TypeParserState Identity (JType -> Constraint)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((JType -> Constraint)
-> ParsecT String TypeParserState Identity (JType -> Constraint)
forall (m :: * -> *) a. Monad m => a -> m a
return JType -> Constraint
Super))
            JType
t <- GenParser Char TypeParserState JType
anyType
            (VarRef, Constraint) -> TypeParser (VarRef, Constraint)
forall (m :: * -> *) a. Monad m => a -> m a
return ((VarRef, Constraint) -> TypeParser (VarRef, Constraint))
-> (VarRef, Constraint) -> TypeParser (VarRef, Constraint)
forall a b. (a -> b) -> a -> b
$ (VarRef
r, JType -> Constraint
c JType
t)

anyType :: TypeParser JType
anyType :: GenParser Char TypeParserState JType
anyType = GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall tok st a. GenParser tok st a -> GenParser tok st a
try (GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
parens GenParser Char TypeParserState JType
anyType) GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
funOrAtomType GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
listType GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
recordType

funOrAtomType :: TypeParser JType
funOrAtomType :: GenParser Char TypeParserState JType
funOrAtomType = do
  [JType]
r <- GenParser Char TypeParserState JType
anyNestedType GenParser Char TypeParserState JType
-> TypeParser String
-> ParsecT String TypeParserState Identity [JType]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` (TypeParser String -> TypeParser String
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
lexeme (String -> TypeParser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"->"))
  JType -> GenParser Char TypeParserState JType
forall (m :: * -> *) a. Monad m => a -> m a
return (JType -> GenParser Char TypeParserState JType)
-> JType -> GenParser Char TypeParserState JType
forall a b. (a -> b) -> a -> b
$ case [JType] -> [JType]
forall a. [a] -> [a]
reverse [JType]
r of
    [JType
x] -> JType
x
    (JType
x:[JType]
xs) -> [JType] -> JType -> JType
JTFunc ([JType] -> [JType]
forall a. [a] -> [a]
reverse [JType]
xs) JType
x
    [JType]
_ -> String -> JType
forall a. HasCallStack => String -> a
error String
"funOrAtomType"

listType :: TypeParser JType
listType :: GenParser Char TypeParserState JType
listType = JType -> JType
JTList (JType -> JType)
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
brackets GenParser Char TypeParserState JType
anyType

anyNestedType :: TypeParser JType
anyNestedType :: GenParser Char TypeParserState JType
anyNestedType = GenParser Char TypeParserState JType
nullType GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
parens GenParser Char TypeParserState JType
anyType GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
atomicType GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
listType GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Char TypeParserState JType
recordType

nullType :: TypeParser JType
nullType :: GenParser Char TypeParserState JType
nullType = String -> TypeParser ()
reservedOp String
"()" TypeParser ()
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> JType -> GenParser Char TypeParserState JType
forall (m :: * -> *) a. Monad m => a -> m a
return JType
JTStat

atomicType :: TypeParser JType
atomicType :: GenParser Char TypeParserState JType
atomicType = do
  String
a <- TypeParser String
identifier
  case String
a of
    String
"Num" -> JType -> GenParser Char TypeParserState JType
forall (m :: * -> *) a. Monad m => a -> m a
return JType
JTNum
    String
"String" -> JType -> GenParser Char TypeParserState JType
forall (m :: * -> *) a. Monad m => a -> m a
return JType
JTString
    String
"Bool" -> JType -> GenParser Char TypeParserState JType
forall (m :: * -> *) a. Monad m => a -> m a
return JType
JTBool
    (Char
x:String
_) | Char -> Bool
isUpper Char
x -> String -> GenParser Char TypeParserState JType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> GenParser Char TypeParserState JType)
-> String -> GenParser Char TypeParserState JType
forall a b. (a -> b) -> a -> b
$ String
"Unknown type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a
          | Bool
otherwise -> VarRef -> JType
JTFree (VarRef -> JType)
-> TypeParser VarRef -> GenParser Char TypeParserState JType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> TypeParser VarRef
freeVarRef String
a
    String
_ -> String -> GenParser Char TypeParserState JType
forall a. HasCallStack => String -> a
error String
"typeAtom"

recordType :: TypeParser JType
recordType :: GenParser Char TypeParserState JType
recordType = GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity a
braces (GenParser Char TypeParserState JType
 -> GenParser Char TypeParserState JType)
-> GenParser Char TypeParserState JType
-> GenParser Char TypeParserState JType
forall a b. (a -> b) -> a -> b
$ JType -> Map String JType -> JType
JTRecord JType
JTImpossible (Map String JType -> JType)
-> ([(String, JType)] -> Map String JType)
-> [(String, JType)]
-> JType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, JType)] -> Map String JType
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, JType)] -> JType)
-> ParsecT String TypeParserState Identity [(String, JType)]
-> GenParser Char TypeParserState JType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeParser (String, JType)
-> ParsecT String TypeParserState Identity [(String, JType)]
forall a.
ParsecT String TypeParserState Identity a
-> ParsecT String TypeParserState Identity [a]
commaSep TypeParser (String, JType)
namePair
    where namePair :: TypeParser (String, JType)
namePair = do
            String
n <- TypeParser String
identifier
            String -> TypeParser ()
reservedOp String
"::"
            JType
t <- GenParser Char TypeParserState JType
anyType
            (String, JType) -> TypeParser (String, JType)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
n, JType
t)

freeVarRef :: String -> TypeParser VarRef
freeVarRef :: String -> TypeParser VarRef
freeVarRef String
v = do
  (Int
i,Map String Int
m) <- ParsecT String TypeParserState Identity TypeParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  (\Int
x -> (String -> Maybe String
forall a. a -> Maybe a
Just String
v, Int
x)) (Int -> VarRef)
-> ParsecT String TypeParserState Identity Int -> TypeParser VarRef
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String TypeParserState Identity Int
-> (Int -> ParsecT String TypeParserState Identity Int)
-> Maybe Int
-> ParsecT String TypeParserState Identity Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TypeParserState -> TypeParser ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,String -> Int -> Map String Int -> Map String Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
v Int
i Map String Int
m) TypeParser ()
-> ParsecT String TypeParserState Identity Int
-> ParsecT String TypeParserState Identity Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ParsecT String TypeParserState Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
i)
                                 Int -> ParsecT String TypeParserState Identity Int
forall (m :: * -> *) a. Monad m => a -> m a
return
                                 (String -> Map String Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
v Map String Int
m)