https://gitlab.com/tezos/tezos
Tip revision: e5f66365c3a9de7e215a5e1777a48d2c708938f1 authored by Philippe Wang on 04 October 2023, 21:22:13 UTC
WIP: CI: testing stuff
WIP: CI: testing stuff
Tip revision: e5f6636
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> *)
(* *)
(* 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
| D_False
| D_Elt
| D_Left
| D_None
| D_Pair
| D_Right
| D_Some
| D_True
| D_Unit
| 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_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_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_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_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_READ_TICKET
| I_SPLIT_TICKET
| I_JOIN_TICKETS
| 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_sapling_transaction
| T_sapling_state
| T_chain_id
| T_never
| T_bls12_381_g1
| T_bls12_381_g2
| T_bls12_381_fr
| T_ticket
(* 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
let namespace = function
| K_code | K_parameter | K_storage ->
Keyword_namespace
| D_Elt
| D_False
| D_Left
| D_None
| D_Pair
| D_Right
| D_Some
| D_True
| D_Unit ->
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_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_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_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_SWAP
| I_TICKET
| I_TOTAL_VOTING_POWER
| I_TRANSFER_TOKENS
| I_UNIT
| I_UNPACK
| I_UNPAIR
| I_UPDATE
| I_VOTING_POWER
| I_XOR ->
Instr_namespace
| T_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_set
| T_signature
| T_string
| T_timestamp
| T_unit
| T_bls12_381_fr
| T_bls12_381_g1
| T_bls12_381_g2
| T_ticket ->
Type_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"
| 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"
| 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_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_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_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_READ_TICKET ->
"READ_TICKET"
| I_SPLIT_TICKET ->
"SPLIT_TICKET"
| I_JOIN_TICKETS ->
"JOIN_TICKETS"
| 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_sapling_state ->
"sapling_state"
| T_sapling_transaction ->
"sapling_transaction"
| 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"
let prim_of_string = function
| "parameter" ->
ok K_parameter
| "storage" ->
ok K_storage
| "code" ->
ok K_code
| "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
| "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
| "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
| "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
| "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
| "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
| "READ_TICKET" ->
ok I_READ_TICKET
| "SPLIT_TICKET" ->
ok I_SPLIT_TICKET
| "JOIN_TICKETS" ->
ok I_JOIN_TICKETS
| "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
| "sapling_state" ->
ok T_sapling_state
| "sapling_transaction" ->
ok T_sapling_transaction
| "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
| 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 ->
map convert args >|? fun args -> Prim (0, prim, args, annot)
| Seq (_, args) ->
map convert args >|? fun args -> Seq (0, args)
in
convert (root expr) >|? fun expr -> strip_locations expr
[@@coq_axiom_with_reason
"implicit type conversion for expr in the constant cases"]
let strings_of_prims expr =
let rec convert = function
| (Int _ | String _ | Bytes _) as expr ->
expr
| Prim (_, prim, args, annot) ->
let prim = string_of_prim prim in
let args = List.map convert args in
Prim (0, prim, args, annot)
| Seq (_, args) ->
let args = List.map convert args in
Seq (0, args)
in
strip_locations (convert (root expr))
[@@coq_axiom_with_reason
"implicit type conversion for expr in the constant cases"]
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", T_sapling_transaction);
("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", I_TICKET);
("READ_TICKET", I_READ_TICKET);
("SPLIT_TICKET", I_SPLIT_TICKET);
("JOIN_TICKETS", I_JOIN_TICKETS);
("GET_AND_UPDATE", I_GET_AND_UPDATE)
(* 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))
(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))
(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))
(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"
