{-# LANGUAGE OverloadedStrings #-}
module Swarm.Language.Parser.Term where
import Control.Lens (view, (^.))
import Control.Monad (guard, join)
import Control.Monad.Combinators.Expr
import Data.Foldable (Foldable (..), asum)
import Data.Functor (($>))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import Data.Set qualified as S
import Data.Set.Lens (setOf)
import Data.Text qualified as T
import Swarm.Language.Parser.Core
import Swarm.Language.Parser.Lex
import Swarm.Language.Parser.Record (parseRecord)
import Swarm.Language.Parser.Type
import Swarm.Language.Syntax
import Swarm.Language.Syntax.Direction
import Swarm.Language.Types
import Swarm.Util (failT, findDup)
import Text.Megaparsec hiding (runParser)
import Text.Megaparsec.Char
import Prelude hiding (Foldable (..))
parseDirection :: Parser Direction
parseDirection :: Parser Direction
parseDirection = [Parser Direction] -> Parser Direction
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Direction -> Parser Direction)
-> [Direction] -> [Parser Direction]
forall a b. (a -> b) -> [a] -> [b]
map Direction -> Parser Direction
alternative [Direction]
allDirs) Parser Direction -> String -> Parser Direction
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"direction constant"
where
alternative :: Direction -> Parser Direction
alternative Direction
d = Direction
d Direction
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Direction
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved (Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ())
-> (Direction -> Text)
-> Direction
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> Text
directionSyntax) Direction
d
parseConst :: Parser Const
parseConst :: Parser Const
parseConst = do
LanguageVersion
ver <- Getting LanguageVersion ParserConfig LanguageVersion
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) LanguageVersion
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LanguageVersion ParserConfig LanguageVersion
Lens' ParserConfig LanguageVersion
languageVersion
[Parser Const] -> Parser Const
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((Const -> Parser Const) -> [Const] -> [Parser Const]
forall a b. (a -> b) -> [a] -> [b]
map (LanguageVersion -> Const -> Parser Const
alternative LanguageVersion
ver) [Const]
consts) Parser Const -> String -> Parser Const
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"built-in user function"
where
consts :: [Const]
consts = (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter Const -> Bool
isUserFunc [Const]
allConst
alternative :: LanguageVersion -> Const -> Parser Const
alternative LanguageVersion
ver Const
c = Const
c Const
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Const
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved (ConstInfo -> Text
syntax (ConstInfo -> Text) -> ConstInfo -> Text
forall a b. (a -> b) -> a -> b
$ LanguageVersion -> Const -> ConstInfo
constInfo' LanguageVersion
ver Const
c)
constInfo' :: LanguageVersion -> Const -> ConstInfo
constInfo' LanguageVersion
SwarmLang0_6 Const
Pure = (Const -> ConstInfo
constInfo Const
Pure) {syntax = "return"}
constInfo' LanguageVersion
_ Const
c = Const -> ConstInfo
constInfo Const
c
parseTermAtom :: Parser Syntax
parseTermAtom :: Parser Syntax
parseTermAtom = do
Syntax
s1 <- Parser Syntax
parseTermAtom2
[(SrcLoc, Text)]
ps <- ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) [(SrcLoc, Text)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Text -> Parser Text
symbol Text
"." Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
forall a. Parser a -> Parser (SrcLoc, a)
parseLocG Parser Text
tmVar)
Syntax -> Parser Syntax
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Syntax -> Parser Syntax) -> Syntax -> Parser Syntax
forall a b. (a -> b) -> a -> b
$ (Syntax -> (SrcLoc, Text) -> Syntax)
-> Syntax -> [(SrcLoc, Text)] -> Syntax
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Syntax SrcLoc
l1 Term
t) (SrcLoc
l2, Text
x) -> SrcLoc -> Term -> Syntax
Syntax (SrcLoc
l1 SrcLoc -> SrcLoc -> SrcLoc
forall a. Semigroup a => a -> a -> a
<> SrcLoc
l2) (Term -> Text -> Term
TProj Term
t Text
x)) Syntax
s1 [(SrcLoc, Text)]
ps
parseTermAtom2 :: Parser Syntax
parseTermAtom2 :: Parser Syntax
parseTermAtom2 =
Parser Term -> Parser Syntax
parseLoc
( Term
forall ty. Term' ty
TUnit Term -> Parser Text -> Parser Term
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"()"
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Const -> Term
forall ty. Const -> Term' ty
TConst (Const -> Term) -> Parser Const -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Const
parseConst
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Term
forall ty. Text -> Term' ty
TVar (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
tmVar
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Direction -> Term
forall ty. Direction -> Term' ty
TDir (Direction -> Term) -> Parser Direction -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Direction
parseDirection
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Term
forall ty. Integer -> Term' ty
TInt (Integer -> Term)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Integer
-> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Integer
integer
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Term
forall ty. Text -> Term' ty
TText (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
textLiteral
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Term
forall ty. Bool -> Term' ty
TBool (Bool -> Term)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
-> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Bool
True Bool
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"true") ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Bool
False Bool
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Bool
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"false"))
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"require" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Term -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Term
parseRequire
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"stock" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Term -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Term
parseStock
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Syntax -> Term) -> (Text, Syntax) -> Term
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Syntax -> Term
forall ty. Text -> Syntax' ty -> Term' ty
SRequirements ((Text, Syntax) -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Text, Syntax)
-> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"requirements" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Text, Syntax)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Text, Syntax)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Syntax
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Tokens Text, Syntax)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
match Parser Syntax
parseTerm)
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LocVar -> Maybe Type -> Syntax -> Term
forall ty. LocVar -> Maybe Type -> Syntax' ty -> Term' ty
SLam
(LocVar -> Maybe Type -> Syntax -> Term)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe Type -> Syntax -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"\\" Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
locTmVar)
ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe Type -> Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe Type)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe Type)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
":" Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
parseType)
ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> Parser Syntax -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
symbol Text
"." Parser Text -> Parser Syntax -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Syntax
parseTerm)
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LetSyntax
-> LocVar -> Maybe RawPolytype -> Syntax -> Syntax -> Term
sLet LetSyntax
LSLet
(LocVar -> Maybe RawPolytype -> Syntax -> Syntax -> Term)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype -> Syntax -> Syntax -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"let" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
locTmVar)
ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype -> Syntax -> Syntax -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
":" Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
parsePolytype)
ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
-> Parser Syntax
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
symbol Text
"=" Parser Text -> Parser Syntax -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Syntax
parseTerm)
ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> Parser Syntax -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"in" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Syntax -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Syntax
parseTerm)
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"def"
locVar :: LocVar
locVar@(LV SrcLoc
_srcLoc Text
nameText) <- ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
locTmVar
Maybe RawPolytype
mTy <- ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
":" Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
parsePolytype)
Text
_ <- Text -> Parser Text
symbol Text
"="
Syntax
body <- Parser Syntax
parseTerm
Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"end" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> String
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> (String
"'end' keyword for definition of '" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
nameText String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'")
Syntax
rest <- Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
";") ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe Text)
-> Parser Syntax -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Syntax
parseTerm Parser Syntax -> Parser Syntax -> Parser Syntax
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Syntax -> Parser Syntax
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Syntax
sNoop))
Term -> Parser Term
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Term -> Parser Term) -> Term -> Parser Term
forall a b. (a -> b) -> a -> b
$ LetSyntax
-> LocVar -> Maybe RawPolytype -> Syntax -> Syntax -> Term
sLet LetSyntax
LSDef LocVar
locVar Maybe RawPolytype
mTy Syntax
body Syntax
rest
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Located TDVar -> Polytype -> Maybe TydefInfo -> Syntax -> Term
forall ty.
Located TDVar
-> Polytype -> Maybe TydefInfo -> Syntax' ty -> Term' ty
STydef
(Located TDVar -> Polytype -> Maybe TydefInfo -> Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Located TDVar)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Polytype -> Maybe TydefInfo -> Syntax -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"tydef" ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Located TDVar)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Located TDVar)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Located TDVar)
locTyName)
ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Polytype -> Maybe TydefInfo -> Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe TydefInfo -> Syntax -> Term)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([Text]
-> Type
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
bindTydef ([Text]
-> Type
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) [Text]
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Type
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Text
tyVar ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Type
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Parser Text
symbol Text
"=" Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
parseType ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
reserved Text
"end"))
ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe TydefInfo -> Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe TydefInfo)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe TydefInfo
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe TydefInfo)
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TydefInfo
forall a. Maybe a
Nothing
ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> Parser Syntax -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
";") ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe Text)
-> Parser Syntax -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Parser Syntax
parseTerm Parser Syntax -> Parser Syntax -> Parser Syntax
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Syntax -> Parser Syntax
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Syntax
sNoop)))
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Map Text (Maybe Syntax) -> Term
forall ty. Map Text (Maybe (Syntax' ty)) -> Term' ty
SRcd (Map Text (Maybe Syntax) -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Map Text (Maybe Syntax))
-> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Map Text (Maybe Syntax))
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Map Text (Maybe Syntax))
forall a. Parser a -> Parser a
brackets (Parser (Maybe Syntax)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Map Text (Maybe Syntax))
forall a. Parser a -> Parser (Map Text a)
parseRecord (Parser Syntax -> Parser (Maybe Syntax)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
"=" Parser Text -> Parser Syntax -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Syntax
parseTerm)))
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Type -> Term
forall ty. Type -> Term' ty
TType (Type -> Term)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"@" Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Type
parseTypeAtom)
)
Parser Syntax -> Parser Syntax -> Parser Syntax
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Term -> Parser Syntax
parseLoc ([Syntax] -> Term
mkTuple ([Syntax] -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) [Syntax]
-> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) [Syntax]
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) [Syntax]
forall a. Parser a -> Parser a
parens (Parser Syntax
parseTerm Parser Syntax
-> Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) [Syntax]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepBy` Text -> Parser Text
symbol Text
","))
Parser Syntax -> Parser Syntax -> Parser Syntax
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Term -> Parser Syntax
parseLoc (Term -> Term
TDelay (Const -> Term
forall ty. Const -> Term' ty
TConst Const
Noop) Term -> Parser Text -> Parser Term
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Text -> Parser Text
symbol Text
"{" Parser Text -> Parser Text -> Parser Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text
symbol Text
"}"))
Parser Syntax -> Parser Syntax -> Parser Syntax
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Term -> Parser Syntax
parseLoc (Syntax -> Term
forall ty. Syntax' ty -> Term' ty
SDelay (Syntax -> Term) -> Parser Syntax -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Syntax -> Parser Syntax
forall a. Parser a -> Parser a
braces Parser Syntax
parseTerm)
Parser Syntax -> Parser Syntax -> Parser Syntax
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Term -> Parser Syntax
parseLoc (Getting Antiquoting ParserConfig Antiquoting
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Antiquoting
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Antiquoting ParserConfig Antiquoting
Lens' ParserConfig Antiquoting
antiquoting ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Antiquoting
-> (Antiquoting
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ())
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> (a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ())
-> (Antiquoting -> Bool)
-> Antiquoting
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Antiquoting -> Antiquoting -> Bool
forall a. Eq a => a -> a -> Bool
== Antiquoting
AllowAntiquoting)) ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Term -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Term
parseAntiquotation)
parseRequire :: Parser Term
parseRequire :: Parser Term
parseRequire = do
LanguageVersion
ver <- Getting LanguageVersion ParserConfig LanguageVersion
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) LanguageVersion
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting LanguageVersion ParserConfig LanguageVersion
Lens' ParserConfig LanguageVersion
languageVersion
[Parser Term] -> Parser Term
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ Text -> Term
forall ty. Text -> Term' ty
TRequire (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text
textLiteral Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"device name in double quotes")
, Bool -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (LanguageVersion
ver LanguageVersion -> LanguageVersion -> Bool
forall a. Eq a => a -> a -> Bool
== LanguageVersion
SwarmLang0_6) ReaderT ParserConfig (StateT WSState (Parsec Void Text)) ()
-> Parser Term -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Term
parseStock
]
parseStock :: Parser Term
parseStock :: Parser Term
parseStock =
(Int -> Text -> Term
forall ty. Int -> Text -> Term' ty
TStock (Int -> Text -> Term)
-> (Integer -> Int) -> Integer -> Text -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Text -> Term)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Integer
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Text -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Integer
integer)
ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Text -> Term)
-> Parser Text -> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text
textLiteral Parser Text -> String -> Parser Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"entity name in double quotes")
sLet :: LetSyntax -> LocVar -> Maybe RawPolytype -> Syntax -> Syntax -> Term
sLet :: LetSyntax
-> LocVar -> Maybe RawPolytype -> Syntax -> Syntax -> Term
sLet LetSyntax
ls LocVar
x Maybe RawPolytype
ty Syntax
t1 = LetSyntax
-> Bool
-> LocVar
-> Maybe RawPolytype
-> Maybe Polytype
-> Maybe Requirements
-> Syntax
-> Syntax
-> Term
forall ty.
LetSyntax
-> Bool
-> LocVar
-> Maybe RawPolytype
-> Maybe Polytype
-> Maybe Requirements
-> Syntax' ty
-> Syntax' ty
-> Term' ty
SLet LetSyntax
ls (LocVar -> Text
forall v. Located v -> v
lvVar LocVar
x Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Getting (Set Text) Syntax Text -> Syntax -> Set Text
forall a s. Getting (Set a) s a -> s -> Set a
setOf Getting (Set Text) Syntax Text
forall ty (f :: * -> *).
Applicative f =>
(Text -> f Text) -> Syntax' ty -> f (Syntax' ty)
freeVarsV Syntax
t1) LocVar
x Maybe RawPolytype
ty Maybe Polytype
forall a. Maybe a
Nothing Maybe Requirements
forall a. Monoid a => a
mempty Syntax
t1
sNoop :: Syntax
sNoop :: Syntax
sNoop = Term -> Syntax
STerm (Const -> Term
forall ty. Const -> Term' ty
TConst Const
Noop)
bindTydef :: [Var] -> Type -> Parser Polytype
bindTydef :: [Text]
-> Type
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
bindTydef [Text]
xs Type
ty
| Just Text
repeated <- [Text] -> Maybe Text
forall a. Ord a => [a] -> Maybe a
findDup [Text]
xs =
[Text]
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Duplicate variable on left-hand side of tydef:", Text
repeated]
| Bool -> Bool
not (Set Text -> Bool
forall a. Set a -> Bool
S.null Set Text
free) =
[Text]
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT ([Text]
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
-> [Text]
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall a b. (a -> b) -> a -> b
$
Text
"Undefined type variable(s) on right-hand side of tydef:" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
free
| Bool
otherwise = Polytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Polytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
-> (RawPolytype -> Polytype)
-> RawPolytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawPolytype -> Polytype
forall t. Typical t => Poly 'Unquantified t -> Poly 'Quantified t
absQuantify (RawPolytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype)
-> RawPolytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) Polytype
forall a b. (a -> b) -> a -> b
$ [Text] -> Type -> RawPolytype
forall t. [Text] -> t -> Poly 'Unquantified t
mkPoly [Text]
xs Type
ty
where
free :: Set Text
free = Type -> Set Text
forall t. Typical t => t -> Set Text
tyVars Type
ty Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
xs
parseAntiquotation :: Parser Term
parseAntiquotation :: Parser Term
parseAntiquotation =
Text -> Term
forall ty. Text -> Term' ty
TAntiText (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Text -> Parser Text
symbol Text
"$str:" Parser Text -> Parser Text -> Parser Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
tmVar)
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Term
forall ty. Text -> Term' ty
TAntiInt (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Text -> Parser Text
symbol Text
"$int:" Parser Text -> Parser Text -> Parser Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
tmVar)
Parser Term -> Parser Term -> Parser Term
forall a.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Term
forall ty. Text -> Term' ty
TAntiSyn (Text -> Term) -> Parser Text -> Parser Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (Parser Text -> Parser Text)
-> (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Text -> Parser Text
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try) (Text -> Parser Text
symbol Text
"$syn:" Parser Text -> Parser Text -> Parser Text
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
tmVar)
parseTerm :: Parser Syntax
parseTerm :: Parser Syntax
parseTerm = ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Stmt
-> Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) [Stmt]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
sepEndBy1 ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Stmt
parseStmt (Text -> Parser Text
symbol Text
";") ReaderT ParserConfig (StateT WSState (Parsec Void Text)) [Stmt]
-> ([Stmt] -> Parser Syntax) -> Parser Syntax
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> (a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Stmt] -> Parser Syntax
mkBindChain
mkBindChain :: [Stmt] -> Parser Syntax
mkBindChain :: [Stmt] -> Parser Syntax
mkBindChain [Stmt]
stmts = case [Stmt] -> Stmt
forall a. HasCallStack => [a] -> a
last [Stmt]
stmts of
Binder LocVar
x Syntax
_ -> Syntax -> Parser Syntax
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Syntax -> Parser Syntax) -> Syntax -> Parser Syntax
forall a b. (a -> b) -> a -> b
$ (Stmt -> Syntax -> Syntax) -> Syntax -> [Stmt] -> Syntax
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Stmt -> Syntax -> Syntax
mkBind (Term -> Syntax
STerm (Term -> Term -> Term
TApp (Const -> Term
forall ty. Const -> Term' ty
TConst Const
Pure) (Text -> Term
forall ty. Text -> Term' ty
TVar (LocVar -> Text
forall v. Located v -> v
lvVar LocVar
x)))) [Stmt]
stmts
BareTerm Syntax
t -> Syntax -> Parser Syntax
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Syntax -> Parser Syntax) -> Syntax -> Parser Syntax
forall a b. (a -> b) -> a -> b
$ (Stmt -> Syntax -> Syntax) -> Syntax -> [Stmt] -> Syntax
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Stmt -> Syntax -> Syntax
mkBind Syntax
t ([Stmt] -> [Stmt]
forall a. HasCallStack => [a] -> [a]
init [Stmt]
stmts)
where
mkBind :: Stmt -> Syntax -> Syntax
mkBind (BareTerm Syntax
t1) Syntax
t2 = Maybe (Located Any) -> Syntax -> Syntax -> Term -> Syntax
forall {v} {ty} {ty}.
Maybe (Located v) -> Syntax' ty -> Syntax' ty -> Term -> Syntax
loc Maybe (Located Any)
forall a. Maybe a
Nothing Syntax
t1 Syntax
t2 (Term -> Syntax) -> Term -> Syntax
forall a b. (a -> b) -> a -> b
$ Maybe LocVar
-> Maybe ()
-> Maybe Polytype
-> Maybe Requirements
-> Syntax
-> Syntax
-> Term
forall ty.
Maybe LocVar
-> Maybe ty
-> Maybe Polytype
-> Maybe Requirements
-> Syntax' ty
-> Syntax' ty
-> Term' ty
SBind Maybe LocVar
forall a. Maybe a
Nothing Maybe ()
forall a. Maybe a
Nothing Maybe Polytype
forall a. Maybe a
Nothing Maybe Requirements
forall a. Maybe a
Nothing Syntax
t1 Syntax
t2
mkBind (Binder LocVar
x Syntax
t1) Syntax
t2 = Maybe LocVar -> Syntax -> Syntax -> Term -> Syntax
forall {v} {ty} {ty}.
Maybe (Located v) -> Syntax' ty -> Syntax' ty -> Term -> Syntax
loc (LocVar -> Maybe LocVar
forall a. a -> Maybe a
Just LocVar
x) Syntax
t1 Syntax
t2 (Term -> Syntax) -> Term -> Syntax
forall a b. (a -> b) -> a -> b
$ Maybe LocVar
-> Maybe ()
-> Maybe Polytype
-> Maybe Requirements
-> Syntax
-> Syntax
-> Term
forall ty.
Maybe LocVar
-> Maybe ty
-> Maybe Polytype
-> Maybe Requirements
-> Syntax' ty
-> Syntax' ty
-> Term' ty
SBind (LocVar -> Maybe LocVar
forall a. a -> Maybe a
Just LocVar
x) Maybe ()
forall a. Maybe a
Nothing Maybe Polytype
forall a. Maybe a
Nothing Maybe Requirements
forall a. Maybe a
Nothing Syntax
t1 Syntax
t2
loc :: Maybe (Located v) -> Syntax' ty -> Syntax' ty -> Term -> Syntax
loc Maybe (Located v)
mx Syntax' ty
a Syntax' ty
b = SrcLoc -> Term -> Syntax
Syntax (SrcLoc -> Term -> Syntax) -> SrcLoc -> Term -> Syntax
forall a b. (a -> b) -> a -> b
$ SrcLoc -> (Located v -> SrcLoc) -> Maybe (Located v) -> SrcLoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SrcLoc
NoLoc Located v -> SrcLoc
forall v. Located v -> SrcLoc
lvSrcLoc Maybe (Located v)
mx SrcLoc -> SrcLoc -> SrcLoc
forall a. Semigroup a => a -> a -> a
<> (Syntax' ty
a Syntax' ty -> Getting SrcLoc (Syntax' ty) SrcLoc -> SrcLoc
forall s a. s -> Getting a s a -> a
^. Getting SrcLoc (Syntax' ty) SrcLoc
forall ty (f :: * -> *).
Functor f =>
(SrcLoc -> f SrcLoc) -> Syntax' ty -> f (Syntax' ty)
sLoc) SrcLoc -> SrcLoc -> SrcLoc
forall a. Semigroup a => a -> a -> a
<> (Syntax' ty
b Syntax' ty -> Getting SrcLoc (Syntax' ty) SrcLoc -> SrcLoc
forall s a. s -> Getting a s a -> a
^. Getting SrcLoc (Syntax' ty) SrcLoc
forall ty (f :: * -> *).
Functor f =>
(SrcLoc -> f SrcLoc) -> Syntax' ty -> f (Syntax' ty)
sLoc)
data Stmt
= BareTerm Syntax
| Binder LocVar Syntax
deriving (Int -> Stmt -> String -> String
[Stmt] -> String -> String
Stmt -> String
(Int -> Stmt -> String -> String)
-> (Stmt -> String) -> ([Stmt] -> String -> String) -> Show Stmt
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Stmt -> String -> String
showsPrec :: Int -> Stmt -> String -> String
$cshow :: Stmt -> String
show :: Stmt -> String
$cshowList :: [Stmt] -> String -> String
showList :: [Stmt] -> String -> String
Show)
parseStmt :: Parser Stmt
parseStmt :: ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Stmt
parseStmt =
Maybe LocVar -> Syntax -> Stmt
mkStmt (Maybe LocVar -> Syntax -> Stmt)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe LocVar)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Stmt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Maybe LocVar)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
forall a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
locTmVar ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
-> Parser Text
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) LocVar
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text
symbol Text
"<-")) ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Stmt)
-> Parser Syntax
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) Stmt
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Syntax
parseExpr
mkStmt :: Maybe LocVar -> Syntax -> Stmt
mkStmt :: Maybe LocVar -> Syntax -> Stmt
mkStmt Maybe LocVar
Nothing = Syntax -> Stmt
BareTerm
mkStmt (Just LocVar
x) = LocVar -> Syntax -> Stmt
Binder LocVar
x
parseExpr :: Parser Syntax
parseExpr :: Parser Syntax
parseExpr =
Parser Term -> Parser Syntax
parseLoc (Parser Term -> Parser Syntax) -> Parser Term -> Parser Syntax
forall a b. (a -> b) -> a -> b
$ Syntax -> Maybe RawPolytype -> Term
ascribe (Syntax -> Maybe RawPolytype -> Term)
-> Parser Syntax
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype -> Term)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Syntax
parseExpr' ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype)
-> Parser Term
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) (a -> b)
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Maybe RawPolytype)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text
symbol Text
":" Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
forall a b.
ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) RawPolytype
parsePolytype)
where
ascribe :: Syntax -> Maybe RawPolytype -> Term
ascribe :: Syntax -> Maybe RawPolytype -> Term
ascribe Syntax
s Maybe RawPolytype
Nothing = Syntax
s Syntax -> Getting Term Syntax Term -> Term
forall s a. s -> Getting a s a -> a
^. Getting Term Syntax Term
forall ty (f :: * -> *).
Functor f =>
(Term' ty -> f (Term' ty)) -> Syntax' ty -> f (Syntax' ty)
sTerm
ascribe Syntax
s (Just RawPolytype
ty) = Syntax -> RawPolytype -> Term
forall ty. Syntax' ty -> RawPolytype -> Term' ty
SAnnotate Syntax
s RawPolytype
ty
parseExpr' :: Parser Syntax
parseExpr' :: Parser Syntax
parseExpr' = Parser Syntax
-> [[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Parser Syntax
forall (m :: * -> *) a.
MonadPlus m =>
m a -> [[Operator m a]] -> m a
makeExprParser Parser Syntax
parseTermAtom [[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
table
where
table :: [[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
table = (Int,
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall a b. (a, b) -> b
snd ((Int,
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [(Int,
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)))
Syntax])]
-> [[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [(Int,
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)))
Syntax])]
forall k a. Map k a -> [(k, a)]
M.toDescList Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
tableMap
tableMap :: Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
tableMap =
([Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall a. [a] -> [a] -> [a]
(++)
[ Int
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall k a. k -> a -> Map k a
M.singleton Int
9 [ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
-> Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL (ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
exprLoc2 (ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax))
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
forall a b. (a -> b) -> a -> b
$ Syntax -> Syntax -> Term
forall ty. Syntax' ty -> Syntax' ty -> Term' ty
SApp (Syntax -> Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"")]
, Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
binOps
, Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
unOps
]
exprLoc2 :: Parser (Syntax -> Syntax -> Term) -> Parser (Syntax -> Syntax -> Syntax)
exprLoc2 :: ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
exprLoc2 ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
p = do
(SrcLoc
l, Syntax -> Syntax -> Term
f) <- ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
-> Parser (SrcLoc, Syntax -> Syntax -> Term)
forall a. Parser a -> Parser (SrcLoc, a)
parseLocG ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Term)
p
(Syntax -> Syntax -> Syntax)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Syntax -> Syntax -> Syntax)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax))
-> (Syntax -> Syntax -> Syntax)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
forall a b. (a -> b) -> a -> b
$ \Syntax
s1 Syntax
s2 -> SrcLoc -> Term -> Syntax
Syntax (SrcLoc
l SrcLoc -> SrcLoc -> SrcLoc
forall a. Semigroup a => a -> a -> a
<> (Syntax
s1 Syntax -> Getting SrcLoc Syntax SrcLoc -> SrcLoc
forall s a. s -> Getting a s a -> a
^. Getting SrcLoc Syntax SrcLoc
forall ty (f :: * -> *).
Functor f =>
(SrcLoc -> f SrcLoc) -> Syntax' ty -> f (Syntax' ty)
sLoc) SrcLoc -> SrcLoc -> SrcLoc
forall a. Semigroup a => a -> a -> a
<> (Syntax
s2 Syntax -> Getting SrcLoc Syntax SrcLoc -> SrcLoc
forall s a. s -> Getting a s a -> a
^. Getting SrcLoc Syntax SrcLoc
forall ty (f :: * -> *).
Functor f =>
(SrcLoc -> f SrcLoc) -> Syntax' ty -> f (Syntax' ty)
sLoc)) (Term -> Syntax) -> Term -> Syntax
forall a b. (a -> b) -> a -> b
$ Syntax -> Syntax -> Term
f Syntax
s1 Syntax
s2
binOps :: Map Int [Operator Parser Syntax]
binOps :: Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
binOps = ([Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall a. [a] -> [a] -> [a]
(++) ([Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall a b. (a -> b) -> a -> b
$ (Const
-> Maybe
(Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)))
Syntax]))
-> [Const]
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Const
-> Maybe
(Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
forall {m :: * -> *}.
MonadFail m =>
Const
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
binOpToTuple [Const]
allConst
where
binOpToTuple :: Const
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
binOpToTuple Const
c = do
let ci :: ConstInfo
ci = Const -> ConstInfo
constInfo Const
c
ConstMBinOp MBinAssoc
assoc <- ConstMeta -> m ConstMeta
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstInfo -> ConstMeta
constMeta ConstInfo
ci)
let assI :: m (a -> a -> a) -> Operator m a
assI = case MBinAssoc
assoc of
MBinAssoc
L -> m (a -> a -> a) -> Operator m a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixL
MBinAssoc
N -> m (a -> a -> a) -> Operator m a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixN
MBinAssoc
R -> m (a -> a -> a) -> Operator m a
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
InfixR
Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)))
Syntax]))
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
forall a b. (a -> b) -> a -> b
$
Int
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall k a. k -> a -> Map k a
M.singleton
(ConstInfo -> Int
fixity ConstInfo
ci)
[ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
-> Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax
forall (m :: * -> *) a. m (a -> a -> a) -> Operator m a
assI (Const -> (SrcLoc, Text) -> Syntax -> Syntax -> Syntax
forall t. Const -> (SrcLoc, t) -> Syntax -> Syntax -> Syntax
mkOp Const
c ((SrcLoc, Text) -> Syntax -> Syntax -> Syntax)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax -> Syntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (SrcLoc, Text)
forall a. Parser a -> Parser (SrcLoc, a)
parseLocG (Text -> Parser Text
operator (ConstInfo -> Text
syntax ConstInfo
ci)))]
unOps :: Map Int [Operator Parser Syntax]
unOps :: Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
unOps = ([Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall a. [a] -> [a] -> [a]
(++) ([Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall a b. (a -> b) -> a -> b
$ (Const
-> Maybe
(Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)))
Syntax]))
-> [Const]
-> [Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Const
-> Maybe
(Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
forall {m :: * -> *}.
MonadFail m =>
Const
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
unOpToTuple [Const]
allConst
where
unOpToTuple :: Const
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
unOpToTuple Const
c = do
let ci :: ConstInfo
ci = Const -> ConstInfo
constInfo Const
c
ConstMUnOp MUnAssoc
assoc <- ConstMeta -> m ConstMeta
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConstInfo -> ConstMeta
constMeta ConstInfo
ci)
let assI :: m (a -> a) -> Operator m a
assI = case MUnAssoc
assoc of
MUnAssoc
P -> m (a -> a) -> Operator m a
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Prefix
MUnAssoc
S -> m (a -> a) -> Operator m a
forall (m :: * -> *) a. m (a -> a) -> Operator m a
Postfix
Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text)))
Syntax]))
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> m (Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax])
forall a b. (a -> b) -> a -> b
$
Int
-> [Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
-> Map
Int
[Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax]
forall k a. k -> a -> Map k a
M.singleton
(ConstInfo -> Int
fixity ConstInfo
ci)
[ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Syntax)
-> Operator
(ReaderT ParserConfig (StateT WSState (Parsec Void Text))) Syntax
forall (m :: * -> *) a. m (a -> a) -> Operator m a
assI (ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Syntax)
exprLoc1 (ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax))
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Syntax)
forall a b. (a -> b) -> a -> b
$ Syntax -> Syntax -> Term
forall ty. Syntax' ty -> Syntax' ty -> Term' ty
SApp (Term -> Syntax
noLoc (Term -> Syntax) -> Term -> Syntax
forall a b. (a -> b) -> a -> b
$ Const -> Term
forall ty. Const -> Term' ty
TConst Const
c) (Syntax -> Term)
-> Parser Text
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
forall a b.
a
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) b
-> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
operator (ConstInfo -> Text
syntax ConstInfo
ci))]
exprLoc1 :: Parser (Syntax -> Term) -> Parser (Syntax -> Syntax)
exprLoc1 :: ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Syntax)
exprLoc1 ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
p = do
(SrcLoc
l, Syntax -> Term
f) <- ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
-> Parser (SrcLoc, Syntax -> Term)
forall a. Parser a -> Parser (SrcLoc, a)
parseLocG ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Term)
p
(Syntax -> Syntax)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Syntax)
forall a.
a -> ReaderT ParserConfig (StateT WSState (Parsec Void Text)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Syntax -> Syntax)
-> ReaderT
ParserConfig
(StateT WSState (Parsec Void Text))
(Syntax -> Syntax))
-> (Syntax -> Syntax)
-> ReaderT
ParserConfig (StateT WSState (Parsec Void Text)) (Syntax -> Syntax)
forall a b. (a -> b) -> a -> b
$ \Syntax
s -> SrcLoc -> Term -> Syntax
Syntax (SrcLoc
l SrcLoc -> SrcLoc -> SrcLoc
forall a. Semigroup a => a -> a -> a
<> Syntax
s Syntax -> Getting SrcLoc Syntax SrcLoc -> SrcLoc
forall s a. s -> Getting a s a -> a
^. Getting SrcLoc Syntax SrcLoc
forall ty (f :: * -> *).
Functor f =>
(SrcLoc -> f SrcLoc) -> Syntax' ty -> f (Syntax' ty)
sLoc) (Term -> Syntax) -> Term -> Syntax
forall a b. (a -> b) -> a -> b
$ Syntax -> Term
f Syntax
s