michelson_v1_primitives.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* Copyright (c) 2020 Metastate AG <hello@metastate.dev> *)
(* Copyright (c) 2022 DaiLambda, Inc. <contact@dailambda,jp> *)
(* *)
(* Permission is hereby granted, free of charge, to any person obtaining a *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *)
(* and/or sell copies of the Software, and to permit persons to whom the *)
(* Software is furnished to do so, subject to the following conditions: *)
(* *)
(* The above copyright notice and this permission notice shall be included *)
(* in all copies or substantial portions of the Software. *)
(* *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *)
(* DEALINGS IN THE SOFTWARE. *)
(* *)
(*****************************************************************************)
open Micheline
type error += Unknown_primitive_name of string
type error += Invalid_case of string
type error +=
| Invalid_primitive_name of
string Micheline.canonical * Micheline.canonical_location
type prim =
| K_parameter
| K_storage
| K_code
| K_view
| D_False
| D_Elt
| D_Left
| D_None
| D_Pair
| D_Right
| D_Some
| D_True
| D_Unit
| D_Lambda_rec
| I_PACK
| I_UNPACK
| I_BLAKE2B
| I_SHA256
| I_SHA512
| I_ABS
| I_ADD
| I_AMOUNT
| I_AND
| I_BALANCE
| I_CAR
| I_CDR
| I_CHAIN_ID
| I_CHECK_SIGNATURE
| I_COMPARE
| I_CONCAT
| I_CONS
| I_CREATE_ACCOUNT
| I_CREATE_CONTRACT
| I_IMPLICIT_ACCOUNT
| I_DIP
| I_DROP
| I_DUP
| I_VIEW
| I_EDIV
| I_EMPTY_BIG_MAP
| I_EMPTY_MAP
| I_EMPTY_SET
| I_EQ
| I_EXEC
| I_APPLY
| I_FAILWITH
| I_GE
| I_GET
| I_GET_AND_UPDATE
| I_GT
| I_HASH_KEY
| I_IF
| I_IF_CONS
| I_IF_LEFT
| I_IF_NONE
| I_INT
| I_LAMBDA
| I_LAMBDA_REC
| I_LE
| I_LEFT
| I_LEVEL
| I_LOOP
| I_LSL
| I_LSR
| I_LT
| I_MAP
| I_MEM
| I_MUL
| I_NEG
| I_NEQ
| I_NIL
| I_NONE
| I_NOT
| I_NOW
| I_MIN_BLOCK_TIME
| I_OR
| I_PAIR
| I_UNPAIR
| I_PUSH
| I_RIGHT
| I_SIZE
| I_SOME
| I_SOURCE
| I_SENDER
| I_SELF
| I_SELF_ADDRESS
| I_SLICE
| I_STEPS_TO_QUOTA
| I_SUB
| I_SUB_MUTEZ
| I_SWAP
| I_TRANSFER_TOKENS
| I_SET_DELEGATE
| I_UNIT
| I_UPDATE
| I_XOR
| I_ITER
| I_LOOP_LEFT
| I_ADDRESS
| I_CONTRACT
| I_ISNAT
| I_CAST
| I_RENAME
| I_SAPLING_EMPTY_STATE
| I_SAPLING_VERIFY_UPDATE
| I_DIG
| I_DUG
| I_NEVER
| I_VOTING_POWER
| I_TOTAL_VOTING_POWER
| I_KECCAK
| I_SHA3
| I_PAIRING_CHECK
| I_TICKET
| I_TICKET_DEPRECATED
| I_READ_TICKET
| I_SPLIT_TICKET
| I_JOIN_TICKETS
| I_OPEN_CHEST
| I_EMIT
| I_BYTES
| I_NAT
| T_bool
| T_contract
| T_int
| T_key
| T_key_hash
| T_lambda
| T_list
| T_map
| T_big_map
| T_nat
| T_option
| T_or
| T_pair
| T_set
| T_signature
| T_string
| T_bytes
| T_mutez
| T_timestamp
| T_unit
| T_operation
| T_address
| T_tx_rollup_l2_address
| T_sapling_transaction
| T_sapling_transaction_deprecated
| T_sapling_state
| T_chain_id
| T_never
| T_bls12_381_g1
| T_bls12_381_g2
| T_bls12_381_fr
| T_ticket
| T_chest_key
| T_chest
| H_constant
(* Auxiliary types for error documentation.
All the prim constructor prefixes must match their namespace. *)
type namespace =
| (* prefix "T" *) Type_namespace
| (* prefix "D" *) Constant_namespace
| (* prefix "I" *) Instr_namespace
| (* prefix "K" *) Keyword_namespace
| (* prefix "H" *) Constant_hash_namespace
let namespace = function
| K_code | K_view | K_parameter | K_storage -> Keyword_namespace
| D_Elt | D_False | D_Left | D_None | D_Pair | D_Right | D_Some | D_True
| D_Unit | D_Lambda_rec ->
Constant_namespace
| I_ABS | I_ADD | I_ADDRESS | I_AMOUNT | I_AND | I_APPLY | I_BALANCE
| I_BLAKE2B | I_CAR | I_CAST | I_CDR | I_CHAIN_ID | I_CHECK_SIGNATURE
| I_COMPARE | I_CONCAT | I_CONS | I_CONTRACT | I_CREATE_ACCOUNT
| I_CREATE_CONTRACT | I_DIG | I_DIP | I_DROP | I_DUG | I_DUP | I_VIEW | I_EDIV
| I_EMPTY_BIG_MAP | I_EMPTY_MAP | I_EMPTY_SET | I_EQ | I_EXEC | I_FAILWITH
| I_GE | I_GET | I_GET_AND_UPDATE | I_GT | I_HASH_KEY | I_IF | I_IF_CONS
| I_IF_LEFT | I_IF_NONE | I_IMPLICIT_ACCOUNT | I_INT | I_ISNAT | I_ITER
| I_JOIN_TICKETS | I_KECCAK | I_LAMBDA | I_LAMBDA_REC | I_LE | I_LEFT
| I_LEVEL | I_LOOP | I_LOOP_LEFT | I_LSL | I_LSR | I_LT | I_MAP | I_MEM
| I_MUL | I_NEG | I_NEQ | I_NEVER | I_NIL | I_NONE | I_NOT | I_NOW
| I_MIN_BLOCK_TIME | I_OR | I_PACK | I_PAIR | I_PAIRING_CHECK | I_PUSH
| I_READ_TICKET | I_RENAME | I_RIGHT | I_SAPLING_EMPTY_STATE
| I_SAPLING_VERIFY_UPDATE | I_SELF | I_SELF_ADDRESS | I_SENDER
| I_SET_DELEGATE | I_SHA256 | I_SHA512 | I_SHA3 | I_SIZE | I_SLICE | I_SOME
| I_SOURCE | I_SPLIT_TICKET | I_STEPS_TO_QUOTA | I_SUB | I_SUB_MUTEZ | I_SWAP
| I_TICKET | I_TICKET_DEPRECATED | I_TOTAL_VOTING_POWER | I_TRANSFER_TOKENS
| I_UNIT | I_UNPACK | I_UNPAIR | I_UPDATE | I_VOTING_POWER | I_XOR
| I_OPEN_CHEST | I_EMIT | I_BYTES | I_NAT ->
Instr_namespace
| T_address | T_tx_rollup_l2_address | T_big_map | T_bool | T_bytes
| T_chain_id | T_contract | T_int | T_key | T_key_hash | T_lambda | T_list
| T_map | T_mutez | T_nat | T_never | T_operation | T_option | T_or | T_pair
| T_sapling_state | T_sapling_transaction | T_sapling_transaction_deprecated
| T_set | T_signature | T_string | T_timestamp | T_unit | T_bls12_381_fr
| T_bls12_381_g1 | T_bls12_381_g2 | T_ticket | T_chest_key | T_chest ->
Type_namespace
| H_constant -> Constant_hash_namespace
let valid_case name =
let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in
let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in
let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in
let len = String.length name in
Compare.Int.(len <> 0)
&& Compare.Char.(name.[0] <> '_')
&& ((is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i]))
|| (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
|| (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
)
let string_of_prim = function
| K_parameter -> "parameter"
| K_storage -> "storage"
| K_code -> "code"
| K_view -> "view"
| D_False -> "False"
| D_Elt -> "Elt"
| D_Left -> "Left"
| D_None -> "None"
| D_Pair -> "Pair"
| D_Right -> "Right"
| D_Some -> "Some"
| D_True -> "True"
| D_Unit -> "Unit"
| D_Lambda_rec -> "Lambda_rec"
| I_PACK -> "PACK"
| I_UNPACK -> "UNPACK"
| I_BLAKE2B -> "BLAKE2B"
| I_SHA256 -> "SHA256"
| I_SHA512 -> "SHA512"
| I_ABS -> "ABS"
| I_ADD -> "ADD"
| I_AMOUNT -> "AMOUNT"
| I_AND -> "AND"
| I_BALANCE -> "BALANCE"
| I_CAR -> "CAR"
| I_CDR -> "CDR"
| I_CHAIN_ID -> "CHAIN_ID"
| I_CHECK_SIGNATURE -> "CHECK_SIGNATURE"
| I_COMPARE -> "COMPARE"
| I_CONCAT -> "CONCAT"
| I_CONS -> "CONS"
| I_CREATE_ACCOUNT -> "CREATE_ACCOUNT"
| I_CREATE_CONTRACT -> "CREATE_CONTRACT"
| I_IMPLICIT_ACCOUNT -> "IMPLICIT_ACCOUNT"
| I_DIP -> "DIP"
| I_DROP -> "DROP"
| I_DUP -> "DUP"
| I_EDIV -> "EDIV"
| I_EMPTY_BIG_MAP -> "EMPTY_BIG_MAP"
| I_EMPTY_MAP -> "EMPTY_MAP"
| I_EMPTY_SET -> "EMPTY_SET"
| I_EQ -> "EQ"
| I_EXEC -> "EXEC"
| I_APPLY -> "APPLY"
| I_FAILWITH -> "FAILWITH"
| I_GE -> "GE"
| I_GET -> "GET"
| I_GET_AND_UPDATE -> "GET_AND_UPDATE"
| I_GT -> "GT"
| I_HASH_KEY -> "HASH_KEY"
| I_IF -> "IF"
| I_IF_CONS -> "IF_CONS"
| I_IF_LEFT -> "IF_LEFT"
| I_IF_NONE -> "IF_NONE"
| I_INT -> "INT"
| I_LAMBDA -> "LAMBDA"
| I_LAMBDA_REC -> "LAMBDA_REC"
| I_LE -> "LE"
| I_LEFT -> "LEFT"
| I_LEVEL -> "LEVEL"
| I_LOOP -> "LOOP"
| I_LSL -> "LSL"
| I_LSR -> "LSR"
| I_LT -> "LT"
| I_MAP -> "MAP"
| I_MEM -> "MEM"
| I_MUL -> "MUL"
| I_NEG -> "NEG"
| I_NEQ -> "NEQ"
| I_NIL -> "NIL"
| I_NONE -> "NONE"
| I_NOT -> "NOT"
| I_NOW -> "NOW"
| I_MIN_BLOCK_TIME -> "MIN_BLOCK_TIME"
| I_OR -> "OR"
| I_PAIR -> "PAIR"
| I_PUSH -> "PUSH"
| I_RIGHT -> "RIGHT"
| I_SIZE -> "SIZE"
| I_SOME -> "SOME"
| I_SOURCE -> "SOURCE"
| I_SENDER -> "SENDER"
| I_SELF -> "SELF"
| I_SELF_ADDRESS -> "SELF_ADDRESS"
| I_SLICE -> "SLICE"
| I_STEPS_TO_QUOTA -> "STEPS_TO_QUOTA"
| I_SUB -> "SUB"
| I_SUB_MUTEZ -> "SUB_MUTEZ"
| I_SWAP -> "SWAP"
| I_TRANSFER_TOKENS -> "TRANSFER_TOKENS"
| I_SET_DELEGATE -> "SET_DELEGATE"
| I_UNIT -> "UNIT"
| I_UNPAIR -> "UNPAIR"
| I_UPDATE -> "UPDATE"
| I_XOR -> "XOR"
| I_ITER -> "ITER"
| I_LOOP_LEFT -> "LOOP_LEFT"
| I_ADDRESS -> "ADDRESS"
| I_CONTRACT -> "CONTRACT"
| I_ISNAT -> "ISNAT"
| I_CAST -> "CAST"
| I_RENAME -> "RENAME"
| I_SAPLING_EMPTY_STATE -> "SAPLING_EMPTY_STATE"
| I_SAPLING_VERIFY_UPDATE -> "SAPLING_VERIFY_UPDATE"
| I_DIG -> "DIG"
| I_DUG -> "DUG"
| I_NEVER -> "NEVER"
| I_VOTING_POWER -> "VOTING_POWER"
| I_TOTAL_VOTING_POWER -> "TOTAL_VOTING_POWER"
| I_KECCAK -> "KECCAK"
| I_SHA3 -> "SHA3"
| I_PAIRING_CHECK -> "PAIRING_CHECK"
| I_TICKET -> "TICKET"
| I_TICKET_DEPRECATED -> "TICKET_DEPRECATED"
| I_READ_TICKET -> "READ_TICKET"
| I_SPLIT_TICKET -> "SPLIT_TICKET"
| I_JOIN_TICKETS -> "JOIN_TICKETS"
| I_OPEN_CHEST -> "OPEN_CHEST"
| I_EMIT -> "EMIT"
| I_VIEW -> "VIEW"
| I_BYTES -> "BYTES"
| I_NAT -> "NAT"
| T_bool -> "bool"
| T_contract -> "contract"
| T_int -> "int"
| T_key -> "key"
| T_key_hash -> "key_hash"
| T_lambda -> "lambda"
| T_list -> "list"
| T_map -> "map"
| T_big_map -> "big_map"
| T_nat -> "nat"
| T_option -> "option"
| T_or -> "or"
| T_pair -> "pair"
| T_set -> "set"
| T_signature -> "signature"
| T_string -> "string"
| T_bytes -> "bytes"
| T_mutez -> "mutez"
| T_timestamp -> "timestamp"
| T_unit -> "unit"
| T_operation -> "operation"
| T_address -> "address"
| T_tx_rollup_l2_address -> "tx_rollup_l2_address"
| T_sapling_state -> "sapling_state"
| T_sapling_transaction -> "sapling_transaction"
| T_sapling_transaction_deprecated -> "sapling_transaction_deprecated"
| T_chain_id -> "chain_id"
| T_never -> "never"
| T_bls12_381_g1 -> "bls12_381_g1"
| T_bls12_381_g2 -> "bls12_381_g2"
| T_bls12_381_fr -> "bls12_381_fr"
| T_ticket -> "ticket"
| T_chest_key -> "chest_key"
| T_chest -> "chest"
| H_constant -> "constant"
let prim_of_string = function
| "parameter" -> ok K_parameter
| "storage" -> ok K_storage
| "code" -> ok K_code
| "view" -> ok K_view
| "False" -> ok D_False
| "Elt" -> ok D_Elt
| "Left" -> ok D_Left
| "None" -> ok D_None
| "Pair" -> ok D_Pair
| "Right" -> ok D_Right
| "Some" -> ok D_Some
| "True" -> ok D_True
| "Unit" -> ok D_Unit
| "Lambda_rec" -> ok D_Lambda_rec
| "PACK" -> ok I_PACK
| "UNPACK" -> ok I_UNPACK
| "BLAKE2B" -> ok I_BLAKE2B
| "SHA256" -> ok I_SHA256
| "SHA512" -> ok I_SHA512
| "ABS" -> ok I_ABS
| "ADD" -> ok I_ADD
| "AMOUNT" -> ok I_AMOUNT
| "AND" -> ok I_AND
| "BALANCE" -> ok I_BALANCE
| "CAR" -> ok I_CAR
| "CDR" -> ok I_CDR
| "CHAIN_ID" -> ok I_CHAIN_ID
| "CHECK_SIGNATURE" -> ok I_CHECK_SIGNATURE
| "COMPARE" -> ok I_COMPARE
| "CONCAT" -> ok I_CONCAT
| "CONS" -> ok I_CONS
| "CREATE_ACCOUNT" -> ok I_CREATE_ACCOUNT
| "CREATE_CONTRACT" -> ok I_CREATE_CONTRACT
| "IMPLICIT_ACCOUNT" -> ok I_IMPLICIT_ACCOUNT
| "DIP" -> ok I_DIP
| "DROP" -> ok I_DROP
| "DUP" -> ok I_DUP
| "VIEW" -> ok I_VIEW
| "EDIV" -> ok I_EDIV
| "EMPTY_BIG_MAP" -> ok I_EMPTY_BIG_MAP
| "EMPTY_MAP" -> ok I_EMPTY_MAP
| "EMPTY_SET" -> ok I_EMPTY_SET
| "EQ" -> ok I_EQ
| "EXEC" -> ok I_EXEC
| "APPLY" -> ok I_APPLY
| "FAILWITH" -> ok I_FAILWITH
| "GE" -> ok I_GE
| "GET" -> ok I_GET
| "GET_AND_UPDATE" -> ok I_GET_AND_UPDATE
| "GT" -> ok I_GT
| "HASH_KEY" -> ok I_HASH_KEY
| "IF" -> ok I_IF
| "IF_CONS" -> ok I_IF_CONS
| "IF_LEFT" -> ok I_IF_LEFT
| "IF_NONE" -> ok I_IF_NONE
| "INT" -> ok I_INT
| "KECCAK" -> ok I_KECCAK
| "LAMBDA" -> ok I_LAMBDA
| "LAMBDA_REC" -> ok I_LAMBDA_REC
| "LE" -> ok I_LE
| "LEFT" -> ok I_LEFT
| "LEVEL" -> ok I_LEVEL
| "LOOP" -> ok I_LOOP
| "LSL" -> ok I_LSL
| "LSR" -> ok I_LSR
| "LT" -> ok I_LT
| "MAP" -> ok I_MAP
| "MEM" -> ok I_MEM
| "MUL" -> ok I_MUL
| "NEG" -> ok I_NEG
| "NEQ" -> ok I_NEQ
| "NIL" -> ok I_NIL
| "NONE" -> ok I_NONE
| "NOT" -> ok I_NOT
| "NOW" -> ok I_NOW
| "MIN_BLOCK_TIME" -> ok I_MIN_BLOCK_TIME
| "OR" -> ok I_OR
| "PAIR" -> ok I_PAIR
| "UNPAIR" -> ok I_UNPAIR
| "PAIRING_CHECK" -> ok I_PAIRING_CHECK
| "PUSH" -> ok I_PUSH
| "RIGHT" -> ok I_RIGHT
| "SHA3" -> ok I_SHA3
| "SIZE" -> ok I_SIZE
| "SOME" -> ok I_SOME
| "SOURCE" -> ok I_SOURCE
| "SENDER" -> ok I_SENDER
| "SELF" -> ok I_SELF
| "SELF_ADDRESS" -> ok I_SELF_ADDRESS
| "SLICE" -> ok I_SLICE
| "STEPS_TO_QUOTA" -> ok I_STEPS_TO_QUOTA
| "SUB" -> ok I_SUB
| "SUB_MUTEZ" -> ok I_SUB_MUTEZ
| "SWAP" -> ok I_SWAP
| "TRANSFER_TOKENS" -> ok I_TRANSFER_TOKENS
| "SET_DELEGATE" -> ok I_SET_DELEGATE
| "UNIT" -> ok I_UNIT
| "UPDATE" -> ok I_UPDATE
| "XOR" -> ok I_XOR
| "ITER" -> ok I_ITER
| "LOOP_LEFT" -> ok I_LOOP_LEFT
| "ADDRESS" -> ok I_ADDRESS
| "CONTRACT" -> ok I_CONTRACT
| "ISNAT" -> ok I_ISNAT
| "CAST" -> ok I_CAST
| "RENAME" -> ok I_RENAME
| "SAPLING_EMPTY_STATE" -> ok I_SAPLING_EMPTY_STATE
| "SAPLING_VERIFY_UPDATE" -> ok I_SAPLING_VERIFY_UPDATE
| "DIG" -> ok I_DIG
| "DUG" -> ok I_DUG
| "NEVER" -> ok I_NEVER
| "VOTING_POWER" -> ok I_VOTING_POWER
| "TOTAL_VOTING_POWER" -> ok I_TOTAL_VOTING_POWER
| "TICKET" -> ok I_TICKET
| "TICKET_DEPRECATED" -> ok I_TICKET_DEPRECATED
| "READ_TICKET" -> ok I_READ_TICKET
| "SPLIT_TICKET" -> ok I_SPLIT_TICKET
| "JOIN_TICKETS" -> ok I_JOIN_TICKETS
| "OPEN_CHEST" -> ok I_OPEN_CHEST
| "EMIT" -> ok I_EMIT
| "BYTES" -> ok I_BYTES
| "NAT" -> ok I_NAT
| "bool" -> ok T_bool
| "contract" -> ok T_contract
| "int" -> ok T_int
| "key" -> ok T_key
| "key_hash" -> ok T_key_hash
| "lambda" -> ok T_lambda
| "list" -> ok T_list
| "map" -> ok T_map
| "big_map" -> ok T_big_map
| "nat" -> ok T_nat
| "option" -> ok T_option
| "or" -> ok T_or
| "pair" -> ok T_pair
| "set" -> ok T_set
| "signature" -> ok T_signature
| "string" -> ok T_string
| "bytes" -> ok T_bytes
| "mutez" -> ok T_mutez
| "timestamp" -> ok T_timestamp
| "unit" -> ok T_unit
| "operation" -> ok T_operation
| "address" -> ok T_address
| "tx_rollup_l2_address" -> ok T_tx_rollup_l2_address
| "sapling_state" -> ok T_sapling_state
| "sapling_transaction" -> ok T_sapling_transaction
| "sapling_transaction_deprecated" -> ok T_sapling_transaction_deprecated
| "chain_id" -> ok T_chain_id
| "never" -> ok T_never
| "bls12_381_g1" -> ok T_bls12_381_g1
| "bls12_381_g2" -> ok T_bls12_381_g2
| "bls12_381_fr" -> ok T_bls12_381_fr
| "ticket" -> ok T_ticket
| "chest_key" -> ok T_chest_key
| "chest" -> ok T_chest
| "constant" -> ok H_constant
| n ->
if valid_case n then error (Unknown_primitive_name n)
else error (Invalid_case n)
let prims_of_strings expr =
let rec convert = function
| (Int _ | String _ | Bytes _) as expr -> ok expr
| Prim (loc, prim, args, annot) ->
Error_monad.record_trace
(Invalid_primitive_name (expr, loc))
(prim_of_string prim)
>>? fun prim ->
List.map_e convert args >|? fun args -> Prim (loc, prim, args, annot)
| Seq (loc, args) -> List.map_e convert args >|? fun args -> Seq (loc, args)
in
convert (root expr) >|? fun expr -> strip_locations expr
let strings_of_prims expr =
let rec convert = function
| (Int _ | String _ | Bytes _) as expr -> expr
| Prim (loc, prim, args, annot) ->
let prim = string_of_prim prim in
let args = List.map convert args in
Prim (loc, prim, args, annot)
| Seq (loc, args) ->
let args = List.map convert args in
Seq (loc, args)
in
strip_locations (convert (root expr))
let prim_encoding =
let open Data_encoding in
def "michelson.v1.primitives"
@@ string_enum
(* Add the comment below every 10 lines *)
[
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("parameter", K_parameter);
("storage", K_storage);
("code", K_code);
("False", D_False);
("Elt", D_Elt);
("Left", D_Left);
("None", D_None);
("Pair", D_Pair);
("Right", D_Right);
("Some", D_Some);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("True", D_True);
("Unit", D_Unit);
("PACK", I_PACK);
("UNPACK", I_UNPACK);
("BLAKE2B", I_BLAKE2B);
("SHA256", I_SHA256);
("SHA512", I_SHA512);
("ABS", I_ABS);
("ADD", I_ADD);
("AMOUNT", I_AMOUNT);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("AND", I_AND);
("BALANCE", I_BALANCE);
("CAR", I_CAR);
("CDR", I_CDR);
("CHECK_SIGNATURE", I_CHECK_SIGNATURE);
("COMPARE", I_COMPARE);
("CONCAT", I_CONCAT);
("CONS", I_CONS);
("CREATE_ACCOUNT", I_CREATE_ACCOUNT);
("CREATE_CONTRACT", I_CREATE_CONTRACT);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT);
("DIP", I_DIP);
("DROP", I_DROP);
("DUP", I_DUP);
("EDIV", I_EDIV);
("EMPTY_MAP", I_EMPTY_MAP);
("EMPTY_SET", I_EMPTY_SET);
("EQ", I_EQ);
("EXEC", I_EXEC);
("FAILWITH", I_FAILWITH);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("GE", I_GE);
("GET", I_GET);
("GT", I_GT);
("HASH_KEY", I_HASH_KEY);
("IF", I_IF);
("IF_CONS", I_IF_CONS);
("IF_LEFT", I_IF_LEFT);
("IF_NONE", I_IF_NONE);
("INT", I_INT);
("LAMBDA", I_LAMBDA);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("LE", I_LE);
("LEFT", I_LEFT);
("LOOP", I_LOOP);
("LSL", I_LSL);
("LSR", I_LSR);
("LT", I_LT);
("MAP", I_MAP);
("MEM", I_MEM);
("MUL", I_MUL);
("NEG", I_NEG);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("NEQ", I_NEQ);
("NIL", I_NIL);
("NONE", I_NONE);
("NOT", I_NOT);
("NOW", I_NOW);
("OR", I_OR);
("PAIR", I_PAIR);
("PUSH", I_PUSH);
("RIGHT", I_RIGHT);
("SIZE", I_SIZE);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("SOME", I_SOME);
("SOURCE", I_SOURCE);
("SENDER", I_SENDER);
("SELF", I_SELF);
("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA);
("SUB", I_SUB);
("SWAP", I_SWAP);
("TRANSFER_TOKENS", I_TRANSFER_TOKENS);
("SET_DELEGATE", I_SET_DELEGATE);
("UNIT", I_UNIT);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("UPDATE", I_UPDATE);
("XOR", I_XOR);
("ITER", I_ITER);
("LOOP_LEFT", I_LOOP_LEFT);
("ADDRESS", I_ADDRESS);
("CONTRACT", I_CONTRACT);
("ISNAT", I_ISNAT);
("CAST", I_CAST);
("RENAME", I_RENAME);
("bool", T_bool);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("contract", T_contract);
("int", T_int);
("key", T_key);
("key_hash", T_key_hash);
("lambda", T_lambda);
("list", T_list);
("map", T_map);
("big_map", T_big_map);
("nat", T_nat);
("option", T_option);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("or", T_or);
("pair", T_pair);
("set", T_set);
("signature", T_signature);
("string", T_string);
("bytes", T_bytes);
("mutez", T_mutez);
("timestamp", T_timestamp);
("unit", T_unit);
("operation", T_operation);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("address", T_address);
(* Alpha_002 addition *)
("SLICE", I_SLICE);
(* Alpha_005 addition *)
("DIG", I_DIG);
("DUG", I_DUG);
("EMPTY_BIG_MAP", I_EMPTY_BIG_MAP);
("APPLY", I_APPLY);
("chain_id", T_chain_id);
("CHAIN_ID", I_CHAIN_ID);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
(* Alpha_008 addition *)
("LEVEL", I_LEVEL);
("SELF_ADDRESS", I_SELF_ADDRESS);
("never", T_never);
("NEVER", I_NEVER);
("UNPAIR", I_UNPAIR);
("VOTING_POWER", I_VOTING_POWER);
("TOTAL_VOTING_POWER", I_TOTAL_VOTING_POWER);
("KECCAK", I_KECCAK);
("SHA3", I_SHA3);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
(* Alpha_008 addition *)
("PAIRING_CHECK", I_PAIRING_CHECK);
("bls12_381_g1", T_bls12_381_g1);
("bls12_381_g2", T_bls12_381_g2);
("bls12_381_fr", T_bls12_381_fr);
("sapling_state", T_sapling_state);
("sapling_transaction_deprecated", T_sapling_transaction_deprecated);
("SAPLING_EMPTY_STATE", I_SAPLING_EMPTY_STATE);
("SAPLING_VERIFY_UPDATE", I_SAPLING_VERIFY_UPDATE);
("ticket", T_ticket);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
(* Alpha_008 addition *)
("TICKET_DEPRECATED", I_TICKET_DEPRECATED);
("READ_TICKET", I_READ_TICKET);
("SPLIT_TICKET", I_SPLIT_TICKET);
("JOIN_TICKETS", I_JOIN_TICKETS);
("GET_AND_UPDATE", I_GET_AND_UPDATE);
(* Alpha_011 addition *)
("chest", T_chest);
("chest_key", T_chest_key);
("OPEN_CHEST", I_OPEN_CHEST);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
("VIEW", I_VIEW);
("view", K_view);
("constant", H_constant);
(* Alpha_012 addition *)
("SUB_MUTEZ", I_SUB_MUTEZ);
(* Alpha_013 addition *)
("tx_rollup_l2_address", T_tx_rollup_l2_address);
("MIN_BLOCK_TIME", I_MIN_BLOCK_TIME);
("sapling_transaction", T_sapling_transaction);
(* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
(* Alpha_014 addition *)
("EMIT", I_EMIT);
(* Alpha_015 addition *)
("Lambda_rec", D_Lambda_rec);
("LAMBDA_REC", I_LAMBDA_REC);
("TICKET", I_TICKET);
("BYTES", I_BYTES);
("NAT", I_NAT)
(* New instructions must be added here, for backward compatibility of the encoding. *)
(* Keep the comment above at the end of the list *);
]
let () =
register_error_kind
`Permanent
~id:"michelson_v1.unknown_primitive_name"
~title:"Unknown primitive name"
~description:"In a script or data expression, a primitive was unknown."
~pp:(fun ppf n -> Format.fprintf ppf "Unknown primitive %s." n)
Data_encoding.(obj1 (req "wrong_primitive_name" @@ string Plain))
(function Unknown_primitive_name got -> Some got | _ -> None)
(fun got -> Unknown_primitive_name got) ;
register_error_kind
`Permanent
~id:"michelson_v1.invalid_primitive_name_case"
~title:"Invalid primitive name case"
~description:
"In a script or data expression, a primitive name is neither uppercase, \
lowercase or capitalized."
~pp:(fun ppf n -> Format.fprintf ppf "Primitive %s has invalid case." n)
Data_encoding.(obj1 (req "wrong_primitive_name" @@ string Plain))
(function Invalid_case name -> Some name | _ -> None)
(fun name -> Invalid_case name) ;
register_error_kind
`Permanent
~id:"michelson_v1.invalid_primitive_name"
~title:"Invalid primitive name"
~description:
"In a script or data expression, a primitive name is unknown or has a \
wrong case."
~pp:(fun ppf _ -> Format.fprintf ppf "Invalid primitive.")
Data_encoding.(
obj2
(req
"expression"
(Micheline.canonical_encoding ~variant:"generic" @@ string Plain))
(req "location" Micheline.canonical_location_encoding))
(function
| Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None)
(fun (expr, loc) -> Invalid_primitive_name (expr, loc))
let string_of_namespace = function
| Type_namespace -> "T"
| Constant_namespace -> "D"
| Instr_namespace -> "I"
| Keyword_namespace -> "K"
| Constant_hash_namespace -> "H"
