module Morley.Michelson.Parser.Ext
( extInstr
, stackType
, printComment
) where
import Prelude hiding (try)
import Text.Megaparsec (choice, label, satisfy, try)
import Text.Megaparsec.Char (alphaNumChar, string)
import qualified Text.Megaparsec.Char.Lexer as L
import Morley.Michelson.Macro (ParsedOp(..), ParsedUExtInstr)
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Type
import Morley.Michelson.Parser.Types (Parser)
import qualified Morley.Michelson.Untyped as U
extInstr :: Parser [ParsedOp] -> Parser ParsedUExtInstr
extInstr :: Parser [ParsedOp] -> Parser ParsedUExtInstr
extInstr Parser [ParsedOp]
opsParser = String -> Parser ParsedUExtInstr -> Parser ParsedUExtInstr
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"morley instruction" (Parser ParsedUExtInstr -> Parser ParsedUExtInstr)
-> Parser ParsedUExtInstr -> Parser ParsedUExtInstr
forall a b. (a -> b) -> a -> b
$ [Parser ParsedUExtInstr] -> Parser ParsedUExtInstr
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [Parser ParsedUExtInstr
stackOp, Parser [ParsedOp] -> Parser ParsedUExtInstr
testAssertOp Parser [ParsedOp]
opsParser, Parser ParsedUExtInstr
printOp]
stackOp :: Parser ParsedUExtInstr
stackOp :: Parser ParsedUExtInstr
stackOp = Tokens Text
-> (StackTypePattern -> ParsedUExtInstr)
-> Parser (StackTypePattern -> ParsedUExtInstr)
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"STACKTYPE" StackTypePattern -> ParsedUExtInstr
forall op. StackTypePattern -> ExtInstrAbstract op
U.STACKTYPE Parser (StackTypePattern -> ParsedUExtInstr)
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> Parser ParsedUExtInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stackType
testAssertOp :: Parser [ParsedOp] -> Parser ParsedUExtInstr
testAssertOp :: Parser [ParsedOp] -> Parser ParsedUExtInstr
testAssertOp Parser [ParsedOp]
opsParser =
Tokens Text
-> (TestAssert ParsedOp -> ParsedUExtInstr)
-> Parser (TestAssert ParsedOp -> ParsedUExtInstr)
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"TEST_ASSERT" TestAssert ParsedOp -> ParsedUExtInstr
forall op. TestAssert op -> ExtInstrAbstract op
U.UTEST_ASSERT Parser (TestAssert ParsedOp -> ParsedUExtInstr)
-> ReaderT
LetEnv (Parsec CustomParserException Text) (TestAssert ParsedOp)
-> Parser ParsedUExtInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [ParsedOp]
-> ReaderT
LetEnv (Parsec CustomParserException Text) (TestAssert ParsedOp)
testAssert Parser [ParsedOp]
opsParser
printOp :: Parser ParsedUExtInstr
printOp :: Parser ParsedUExtInstr
printOp = Tokens Text
-> (PrintComment -> ParsedUExtInstr)
-> Parser (PrintComment -> ParsedUExtInstr)
forall a. Tokens Text -> a -> Parser a
word' Tokens Text
"PRINT" PrintComment -> ParsedUExtInstr
forall op. PrintComment -> ExtInstrAbstract op
U.UPRINT Parser (PrintComment -> ParsedUExtInstr)
-> ReaderT LetEnv (Parsec CustomParserException Text) PrintComment
-> Parser ParsedUExtInstr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT LetEnv (Parsec CustomParserException Text) PrintComment
printComment
testAssert :: Parser [ParsedOp] -> Parser (U.TestAssert ParsedOp)
testAssert :: Parser [ParsedOp]
-> ReaderT
LetEnv (Parsec CustomParserException Text) (TestAssert ParsedOp)
testAssert Parser [ParsedOp]
opsParser = do
Text
n <- Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> ReaderT LetEnv (Parsec CustomParserException Text) String
-> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ReaderT LetEnv (Parsec CustomParserException Text) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar)
PrintComment
c <- ReaderT LetEnv (Parsec CustomParserException Text) PrintComment
printComment
[ParsedOp]
o <- Parser [ParsedOp]
opsParser
return $ Text -> PrintComment -> [ParsedOp] -> TestAssert ParsedOp
forall op. Text -> PrintComment -> [op] -> TestAssert op
U.TestAssert Text
n PrintComment
c [ParsedOp]
o
printComment :: Parser U.PrintComment
= do
Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\""
let validChar :: Parser Text
validChar = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> ReaderT LetEnv (Parsec CustomParserException Text) String
-> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT LetEnv (Parsec CustomParserException Text) Char
-> ReaderT LetEnv (Parsec CustomParserException Text) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Token Text -> Bool)
-> ReaderT LetEnv (Parsec CustomParserException Text) (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
x -> Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%' Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Char
Token Text
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))
[Either Text StackRef]
c <- ReaderT
LetEnv (Parsec CustomParserException Text) (Either Text StackRef)
-> ReaderT
LetEnv (Parsec CustomParserException Text) [Either Text StackRef]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StackRef -> Either Text StackRef
forall a b. b -> Either a b
Right (StackRef -> Either Text StackRef)
-> ReaderT LetEnv (Parsec CustomParserException Text) StackRef
-> ReaderT
LetEnv (Parsec CustomParserException Text) (Either Text StackRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT LetEnv (Parsec CustomParserException Text) StackRef
stackRef ReaderT
LetEnv (Parsec CustomParserException Text) (Either Text StackRef)
-> ReaderT
LetEnv (Parsec CustomParserException Text) (Either Text StackRef)
-> ReaderT
LetEnv (Parsec CustomParserException Text) (Either Text StackRef)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Either Text StackRef
forall a b. a -> Either a b
Left (Text -> Either Text StackRef)
-> Parser Text
-> ReaderT
LetEnv (Parsec CustomParserException Text) (Either Text StackRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
validChar)
Tokens Text -> Parser ()
symbol Tokens Text
"\""
return $ [Either Text StackRef] -> PrintComment
U.PrintComment [Either Text StackRef]
c
stackRef :: Parser U.StackRef
stackRef :: ReaderT LetEnv (Parsec CustomParserException Text) StackRef
stackRef = do
Tokens Text
-> ReaderT LetEnv (Parsec CustomParserException Text) (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"%"
Natural
n <- Parser Natural -> Parser Natural
forall a. Parser a -> Parser a
brackets' Parser Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
L.decimal
return $ Natural -> StackRef
U.StackRef Natural
n
stackType :: Parser U.StackTypePattern
stackType :: ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stackType = Tokens Text -> Parser ()
symbol Tokens Text
"'[" Parser ()
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
emptyStk ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stkCons ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stkRest)
where
emptyStk :: ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
emptyStk = ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern)
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall a b. (a -> b) -> a -> b
$ Tokens Text -> Parser ()
symbol Tokens Text
"]" Parser ()
-> StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StackTypePattern
U.StkEmpty
stkRest :: ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stkRest = ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern)
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall a b. (a -> b) -> a -> b
$ Tokens Text -> Parser ()
symbol Tokens Text
"..." Parser ()
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tokens Text -> Parser ()
symbol Tokens Text
"]" Parser ()
-> StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> StackTypePattern
U.StkRest
stkCons :: ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stkCons = ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern)
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall a b. (a -> b) -> a -> b
$ do
TyVar
t <- Parser TyVar
tyVar
StackTypePattern
s <- (Tokens Text -> Parser ()
symbol Tokens Text
"," Parser ()
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stkCons ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
stkRest) ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
-> ReaderT
LetEnv (Parsec CustomParserException Text) StackTypePattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT LetEnv (Parsec CustomParserException Text) StackTypePattern
emptyStk
return $ TyVar -> StackTypePattern -> StackTypePattern
U.StkCons TyVar
t StackTypePattern
s
tyVar :: Parser U.TyVar
tyVar :: Parser TyVar
tyVar = (Ty -> TyVar
U.TyCon (Ty -> TyVar)
-> ReaderT LetEnv (Parsec CustomParserException Text) Ty
-> Parser TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT LetEnv (Parsec CustomParserException Text) Ty
type_) Parser TyVar -> Parser TyVar -> Parser TyVar
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Var -> TyVar
U.VarID (Var -> TyVar)
-> ReaderT LetEnv (Parsec CustomParserException Text) Var
-> Parser TyVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT LetEnv (Parsec CustomParserException Text) Var
varID)