module Michelson.Parser.Instr
( primInstr
, ops'
, mapOp
, pairOp
, cmpOp
) where
import Prelude hiding (EQ, GT, LT, many, note, some, try)
import Text.Megaparsec (choice, notFollowedBy, sepEndBy, try)
import qualified Text.Megaparsec.Char.Lexer as L
import Michelson.Let (LetValue(..))
import Michelson.Macro (ParsedInstr, ParsedOp(..))
import Michelson.Parser.Annotations
import Michelson.Parser.Lexer
import Michelson.Parser.Type
import Michelson.Parser.Types (Parser, letValues)
import Michelson.Parser.Value
import Michelson.Untyped
primInstr :: Parser (Contract' ParsedOp) -> Parser ParsedOp -> Parser ParsedInstr
primInstr contractParser opParser = choice
[ dropOp, dupOp, swapOp, digOp, dugOp, pushOp opParser, someOp, noneOp, unitOp
, ifNoneOp opParser, carOp, cdrOp, leftOp, rightOp, ifLeftOp opParser, nilOp
, consOp, ifConsOp opParser, sizeOp, emptySetOp, emptyMapOp, emptyBigMapOp, iterOp opParser
, memOp, getOp, updateOp, loopLOp opParser, loopOp opParser
, lambdaOp opParser, execOp, applyOp, dipOp opParser, failWithOp, castOp, renameOp
, concatOp, packOp, unpackOp, sliceOp, isNatOp, addressOp, addOp, subOp
, mulOp, edivOp, absOp, negOp, lslOp, lsrOp, orOp, andOp, xorOp, notOp
, compareOp, eqOp, neqOp, ltOp, leOp, gtOp, geOp, intOp, selfOp, contractOp
, transferTokensOp, setDelegateOp
, createContractOp contractParser, implicitAccountOp, nowOp, amountOp
, balanceOp, checkSigOp, sha256Op, sha512Op, blake2BOp, hashKeyOp
, stepsToQuotaOp, sourceOp, senderOp, chainIdOp
]
ops' :: Parser ParsedOp -> Parser [ParsedOp]
ops' opParser = (braces $ sepEndBy opParser semicolon) <|> (pure <$> opParser)
failWithOp :: Parser ParsedInstr
failWithOp = word' "FAILWITH" FAILWITH
loopOp :: Parser ParsedOp -> Parser ParsedInstr
loopOp opParser = word' "LOOP" LOOP <*> ops' opParser
loopLOp :: Parser ParsedOp -> Parser ParsedInstr
loopLOp opParser = word' "LOOP_LEFT" LOOP_LEFT <*> ops' opParser
execOp :: Parser ParsedInstr
execOp = word' "EXEC" EXEC <*> noteDef
applyOp :: Parser ParsedInstr
applyOp = word' "APPLY" APPLY <*> noteDef
dipOp :: Parser ParsedOp -> Parser ParsedInstr
dipOp opParser = parseWithOptionalParameter "DIP" DIPN DIP <*> ops' opParser
parseWithOptionalParameter :: Text -> (Word -> instr) -> instr -> Parser instr
parseWithOptionalParameter instrName constructorWithParam constructorNoParam =
symbol' instrName *>
(try (constructorWithParam <$> lexeme L.decimal) <|> pure constructorNoParam)
dropOp :: Parser ParsedInstr
dropOp = parseWithOptionalParameter "DROP" DROPN DROP
dupOp :: Parser ParsedInstr
dupOp = word' "DUP" DUP <*> noteDef
swapOp :: Parser ParsedInstr
swapOp = word' "SWAP" SWAP;
digOp :: Parser ParsedInstr
digOp = word' "DIG" DIG <*> lexeme L.decimal
dugOp :: Parser ParsedInstr
dugOp = word' "DUG" DUG <*> lexeme L.decimal
pushOp :: Parser ParsedOp -> Parser ParsedInstr
pushOp opParser = do
symbol' "PUSH"
v <- noteDef
(try $ pushLet v) <|> (push' v)
where
pushLet v = do
lvs <- asks letValues
lv <- mkLetVal lvs
return $ PUSH v (lvSig lv) (lvVal lv)
push' v = PUSH v <$> type_ <*> value' opParser
unitOp :: Parser ParsedInstr
unitOp = do symbol' "UNIT"; (t, v) <- notesTV; return $ UNIT t v
lambdaOp :: Parser ParsedOp -> Parser ParsedInstr
lambdaOp opParser =
word' "LAMBDA" LAMBDA <*> noteDef <*> type_ <*> type_ <*> ops' opParser
cmpOp :: Parser ParsedInstr
cmpOp = eqOp <|> neqOp <|> ltOp <|> gtOp <|> leOp <|> gtOp <|> geOp
eqOp :: Parser ParsedInstr
eqOp = word' "EQ" EQ <*> noteDef
neqOp :: Parser ParsedInstr
neqOp = word' "NEQ" NEQ <*> noteDef
ltOp :: Parser ParsedInstr
ltOp = word' "LT" LT <*> noteDef
gtOp :: Parser ParsedInstr
gtOp = word' "GT" GT <*> noteDef
leOp :: Parser ParsedInstr
leOp = word' "LE" LE <*> noteDef
geOp :: Parser ParsedInstr
geOp = word' "GE" GE <*> noteDef
compareOp :: Parser ParsedInstr
compareOp = word' "COMPARE" COMPARE <*> noteDef
orOp :: Parser ParsedInstr
orOp = word' "OR" OR <*> noteDef
andOp :: Parser ParsedInstr
andOp = word' "AND" AND <*> noteDef
xorOp :: Parser ParsedInstr
xorOp = word' "XOR" XOR <*> noteDef
notOp :: Parser ParsedInstr
notOp = word' "NOT" NOT <*> noteDef
addOp :: Parser ParsedInstr
addOp = word' "ADD" ADD <*> noteDef
subOp :: Parser ParsedInstr
subOp = word' "SUB" SUB <*> noteDef
mulOp :: Parser ParsedInstr
mulOp = word' "MUL" MUL <*> noteDef
edivOp :: Parser ParsedInstr
edivOp = word' "EDIV"EDIV <*> noteDef
absOp :: Parser ParsedInstr
absOp = word' "ABS" ABS <*> noteDef
negOp :: Parser ParsedInstr
negOp = word' "NEG" NEG <*> noteDef
lslOp :: Parser ParsedInstr
lslOp = word' "LSL" LSL <*> noteDef
lsrOp :: Parser ParsedInstr
lsrOp = word' "LSR" LSR <*> noteDef
concatOp :: Parser ParsedInstr
concatOp = word' "CONCAT" CONCAT <*> noteDef
sliceOp :: Parser ParsedInstr
sliceOp = word' "SLICE" SLICE <*> noteDef
pairOp :: Parser ParsedInstr
pairOp = do symbol' "PAIR"; (t, v, (p, q)) <- notesTVF2; return $ PAIR t v p q
carOp :: Parser ParsedInstr
carOp = do symbol' "CAR"; (v, f) <- notesVF; return $ CAR v f
cdrOp :: Parser ParsedInstr
cdrOp = do symbol' "CDR"; (v, f) <- notesVF; return $ CDR v f
emptySetOp :: Parser ParsedInstr
emptySetOp = do symbol' "EMPTY_SET"; (t, v) <- notesTV;
EMPTY_SET t v <$> comparable
emptyMapOp :: Parser ParsedInstr
emptyMapOp = do symbol' "EMPTY_MAP"; (t, v) <- notesTV; a <- comparable;
EMPTY_MAP t v a <$> type_
emptyBigMapOp :: Parser ParsedInstr
emptyBigMapOp = do symbol' "EMPTY_BIG_MAP"; (t, v) <- notesTV; a <- comparable;
EMPTY_BIG_MAP t v a <$> type_
memOp :: Parser ParsedInstr
memOp = word' "MEM" MEM <*> noteDef
updateOp :: Parser ParsedInstr
updateOp = word' "UPDATE" UPDATE <*> noteDef
iterOp :: Parser ParsedOp -> Parser ParsedInstr
iterOp opParser = word' "ITER" ITER <*> ops' opParser
sizeOp :: Parser ParsedInstr
sizeOp = word' "SIZE" SIZE <*> noteDef
mapOp :: Parser ParsedOp -> Parser ParsedInstr
mapOp opParser = word' "MAP" MAP <*> noteDef <*> ops' opParser
getOp :: Parser ParsedInstr
getOp = word' "GET" GET <*> noteDef
nilOp :: Parser ParsedInstr
nilOp = do symbol' "NIL"; (t, v) <- notesTV; NIL t v <$> type_
consOp :: Parser ParsedInstr
consOp = do
try . lexeme $ do
void $ string' "CONS"
notFollowedBy (string' "T")
CONS <$> noteDef
ifConsOp :: Parser ParsedOp -> Parser ParsedInstr
ifConsOp opParser = word' "IF_CONS" IF_CONS <*> ops' opParser <*> ops' opParser
someOp :: Parser ParsedInstr
someOp = do symbol' "SOME"; (t, v) <- notesTV; return $ SOME t v
noneOp :: Parser ParsedInstr
noneOp = do symbol' "NONE"; (t, v) <- notesTV; NONE t v <$> type_
ifNoneOp :: Parser ParsedOp -> Parser ParsedInstr
ifNoneOp opParser = word' "IF_NONE" IF_NONE <*> ops' opParser <*> ops' opParser
leftOp :: Parser ParsedInstr
leftOp = do symbol' "LEFT"; (t, v, (f, f')) <- notesTVF2;
LEFT t v f f' <$> type_
rightOp :: Parser ParsedInstr
rightOp = do symbol' "RIGHT"; (t, v, (f, f')) <- notesTVF2;
RIGHT t v f f' <$> type_
ifLeftOp :: Parser ParsedOp -> Parser ParsedInstr
ifLeftOp opParser = word' "IF_LEFT" IF_LEFT <*> ops' opParser <*> ops' opParser
createContractOp :: Parser (Contract' ParsedOp) -> Parser ParsedInstr
createContractOp contractParser =
word' "CREATE_CONTRACT" CREATE_CONTRACT
<*> noteDef <*> noteDef <*> braces contractParser
transferTokensOp :: Parser ParsedInstr
transferTokensOp = word' "TRANSFER_TOKENS" TRANSFER_TOKENS <*> noteDef
setDelegateOp :: Parser ParsedInstr
setDelegateOp = word' "SET_DELEGATE" SET_DELEGATE <*> noteDef
balanceOp :: Parser ParsedInstr
balanceOp = word' "BALANCE" BALANCE <*> noteDef
contractOp :: Parser ParsedInstr
contractOp = word' "CONTRACT" CONTRACT <*> noteDef <*> noteDef <*> type_
sourceOp :: Parser ParsedInstr
sourceOp = word' "SOURCE" SOURCE <*> noteDef
senderOp :: Parser ParsedInstr
senderOp = word' "SENDER" SENDER <*> noteDef
amountOp :: Parser ParsedInstr
amountOp = word' "AMOUNT" AMOUNT <*> noteDef
implicitAccountOp :: Parser ParsedInstr
implicitAccountOp = word' "IMPLICIT_ACCOUNT" IMPLICIT_ACCOUNT <*> noteDef
selfOp :: Parser ParsedInstr
selfOp = word' "SELF" SELF <*> noteDef <*> noteDef
addressOp :: Parser ParsedInstr
addressOp = word' "ADDRESS" ADDRESS <*> noteDef
nowOp :: Parser ParsedInstr
nowOp = word' "NOW" NOW <*> noteDef
stepsToQuotaOp :: Parser ParsedInstr
stepsToQuotaOp = word' "STEPS_TO_QUOTA" STEPS_TO_QUOTA <*> noteDef
chainIdOp :: Parser ParsedInstr
chainIdOp = word' "CHAIN_ID" CHAIN_ID <*> noteDef
packOp :: Parser ParsedInstr
packOp = word' "PACK" PACK <*> noteDef
unpackOp :: Parser ParsedInstr
unpackOp = do symbol' "UNPACK"; (t, v) <- notesTV; UNPACK t v <$> type_
checkSigOp :: Parser ParsedInstr
checkSigOp = word' "CHECK_SIGNATURE" CHECK_SIGNATURE <*> noteDef
blake2BOp :: Parser ParsedInstr
blake2BOp = word' "BLAKE2B" BLAKE2B <*> noteDef
sha256Op :: Parser ParsedInstr
sha256Op = word' "SHA256" SHA256 <*> noteDef
sha512Op :: Parser ParsedInstr
sha512Op = word' "SHA512" SHA512 <*> noteDef
hashKeyOp :: Parser ParsedInstr
hashKeyOp = word' "HASH_KEY" HASH_KEY <*> noteDef
castOp :: Parser ParsedInstr
castOp = word' "CAST" CAST <*> noteDef <*> type_
renameOp :: Parser ParsedInstr
renameOp = word' "RENAME" RENAME <*> noteDef
isNatOp :: Parser ParsedInstr
isNatOp = word' "ISNAT" ISNAT <*> noteDef
intOp :: Parser ParsedInstr
intOp = word' "INT" INT <*> noteDef