{-# OPTIONS_GHC -Wno-deprecations #-}
module Morley.Michelson.Parser.Macro
( macro
, duupMac
, pairMac
, ifCmpMac
, mapCadrMac
, cadrMac
, carnMac
, cdrnMac
) where
import Prelude hiding (note, try)
import Text.Megaparsec (customFailure, label, notFollowedBy, skipMany, try)
import Text.Megaparsec.Char.Lexer (decimal)
import Unsafe qualified (fromIntegral)
import Morley.Michelson.Macro
(CadrStruct(..), Macro(..), PairStruct(..), ParsedOp(..), UnpairStruct(..))
import Morley.Michelson.Macro qualified as Macro
import Morley.Michelson.Parser.Annotations
import Morley.Michelson.Parser.Error
import Morley.Michelson.Parser.Helpers
import Morley.Michelson.Parser.Instr
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Type
import Morley.Michelson.Parser.Types (Parser, Parser', assertLetEnv)
import Morley.Michelson.Untyped (T(..), Ty(..), noAnn)
import Morley.Util.Positive
macro :: Parser' le ParsedOp -> Parser le Macro
macro :: Parser' le ParsedOp -> Parser le Macro
macro Parser' le ParsedOp
opParser = String
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"macro"
(ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro)
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall a b. (a -> b) -> a -> b
$ ReaderT le (Parsec CustomParserException Text) Macro
forall le. Parser le Macro
setCadrMac
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> (NonEmpty [ParsedOp] -> Macro)
-> Parser le (NonEmpty [ParsedOp] -> Macro)
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"CASE" NonEmpty [ParsedOp] -> Macro
CASE Parser' le (NonEmpty [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le (NonEmpty [ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le (NonEmpty [ParsedOp] -> Macro)
-> ReaderT
le (Parsec CustomParserException Text) (NonEmpty [ParsedOp])
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT
le (Parsec CustomParserException Text) (NonEmpty [ParsedOp])
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
someNE ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"TAG" Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT le (Parsec CustomParserException Text) Macro
forall le. Parser le Macro
tagMac
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"ACCESS" Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT le (Parsec CustomParserException Text) Macro
forall le. Parser le Macro
accessMac
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"SET" Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le ()
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReaderT le (Parsec CustomParserException Text) Macro
forall le. Parser le Macro
setMac
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> (NonEmpty [ParsedOp] -> Macro)
-> Parser le (NonEmpty [ParsedOp] -> Macro)
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"CONSTRUCT" NonEmpty [ParsedOp] -> Macro
CONSTRUCT Parser' le (NonEmpty [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le (NonEmpty [ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le (NonEmpty [ParsedOp] -> Macro)
-> ReaderT
le (Parsec CustomParserException Text) (NonEmpty [ParsedOp])
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT
le (Parsec CustomParserException Text) (NonEmpty [ParsedOp])
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
someNE ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ([ParsedOp] -> Macro) -> Parser le ([ParsedOp] -> Macro)
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"VIEW_" [ParsedOp] -> Macro
VIEW_ Parser' le ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ([ParsedOp] -> Macro) -> Parser le ([ParsedOp] -> Macro)
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"VOID" [ParsedOp] -> Macro
VOID Parser' le ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
-> Parser' le ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReaderT le (Parsec CustomParserException Text) (le :~: LetEnv)
forall le. Parser le (le :~: LetEnv)
assertLetEnv) Parser' le ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"CMP" Parser' le Text
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> VarAnn -> Macro)
-> ReaderT
le
(Parsec CustomParserException Text)
(ParsedInstr -> VarAnn -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedInstr -> VarAnn -> Macro
CMP ReaderT
le
(Parsec CustomParserException Text)
(ParsedInstr -> VarAnn -> Macro)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> ReaderT le (Parsec CustomParserException Text) (VarAnn -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall le. Parser le ParsedInstr
cmpOp ReaderT le (Parsec CustomParserException Text) (VarAnn -> Macro)
-> ReaderT le (Parsec CustomParserException Text) VarAnn
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) VarAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
noteDef)
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ([ParsedOp] -> [ParsedOp] -> Macro)
-> Parser le ([ParsedOp] -> [ParsedOp] -> Macro)
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"IF_SOME" [ParsedOp] -> [ParsedOp] -> Macro
IF_SOME Parser' le ([ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> Parser' le ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops Parser' le ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ([ParsedOp] -> [ParsedOp] -> Macro)
-> Parser le ([ParsedOp] -> [ParsedOp] -> Macro)
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"IF_RIGHT" [ParsedOp] -> [ParsedOp] -> Macro
IF_RIGHT Parser' le ([ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> Parser' le ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops Parser' le ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser le Macro
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"FAIL" Macro
FAIL
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"ASSERT_CMP" Parser' le Text
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> Macro)
-> ReaderT
le (Parsec CustomParserException Text) (ParsedInstr -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedInstr -> Macro
ASSERT_CMP ReaderT
le (Parsec CustomParserException Text) (ParsedInstr -> Macro)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall le. Parser le ParsedInstr
cmpOp)
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser le Macro
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"ASSERT_NONE" Macro
ASSERT_NONE
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser le Macro
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"ASSERT_SOME" Macro
ASSERT_SOME
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser le Macro
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"ASSERT_LEFT" Macro
ASSERT_LEFT
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser le Macro
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"ASSERT_RIGHT" Macro
ASSERT_RIGHT
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"ASSERT_" Parser' le Text
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> Macro)
-> ReaderT
le (Parsec CustomParserException Text) (ParsedInstr -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedInstr -> Macro
ASSERTX ReaderT
le (Parsec CustomParserException Text) (ParsedInstr -> Macro)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall le. Parser le ParsedInstr
cmpOp)
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser le Macro
forall a le. Tokens Text -> a -> Parser le a
word' Tokens Text
"ASSERT" Macro
ASSERT
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"DI"; Word
n <- Text -> ReaderT le (Parsec CustomParserException Text) Word
forall le.
HasLetEnv le =>
Text -> ReaderT le (Parsec CustomParserException Text) Word
num Text
"I"; Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"P"; Word -> [ParsedOp] -> Macro
DIIP (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops
ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReaderT le (Parsec CustomParserException Text) Macro
forall le. Parser le Macro
unpairMac
where
ops :: ReaderT le (Parsec CustomParserException Text) [ParsedOp]
ops = Parser' le ParsedOp -> Parser le [ParsedOp]
forall le. Parser' le ParsedOp -> Parser le [ParsedOp]
ops' Parser' le ParsedOp
opParser
num :: Text -> ReaderT le (Parsec CustomParserException Text) Word
num Text
str = (HasCallStack, Integral Int, Integral Word) => Int -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Word (Int -> Word) -> ([Text] -> Int) -> [Text] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall t. Container t => t -> Int
length ([Text] -> Word)
-> ReaderT le (Parsec CustomParserException Text) [Text]
-> ReaderT le (Parsec CustomParserException Text) Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) Text
-> ReaderT le (Parsec CustomParserException Text) [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
str)
duupMac :: Parser le Macro
duupMac :: Parser' le Macro
duupMac = do Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"DU"; Word
n <- Text -> ReaderT le (Parsec CustomParserException Text) Word
forall le.
HasLetEnv le =>
Text -> ReaderT le (Parsec CustomParserException Text) Word
num Text
"U"; Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"P"; Word -> VarAnn -> Macro
DUUP (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) (VarAnn -> Macro)
-> ReaderT le (Parsec CustomParserException Text) VarAnn
-> Parser' le Macro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) VarAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
noteDef
where
num :: Text -> ReaderT le (Parsec CustomParserException Text) Word
num Text
str = (HasCallStack, Integral Int, Integral Word) => Int -> Word
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Word (Int -> Word) -> ([Text] -> Int) -> [Text] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall t. Container t => t -> Int
length ([Text] -> Word)
-> ReaderT le (Parsec CustomParserException Text) [Text]
-> ReaderT le (Parsec CustomParserException Text) Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) Text
-> ReaderT le (Parsec CustomParserException Text) [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
str)
pairMacInner :: Parser le PairStruct
pairMacInner :: Parser' le PairStruct
pairMacInner = do
Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"P"
PairStruct
l <- (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"A" Parser' le Text -> PairStruct -> Parser' le PairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FieldAnn -> PairStruct
F FieldAnn
forall k (a :: k). Annotation a
noAnn) Parser' le PairStruct
-> Parser' le PairStruct -> Parser' le PairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le PairStruct
forall le. Parser le PairStruct
pairMacInner
PairStruct
r <- (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"I" Parser' le Text -> PairStruct -> Parser' le PairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FieldAnn -> PairStruct
F FieldAnn
forall k (a :: k). Annotation a
noAnn) Parser' le PairStruct
-> Parser' le PairStruct -> Parser' le PairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le PairStruct
forall le. Parser le PairStruct
pairMacInner
return $ PairStruct -> PairStruct -> PairStruct
P PairStruct
l PairStruct
r
pairMac :: Parser le Macro
pairMac :: Parser' le Macro
pairMac = do
PairStruct
a <- Parser' le PairStruct
forall le. Parser le PairStruct
pairMacInner
Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"R"
(Annotation TypeTag
tn, VarAnn
vn, [FieldAnn]
fns) <- ReaderT le (Parsec CustomParserException Text) (Annotation TypeTag)
-> ReaderT le (Parsec CustomParserException Text) VarAnn
-> ReaderT le (Parsec CustomParserException Text) [FieldAnn]
-> ReaderT
le
(Parsec CustomParserException Text)
(Annotation TypeTag, VarAnn, [FieldAnn])
forall a b c (f :: * -> *).
(Default a, Default b, Default c, Monad f, Alternative f) =>
f a -> f b -> f c -> f (a, b, c)
permute3Def ReaderT le (Parsec CustomParserException Text) (Annotation TypeTag)
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
noteDef ReaderT le (Parsec CustomParserException Text) VarAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
note (ReaderT le (Parsec CustomParserException Text) FieldAnn
-> ReaderT le (Parsec CustomParserException Text) [FieldAnn]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ReaderT le (Parsec CustomParserException Text) FieldAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
note)
let ps :: PairStruct
ps = [FieldAnn] -> PairStruct -> PairStruct
Macro.mapPairLeaves [FieldAnn]
fns PairStruct
a
return $ PairStruct -> Annotation TypeTag -> VarAnn -> Macro
PAPAIR PairStruct
ps Annotation TypeTag
tn VarAnn
vn
unpairMacInner :: Parser le UnpairStruct
unpairMacInner :: Parser' le UnpairStruct
unpairMacInner = do
Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"P"
UnpairStruct
l <- (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"A" Parser' le Text -> UnpairStruct -> Parser' le UnpairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UnpairStruct
UF) Parser' le UnpairStruct
-> Parser' le UnpairStruct -> Parser' le UnpairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le UnpairStruct
forall le. Parser le UnpairStruct
unpairMacInner
UnpairStruct
r <- (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"I" Parser' le Text -> UnpairStruct -> Parser' le UnpairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UnpairStruct
UF) Parser' le UnpairStruct
-> Parser' le UnpairStruct -> Parser' le UnpairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser' le UnpairStruct
forall le. Parser le UnpairStruct
unpairMacInner
return $ UnpairStruct -> UnpairStruct -> UnpairStruct
UP UnpairStruct
l UnpairStruct
r
unpairMac :: Parser le Macro
unpairMac :: Parser' le Macro
unpairMac = do
Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"UN"
UnpairStruct
a <- Parser' le UnpairStruct
forall le. Parser le UnpairStruct
unpairMacInner
Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"R"
Parser' le () -> Parser' le ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (Parser' le () -> Parser' le ()) -> Parser' le () -> Parser' le ()
forall a b. (a -> b) -> a -> b
$ (ReaderT le (Parsec CustomParserException Text) FieldAnn
-> Parser' le ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ReaderT le (Parsec CustomParserException Text) FieldAnn
forall le. Parser le FieldAnn
noteF) Parser' le () -> Parser' le () -> Parser' le ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReaderT le (Parsec CustomParserException Text) VarAnn
-> Parser' le ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ReaderT le (Parsec CustomParserException Text) VarAnn
forall le. Parser le VarAnn
noteV)
return $ UnpairStruct -> Macro
UNPAPAIR UnpairStruct
a
cadrMac :: Parser le Macro
cadrMac :: Parser' le Macro
cadrMac = Parser le Macro -> Parser le Macro
forall le a. Parser le a -> Parser le a
lexeme (Parser le Macro -> Parser le Macro)
-> Parser le Macro -> Parser le Macro
forall a b. (a -> b) -> a -> b
$ do
Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"C"
[CadrStruct]
a <- ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) [CadrStruct]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) [CadrStruct])
-> ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) [CadrStruct]
forall a b. (a -> b) -> a -> b
$ ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) CadrStruct
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) CadrStruct)
-> ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) CadrStruct
forall a b. (a -> b) -> a -> b
$ ReaderT le (Parsec CustomParserException Text) CadrStruct
forall le. Parser le CadrStruct
cadrInner ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) ()
-> ReaderT le (Parsec CustomParserException Text) CadrStruct
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser' le Text
-> ReaderT le (Parsec CustomParserException Text) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"R")
CadrStruct
b <- ReaderT le (Parsec CustomParserException Text) CadrStruct
forall le. Parser le CadrStruct
cadrInner
Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"R"
(VarAnn
vn, FieldAnn
fn) <- Parser' le (VarAnn, FieldAnn)
forall le. Parser le (VarAnn, FieldAnn)
notesVF
return $ [CadrStruct] -> VarAnn -> FieldAnn -> Macro
CADR ([CadrStruct]
a [CadrStruct] -> [CadrStruct] -> [CadrStruct]
forall a. [a] -> [a] -> [a]
++ CadrStruct -> [CadrStruct]
forall (f :: * -> *) a. Applicative f => a -> f a
pure CadrStruct
b) VarAnn
vn FieldAnn
fn
cadrInner :: Parser le CadrStruct
cadrInner :: Parser' le CadrStruct
cadrInner = (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"A" Parser' le Text -> CadrStruct -> Parser' le CadrStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CadrStruct
A) Parser' le CadrStruct
-> Parser' le CadrStruct -> Parser' le CadrStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"D" Parser' le Text -> CadrStruct -> Parser' le CadrStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CadrStruct
D)
carnMac :: Parser le Macro
carnMac :: Parser' le Macro
carnMac = Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"CAR" Parser' le () -> Parser' le Macro -> Parser' le Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (VarAnn -> Word -> Macro
CARN (VarAnn -> Word -> Macro)
-> ReaderT le (Parsec CustomParserException Text) VarAnn
-> ReaderT le (Parsec CustomParserException Text) (Word -> Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) VarAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
noteDef ReaderT le (Parsec CustomParserException Text) (Word -> Macro)
-> ReaderT le (Parsec CustomParserException Text) Word
-> Parser' le Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser le Word -> Parser le Word
forall le a. Parser le a -> Parser le a
lexeme Parser le Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)
cdrnMac :: Parser le Macro
cdrnMac :: Parser' le Macro
cdrnMac = Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"CDR" Parser' le () -> Parser' le Macro -> Parser' le Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (VarAnn -> Word -> Macro
CDRN (VarAnn -> Word -> Macro)
-> ReaderT le (Parsec CustomParserException Text) VarAnn
-> ReaderT le (Parsec CustomParserException Text) (Word -> Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT le (Parsec CustomParserException Text) VarAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
noteDef ReaderT le (Parsec CustomParserException Text) (Word -> Macro)
-> ReaderT le (Parsec CustomParserException Text) Word
-> Parser' le Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser le Word -> Parser le Word
forall le a. Parser le a -> Parser le a
lexeme Parser le Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)
{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
setCadrMac :: Parser le Macro
setCadrMac :: Parser' le Macro
setCadrMac = do
Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"SET_C"
[CadrStruct]
a <- ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) [CadrStruct]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ReaderT le (Parsec CustomParserException Text) CadrStruct
forall le. Parser le CadrStruct
cadrInner
Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"R"
(VarAnn
v, FieldAnn
f) <- Parser' le (VarAnn, FieldAnn)
forall le. Parser le (VarAnn, FieldAnn)
notesVF
return $ [CadrStruct] -> VarAnn -> FieldAnn -> Macro
SET_CADR [CadrStruct]
a VarAnn
v FieldAnn
f
mapCadrMac :: Parser le ParsedOp -> Parser le Macro
mapCadrMac :: Parser le ParsedOp -> Parser le Macro
mapCadrMac Parser le ParsedOp
opParser = do
Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"MAP_C"
[CadrStruct]
a <- ReaderT le (Parsec CustomParserException Text) CadrStruct
-> ReaderT le (Parsec CustomParserException Text) [CadrStruct]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ReaderT le (Parsec CustomParserException Text) CadrStruct
forall le. Parser le CadrStruct
cadrInner
Text -> Parser le ()
forall le. Text -> Parser le ()
symbol1' Text
"R"
(VarAnn
v, FieldAnn
f) <- Parser' le (VarAnn, FieldAnn)
forall le. Parser le (VarAnn, FieldAnn)
notesVF
[CadrStruct] -> VarAnn -> FieldAnn -> [ParsedOp] -> Macro
MAP_CADR [CadrStruct]
a VarAnn
v FieldAnn
f ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> Parser' le Macro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser' le ParsedOp -> Parser le [ParsedOp]
forall le. Parser' le ParsedOp -> Parser le [ParsedOp]
ops' Parser' le ParsedOp
Parser le ParsedOp
opParser
ifCmpMac :: Parser le ParsedOp -> Parser le Macro
ifCmpMac :: Parser le ParsedOp -> Parser le Macro
ifCmpMac Parser le ParsedOp
opParser = Text -> Parser le Text
forall le. Text -> Parser le Text
string' Text
"IFCMP" Parser' le Text
-> ReaderT le (Parsec CustomParserException Text) Macro
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT
le
(Parsec CustomParserException Text)
(ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return
ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro
IFCMP ReaderT
le
(Parsec CustomParserException Text)
(ParsedInstr -> VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) ParsedInstr
-> ReaderT
le
(Parsec CustomParserException Text)
(VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) ParsedInstr
forall le. Parser le ParsedInstr
cmpOp ReaderT
le
(Parsec CustomParserException Text)
(VarAnn -> [ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) VarAnn
-> ReaderT
le
(Parsec CustomParserException Text)
([ParsedOp] -> [ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT le (Parsec CustomParserException Text) VarAnn
forall tag le. KnownAnnTag tag => Parser le (Annotation tag)
noteDef ReaderT
le
(Parsec CustomParserException Text)
([ParsedOp] -> [ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT
le (Parsec CustomParserException Text) ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' le ParsedOp -> Parser le [ParsedOp]
forall le. Parser' le ParsedOp -> Parser le [ParsedOp]
ops' Parser' le ParsedOp
Parser le ParsedOp
opParser ReaderT
le (Parsec CustomParserException Text) ([ParsedOp] -> Macro)
-> ReaderT le (Parsec CustomParserException Text) [ParsedOp]
-> ReaderT le (Parsec CustomParserException Text) Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser' le ParsedOp -> Parser le [ParsedOp]
forall le. Parser' le ParsedOp -> Parser le [ParsedOp]
ops' Parser' le ParsedOp
Parser le ParsedOp
opParser
tagMac :: Parser le Macro
tagMac :: Parser' le Macro
tagMac = do
Natural
idx <- ReaderT le (Parsec CustomParserException Text) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
Parser' le ()
forall le. Parser le ()
spaces
Ty
ty <- Parser' le Ty
forall le. Parser le Ty
type_
let utys :: NonEmpty Ty
utys = Ty -> [Ty] -> NonEmpty Ty
unrollUnion Ty
ty []
Bool -> Parser' le () -> Parser' le ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural -> Int
forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Natural @Int Natural
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= NonEmpty Ty -> Int
forall t. Container t => t -> Int
length NonEmpty Ty
utys) (Parser' le () -> Parser' le ()) -> Parser' le () -> Parser' le ()
forall a b. (a -> b) -> a -> b
$
CustomParserException -> Parser' le ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException -> Parser' le ())
-> CustomParserException -> Parser' le ()
forall a b. (a -> b) -> a -> b
$ Natural -> Positive -> CustomParserException
WrongTagArgs Natural
idx (NonEmpty Ty -> Positive
forall a. NonEmpty a -> Positive
lengthNE NonEmpty Ty
utys)
return $ Natural -> NonEmpty Ty -> Macro
TAG Natural
idx NonEmpty Ty
utys
where
unrollUnion :: Ty -> [Ty] -> NonEmpty Ty
unrollUnion Ty
ty =
case Ty
ty of
Ty (TOr FieldAnn
_ FieldAnn
_ Ty
l Ty
r) Annotation TypeTag
_ -> Ty -> [Ty] -> NonEmpty Ty
unrollUnion Ty
l ([Ty] -> NonEmpty Ty) -> ([Ty] -> [Ty]) -> [Ty] -> NonEmpty Ty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Ty -> [Ty]
forall t. Container t => t -> [Element t]
toList (NonEmpty Ty -> [Ty]) -> ([Ty] -> NonEmpty Ty) -> [Ty] -> [Ty]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ty -> [Ty] -> NonEmpty Ty
unrollUnion Ty
r
Ty
_ -> (Ty
ty Ty -> [Ty] -> NonEmpty Ty
forall a. a -> [a] -> NonEmpty a
:|)
accessMac :: Parser le Macro
accessMac :: Parser' le Macro
accessMac = do
Natural
idx <- ReaderT le (Parsec CustomParserException Text) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
Parser' le ()
forall le. Parser le ()
spaces
Positive
size <- Parser' le Positive
forall le. Parser le Positive
positive
Bool -> Parser' le () -> Parser' le ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
idx Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Positive -> Natural
unPositive Positive
size) (Parser' le () -> Parser' le ()) -> Parser' le () -> Parser' le ()
forall a b. (a -> b) -> a -> b
$
CustomParserException -> Parser' le ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException -> Parser' le ())
-> CustomParserException -> Parser' le ()
forall a b. (a -> b) -> a -> b
$ Natural -> Positive -> CustomParserException
WrongAccessArgs Natural
idx Positive
size
return $ Natural -> Positive -> Macro
ACCESS Natural
idx Positive
size
setMac :: Parser le Macro
setMac :: Parser' le Macro
setMac = do
Natural
idx <- ReaderT le (Parsec CustomParserException Text) Natural
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
Parser' le ()
forall le. Parser le ()
spaces
Positive
size <- Parser' le Positive
forall le. Parser le Positive
positive
Bool -> Parser' le () -> Parser' le ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Natural
idx Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= Positive -> Natural
unPositive Positive
size) (Parser' le () -> Parser' le ()) -> Parser' le () -> Parser' le ()
forall a b. (a -> b) -> a -> b
$
CustomParserException -> Parser' le ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
customFailure (CustomParserException -> Parser' le ())
-> CustomParserException -> Parser' le ()
forall a b. (a -> b) -> a -> b
$ Natural -> Positive -> CustomParserException
WrongSetArgs Natural
idx Positive
size
return $ Natural -> Positive -> Macro
SET Natural
idx Positive
size