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

-- TODO [#712]: Remove this next major release
{-# OPTIONS_GHC -Wno-deprecations #-}

-- | 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 (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