865 lines
19 KiB
OCaml
865 lines
19 KiB
OCaml
(*****************************************************************************)
|
|
(* *)
|
|
(* Open Source License *)
|
|
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
|
|
(* *)
|
|
(* 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_GT
|
|
| I_HASH_KEY
|
|
| I_IF
|
|
| I_IF_CONS
|
|
| I_IF_LEFT
|
|
| I_IF_NONE
|
|
| I_INT
|
|
| I_LAMBDA
|
|
| I_LE
|
|
| I_LEFT
|
|
| 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_PUSH
|
|
| I_RIGHT
|
|
| I_SIZE
|
|
| I_SOME
|
|
| I_SOURCE
|
|
| I_SENDER
|
|
| I_SELF
|
|
| 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_DIG
|
|
| I_DUG
|
|
| 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_chain_id
|
|
|
|
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_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_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_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_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_DIG ->
|
|
"DIG"
|
|
| I_DUG ->
|
|
"DUG"
|
|
| 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_chain_id ->
|
|
"chain_id"
|
|
|
|
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
|
|
| "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
|
|
| "LAMBDA" ->
|
|
ok I_LAMBDA
|
|
| "LE" ->
|
|
ok I_LE
|
|
| "LEFT" ->
|
|
ok I_LEFT
|
|
| "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
|
|
| "PUSH" ->
|
|
ok I_PUSH
|
|
| "RIGHT" ->
|
|
ok I_RIGHT
|
|
| "SIZE" ->
|
|
ok I_SIZE
|
|
| "SOME" ->
|
|
ok I_SOME
|
|
| "SOURCE" ->
|
|
ok I_SOURCE
|
|
| "SENDER" ->
|
|
ok I_SENDER
|
|
| "SELF" ->
|
|
ok I_SELF
|
|
| "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
|
|
| "DIG" ->
|
|
ok I_DIG
|
|
| "DUG" ->
|
|
ok I_DUG
|
|
| "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
|
|
| "chain_id" ->
|
|
ok T_chain_id
|
|
| 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.fold_left
|
|
(fun acc arg ->
|
|
acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
|
|
(ok [])
|
|
args
|
|
>>? fun args -> ok (Prim (0, prim, List.rev args, annot))
|
|
| Seq (_, args) ->
|
|
List.fold_left
|
|
(fun acc arg ->
|
|
acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
|
|
(ok [])
|
|
args
|
|
>>? fun args -> ok (Seq (0, List.rev args))
|
|
in
|
|
convert (root expr) >>? fun expr -> ok (strip_locations expr)
|
|
|
|
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))
|
|
|
|
let prim_encoding =
|
|
let open Data_encoding in
|
|
def "michelson.v1.primitives"
|
|
@@ string_enum
|
|
[ (* /!\ 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 here, for backward compatibility of the encoding. *)
|
|
]
|
|
|
|
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))
|