{-# 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
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
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
Ord, ReadPrec [JType]
ReadPrec JType
Int -> ReadS JType
ReadS [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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JType] -> ShowS
$cshowList :: [JType] -> ShowS
show :: JType -> [Char]
$cshow :: JType -> [Char]
showsPrec :: Int -> JType -> ShowS
$cshowsPrec :: Int -> JType -> ShowS
Show, Typeable, Typeable JType
JType -> DataType
JType -> Constr
(forall b. Data b => b -> b) -> JType -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> JType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> JType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JType -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data)

data Constraint = Sub JType
                | Super JType
                  deriving (Constraint -> Constraint -> Bool
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
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
Ord, ReadPrec [Constraint]
ReadPrec Constraint
Int -> ReadS Constraint
ReadS [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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Constraint] -> ShowS
$cshowList :: [Constraint] -> ShowS
show :: Constraint -> [Char]
$cshow :: Constraint -> [Char]
showsPrec :: Int -> Constraint -> ShowS
$cshowsPrec :: Int -> Constraint -> ShowS
Show, Typeable, Typeable Constraint
Constraint -> DataType
Constraint -> Constr
(forall b. Data b => b -> b) -> Constraint -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Constraint -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Constraint -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
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 = forall st. LanguageDef st
emptyDef {
           reservedNames :: [[Char]]
P.reservedNames = [[Char]
"()",[Char]
"->"],
           reservedOpNames :: [[Char]]
P.reservedOpNames = [[Char]
"()",[Char]
"->",[Char]
"::"],
           identLetter :: ParsecT [Char] TypeParserState Identity Char
P.identLetter = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$",
           identStart :: ParsecT [Char] TypeParserState Identity Char
P.identStart  = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
oneOf [Char]
"_$"
          }

lexer :: P.TokenParser TypeParserState
lexer :: TokenParser TypeParserState
lexer = 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 :: forall a. TypeParser a -> TypeParser a
parens    = 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 :: forall a. TypeParser a -> TypeParser a
braces    = 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 :: forall a. TypeParser a -> TypeParser a
brackets  = 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 [Char]
identifier= forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m [Char]
P.identifier TokenParser TypeParserState
lexer
reservedOp :: [Char] -> TypeParser ()
reservedOp= forall s u (m :: * -> *).
GenTokenParser s u m -> [Char] -> ParsecT s u m ()
P.reservedOp TokenParser TypeParserState
lexer
commaSep1 :: forall a. TypeParser a -> TypeParser [a]
commaSep1 = 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 :: forall a. TypeParser a -> TypeParser [a]
commaSep  = 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 :: forall a. TypeParser a -> TypeParser a
lexeme    = 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 :: [Char] -> Either ParseError JType
parseType [Char]
s = forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser TypeParser JType
anyType (Int
0,forall k a. Map k a
M.empty) [Char]
"" [Char]
s

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

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

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



constrainedType :: TypeParser JLocalType
constrainedType :: TypeParser JLocalType
constrainedType = do
  Maybe [(VarRef, Constraint)]
c <- forall tok st a. GenParser tok st a -> GenParser tok st a
try (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT [Char] TypeParserState Identity [(VarRef, Constraint)]
constraintHead forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> TypeParser ()
reservedOp [Char]
"=>")) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
  JType
t <- TypeParser JType
anyType
  forall (m :: * -> *) a. Monad m => a -> m a
return (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 [Char] TypeParserState Identity [(VarRef, Constraint)]
constraintHead = forall a. TypeParser a -> TypeParser a
parens ParsecT [Char] TypeParserState Identity [(VarRef, Constraint)]
go forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Char] TypeParserState Identity [(VarRef, Constraint)]
go
    where go :: ParsecT [Char] TypeParserState Identity [(VarRef, Constraint)]
go = forall a. TypeParser a -> TypeParser [a]
commaSep1 ParsecT [Char] TypeParserState Identity (VarRef, Constraint)
constraint
          constraint :: ParsecT [Char] TypeParserState Identity (VarRef, Constraint)
constraint = do
            VarRef
r <- [Char] -> ParsecT [Char] TypeParserState Identity VarRef
freeVarRef forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeParser [Char]
identifier
            JType -> Constraint
c <- ([Char] -> TypeParser ()
reservedOp [Char]
"<:" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (m :: * -> *) a. Monad m => a -> m a
return JType -> Constraint
Sub)) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                 ([Char] -> TypeParser ()
reservedOp [Char]
":>" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (m :: * -> *) a. Monad m => a -> m a
return JType -> Constraint
Super))
            JType
t <- TypeParser JType
anyType
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (VarRef
r, JType -> Constraint
c JType
t)

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

funOrAtomType :: TypeParser JType
funOrAtomType :: TypeParser JType
funOrAtomType = do
  [JType]
r <- TypeParser JType
anyNestedType 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` (forall a. TypeParser a -> TypeParser a
lexeme (forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"->"))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a. [a] -> [a]
reverse [JType]
r of
    [JType
x] -> JType
x
    (JType
x:[JType]
xs) -> [JType] -> JType -> JType
JTFunc (forall a. [a] -> [a]
reverse [JType]
xs) JType
x
    [JType]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"funOrAtomType"

listType :: TypeParser JType
listType :: TypeParser JType
listType = JType -> JType
JTList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TypeParser a -> TypeParser a
brackets TypeParser JType
anyType

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

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

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

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

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