{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module UntypedPlutusCore.Parser
( parse
, term
, program
, parseTerm
, parseProgram
, parseScoped
, Parser
, SourcePos
) where
import Prelude hiding (fail)
import Control.Monad (fail, (<=<))
import Control.Monad.Except (MonadError)
import PlutusCore qualified as PLC
import PlutusCore.Annotation
import PlutusPrelude (through)
import Text.Megaparsec hiding (ParseError, State, parse)
import Text.Megaparsec.Char.Lexer qualified as Lex
import UntypedPlutusCore.Check.Uniques (checkProgram)
import UntypedPlutusCore.Core.Type qualified as UPLC
import UntypedPlutusCore.Rename (Rename (rename))
import Data.Text (Text)
import Data.Vector qualified as V
import PlutusCore.Error (AsParserErrorBundle)
import PlutusCore.MkPlc (mkIterApp)
import PlutusCore.Parser hiding (parseProgram, parseTerm, program)
import PlutusCore.Version
type PTerm = UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan
conTerm :: Parser PTerm
conTerm :: Parser PTerm
conTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ SrcSpan -> Some (ValueOf DefaultUni) -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> Some (ValueOf uni) -> Term name uni fun ann
UPLC.Constant SrcSpan
sp (Some (ValueOf DefaultUni) -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Some (ValueOf DefaultUni))
-> Parser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"con" Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Some (ValueOf DefaultUni))
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Some (ValueOf DefaultUni))
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Some (ValueOf DefaultUni))
constant)
builtinTerm :: Parser PTerm
builtinTerm :: Parser PTerm
builtinTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ SrcSpan -> DefaultFun -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> fun -> Term name uni fun ann
UPLC.Builtin SrcSpan
sp (DefaultFun -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
DefaultFun
-> Parser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"builtin" Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
DefaultFun
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
DefaultFun
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
DefaultFun
builtinFunction)
varTerm :: Parser PTerm
varTerm :: Parser PTerm
varTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
SrcSpan -> Name -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann
UPLC.Var SrcSpan
sp (Name -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
-> Parser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
name
lamTerm :: Parser PTerm
lamTerm :: Parser PTerm
lamTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ SrcSpan -> Name -> PTerm -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> name -> Term name uni fun ann -> Term name uni fun ann
UPLC.LamAbs SrcSpan
sp (Name -> PTerm -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(PTerm -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"lam" Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
forall a. Parser a -> Parser a
trailingWhitespace ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Name
name) ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(PTerm -> PTerm)
-> Parser PTerm -> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(a -> b)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
term
appTerm :: Parser PTerm
appTerm :: Parser PTerm
appTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ PTerm -> [(SrcSpan, PTerm)] -> PTerm
forall (term :: * -> *) tyname name (uni :: * -> *) fun ann.
TermLike term tyname name uni fun =>
term ann -> [(ann, term ann)] -> term ann
mkIterApp (PTerm -> [(SrcSpan, PTerm)] -> PTerm)
-> Parser PTerm
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
([(SrcSpan, PTerm)] -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PTerm
term ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
([(SrcSpan, PTerm)] -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[(SrcSpan, PTerm)]
-> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(a -> b)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((PTerm -> (SrcSpan, PTerm)) -> [PTerm] -> [(SrcSpan, PTerm)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan
sp,) ([PTerm] -> [(SrcSpan, PTerm)])
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[PTerm]
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[(SrcSpan, PTerm)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PTerm
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[PTerm]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some Parser PTerm
term)
delayTerm :: Parser PTerm
delayTerm :: Parser PTerm
delayTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ SrcSpan -> PTerm -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
UPLC.Delay SrcSpan
sp (PTerm -> PTerm) -> Parser PTerm -> Parser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"delay" Parser Text -> Parser PTerm -> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser PTerm
term)
forceTerm :: Parser PTerm
forceTerm :: Parser PTerm
forceTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ SrcSpan -> PTerm -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> Term name uni fun ann -> Term name uni fun ann
UPLC.Force SrcSpan
sp (PTerm -> PTerm) -> Parser PTerm -> Parser PTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"force" Parser Text -> Parser PTerm -> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser PTerm
term)
errorTerm :: Parser PTerm
errorTerm :: Parser PTerm
errorTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ SrcSpan -> PTerm
forall name (uni :: * -> *) fun ann. ann -> Term name uni fun ann
UPLC.Error SrcSpan
sp PTerm -> Parser Text -> Parser PTerm
forall a b.
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text
symbol Text
"error"
constrTerm :: Parser PTerm
constrTerm :: Parser PTerm
constrTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ do
PTerm
res <- SrcSpan -> Word64 -> [PTerm] -> PTerm
forall name (uni :: * -> *) fun ann.
ann -> Word64 -> [Term name uni fun ann] -> Term name uni fun ann
UPLC.Constr SrcSpan
sp (Word64 -> [PTerm] -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Word64
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
([PTerm] -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"constr" Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Word64
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Word64
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Word64
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Word64
forall a. Parser a -> Parser a
lexeme ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Word64
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal) ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
([PTerm] -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[PTerm]
-> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(a -> b)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser PTerm
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[PTerm]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser PTerm
term
(Version -> Bool) -> Parser () -> Parser ()
whenVersion (\Version
v -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
plcVersion110) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a.
String
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'constr' is not allowed before version 1.1.0"
PTerm -> Parser PTerm
forall a.
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PTerm
res
caseTerm :: Parser PTerm
caseTerm :: Parser PTerm
caseTerm = (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser PTerm) -> Parser PTerm)
-> (SrcSpan -> Parser PTerm) -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp ->
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
$ do
PTerm
res <- SrcSpan -> PTerm -> Vector PTerm -> PTerm
forall name (uni :: * -> *) fun ann.
ann
-> Term name uni fun ann
-> Vector (Term name uni fun ann)
-> Term name uni fun ann
UPLC.Case SrcSpan
sp (PTerm -> Vector PTerm -> PTerm)
-> Parser PTerm
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Vector PTerm -> PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text
symbol Text
"case" Parser Text -> Parser PTerm -> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser PTerm
term) ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Vector PTerm -> PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Vector PTerm)
-> Parser PTerm
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(a -> b)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([PTerm] -> Vector PTerm
forall a. [a] -> Vector a
V.fromList ([PTerm] -> Vector PTerm)
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[PTerm]
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Vector PTerm)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PTerm
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
[PTerm]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser PTerm
term)
(Version -> Bool) -> Parser () -> Parser ()
whenVersion (\Version
v -> Version
v Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< Version
plcVersion110) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Parser ()
forall a.
String
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"'case' is not allowed before version 1.1.0"
PTerm -> Parser PTerm
forall a.
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PTerm
res
term :: Parser PTerm
term :: Parser PTerm
term = Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
leadingWhitespace Parser PTerm
go
where
go :: Parser PTerm
go =
[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 a. Parser a -> Parser a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try [
Parser PTerm
conTerm
, Parser PTerm
builtinTerm
, Parser PTerm
varTerm
, Parser PTerm
lamTerm
, Parser PTerm
appTerm
, Parser PTerm
delayTerm
, Parser PTerm
forceTerm
, Parser PTerm
errorTerm
, Parser PTerm
constrTerm
, Parser PTerm
caseTerm
]
program :: Parser (UPLC.Program PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan)
program :: Parser (Program Name DefaultUni DefaultFun SrcSpan)
program = Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a. Parser a -> Parser a
leadingWhitespace Parser (Program Name DefaultUni DefaultFun SrcSpan)
go
where
go :: Parser (Program Name DefaultUni DefaultFun SrcSpan)
go = do
Program Name DefaultUni DefaultFun SrcSpan
prog <- (SrcSpan -> Parser (Program Name DefaultUni DefaultFun SrcSpan))
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a. (SrcSpan -> Parser a) -> Parser a
withSpan ((SrcSpan -> Parser (Program Name DefaultUni DefaultFun SrcSpan))
-> Parser (Program Name DefaultUni DefaultFun SrcSpan))
-> (SrcSpan -> Parser (Program Name DefaultUni DefaultFun SrcSpan))
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a b. (a -> b) -> a -> b
$ \SrcSpan
sp -> Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a. Parser a -> Parser a
inParens (Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan))
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a b. (a -> b) -> a -> b
$ do
Version
v <- Text -> Parser Text
symbol Text
"program" Parser Text
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Version
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Version
forall a b.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
Version
version
Version
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a. Version -> Parser a -> Parser a
withVersion Version
v (Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan))
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a b. (a -> b) -> a -> b
$ SrcSpan
-> Version -> PTerm -> Program Name DefaultUni DefaultFun SrcSpan
forall name (uni :: * -> *) fun ann.
ann -> Version -> Term name uni fun ann -> Program name uni fun ann
UPLC.Program SrcSpan
sp Version
v (PTerm -> Program Name DefaultUni DefaultFun SrcSpan)
-> Parser PTerm
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PTerm
term
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
-> Parser ()
forall a.
ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
-> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
(Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
Program Name DefaultUni DefaultFun SrcSpan
-> Parser (Program Name DefaultUni DefaultFun SrcSpan)
forall a.
a
-> ParsecT
ParserError
Text
(StateT ParserState (ReaderT (Maybe Version) Quote))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program Name DefaultUni DefaultFun SrcSpan
prog
parseTerm :: (AsParserErrorBundle e, MonadError e m, PLC.MonadQuote m) => Text -> m PTerm
parseTerm :: forall e (m :: * -> *).
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Text -> m PTerm
parseTerm = Parser PTerm -> Text -> m PTerm
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> Text -> m a
parseGen Parser PTerm
term
parseProgram ::
(AsParserErrorBundle e, MonadError e m, PLC.MonadQuote m)
=> Text
-> m (UPLC.Program PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan)
parseProgram :: forall e (m :: * -> *).
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
parseProgram = Parser (Program Name DefaultUni DefaultFun SrcSpan)
-> Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
forall e (m :: * -> *) a.
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Parser a -> Text -> m a
parseGen Parser (Program Name DefaultUni DefaultFun SrcSpan)
program
parseScoped ::
(AsParserErrorBundle e, PLC.AsUniqueError e SrcSpan, MonadError e m, PLC.MonadQuote m)
=> Text
-> m (UPLC.Program PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan)
parseScoped :: forall e (m :: * -> *).
(AsParserErrorBundle e, AsUniqueError e SrcSpan, MonadError e m,
MonadQuote m) =>
Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
parseScoped = (Program Name DefaultUni DefaultFun SrcSpan -> m ())
-> Program Name DefaultUni DefaultFun SrcSpan
-> m (Program Name DefaultUni DefaultFun SrcSpan)
forall (f :: * -> *) a b. Functor f => (a -> f b) -> a -> f a
through ((UniqueError SrcSpan -> Bool)
-> Program Name DefaultUni DefaultFun SrcSpan -> m ()
forall ann name e (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique, AsUniqueError e ann,
MonadError e m) =>
(UniqueError ann -> Bool) -> Program name uni fun ann -> m ()
checkProgram (Bool -> UniqueError SrcSpan -> Bool
forall a b. a -> b -> a
const Bool
True)) (Program Name DefaultUni DefaultFun SrcSpan
-> m (Program Name DefaultUni DefaultFun SrcSpan))
-> (Text -> m (Program Name DefaultUni DefaultFun SrcSpan))
-> Text
-> m (Program Name DefaultUni DefaultFun SrcSpan)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Program Name DefaultUni DefaultFun SrcSpan
-> m (Program Name DefaultUni DefaultFun SrcSpan)
forall a (m :: * -> *). (Rename a, MonadQuote m) => a -> m a
forall (m :: * -> *).
MonadQuote m =>
Program Name DefaultUni DefaultFun SrcSpan
-> m (Program Name DefaultUni DefaultFun SrcSpan)
rename (Program Name DefaultUni DefaultFun SrcSpan
-> m (Program Name DefaultUni DefaultFun SrcSpan))
-> (Text -> m (Program Name DefaultUni DefaultFun SrcSpan))
-> Text
-> m (Program Name DefaultUni DefaultFun SrcSpan)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
forall e (m :: * -> *).
(AsParserErrorBundle e, MonadError e m, MonadQuote m) =>
Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
parseProgram