-- editorconfig-checker-disable-file
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

module UntypedPlutusCore.Parser
  ( parse
  , term
  , program
  , parseTerm
  , parseProgram
  , parseScoped
  , Parser
  , SourcePos
  ) where

import Prelude hiding (fail)

import Control.Monad (fail, when, (<=<))
import Control.Monad.Except

import PlutusCore qualified as PLC
import PlutusCore.Annotation
import PlutusCore.Error qualified as PLC
import PlutusPrelude (through)
import Text.Megaparsec hiding (ParseError, State, parse)
import Text.Megaparsec.Char (char)
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 Data.Word (Word64)
import PlutusCore.MkPlc (mkIterApp)
import PlutusCore.Parser hiding (parseProgram, parseTerm, program)
import PlutusCore.Version

-- Parsers for UPLC terms

-- | A parsable UPLC term.
type PTerm = UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan

conTerm :: SrcSpan -> Parser PTerm
conTerm :: SrcSpan -> Parser PTerm
conTerm SrcSpan
sp =
  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
<$> ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  (Some (ValueOf DefaultUni))
constant

builtinTerm :: SrcSpan -> Parser PTerm
builtinTerm :: SrcSpan -> Parser PTerm
builtinTerm SrcSpan
sp =
  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
<$> 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 :: SrcSpan -> Parser PTerm
lamTerm :: SrcSpan -> Parser PTerm
lamTerm SrcSpan
sp =
  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
<$> (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 :: SrcSpan -> Parser PTerm
appTerm :: SrcSpan -> Parser PTerm
appTerm SrcSpan
sp =
  -- TODO: should not use the same `sp` for all arguments.
  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 :: SrcSpan -> Parser PTerm
delayTerm :: SrcSpan -> Parser PTerm
delayTerm SrcSpan
sp =
  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
<$> Parser PTerm
term

forceTerm :: SrcSpan -> Parser PTerm
forceTerm :: SrcSpan -> Parser PTerm
forceTerm SrcSpan
sp =
  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
<$> Parser PTerm
term

errorTerm :: SrcSpan -> Parser PTerm
errorTerm :: SrcSpan -> Parser PTerm
errorTerm SrcSpan
sp =
  PTerm -> Parser PTerm
forall a.
a
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan -> PTerm
forall name (uni :: * -> *) fun ann. ann -> Term name uni fun ann
UPLC.Error SrcSpan
sp)

constrTerm :: SrcSpan -> Parser PTerm
constrTerm :: SrcSpan -> Parser PTerm
constrTerm SrcSpan
sp = do
  let maxTag :: Integer
maxTag = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)
  Integer
tag :: Integer <- Parser Integer -> Parser Integer
forall a. Parser a -> Parser a
lexeme Parser Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
Lex.decimal
  [PTerm]
args <- 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"
  Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
tag Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxTag) (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 tag too large: must be a legal Word64 value"
  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 -> Parser PTerm) -> PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ 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 (Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
tag) [PTerm]
args

caseTerm :: SrcSpan -> Parser PTerm
caseTerm :: SrcSpan -> Parser PTerm
caseTerm SrcSpan
sp = 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
<$> 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

-- | Parser for all UPLC terms.
term :: Parser PTerm
term :: Parser PTerm
term =
  Parser PTerm -> Parser PTerm
forall a. Parser a -> Parser a
leadingWhitespace (Parser PTerm -> Parser PTerm) -> Parser PTerm -> Parser PTerm
forall a b. (a -> b) -> a -> b
$ do
    [Parser PTerm] -> Parser PTerm
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ Parser PTerm
tryAppTerm
      , Parser PTerm
tryTermInParens
      , Parser PTerm
varTerm
      ]
  where
    tryAppTerm :: Parser PTerm
    tryAppTerm :: Parser PTerm
tryAppTerm =
      (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 ->
        ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Char
-> Parser PTerm
-> Parser PTerm
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between
          (Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"[" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> String
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"opening bracket '['")
          (Token Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']' ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
-> String
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"closing bracket ']'")
          (SrcSpan -> Parser PTerm
appTerm SrcSpan
sp)

    tryTermInParens :: Parser PTerm
    tryTermInParens :: Parser PTerm
tryTermInParens =
      (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 ->
        ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Char
-> Parser PTerm
-> Parser PTerm
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between
          (Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"(" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Text
-> String
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"opening parenthesis '('")
          (Token Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
')' ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  Char
-> String
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Char
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"closing parenthesis ')'")
          ( [Parser PTerm] -> Parser PTerm
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
              [ Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"builtin" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
builtinTerm SrcSpan
sp
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"lam" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
lamTerm SrcSpan
sp
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"constr" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
constrTerm SrcSpan
sp -- "constr" must come before "con"
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"con" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
conTerm SrcSpan
sp
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"delay" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
delayTerm SrcSpan
sp
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"force" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
forceTerm SrcSpan
sp
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"error" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
errorTerm SrcSpan
sp
              , Text
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"case" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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
*> SrcSpan -> Parser PTerm
caseTerm SrcSpan
sp
              ]
              Parser PTerm -> String -> Parser PTerm
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"term keyword (builtin, lam, constr, con, delay, force, error, case)"
          )

-- | Parser for UPLC programs.
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
-> ParsecT
     ParserError
     Text
     (StateT ParserState (ReaderT (Maybe Version) Quote))
     Text
symbol Text
"program" ParsecT
  ParserError
  Text
  (StateT ParserState (ReaderT (Maybe Version) Quote))
  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

{-| Parse a UPLC term. The resulting program will have fresh names. The underlying monad must be capable
of handling any parse errors. -}
parseTerm :: (MonadError PLC.ParserErrorBundle m, PLC.MonadQuote m) => Text -> m PTerm
parseTerm :: forall (m :: * -> *).
(MonadError ParserErrorBundle m, MonadQuote m) =>
Text -> m PTerm
parseTerm = Parser PTerm -> Text -> m PTerm
forall (m :: * -> *) a.
(MonadError ParserErrorBundle m, MonadQuote m) =>
Parser a -> Text -> m a
parseGen Parser PTerm
term

{-| Parse a UPLC program. The resulting program will have fresh names. The
underlying monad must be capable of handling any parse errors.  This passes
"test" to the parser as the name of the input stream; to supply a name
explicity, use `parse program <name> <input>`.` -}
parseProgram
  :: (MonadError PLC.ParserErrorBundle m, PLC.MonadQuote m)
  => Text
  -> m (UPLC.Program PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan)
parseProgram :: forall (m :: * -> *).
(MonadError ParserErrorBundle 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 (m :: * -> *) a.
(MonadError ParserErrorBundle m, MonadQuote m) =>
Parser a -> Text -> m a
parseGen Parser (Program Name DefaultUni DefaultFun SrcSpan)
program

{-| Parse and rewrite so that names are globally unique, not just unique within
their scope. -}
parseScoped
  :: (MonadError (PLC.Error uni fun SrcSpan) m, PLC.MonadQuote m)
  => Text
  -> m (UPLC.Program PLC.Name PLC.DefaultUni PLC.DefaultFun SrcSpan)
-- don't require there to be no free variables at this point, we might be parsing an open term
parseScoped :: forall (uni :: * -> *) fun (m :: * -> *).
(MonadError (Error uni fun SrcSpan) 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 -> Error uni fun SrcSpan)
-> ExceptT (UniqueError SrcSpan) m () -> m ()
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError UniqueError SrcSpan -> Error uni fun SrcSpan
forall (uni :: * -> *) fun ann.
UniqueError ann -> Error uni fun ann
PLC.UniqueCoherencyErrorE (ExceptT (UniqueError SrcSpan) m () -> m ())
-> (Program Name DefaultUni DefaultFun SrcSpan
    -> ExceptT (UniqueError SrcSpan) m ())
-> Program Name DefaultUni DefaultFun SrcSpan
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UniqueError SrcSpan -> Bool)
-> Program Name DefaultUni DefaultFun SrcSpan
-> ExceptT (UniqueError SrcSpan) m ()
forall ann name (m :: * -> *) (uni :: * -> *) fun.
(Ord ann, HasUnique name TermUnique,
 MonadError (UniqueError ann) 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
<=< (ParserErrorBundle -> Error uni fun SrcSpan)
-> ExceptT
     ParserErrorBundle m (Program Name DefaultUni DefaultFun SrcSpan)
-> m (Program Name DefaultUni DefaultFun SrcSpan)
forall e' (m :: * -> *) e a.
MonadError e' m =>
(e -> e') -> ExceptT e m a -> m a
modifyError ParserErrorBundle -> Error uni fun SrcSpan
forall (uni :: * -> *) fun ann.
ParserErrorBundle -> Error uni fun ann
PLC.ParseErrorE (ExceptT
   ParserErrorBundle m (Program Name DefaultUni DefaultFun SrcSpan)
 -> m (Program Name DefaultUni DefaultFun SrcSpan))
-> (Text
    -> ExceptT
         ParserErrorBundle m (Program Name DefaultUni DefaultFun SrcSpan))
-> Text
-> m (Program Name DefaultUni DefaultFun SrcSpan)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ExceptT
     ParserErrorBundle m (Program Name DefaultUni DefaultFun SrcSpan)
forall (m :: * -> *).
(MonadError ParserErrorBundle m, MonadQuote m) =>
Text -> m (Program Name DefaultUni DefaultFun SrcSpan)
parseProgram