diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 173f1f252..544e675e9 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -243,6 +243,7 @@ module Script : sig | I_LOOP_LEFT | I_ADDRESS | I_CONTRACT + | I_ISNAT | T_bool | T_contract | T_int diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml index 1cea252fa..efc5c04ed 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -96,6 +96,7 @@ type prim = | I_LOOP_LEFT | I_ADDRESS | I_CONTRACT + | I_ISNAT | T_bool | T_contract | T_int @@ -220,6 +221,7 @@ let string_of_prim = function | I_LOOP_LEFT -> "LOOP_LEFT" | I_ADDRESS -> "ADDRESS" | I_CONTRACT -> "CONTRACT" + | I_ISNAT -> "ISNAT" | T_bool -> "bool" | T_contract -> "contract" | T_int -> "int" @@ -325,6 +327,7 @@ let prim_of_string = function | "LOOP_LEFT" -> ok I_LOOP_LEFT | "ADDRESS" -> ok I_ADDRESS | "CONTRACT" -> ok I_CONTRACT + | "ISNAT" -> ok I_ISNAT | "bool" -> ok T_bool | "contract" -> ok T_contract | "int" -> ok T_int @@ -474,6 +477,7 @@ let prim_encoding = ("LOOP_LEFT", I_LOOP_LEFT) ; ("ADDRESS", I_ADDRESS) ; ("CONTRACT", I_CONTRACT) ; + ("ISNAT", I_ISNAT) ; ("bool", T_bool) ; ("contract", T_contract) ; ("int", T_int) ; diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli index 051e2a50d..d2a5efa3b 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli @@ -94,6 +94,7 @@ type prim = | I_LOOP_LEFT | I_ADDRESS | I_CONTRACT + | I_ISNAT | T_bool | T_contract | T_int diff --git a/src/proto_alpha/lib_protocol/src/script_int_repr.ml b/src/proto_alpha/lib_protocol/src/script_int_repr.ml index 10213ee93..27e638bc3 100644 --- a/src/proto_alpha/lib_protocol/src/script_int_repr.ml +++ b/src/proto_alpha/lib_protocol/src/script_int_repr.ml @@ -43,6 +43,8 @@ let mul_n = mul let ediv_n = ediv let abs x = Z.abs x +let is_nat x = + if Compare.Z.(x < Z.zero) then None else Some x let neg x = Z.neg x let int x = x diff --git a/src/proto_alpha/lib_protocol/src/script_int_repr.mli b/src/proto_alpha/lib_protocol/src/script_int_repr.mli index 2765b62ed..6f01e4d95 100644 --- a/src/proto_alpha/lib_protocol/src/script_int_repr.mli +++ b/src/proto_alpha/lib_protocol/src/script_int_repr.mli @@ -88,6 +88,9 @@ val ediv: _ num -> _ num -> (z num * n num) option (** Compute the absolute value of a relative, turning it into a natural. *) val abs : z num -> n num +(** Partial identity over [N]. *) +val is_nat : z num -> n num option + (** Negates a number. *) val neg : _ num -> z num diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index 0632f02cd..12b7da87d 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -451,6 +451,8 @@ let rec interp | Not, Item (x, rest) -> consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt (* integer operations *) + | Is_nat, Item (x, rest) -> + consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest ctxt | Abs_int, Item (x, rest) -> consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt | Int_nat, Item (x, rest) -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index beffd7f80..d203865ee 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -151,6 +151,7 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function | And -> 0 | Xor -> 0 | Not -> 0 + | Is_nat -> 0 | Neg_nat -> 0 | Neg_int -> 0 | Abs_int -> 0 @@ -306,7 +307,8 @@ let namespace = function | I_ITER | I_LOOP_LEFT | I_ADDRESS - | I_CONTRACT -> Instr_namespace + | I_CONTRACT + | I_ISNAT -> Instr_namespace | T_bool | T_contract | T_int @@ -1845,6 +1847,14 @@ and parse_instr Item_t (Int_t, rest, _) -> typed ctxt loc Abs_int (Item_t (Nat_t, rest, instr_annot)) + | Prim (loc, I_ISNAT, [], Some instr_annot), + Item_t (Int_t, rest, None) -> + typed ctxt loc Is_nat + (Item_t (Option_t Nat_t, rest, Some instr_annot)) + | Prim (loc, I_ISNAT, [], None), + Item_t (Int_t, rest, annot) -> + typed ctxt loc Is_nat + (Item_t (Option_t Nat_t, rest, annot)) | Prim (loc, I_INT, [], instr_annot), Item_t (Nat_t, rest, _) -> typed ctxt loc Int_nat diff --git a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml index 3e935c9f7..a89c378ae 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -232,6 +232,8 @@ and ('bef, 'aft) instr = | Not : (bool * 'rest, bool * 'rest) instr (* integer operations *) + | Is_nat : + (z num * 'rest, n num option * 'rest) instr | Neg_nat : (n num * 'rest, z num * 'rest) instr | Neg_int :