{-# LANGUAGE OverloadedStrings #-}
module PlutusCore.Parser
( parseProgram
, parseTerm
, parseType
, ParseError(..)
) where
import Data.ByteString.Lazy (ByteString)
import Data.Text qualified as T
import PlutusCore.Core (Program (..), Term (..), Type)
import PlutusCore.Default
import PlutusCore.Error (ParseError (..))
import PlutusCore.MkPlc (mkIterApp, mkIterInst)
import PlutusCore.Name (Name, TyName)
import PlutusCore.Parser.ParserCommon
import Text.Megaparsec (MonadParsec (notFollowedBy), SourcePos, anySingle, choice, getSourcePos, many, some, try)
import Text.Megaparsec.Error (ParseErrorBundle)
type PTerm = Term TyName Name DefaultUni DefaultFun SourcePos
varTerm :: Parser PTerm
varTerm :: Parser PTerm
varTerm = SourcePos -> Name -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann -> name -> Term tyname name uni fun ann
Var (SourcePos -> Name -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError Text (StateT ParserState Quote) (Name -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos ParsecT ParseError Text (StateT ParserState Quote) (Name -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) Name
-> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) Name
name
tyAbsTerm :: Parser PTerm
tyAbsTerm :: Parser PTerm
tyAbsTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> TyName -> Kind SourcePos -> PTerm -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann
-> tyname
-> Kind ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
TyAbs (SourcePos -> TyName -> Kind SourcePos -> PTerm -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(TyName -> Kind SourcePos -> PTerm -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"abs" ParsecT
ParseError
Text
(StateT ParserState Quote)
(TyName -> Kind SourcePos -> PTerm -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) TyName
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Kind SourcePos -> PTerm -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) TyName
tyName ParsecT
ParseError
Text
(StateT ParserState Quote)
(Kind SourcePos -> PTerm -> PTerm)
-> ParsecT
ParseError Text (StateT ParserState Quote) (Kind SourcePos)
-> ParsecT
ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) (Kind SourcePos)
kind ParsecT ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
-> Parser PTerm -> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term
lamTerm :: Parser PTerm
lamTerm :: Parser PTerm
lamTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos
-> Name -> Type TyName DefaultUni SourcePos -> PTerm -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann
-> name
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
LamAbs (SourcePos
-> Name -> Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Name -> Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"lam" ParsecT
ParseError
Text
(StateT ParserState Quote)
(Name -> Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) Name
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) Name
name ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
-> ParsecT
ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
pType ParsecT ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
-> Parser PTerm -> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term
appTerm :: Parser PTerm
appTerm :: Parser PTerm
appTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inBrackets (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> PTerm -> [PTerm] -> PTerm
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> [term ann] -> term ann
mkIterApp (SourcePos -> PTerm -> [PTerm] -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(PTerm -> [PTerm] -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos ParsecT
ParseError
Text
(StateT ParserState Quote)
(PTerm -> [PTerm] -> PTerm)
-> Parser PTerm
-> ParsecT
ParseError Text (StateT ParserState Quote) ([PTerm] -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term ParsecT
ParseError Text (StateT ParserState Quote) ([PTerm] -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) [PTerm]
-> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
-> ParsecT ParseError Text (StateT ParserState Quote) [PTerm]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser PTerm
term
conTerm :: Parser PTerm
conTerm :: Parser PTerm
conTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> Some (ValueOf DefaultUni) -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann -> Some (ValueOf uni) -> Term tyname name uni fun ann
Constant (SourcePos -> Some (ValueOf DefaultUni) -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Some (ValueOf DefaultUni) -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"con" ParsecT
ParseError
Text
(StateT ParserState Quote)
(Some (ValueOf DefaultUni) -> PTerm)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Some (ValueOf DefaultUni))
-> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Some (ValueOf DefaultUni))
constant
builtinTerm :: Parser PTerm
builtinTerm :: Parser PTerm
builtinTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> DefaultFun -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann -> fun -> Term tyname name uni fun ann
Builtin (SourcePos -> DefaultFun -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError Text (StateT ParserState Quote) (DefaultFun -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"builtin" ParsecT
ParseError Text (StateT ParserState Quote) (DefaultFun -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) DefaultFun
-> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ParseError Text (StateT ParserState Quote) DefaultFun
builtinFunction
tyInstTerm :: Parser PTerm
tyInstTerm :: Parser PTerm
tyInstTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inBraces (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ do
SourcePos
pos <- ParsecT ParseError Text (StateT ParserState Quote) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
PTerm
tm <- Parser PTerm
term
[Type TyName DefaultUni SourcePos]
tys <- ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
[Type TyName DefaultUni SourcePos]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
pType
PTerm -> Parser PTerm
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PTerm -> Parser PTerm) -> PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> PTerm -> [Type TyName DefaultUni SourcePos] -> PTerm
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
ann -> term ann -> [Type tyname uni ann] -> term ann
mkIterInst SourcePos
pos PTerm
tm [Type TyName DefaultUni SourcePos]
tys
unwrapTerm :: Parser PTerm
unwrapTerm :: Parser PTerm
unwrapTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> PTerm -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann -> Term tyname name uni fun ann -> Term tyname name uni fun ann
Unwrap (SourcePos -> PTerm -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"unwrap" ParsecT ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
-> Parser PTerm -> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term
iwrapTerm :: Parser PTerm
iwrapTerm :: Parser PTerm
iwrapTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos
-> Type TyName DefaultUni SourcePos
-> Type TyName DefaultUni SourcePos
-> PTerm
-> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann
-> Type tyname uni ann
-> Type tyname uni ann
-> Term tyname name uni fun ann
-> Term tyname name uni fun ann
IWrap (SourcePos
-> Type TyName DefaultUni SourcePos
-> Type TyName DefaultUni SourcePos
-> PTerm
-> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos
-> Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"iwrap" ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos
-> Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
pType ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos -> PTerm -> PTerm)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
-> ParsecT
ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
pType ParsecT ParseError Text (StateT ParserState Quote) (PTerm -> PTerm)
-> Parser PTerm -> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term
errorTerm
:: Parser PTerm
errorTerm :: Parser PTerm
errorTerm = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
inParens (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ SourcePos -> Type TyName DefaultUni SourcePos -> PTerm
forall tyname name (uni :: * -> *) fun ann.
ann -> Type tyname uni ann -> Term tyname name uni fun ann
Error (SourcePos -> Type TyName DefaultUni SourcePos -> PTerm)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"error" ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos -> PTerm)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
-> Parser PTerm
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
pType
term :: Parser PTerm
term :: Parser PTerm
term = [Parser PTerm] -> Parser PTerm
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice ([Parser PTerm] -> Parser PTerm) -> [Parser PTerm] -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ (Parser PTerm -> Parser PTerm) -> [Parser PTerm] -> [Parser PTerm]
forall a b. (a -> b) -> [a] -> [b]
map Parser PTerm -> Parser PTerm
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try
[ Parser PTerm
tyAbsTerm
, Parser PTerm
lamTerm
, Parser PTerm
appTerm
, Parser PTerm
conTerm
, Parser PTerm
builtinTerm
, Parser PTerm
tyInstTerm
, Parser PTerm
unwrapTerm
, Parser PTerm
iwrapTerm
, Parser PTerm
errorTerm
, Parser PTerm
varTerm
]
parseProgram ::
ByteString -> Either (ParseErrorBundle T.Text ParseError) (Program TyName Name DefaultUni DefaultFun SourcePos)
parseProgram :: ByteString
-> Either
(ParseErrorBundle Text ParseError)
(Program TyName Name DefaultUni DefaultFun SourcePos)
parseProgram = Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
-> ByteString
-> Either
(ParseErrorBundle Text ParseError)
(Program TyName Name DefaultUni DefaultFun SourcePos)
forall a.
Parser a
-> ByteString -> Either (ParseErrorBundle Text ParseError) a
parseGen Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
program
program :: Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
program :: Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
program = Parser ()
whitespace Parser ()
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
Program TyName Name DefaultUni DefaultFun SourcePos
prog <- Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
forall a. Parser a -> Parser a
inParens (Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos))
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
forall a b. (a -> b) -> a -> b
$ SourcePos
-> Version SourcePos
-> PTerm
-> Program TyName Name DefaultUni DefaultFun SourcePos
forall tyname name (uni :: * -> *) fun ann.
ann
-> Version ann
-> Term tyname name uni fun ann
-> Program tyname name uni fun ann
Program (SourcePos
-> Version SourcePos
-> PTerm
-> Program TyName Name DefaultUni DefaultFun SourcePos)
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(Version SourcePos
-> PTerm -> Program TyName Name DefaultUni DefaultFun SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ParsecT ParseError Text (StateT ParserState Quote) SourcePos
wordPos Text
"program" ParsecT
ParseError
Text
(StateT ParserState Quote)
(Version SourcePos
-> PTerm -> Program TyName Name DefaultUni DefaultFun SourcePos)
-> ParsecT
ParseError Text (StateT ParserState Quote) (Version SourcePos)
-> ParsecT
ParseError
Text
(StateT ParserState Quote)
(PTerm -> Program TyName Name DefaultUni DefaultFun SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT
ParseError Text (StateT ParserState Quote) (Version SourcePos)
version ParsecT
ParseError
Text
(StateT ParserState Quote)
(PTerm -> Program TyName Name DefaultUni DefaultFun SourcePos)
-> Parser PTerm
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term
ParsecT ParseError Text (StateT ParserState Quote) Char
-> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT ParseError Text (StateT ParserState Quote) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
Program TyName Name DefaultUni DefaultFun SourcePos
-> Parser (Program TyName Name DefaultUni DefaultFun SourcePos)
forall (m :: * -> *) a. Monad m => a -> m a
return Program TyName Name DefaultUni DefaultFun SourcePos
prog
parseTerm ::
ByteString ->
Either (ParseErrorBundle T.Text ParseError) (Term TyName Name DefaultUni DefaultFun SourcePos)
parseTerm :: ByteString -> Either (ParseErrorBundle Text ParseError) PTerm
parseTerm = Parser PTerm
-> ByteString -> Either (ParseErrorBundle Text ParseError) PTerm
forall a.
Parser a
-> ByteString -> Either (ParseErrorBundle Text ParseError) a
parseGen Parser PTerm
term
parseType ::
ByteString ->
Either (ParseErrorBundle T.Text ParseError) (Type TyName DefaultUni SourcePos)
parseType :: ByteString
-> Either
(ParseErrorBundle Text ParseError)
(Type TyName DefaultUni SourcePos)
parseType = ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
-> ByteString
-> Either
(ParseErrorBundle Text ParseError)
(Type TyName DefaultUni SourcePos)
forall a.
Parser a
-> ByteString -> Either (ParseErrorBundle Text ParseError) a
parseGen ParsecT
ParseError
Text
(StateT ParserState Quote)
(Type TyName DefaultUni SourcePos)
pType