-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Parsing of built-in Michelson macros.

module Morley.Michelson.Parser.Macro
  ( macro
  -- * These are handled separately to have better error messages
  , duupMac
  , pairMac
  , ifCmpMac
  , mapCadrMac
  , cadrMac
  , carnMac
  , cdrnMac
  ) where

import Prelude hiding (note, try)

import Text.Megaparsec (label, notFollowedBy, skipMany, try)
import Text.Megaparsec.Char (string)
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.Instr
import Morley.Michelson.Parser.Lexer
import Morley.Michelson.Parser.Types (Parser)
import Morley.Michelson.Untyped (noAnn)

macro :: Parser ParsedOp -> Parser Macro
macro :: Parser ParsedOp -> Parser Macro
macro Parser ParsedOp
opParser = String -> Parser Macro -> Parser Macro
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"macro"
   (Parser Macro -> Parser Macro) -> Parser Macro -> Parser Macro
forall a b. (a -> b) -> a -> b
$ Parser Macro
setCadrMac
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"CMP" ParsecT CustomParserException Text Identity Text
-> Parser Macro -> Parser Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> Annotation VarTag -> Macro)
-> ParsecT
     CustomParserException
     Text
     Identity
     (ParsedInstr -> Annotation VarTag -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedInstr -> Annotation VarTag -> Macro
CMP ParsecT
  CustomParserException
  Text
  Identity
  (ParsedInstr -> Annotation VarTag -> Macro)
-> ParsecT CustomParserException Text Identity ParsedInstr
-> ParsecT
     CustomParserException Text Identity (Annotation VarTag -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity ParsedInstr
cmpOp ParsecT
  CustomParserException Text Identity (Annotation VarTag -> Macro)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef)
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ([ParsedOp] -> [ParsedOp] -> Macro)
-> Parser ([ParsedOp] -> [ParsedOp] -> Macro)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"IF_SOME" [ParsedOp] -> [ParsedOp] -> Macro
IF_SOME Parser ([ParsedOp] -> [ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> ParsecT
     CustomParserException Text Identity ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity [ParsedOp]
ops ParsecT CustomParserException Text Identity ([ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity [ParsedOp]
ops
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text
-> ([ParsedOp] -> [ParsedOp] -> Macro)
-> Parser ([ParsedOp] -> [ParsedOp] -> Macro)
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"IF_RIGHT" [ParsedOp] -> [ParsedOp] -> Macro
IF_RIGHT Parser ([ParsedOp] -> [ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> ParsecT
     CustomParserException Text Identity ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity [ParsedOp]
ops ParsecT CustomParserException Text Identity ([ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity [ParsedOp]
ops
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser Macro
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"FAIL" Macro
FAIL
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"ASSERT_CMP" ParsecT CustomParserException Text Identity Text
-> Parser Macro -> Parser Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> Macro)
-> ParsecT
     CustomParserException Text Identity (ParsedInstr -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedInstr -> Macro
ASSERT_CMP ParsecT CustomParserException Text Identity (ParsedInstr -> Macro)
-> ParsecT CustomParserException Text Identity ParsedInstr
-> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity ParsedInstr
cmpOp)
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser Macro
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"ASSERT_NONE" Macro
ASSERT_NONE
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser Macro
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"ASSERT_SOME" Macro
ASSERT_SOME
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser Macro
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"ASSERT_LEFT" Macro
ASSERT_LEFT
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser Macro
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"ASSERT_RIGHT" Macro
ASSERT_RIGHT
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"ASSERT_" ParsecT CustomParserException Text Identity Text
-> Parser Macro -> Parser Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr -> Macro)
-> ParsecT
     CustomParserException Text Identity (ParsedInstr -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedInstr -> Macro
ASSERTX ParsecT CustomParserException Text Identity (ParsedInstr -> Macro)
-> ParsecT CustomParserException Text Identity ParsedInstr
-> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity ParsedInstr
cmpOp)
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens Text -> Macro -> Parser Macro
forall a. Tokens Text -> a -> Parser a
word Tokens Text
"ASSERT" Macro
ASSERT
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DI"; Word
n <- Tokens Text -> ParsecT CustomParserException Text Identity Word
forall {f :: * -> *} {e} {s}.
MonadParsec e s f =>
Tokens s -> f Word
num Tokens Text
"I"; Tokens Text -> Parser ()
symbol1 Tokens Text
"P"; Word -> [ParsedOp] -> Macro
DIIP (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) ([ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> Parser Macro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomParserException Text Identity [ParsedOp]
ops
  Parser Macro -> Parser Macro -> Parser Macro
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Macro
unpairMac
  where
   ops :: ParsecT CustomParserException Text Identity [ParsedOp]
ops = Parser ParsedOp
-> ParsecT CustomParserException Text Identity [ParsedOp]
ops' Parser ParsedOp
opParser
   num :: Tokens s -> f Word
num Tokens s
str = forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Word (Int -> Word) -> ([Tokens s] -> Int) -> [Tokens s] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tokens s] -> Int
forall t. Container t => t -> Int
length ([Tokens s] -> Word) -> f [Tokens s] -> f Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Tokens s) -> f [Tokens s]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
str)

duupMac :: Parser Macro
duupMac :: Parser Macro
duupMac = do Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DU"; Word
n <- Tokens Text -> ParsecT CustomParserException Text Identity Word
forall {f :: * -> *} {e} {s}.
MonadParsec e s f =>
Tokens s -> f Word
num Tokens Text
"U"; Tokens Text -> Parser ()
symbol1 Tokens Text
"P"; Word -> Annotation VarTag -> Macro
DUUP (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) (Annotation VarTag -> Macro)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser Macro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef
  where
    num :: Tokens s -> f Word
num Tokens s
str = forall a b. (HasCallStack, Integral a, Integral b) => a -> b
Unsafe.fromIntegral @Int @Word (Int -> Word) -> ([Tokens s] -> Int) -> [Tokens s] -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Tokens s] -> Int
forall t. Container t => t -> Int
length ([Tokens s] -> Word) -> f [Tokens s] -> f Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Tokens s) -> f [Tokens s]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Tokens s -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens s
str)

pairMacInner :: Parser PairStruct
pairMacInner :: Parser PairStruct
pairMacInner = do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"P"
  PairStruct
l <- (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"A" ParsecT CustomParserException Text Identity Text
-> PairStruct -> Parser PairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Annotation FieldTag -> PairStruct
F Annotation FieldTag
forall {k} (a :: k). Annotation a
noAnn) Parser PairStruct -> Parser PairStruct -> Parser PairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PairStruct
pairMacInner
  PairStruct
r <- (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"I" ParsecT CustomParserException Text Identity Text
-> PairStruct -> Parser PairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Annotation FieldTag -> PairStruct
F Annotation FieldTag
forall {k} (a :: k). Annotation a
noAnn) Parser PairStruct -> Parser PairStruct -> Parser PairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser PairStruct
pairMacInner
  return $ PairStruct -> PairStruct -> PairStruct
P PairStruct
l PairStruct
r

pairMac :: Parser Macro
pairMac :: Parser Macro
pairMac = do
  PairStruct
a <- Parser PairStruct
pairMacInner
  Tokens Text -> Parser ()
symbol1 Tokens Text
"R"
  (Annotation TypeTag
tn, Annotation VarTag
vn, [Annotation FieldTag]
fns) <- ParsecT CustomParserException Text Identity (Annotation TypeTag)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT
     CustomParserException Text Identity [Annotation FieldTag]
-> ParsecT
     CustomParserException
     Text
     Identity
     (Annotation TypeTag, Annotation VarTag, [Annotation FieldTag])
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 ParsecT CustomParserException Text Identity (Annotation TypeTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note (ParsecT CustomParserException Text Identity (Annotation FieldTag)
-> ParsecT
     CustomParserException Text Identity [Annotation FieldTag]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT CustomParserException Text Identity (Annotation FieldTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
note)
  let ps :: PairStruct
ps = [Annotation FieldTag] -> PairStruct -> PairStruct
Macro.mapPairLeaves [Annotation FieldTag]
fns PairStruct
a
  return $ PairStruct -> Annotation TypeTag -> Annotation VarTag -> Macro
PAPAIR PairStruct
ps Annotation TypeTag
tn Annotation VarTag
vn

unpairMacInner :: Parser UnpairStruct
unpairMacInner :: Parser UnpairStruct
unpairMacInner = do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"P"
  UnpairStruct
l <- (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"A" ParsecT CustomParserException Text Identity Text
-> UnpairStruct -> Parser UnpairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UnpairStruct
UF) Parser UnpairStruct -> Parser UnpairStruct -> Parser UnpairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UnpairStruct
unpairMacInner
  UnpairStruct
r <- (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"I" ParsecT CustomParserException Text Identity Text
-> UnpairStruct -> Parser UnpairStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> UnpairStruct
UF) Parser UnpairStruct -> Parser UnpairStruct -> Parser UnpairStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser UnpairStruct
unpairMacInner
  return $ UnpairStruct -> UnpairStruct -> UnpairStruct
UP UnpairStruct
l UnpairStruct
r

unpairMac :: Parser Macro
unpairMac :: Parser Macro
unpairMac = do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"UN"
  UnpairStruct
a <- Parser UnpairStruct
unpairMacInner
  Tokens Text -> Parser ()
symbol1 Tokens Text
"R"
  Parser () -> Parser ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ (ParsecT CustomParserException Text Identity (Annotation FieldTag)
-> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT CustomParserException Text Identity (Annotation FieldTag)
noteF) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT CustomParserException Text Identity (Annotation VarTag)
noteV)
  return $ UnpairStruct -> Macro
UNPAPAIR UnpairStruct
a

cadrMac :: Parser Macro
cadrMac :: Parser Macro
cadrMac = Parser Macro -> Parser Macro
forall a. Parser a -> Parser a
lexeme (Parser Macro -> Parser Macro) -> Parser Macro -> Parser Macro
forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"C"
  [CadrStruct]
a <- ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity [CadrStruct]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (ParsecT CustomParserException Text Identity CadrStruct
 -> ParsecT CustomParserException Text Identity [CadrStruct])
-> ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity [CadrStruct]
forall a b. (a -> b) -> a -> b
$ ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity CadrStruct
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT CustomParserException Text Identity CadrStruct
 -> ParsecT CustomParserException Text Identity CadrStruct)
-> ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity CadrStruct
forall a b. (a -> b) -> a -> b
$ ParsecT CustomParserException Text Identity CadrStruct
cadrInner ParsecT CustomParserException Text Identity CadrStruct
-> Parser ()
-> ParsecT CustomParserException Text Identity CadrStruct
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT CustomParserException Text Identity Text -> Parser ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"R")
  CadrStruct
b <- ParsecT CustomParserException Text Identity CadrStruct
cadrInner
  Tokens Text -> Parser ()
symbol1 Tokens Text
"R"
  (Annotation VarTag
vn, Annotation FieldTag
fn) <- Parser (Annotation VarTag, Annotation FieldTag)
notesVF
  return $ [CadrStruct] -> Annotation VarTag -> Annotation FieldTag -> 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) Annotation VarTag
vn Annotation FieldTag
fn

cadrInner :: Parser CadrStruct
cadrInner :: ParsecT CustomParserException Text Identity CadrStruct
cadrInner = (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"A" ParsecT CustomParserException Text Identity Text
-> CadrStruct
-> ParsecT CustomParserException Text Identity CadrStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CadrStruct
A) ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity CadrStruct
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"D" ParsecT CustomParserException Text Identity Text
-> CadrStruct
-> ParsecT CustomParserException Text Identity CadrStruct
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CadrStruct
D)

carnMac :: Parser Macro
carnMac :: Parser Macro
carnMac = Tokens Text -> Parser ()
symbol1 Tokens Text
"CAR" Parser () -> Parser Macro -> Parser Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Annotation VarTag -> Word -> Macro
CARN (Annotation VarTag -> Word -> Macro)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT CustomParserException Text Identity (Word -> Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef ParsecT CustomParserException Text Identity (Word -> Macro)
-> ParsecT CustomParserException Text Identity Word -> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity Word
-> ParsecT CustomParserException Text Identity Word
forall a. Parser a -> Parser a
lexeme ParsecT CustomParserException Text Identity Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)

cdrnMac :: Parser Macro
cdrnMac :: Parser Macro
cdrnMac = Tokens Text -> Parser ()
symbol1 Tokens Text
"CDR" Parser () -> Parser Macro -> Parser Macro
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Annotation VarTag -> Word -> Macro
CDRN (Annotation VarTag -> Word -> Macro)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> ParsecT CustomParserException Text Identity (Word -> Macro)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef ParsecT CustomParserException Text Identity (Word -> Macro)
-> ParsecT CustomParserException Text Identity Word -> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity Word
-> ParsecT CustomParserException Text Identity Word
forall a. Parser a -> Parser a
lexeme ParsecT CustomParserException Text Identity 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 Macro
setCadrMac :: Parser Macro
setCadrMac = do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"SET_C"
  [CadrStruct]
a <- ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity [CadrStruct]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT CustomParserException Text Identity CadrStruct
cadrInner
  Tokens Text -> Parser ()
symbol1 Tokens Text
"R"
  (Annotation VarTag
v, Annotation FieldTag
f) <- Parser (Annotation VarTag, Annotation FieldTag)
notesVF
  return $ [CadrStruct] -> Annotation VarTag -> Annotation FieldTag -> Macro
SET_CADR [CadrStruct]
a Annotation VarTag
v Annotation FieldTag
f

mapCadrMac :: Parser ParsedOp -> Parser Macro
mapCadrMac :: Parser ParsedOp -> Parser Macro
mapCadrMac Parser ParsedOp
opParser = do
  Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"MAP_C"
  [CadrStruct]
a <- ParsecT CustomParserException Text Identity CadrStruct
-> ParsecT CustomParserException Text Identity [CadrStruct]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ParsecT CustomParserException Text Identity CadrStruct
cadrInner
  Tokens Text -> Parser ()
symbol1 Tokens Text
"R"
  (Annotation VarTag
v, Annotation FieldTag
f) <- Parser (Annotation VarTag, Annotation FieldTag)
notesVF
  [CadrStruct]
-> Annotation VarTag -> Annotation FieldTag -> [ParsedOp] -> Macro
MAP_CADR [CadrStruct]
a Annotation VarTag
v Annotation FieldTag
f ([ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> Parser Macro
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ParsedOp
-> ParsecT CustomParserException Text Identity [ParsedOp]
ops' Parser ParsedOp
opParser

ifCmpMac :: Parser ParsedOp -> Parser Macro
ifCmpMac :: Parser ParsedOp -> Parser Macro
ifCmpMac Parser ParsedOp
opParser = Tokens Text
-> ParsecT CustomParserException Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"IFCMP" ParsecT CustomParserException Text Identity Text
-> Parser Macro -> Parser Macro
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedInstr
 -> Annotation VarTag -> [ParsedOp] -> [ParsedOp] -> Macro)
-> ParsecT
     CustomParserException
     Text
     Identity
     (ParsedInstr
      -> Annotation VarTag -> [ParsedOp] -> [ParsedOp] -> Macro)
forall (m :: * -> *) a. Monad m => a -> m a
return
  ParsedInstr
-> Annotation VarTag -> [ParsedOp] -> [ParsedOp] -> Macro
IFCMP ParsecT
  CustomParserException
  Text
  Identity
  (ParsedInstr
   -> Annotation VarTag -> [ParsedOp] -> [ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity ParsedInstr
-> ParsecT
     CustomParserException
     Text
     Identity
     (Annotation VarTag -> [ParsedOp] -> [ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity ParsedInstr
cmpOp ParsecT
  CustomParserException
  Text
  Identity
  (Annotation VarTag -> [ParsedOp] -> [ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity (Annotation VarTag)
-> Parser ([ParsedOp] -> [ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT CustomParserException Text Identity (Annotation VarTag)
forall tag. KnownAnnTag tag => Parser (Annotation tag)
noteDef Parser ([ParsedOp] -> [ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> ParsecT
     CustomParserException Text Identity ([ParsedOp] -> Macro)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp
-> ParsecT CustomParserException Text Identity [ParsedOp]
ops' Parser ParsedOp
opParser ParsecT CustomParserException Text Identity ([ParsedOp] -> Macro)
-> ParsecT CustomParserException Text Identity [ParsedOp]
-> Parser Macro
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ParsedOp
-> ParsecT CustomParserException Text Identity [ParsedOp]
ops' Parser ParsedOp
opParser