From c322a1f37ae59373b33c4505b290b286e5558687 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:45:00 +0100 Subject: [PATCH 01/17] Proto/Michelson: remove unit_key replaced by `unit_t` --- .../lib_benchmark/michelson_samplers.ml | 2 +- .../interpreter_benchmarks.ml | 26 +++++++------------ .../lib_benchmarks_proto/michelson_types.ml | 2 -- .../translator_benchmarks.ml | 4 +-- .../lib_protocol/script_ir_translator.ml | 3 +-- .../lib_protocol/script_typed_ir.ml | 2 -- .../lib_protocol/script_typed_ir.mli | 2 -- .../michelson/test_interpretation.ml | 6 ++--- .../michelson/test_ticket_balance.ml | 2 +- 9 files changed, 16 insertions(+), 33 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 022b2b20a94a..85c2351eaecd 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -328,7 +328,7 @@ end) | `TKey_hash -> Ex_comparable_ty key_hash_key | `TMutez -> Ex_comparable_ty mutez_key | `TInt -> Ex_comparable_ty int_key - | `TUnit -> Ex_comparable_ty unit_key + | `TUnit -> Ex_comparable_ty unit_t | `TSignature -> Ex_comparable_ty signature_key | `TKey -> Ex_comparable_ty key_key | `TChain_id -> Ex_comparable_ty chain_id_key diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index c036e023f030..5d708f84a677 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -1118,8 +1118,7 @@ module Registration_section = struct let () = simple_benchmark ~name:Interpreter_workload.N_IEmpty_set - ~kinstr: - (IEmpty_set (kinfo_unit, unit_cmp, halt (set unit_cmp @$ unit @$ bot))) + ~kinstr:(IEmpty_set (kinfo_unit, unit, halt (set unit @$ unit @$ bot))) () let set_iter_code = @@ -1217,7 +1216,7 @@ module Registration_section = struct let () = simple_benchmark ~name:Interpreter_workload.N_ISet_size - ~kinstr:(ISet_size (kinfo (set unit_cmp @$ bot), halt (nat @$ bot))) + ~kinstr:(ISet_size (kinfo (set unit @$ bot), halt (nat @$ bot))) () end @@ -1244,8 +1243,7 @@ module Registration_section = struct simple_benchmark ~name:Interpreter_workload.N_IEmpty_map ~kinstr: - (IEmpty_map - (kinfo_unit, unit_cmp, halt (map unit_cmp unit @$ unit @$ bot))) + (IEmpty_map (kinfo_unit, unit, halt (map unit unit @$ unit @$ bot))) () (* @@ -1436,10 +1434,7 @@ module Registration_section = struct ~name:Interpreter_workload.N_IEmpty_big_map ~kinstr: (IEmpty_big_map - ( kinfo_unit, - unit_cmp, - unit, - halt (big_map unit_cmp unit @$ unit @$ bot) )) + (kinfo_unit, unit, unit, halt (big_map unit unit @$ unit @$ bot))) () let () = @@ -2657,7 +2652,7 @@ module Registration_section = struct simple_benchmark ~name:Interpreter_workload.N_ITicket ~kinstr: - (ITicket (kinfo (unit @$ nat @$ bot), halt (ticket unit_cmp @$ bot))) + (ITicket (kinfo (unit @$ nat @$ bot), halt (ticket unit @$ bot))) () let () = @@ -2665,13 +2660,12 @@ module Registration_section = struct ~name:Interpreter_workload.N_IRead_ticket ~kinstr: (IRead_ticket - ( kinfo (ticket unit_cmp @$ bot), - halt (cpair address (cpair unit nat) @$ ticket unit_cmp @$ bot) - )) + ( kinfo (ticket unit @$ bot), + halt (cpair address (cpair unit nat) @$ ticket unit @$ bot) )) () let split_ticket_instr = - let ticket_unit = ticket unit_cmp in + let ticket_unit = ticket unit in let (Ty_ex_c pair_ticket_unit_ticket_unit) = pair ticket_unit ticket_unit in @@ -2707,9 +2701,7 @@ module Registration_section = struct fun () -> let half_amount = Samplers.Random_value.value nat rng_state in let amount = Script_int.add_n half_amount half_amount in - let ticket = - Samplers.Random_value.value (ticket unit_cmp) rng_state - in + let ticket = Samplers.Random_value.value (ticket unit) rng_state in let ticket = {ticket with amount} in Ex_stack_and_kinstr { diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index 9887d7b00359..33641e55126e 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -34,8 +34,6 @@ let bot = Bot_t let unit = unit_t -let unit_cmp = unit_key - let int_cmp = int_key let string_cmp = string_key diff --git a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml index 558a77503f00..a4c14e7ee035 100644 --- a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml @@ -646,11 +646,11 @@ let rec dummy_type_generator size = let rec dummy_comparable_type_generator size = let open Script_ir_translator in let open Script_typed_ir in - if size <= 0 then Ex_comparable_ty unit_key + if size <= 0 then Ex_comparable_ty unit_t else match dummy_comparable_type_generator (size - 2) with | Ex_comparable_ty r -> - let l = unit_key in + let l = unit_t in Ex_comparable_ty (match pair_key (-1) l r with Error _ -> assert false | Ok t -> t) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 6fe18495b508..573cc6575b54 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1039,8 +1039,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : else match ty with | Prim (loc, T_unit, [], annot) -> - check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty unit_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty unit_t, ctxt) | Prim (loc, T_never, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty never_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index e934766c2e32..a72657b1bcc7 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1842,8 +1842,6 @@ type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] let unit_t = Unit_t -let unit_key = unit_t - let int_t = Int_t let int_key = int_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index a1ea5b52702a..a63206910afa 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val unit_key : unit comparable_ty - val never_key : never comparable_ty val int_key : z num comparable_ty diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml index e0a111a7e440..631f4901db68 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml @@ -160,17 +160,15 @@ let test_stack_overflow_in_lwt () = in let stack = Bot_t in let item ty s = Item_t (ty, s) in - let unit_t = unit_t in - let unit_k = unit_key in let bool_t = bool_t in - big_map_t (-1) unit_k unit_t >>??= fun big_map_t -> + big_map_t (-1) unit_t unit_t >>??= fun big_map_t -> let descr kinstr = {kloc = 0; kbef = stack; kaft = stack; kinstr} in let kinfo s = {iloc = -1; kstack_ty = s} in let stack1 = item big_map_t Bot_t in let stack2 = item big_map_t (item big_map_t Bot_t) in let stack3 = item unit_t stack2 in let stack4 = item bool_t stack1 in - let push_empty_big_map k = IEmpty_big_map (kinfo stack, unit_k, unit_t, k) in + let push_empty_big_map k = IEmpty_big_map (kinfo stack, unit_t, unit_t, k) in let large_mem_seq n = let rec aux n acc = if n = 0 then acc diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml index ceed895495d9..0f673614defe 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml @@ -161,7 +161,7 @@ let string_token ~ticketer content = let unit_ticket ~ticketer = Ticket_token.Ex_token - {ticketer; contents_type = Script_typed_ir.unit_key; contents = ()} + {ticketer; contents_type = Script_typed_ir.unit_t; contents = ()} let new_contracts ~before ~after = let all_contracts current_block = -- GitLab From b017d7d40776638c327a3a9deec1bc0396f3d737 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:48:01 +0100 Subject: [PATCH 02/17] Proto/Michelson: remove never_key --- src/proto_alpha/lib_protocol/script_ir_translator.ml | 3 +-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 573cc6575b54..f8a055573b5c 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1041,8 +1041,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_unit, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty unit_t, ctxt) | Prim (loc, T_never, [], annot) -> - check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty never_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty never_t, ctxt) | Prim (loc, T_int, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty int_key, ctxt) | Prim (loc, T_nat, [], annot) -> diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index a72657b1bcc7..722efdfa1e8f 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -2001,8 +2001,6 @@ let chain_id_key = chain_id_t let never_t = Never_t -let never_key = never_t - let bls12_381_g1_t = Bls12_381_g1_t let bls12_381_g2_t = Bls12_381_g2_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index a63206910afa..66f0282e2d3d 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val never_key : never comparable_ty - val int_key : z num comparable_ty val nat_key : n num comparable_ty -- GitLab From 51ad3a6d9887bc90985cfd792c9d81c68592fd48 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:51:44 +0100 Subject: [PATCH 03/17] Proto/Michelson: remove int_key --- .../lib_benchmark/michelson_samplers.ml | 2 +- .../interpreter_benchmarks.ml | 85 +++++++++---------- .../lib_benchmarks_proto/michelson_types.ml | 2 - .../lib_benchmarks_proto/ticket_benchmarks.ml | 2 +- .../lib_protocol/script_ir_translator.ml | 2 +- .../lib_protocol/script_typed_ir.ml | 2 - .../lib_protocol/script_typed_ir.mli | 2 - .../test/integration/gas/test_gas_costs.ml | 6 +- .../michelson/test_ticket_accounting.ml | 34 ++++---- .../test_ticket_lazy_storage_diff.ml | 2 +- .../michelson/test_ticket_operations_diff.ml | 6 +- .../michelson/test_ticket_scanner.ml | 2 +- 12 files changed, 68 insertions(+), 79 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 85c2351eaecd..e7a98a323359 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -327,7 +327,7 @@ end) | `TTimestamp -> Ex_comparable_ty timestamp_key | `TKey_hash -> Ex_comparable_ty key_hash_key | `TMutez -> Ex_comparable_ty mutez_key - | `TInt -> Ex_comparable_ty int_key + | `TInt -> Ex_comparable_ty int_t | `TUnit -> Ex_comparable_ty unit_t | `TSignature -> Ex_comparable_ty signature_key | `TKey -> Ex_comparable_ty key_key diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index 5d708f84a677..c7c317d6c33a 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -1123,7 +1123,7 @@ module Registration_section = struct let set_iter_code = ISet_iter - ( kinfo (set int_cmp @$ unit @$ bot), + ( kinfo (set int @$ unit @$ bot), IDrop (kinfo (int @$ unit @$ bot), halt_unit), halt_unit ) @@ -1140,7 +1140,7 @@ module Registration_section = struct *) simple_benchmark ~name:Interpreter_workload.N_ISet_iter - ~intercept_stack:(Script_set.empty int_cmp, ((), eos)) + ~intercept_stack:(Script_set.empty int, ((), eos)) ~kinstr:set_iter_code () @@ -1149,9 +1149,8 @@ module Registration_section = struct ~name:Interpreter_workload.N_ISet_mem ~kinstr: (ISet_mem - ( kinfo (int @$ set int_cmp @$ unit @$ bot), - halt (bool @$ unit @$ bot) )) - ~intercept_stack:(Script_int.zero, (Script_set.empty int_cmp, ((), eos))) + (kinfo (int @$ set int @$ unit @$ bot), halt (bool @$ unit @$ bot))) + ~intercept_stack:(Script_int.zero, (Script_set.empty int, ((), eos))) ~stack_sampler:(fun cfg rng_state () -> assert (cfg.sampler.set_size.min >= 1) ; let n = @@ -1163,7 +1162,7 @@ module Registration_section = struct let set = List.fold_left (fun set elt -> Script_set.update elt true set) - (Script_set.empty int_cmp) + (Script_set.empty int) elts in let elt = @@ -1178,10 +1177,8 @@ module Registration_section = struct ~name:Interpreter_workload.N_ISet_update ~kinstr: (ISet_update - ( kinfo (int @$ bool @$ set int_cmp @$ bot), - halt (set int_cmp @$ bot) )) - ~intercept_stack: - (Script_int.zero, (false, (Script_set.empty int_cmp, eos))) + (kinfo (int @$ bool @$ set int @$ bot), halt (set int @$ bot))) + ~intercept_stack:(Script_int.zero, (false, (Script_set.empty int, eos))) ~stack_sampler:(fun cfg rng_state () -> assert (cfg.sampler.set_size.min >= 2) ; let n = @@ -1196,7 +1193,7 @@ module Registration_section = struct let set = List.fold_left (fun set elt -> Script_set.update elt true set) - (Script_set.empty int_cmp) + (Script_set.empty int) in_set in let stack = @@ -1229,7 +1226,7 @@ module Registration_section = struct let map = List.fold_left (fun map i -> Script_map.update i (Some ()) map) - (Script_map.empty int_cmp) + (Script_map.empty int) keys in let (module M) = Script_map.get_module map in @@ -1249,16 +1246,16 @@ module Registration_section = struct (* let map_map_code = IMap_map - ( kinfo (map int_cmp unit @$ unit @$ bot), + ( kinfo (map int unit @$ unit @$ bot), ICdr (kinfo (cpair int unit @$ unit @$ bot), halt_unitunit), - halt (map int_cmp unit @$ unit @$ bot) ) + halt (map int unit @$ unit @$ bot) ) *) let map_map_code = IMap_map - ( kinfo (map int_cmp unit @$ unit @$ bot), + ( kinfo (map int unit @$ unit @$ bot), IFailwith (kinfo (cpair int unit @$ unit @$ bot), 0, cpair int unit), - halt (map int_cmp unit @$ unit @$ bot) ) + halt (map int unit @$ unit @$ bot) ) let () = (* @@ -1270,14 +1267,14 @@ module Registration_section = struct simple_benchmark ~name:Interpreter_workload.N_IMap_map ~intercept_stack: - (let map = Script_map.empty int_cmp in + (let map = Script_map.empty int in (map, ((), eos))) ~kinstr:map_map_code () let kmap_iter_code = IMap_iter - ( kinfo (map int_cmp unit @$ unit @$ bot), + ( kinfo (map int unit @$ unit @$ bot), IDrop (kinfo (cpair int unit @$ unit @$ bot), halt_unit), halt_unit ) @@ -1291,7 +1288,7 @@ module Registration_section = struct simple_benchmark ~name:Interpreter_workload.N_IMap_iter ~intercept_stack: - (let map = Script_map.empty int_cmp in + (let map = Script_map.empty int in (map, ((), eos))) ~kinstr:kmap_iter_code () @@ -1306,10 +1303,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IMap_mem ~kinstr: (IMap_mem - ( kinfo (int @$ map int_cmp unit @$ unit @$ bot), + ( kinfo (int @$ map int unit @$ unit @$ bot), halt (bool @$ unit @$ bot) )) ~intercept_stack: - (let map = Script_map.empty int_cmp in + (let map = Script_map.empty int in (Script_int.zero, (map, ((), eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_map_and_key_in_map cfg rng_state in @@ -1326,10 +1323,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IMap_get ~kinstr: (IMap_get - ( kinfo (int @$ map int_cmp unit @$ unit @$ bot), + ( kinfo (int @$ map int unit @$ unit @$ bot), halt (option unit @$ unit @$ bot) )) ~intercept_stack: - (let map = Script_map.empty int_cmp in + (let map = Script_map.empty int in (Script_int.zero, (map, ((), eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_map_and_key_in_map cfg rng_state in @@ -1346,10 +1343,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IMap_update ~kinstr: (IMap_update - ( kinfo (int @$ option unit @$ map int_cmp unit @$ bot), - halt (map int_cmp unit @$ bot) )) + ( kinfo (int @$ option unit @$ map int unit @$ bot), + halt (map int unit @$ bot) )) ~intercept_stack: - (let map = Script_map.empty int_cmp in + (let map = Script_map.empty int in (Script_int.zero, (None, (map, eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_map_and_key_in_map cfg rng_state in @@ -1367,10 +1364,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IMap_get_and_update ~kinstr: (IMap_get_and_update - ( kinfo (int @$ option unit @$ map int_cmp unit @$ bot), - halt (option unit @$ map int_cmp unit @$ bot) )) + ( kinfo (int @$ option unit @$ map int unit @$ bot), + halt (option unit @$ map int unit @$ bot) )) ~intercept_stack: - (let map = Script_map.empty int_cmp in + (let map = Script_map.empty int in (Script_int.zero, (None, (map, eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_map_and_key_in_map cfg rng_state in @@ -1386,9 +1383,9 @@ module Registration_section = struct *) simple_benchmark_with_stack_sampler ~name:Interpreter_workload.N_IMap_size - ~kinstr:(IMap_size (kinfo (map int_cmp unit @$ bot), halt (nat @$ bot))) + ~kinstr:(IMap_size (kinfo (map int unit @$ bot), halt (nat @$ bot))) ~stack_sampler:(fun _cfg _rng_state -> - let map = Script_map.empty int_cmp in + let map = Script_map.empty int in fun () -> (map, eos)) () end @@ -1403,7 +1400,7 @@ module Registration_section = struct let map = List.fold_left (fun map i -> Script_map.update i (Some (Some ())) map) - (Script_map.empty int_cmp) + (Script_map.empty int) keys in let (module M) = Script_map.get_module map in @@ -1415,9 +1412,7 @@ module Registration_section = struct raise_if_error (Lwt_main.run ( Execution_context.make ~rng_state >>=? fun (ctxt, _) -> - let big_map = - Script_ir_translator.empty_big_map int_cmp unit_t - in + let big_map = Script_ir_translator.empty_big_map int unit_t in Script_map.fold (fun k v acc -> acc >>=? fun (bm, ctxt_acc) -> @@ -1448,7 +1443,7 @@ module Registration_section = struct ~name:Interpreter_workload.N_IBig_map_mem ~kinstr: (IBig_map_mem - ( kinfo (int @$ big_map int_cmp unit @$ unit @$ bot), + ( kinfo (int @$ big_map int unit @$ unit @$ bot), halt (bool @$ unit @$ bot) )) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_big_map_and_key_in_map cfg rng_state in @@ -1465,10 +1460,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IBig_map_get ~kinstr: (IBig_map_get - ( kinfo (int @$ big_map int_cmp unit @$ unit @$ bot), + ( kinfo (int @$ big_map int unit @$ unit @$ bot), halt (option unit @$ unit @$ bot) )) ~intercept_stack: - (let map = Script_ir_translator.empty_big_map int_cmp unit in + (let map = Script_ir_translator.empty_big_map int unit in (Script_int.zero, (map, ((), eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_big_map_and_key_in_map cfg rng_state in @@ -1485,10 +1480,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IBig_map_update ~kinstr: (IBig_map_update - ( kinfo (int @$ option unit @$ big_map int_cmp unit @$ bot), - halt (big_map int_cmp unit @$ bot) )) + ( kinfo (int @$ option unit @$ big_map int unit @$ bot), + halt (big_map int unit @$ bot) )) ~intercept_stack: - (let map = Script_ir_translator.empty_big_map int_cmp unit in + (let map = Script_ir_translator.empty_big_map int unit in (Script_int.zero, (None, (map, eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_big_map_and_key_in_map cfg rng_state in @@ -1506,10 +1501,10 @@ module Registration_section = struct ~name:Interpreter_workload.N_IBig_map_get_and_update ~kinstr: (IBig_map_get_and_update - ( kinfo (int @$ option unit @$ big_map int_cmp unit @$ bot), - halt (option unit @$ big_map int_cmp unit @$ bot) )) + ( kinfo (int @$ option unit @$ big_map int unit @$ bot), + halt (option unit @$ big_map int unit @$ bot) )) ~intercept_stack: - (let map = Script_ir_translator.empty_big_map int_cmp unit in + (let map = Script_ir_translator.empty_big_map int unit in (Script_int.zero, (None, (map, eos)))) ~stack_sampler:(fun cfg rng_state () -> let (key, map) = generate_big_map_and_key_in_map cfg rng_state in @@ -3047,7 +3042,7 @@ module Registration_section = struct let map_enter_body_code = let kbody = ICdr (kinfo (cpair int unit @$ unit @$ bot), halt_unitunit) in - fun accu -> KMap_enter_body (kbody, accu, Script_map.empty int_cmp, KNil) + fun accu -> KMap_enter_body (kbody, accu, Script_map.empty int, KNil) let () = (* diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index 33641e55126e..6886edc11336 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -34,8 +34,6 @@ let bot = Bot_t let unit = unit_t -let int_cmp = int_key - let string_cmp = string_key (* the type of integers *) diff --git a/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml index a298d2522e26..46df2541fd29 100644 --- a/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml @@ -169,7 +169,7 @@ let () = Registration_helpers.register (module Compare_key_contract_benchmark) (* A simple ticket type for use in the benchmarks. *) let ticket_ty = let open Script_typed_ir in - WithExceptions.Result.get_ok ~loc:__LOC__ (ticket_t (-1) int_key) + WithExceptions.Result.get_ok ~loc:__LOC__ (ticket_t (-1) int_t) (* A dummy type generator, sampling linear terms of a given size. The generator always returns types of the shape: diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index f8a055573b5c..dc59ccd1ae9c 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1043,7 +1043,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_never, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty never_t, ctxt) | Prim (loc, T_int, [], annot) -> - check_type_annot loc annot >|? fun () -> (Ex_comparable_ty int_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty int_t, ctxt) | Prim (loc, T_nat, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty nat_key, ctxt) | Prim (loc, T_signature, [], annot) -> diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 722efdfa1e8f..6412e2457248 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1844,8 +1844,6 @@ let unit_t = Unit_t let int_t = Int_t -let int_key = int_t - let nat_t = Nat_t let nat_key = nat_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 66f0282e2d3d..89c42a7553ae 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val int_key : z num comparable_ty - val nat_key : n num comparable_ty val signature_key : signature comparable_ty diff --git a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml index 1f35489e4703..ab5546d1fe6b 100644 --- a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml +++ b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml @@ -45,11 +45,11 @@ let forty_two_n = Script_int.abs forty_two let dummy_set = let open Script_set in - update forty_two true (empty Script_typed_ir.int_key) + update forty_two true (empty Script_typed_ir.int_t) let dummy_map = let open Script_map in - update forty_two (Some forty_two) (empty Script_typed_ir.int_key) + update forty_two (Some forty_two) (empty Script_typed_ir.int_t) let dummy_timestamp = Script_timestamp.of_zint (Z.of_int 42) @@ -148,7 +148,7 @@ let all_interpreter_costs = ("dipn", dipn 42); ("dropn", dropn 42); ("neq", neq); - ("compare", compare Script_typed_ir.int_key forty_two forty_two); + ("compare", compare Script_typed_ir.int_t forty_two forty_two); ( "concat_string_precheck", concat_string_precheck Script_list.(cons "42" empty) ); ("concat_string", concat_string (S.safe_int 42)); diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml index 76d0586a66f5..8cd2b60ec063 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml @@ -488,11 +488,11 @@ let test_diffs_empty () = let open Script_typed_ir in let* (_contract, ctxt) = init () in let*? int_ticket_big_map_ty = - big_map_type ~key_type:int_key ~value_type:ticket_string_type + big_map_type ~key_type:int_t ~value_type:ticket_string_type in (* Start with an empty big-map *) let* (empty_big_map, ctxt) = - empty_big_map ctxt ~key_type:int_key ~value_type:ticket_string_type + empty_big_map ctxt ~key_type:int_t ~value_type:ticket_string_type in assert_ticket_diffs ctxt @@ -623,17 +623,17 @@ let test_diffs_lazy_storage_alloc () = let open Script_typed_ir in let* (_contract, ctxt) = init () in let*? int_ticket_big_map_ty = - big_map_type ~key_type:int_key ~value_type:ticket_string_type + big_map_type ~key_type:int_t ~value_type:ticket_string_type in (* Start with an empty big-map *) let* (empty_big_map, ctxt) = - empty_big_map ctxt ~key_type:int_key ~value_type:ticket_string_type + empty_big_map ctxt ~key_type:int_t ~value_type:ticket_string_type in (* We add one ticket to the storage. *) let* (lazy_storage_diff, ctxt) = alloc_diff ctxt - ~key_type:int_key + ~key_type:int_t ~value_type:ticket_string_type [ ( Script_int.of_int 1, @@ -657,18 +657,18 @@ let test_diffs_remove_from_big_map () = let open Script_typed_ir in let* (contract, ctxt) = init () in let*? int_ticket_big_map_ty = - big_map_type ~key_type:int_key ~value_type:ticket_string_type + big_map_type ~key_type:int_t ~value_type:ticket_string_type in (* Start with an empty big-map *) let* (empty_big_map, ctxt) = - empty_big_map ctxt ~key_type:int_key ~value_type:ticket_string_type + empty_big_map ctxt ~key_type:int_t ~value_type:ticket_string_type in (* Remove one ticket from the lazy storage. *) let* (lazy_storage_diff, ctxt) = remove_diff ctxt contract - ~key_type:int_key + ~key_type:int_t ~value_type:ticket_string_type ~existing_entries: [ @@ -693,18 +693,18 @@ let test_diffs_copy_big_map () = let open Script_typed_ir in let* (contract, ctxt) = init () in let*? int_ticket_big_map_ty = - big_map_type ~key_type:int_key ~value_type:ticket_string_type + big_map_type ~key_type:int_t ~value_type:ticket_string_type in (* Start with an empty big-map *) let* (empty_big_map, ctxt) = - empty_big_map ctxt ~key_type:int_key ~value_type:ticket_string_type + empty_big_map ctxt ~key_type:int_t ~value_type:ticket_string_type in (* We add one ticket to the storage. *) let* (lazy_storage_diff, ctxt) = copy_diff ctxt contract - ~key_type:int_key + ~key_type:int_t ~value_type:ticket_string_type ~existing_entries: [ @@ -742,13 +742,13 @@ let test_diffs_add_to_existing_big_map () = let open Script_typed_ir in let* (contract, ctxt) = init () in let*? int_ticket_big_map_ty = - big_map_type ~key_type:int_key ~value_type:ticket_string_type + big_map_type ~key_type:int_t ~value_type:ticket_string_type in let* (old_storage, ctxt) = make_big_map ctxt contract - ~key_type:int_key + ~key_type:int_t ~value_type:ticket_string_type [ (* It doesn't matter what the old entries are. They are never traversed *) @@ -765,7 +765,7 @@ let test_diffs_add_to_existing_big_map () = existing_diff ctxt contract - ~key_type:int_key + ~key_type:int_t ~value_type:ticket_string_type ~existing_entries: [ @@ -806,14 +806,14 @@ let test_diffs_args_storage_and_lazy_diffs () = let open Script_typed_ir in let* (contract, ctxt) = init () in let*? int_ticket_big_map_ty = - big_map_type ~key_type:int_key ~value_type:ticket_string_type + big_map_type ~key_type:int_t ~value_type:ticket_string_type in let*? (Ty_ex_c list_big_map_pair_type) = Environment.wrap_tzresult @@ pair_t (-1) ticket_string_list_type int_ticket_big_map_ty in let* (empty_big_map, ctxt) = - empty_big_map ctxt ~key_type:int_key ~value_type:ticket_string_type + empty_big_map ctxt ~key_type:int_t ~value_type:ticket_string_type in (* We send two tickets in the args. *) let arg = @@ -828,7 +828,7 @@ let test_diffs_args_storage_and_lazy_diffs () = existing_diff ctxt contract - ~key_type:int_key + ~key_type:int_t ~value_type:ticket_string_type ~existing_entries:[] ~updates: diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml index bbf5b4827362..c9818c6eb9b2 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml @@ -112,7 +112,7 @@ let updates_of_key_values ctxt key_values = wrap (Script_ir_translator.hash_comparable_data ctxt - Script_typed_ir.int_key + Script_typed_ir.int_t (Script_int.of_int key)) in return diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml index 668aefffca4f..be60ac824c74 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml @@ -59,7 +59,7 @@ let big_map_updates_of_key_values ctxt key_values = wrap (Script_ir_translator.hash_comparable_data ctxt - Script_typed_ir.int_key + Script_typed_ir.int_t (Script_int.of_int key)) in return @@ -1099,14 +1099,14 @@ let test_transfer_big_map_with_tickets () = in let*? parameters_ty = Environment.wrap_tzresult - @@ big_map_t Micheline.dummy_location int_key value_type + @@ big_map_t Micheline.dummy_location int_t value_type in let parameters = Big_map { id = Some big_map_id; diff = {map = Big_map_overlay.empty; size = 0}; - key_type = int_key; + key_type = int_t; value_type; } in diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml index 427c0bbd835a..a1601223180d 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml @@ -184,7 +184,7 @@ let tickets_from_big_map_ref ~pre_populated value_exp = wrap @@ Script_ir_translator.hash_comparable_data ctxt - Script_typed_ir.int_key + Script_typed_ir.int_t (Script_int.of_int key) in return -- GitLab From f37c537952fbbbb933f3b17091790f13f5880176 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:54:09 +0100 Subject: [PATCH 04/17] Proto/Michelson: remove nat_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 4 ++-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- .../test/integration/michelson/test_typechecking.ml | 8 +++----- .../test/integration/operations/test_tx_rollup.ml | 2 +- 6 files changed, 7 insertions(+), 13 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index e7a98a323359..040dc9c65576 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -319,7 +319,7 @@ end) Script_ir_translator.ex_comparable_ty = match cmp_tn with | `TString -> Ex_comparable_ty string_key - | `TNat -> Ex_comparable_ty nat_key + | `TNat -> Ex_comparable_ty nat_t | `TBytes -> Ex_comparable_ty bytes_key | `TBool -> Ex_comparable_ty bool_key | `TAddress -> Ex_comparable_ty address_key diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index dc59ccd1ae9c..d0af68810b5e 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1045,7 +1045,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_int, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty int_t, ctxt) | Prim (loc, T_nat, [], annot) -> - check_type_annot loc annot >|? fun () -> (Ex_comparable_ty nat_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty nat_t, ctxt) | Prim (loc, T_signature, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty signature_key, ctxt) @@ -2046,7 +2046,7 @@ let parse_uint11 = parse_uint ~nb_bits:11 (* This type is used to: - serialize and deserialize tickets when they are stored or transferred, - type the READ_TICKET instruction. *) -let opened_ticket_type loc ty = pair_3_key loc address_key ty nat_key +let opened_ticket_type loc ty = pair_3_key loc address_key ty nat_t (* -- parse data of primitive types -- *) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 6412e2457248..df345c59b227 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1846,8 +1846,6 @@ let int_t = Int_t let nat_t = Nat_t -let nat_key = nat_t - let signature_t = Signature_t let signature_key = signature_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 89c42a7553ae..03fdf1c488cf 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val nat_key : n num comparable_ty - val signature_key : signature comparable_ty val string_key : Script_string.t comparable_ty diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml index be2a0ae79b15..cf16b3d94e20 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml @@ -307,7 +307,7 @@ let test_unparse_comb_comparable_type () = let open Script in let open Script_typed_ir in let nat_prim = Prim ((), T_nat, [], []) in - let nat_ty = nat_key in + let nat_ty = nat_t in let pair_prim l = Prim ((), T_pair, l, []) in let pair_ty ty1 ty2 = pair_key (-1) ty1 ty2 in let pair_prim2 a b = pair_prim [a; b] in @@ -381,7 +381,7 @@ let test_parse_comb_data () = let pair_prim2 a b = pair_prim [a; b] in let pair_z_z_prim = pair_prim2 z_prim z_prim in list_t (-1) nat_ty >>??= fun list_nat_ty -> - big_map_t (-1) nat_key nat_ty >>??= fun big_map_nat_nat_ty -> + big_map_t (-1) nat_ty nat_ty >>??= fun big_map_nat_nat_ty -> test_context_with_nat_nat_big_map () >>=? fun (ctxt, big_map_id) -> (* Pair 0 0 *) test_parse_data __LOC__ ctxt pair_nat_nat_ty pair_z_z_prim (z, z) @@ -452,9 +452,7 @@ let test_parse_comb_data () = let expected_big_map = let open Script_typed_ir in let diff = {map = Big_map_overlay.empty; size = 0} in - let nat_key_ty = nat_key in - Big_map - {id = Some big_map_id; diff; key_type = nat_key_ty; value_type = nat_ty} + Big_map {id = Some big_map_id; diff; key_type = nat_ty; value_type = nat_ty} in let ty_equal : type a ac1 ac2. diff --git a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml index 06659ba01254..7843633c3095 100644 --- a/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml +++ b/src/proto_alpha/lib_protocol/test/integration/operations/test_tx_rollup.ml @@ -491,7 +491,7 @@ module Nat_ticket = struct @@ Script_int.(of_int contents_nat |> is_nat) in Ticket_token.Ex_token - {ticketer; contents_type = Script_typed_ir.nat_key; contents} + {ticketer; contents_type = Script_typed_ir.nat_t; contents} let contents = Expr.from_string (string_of_int contents_nat) -- GitLab From ebe3880d5094542934605eec26cb961a2fa7a876 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:55:19 +0100 Subject: [PATCH 05/17] Proto/Michelson: remove signature_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 040dc9c65576..8a35489b584b 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -329,7 +329,7 @@ end) | `TMutez -> Ex_comparable_ty mutez_key | `TInt -> Ex_comparable_ty int_t | `TUnit -> Ex_comparable_ty unit_t - | `TSignature -> Ex_comparable_ty signature_key + | `TSignature -> Ex_comparable_ty signature_t | `TKey -> Ex_comparable_ty key_key | `TChain_id -> Ex_comparable_ty chain_id_key diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index d0af68810b5e..8d455ff968ba 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1048,7 +1048,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : check_type_annot loc annot >|? fun () -> (Ex_comparable_ty nat_t, ctxt) | Prim (loc, T_signature, [], annot) -> check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty signature_key, ctxt) + (Ex_comparable_ty signature_t, ctxt) | Prim (loc, T_string, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty string_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index df345c59b227..f868322094a0 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1848,8 +1848,6 @@ let nat_t = Nat_t let signature_t = Signature_t -let signature_key = signature_t - let string_t = String_t let string_key = string_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 03fdf1c488cf..6b1fdad18a60 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val signature_key : signature comparable_ty - val string_key : Script_string.t comparable_ty val bytes_key : Bytes.t comparable_ty -- GitLab From 0b994c3a2505ff95550abda25e61b65bfd358ce1 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:57:04 +0100 Subject: [PATCH 06/17] Proto/Michelson: remove string_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- .../lib_benchmarks_proto/interpreter_benchmarks.ml | 8 ++++---- src/proto_alpha/lib_benchmarks_proto/michelson_types.ml | 2 -- src/proto_alpha/lib_protocol/script_ir_translator.ml | 4 ++-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- .../test/integration/michelson/test_ticket_accounting.ml | 4 ++-- .../test/integration/michelson/test_ticket_balance.ml | 2 +- .../integration/michelson/test_ticket_operations_diff.ml | 8 ++++---- 9 files changed, 14 insertions(+), 20 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 8a35489b584b..a64dcf0cbdb3 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -318,7 +318,7 @@ end) (cmp_tn : 'a comparable_and_atomic) : Script_ir_translator.ex_comparable_ty = match cmp_tn with - | `TString -> Ex_comparable_ty string_key + | `TString -> Ex_comparable_ty string_t | `TNat -> Ex_comparable_ty nat_t | `TBytes -> Ex_comparable_ty bytes_key | `TBool -> Ex_comparable_ty bool_key diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index c7c317d6c33a..632fd4831fac 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -2706,11 +2706,11 @@ module Registration_section = struct () let join_tickets_instr = - let ticket_str = ticket string_cmp in + let ticket_str = ticket string in let (Ty_ex_c pair_ticket_str_ticket_str) = pair ticket_str ticket_str in IJoin_tickets ( kinfo (pair_ticket_str_ticket_str @$ bot), - string_cmp, + string, halt (option ticket_str @$ bot) ) let () = @@ -2723,7 +2723,7 @@ module Registration_section = struct in fun () -> let ticket = - Samplers.Random_value.value (ticket string_cmp) rng_state + Samplers.Random_value.value (ticket string) rng_state in let ticket = { @@ -2745,7 +2745,7 @@ module Registration_section = struct in fun () -> let ticket = - Samplers.Random_value.value (ticket string_cmp) rng_state + Samplers.Random_value.value (ticket string) rng_state in let alt_amount = Samplers.Random_value.value nat rng_state in let ticket' = {ticket with amount = alt_amount} in diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index 6886edc11336..b94a73ff1fea 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -34,8 +34,6 @@ let bot = Bot_t let unit = unit_t -let string_cmp = string_key - (* the type of integers *) let int = int_t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 8d455ff968ba..82f68e3828f8 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1051,7 +1051,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : (Ex_comparable_ty signature_t, ctxt) | Prim (loc, T_string, [], annot) -> check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty string_key, ctxt) + (Ex_comparable_ty string_t, ctxt) | Prim (loc, T_bytes, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty bytes_key, ctxt) @@ -5190,7 +5190,7 @@ and parse_toplevel : let allowed = [K_parameter; K_storage; K_code; K_view] in error (Invalid_primitive (loc, allowed, name)) in - find_fields ctxt None None None (Script_map.empty string_key) fields + find_fields ctxt None None None (Script_map.empty string_t) fields >>? fun (ctxt, toplevel) -> match toplevel with | (None, _, _, _) -> error (Missing_field K_parameter) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index f868322094a0..f801e6ed6505 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1850,8 +1850,6 @@ let signature_t = Signature_t let string_t = String_t -let string_key = string_t - let bytes_t = Bytes_t let bytes_key = bytes_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 6b1fdad18a60..14cd4b40730e 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val string_key : Script_string.t comparable_ty - val bytes_key : Bytes.t comparable_ty val mutez_key : Tez.t comparable_ty diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml index 8cd2b60ec063..b5927986155f 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml @@ -413,7 +413,7 @@ let transfer_operation ctxt ~src ~destination ~arg_type ~arg = let ticket_string_type = WithExceptions.Result.get_ok ~loc:__LOC__ - @@ Script_typed_ir.(ticket_t (-1) string_key) + @@ Script_typed_ir.(ticket_t (-1) string_t) let ticket_string_list_type = Result.value_f ~default:(fun _ -> assert false) @@ -481,7 +481,7 @@ let string_ticket_token ticketer content = let*? ticketer = Environment.wrap_tzresult @@ Contract.of_b58check ticketer in return (Ticket_token.Ex_token - {ticketer; contents_type = Script_typed_ir.string_key; contents}) + {ticketer; contents_type = Script_typed_ir.string_t; contents}) let test_diffs_empty () = let open Lwt_tzresult_syntax in diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml index 0f673614defe..ca33275908f7 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_balance.ml @@ -157,7 +157,7 @@ let string_token ~ticketer content = WithExceptions.Result.get_ok ~loc:__LOC__ @@ Script_string.of_string content in Ticket_token.Ex_token - {ticketer; contents_type = Script_typed_ir.string_key; contents} + {ticketer; contents_type = Script_typed_ir.string_t; contents} let unit_ticket ~ticketer = Ticket_token.Ex_token diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml index be60ac824c74..f9f07b9491bc 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml @@ -176,7 +176,7 @@ let string_token ~ticketer content = @@ Script_string.of_string content in Ticket_token.Ex_token - {ticketer; contents_type = Script_typed_ir.string_key; contents} + {ticketer; contents_type = Script_typed_ir.string_t; contents} (** Initializes one address for operations and one baker. *) let init ?tx_rollup_enable () = @@ -381,7 +381,7 @@ let ticket_big_map_script = |} let list_ticket_string_ty = - ticket_t Micheline.dummy_location string_key >>? fun ticket_ty -> + ticket_t Micheline.dummy_location string_t >>? fun ticket_ty -> list_t Micheline.dummy_location ticket_ty let make_ticket (ticketer, contents, amount) = @@ -1095,7 +1095,7 @@ let test_transfer_big_map_with_tickets () = in let open Lwt_tzresult_syntax in let*? value_type = - Environment.wrap_tzresult @@ ticket_t Micheline.dummy_location string_key + Environment.wrap_tzresult @@ ticket_t Micheline.dummy_location string_t in let*? parameters_ty = Environment.wrap_tzresult @@ -1154,7 +1154,7 @@ let test_tx_rollup_deposit_one_ticket () = let* incr = Incremental.add_operation incr operation in let*? ticket_ty = - Script_typed_ir.(ticket_t Micheline.dummy_location string_key) + Script_typed_ir.(ticket_t Micheline.dummy_location string_t) |> Environment.wrap_tzresult in let*? (Ty_ex_c parameters_ty) = -- GitLab From 1b77e31a7070b3816e1ada7964f0d5249a95bf8a Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:58:07 +0100 Subject: [PATCH 07/17] Proto/Michelson: remove bytes_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 3 +-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index a64dcf0cbdb3..181f9539d2aa 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -320,7 +320,7 @@ end) match cmp_tn with | `TString -> Ex_comparable_ty string_t | `TNat -> Ex_comparable_ty nat_t - | `TBytes -> Ex_comparable_ty bytes_key + | `TBytes -> Ex_comparable_ty bytes_t | `TBool -> Ex_comparable_ty bool_key | `TAddress -> Ex_comparable_ty address_key | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 82f68e3828f8..5f20055c7c81 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1053,8 +1053,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : check_type_annot loc annot >|? fun () -> (Ex_comparable_ty string_t, ctxt) | Prim (loc, T_bytes, [], annot) -> - check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty bytes_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty bytes_t, ctxt) | Prim (loc, T_mutez, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty mutez_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index f801e6ed6505..d8bfe5241905 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1852,8 +1852,6 @@ let string_t = String_t let bytes_t = Bytes_t -let bytes_key = bytes_t - let mutez_t = Mutez_t let mutez_key = mutez_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 14cd4b40730e..a61cf43b0a80 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val bytes_key : Bytes.t comparable_ty - val mutez_key : Tez.t comparable_ty val bool_key : bool comparable_ty -- GitLab From 57151ac6bed37d716d1590cbe4f67cac293fa4ce Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:58:53 +0100 Subject: [PATCH 08/17] Proto/Michelson: remove mutez_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 3 +-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 181f9539d2aa..9bfb7ae42dc6 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -326,7 +326,7 @@ end) | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key | `TTimestamp -> Ex_comparable_ty timestamp_key | `TKey_hash -> Ex_comparable_ty key_hash_key - | `TMutez -> Ex_comparable_ty mutez_key + | `TMutez -> Ex_comparable_ty mutez_t | `TInt -> Ex_comparable_ty int_t | `TUnit -> Ex_comparable_ty unit_t | `TSignature -> Ex_comparable_ty signature_t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 5f20055c7c81..640eccff015c 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1055,8 +1055,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_bytes, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty bytes_t, ctxt) | Prim (loc, T_mutez, [], annot) -> - check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty mutez_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty mutez_t, ctxt) | Prim (loc, T_bool, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty bool_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index d8bfe5241905..f97b03e7b7a6 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1854,8 +1854,6 @@ let bytes_t = Bytes_t let mutez_t = Mutez_t -let mutez_key = mutez_t - let key_hash_t = Key_hash_t let key_hash_key = key_hash_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index a61cf43b0a80..b5aca08dc296 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val mutez_key : Tez.t comparable_ty - val bool_key : bool comparable_ty val key_hash_key : public_key_hash comparable_ty -- GitLab From fc96d04135bd1289034c90786dce3103e1462d07 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sat, 26 Feb 2022 23:59:41 +0100 Subject: [PATCH 09/17] Proto/Michelson: remove bool_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 3 +-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 9bfb7ae42dc6..2e057eab81fb 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -321,7 +321,7 @@ end) | `TString -> Ex_comparable_ty string_t | `TNat -> Ex_comparable_ty nat_t | `TBytes -> Ex_comparable_ty bytes_t - | `TBool -> Ex_comparable_ty bool_key + | `TBool -> Ex_comparable_ty bool_t | `TAddress -> Ex_comparable_ty address_key | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key | `TTimestamp -> Ex_comparable_ty timestamp_key diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 640eccff015c..629cc9f0dd7e 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1057,8 +1057,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_mutez, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty mutez_t, ctxt) | Prim (loc, T_bool, [], annot) -> - check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty bool_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty bool_t, ctxt) | Prim (loc, T_key_hash, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty key_hash_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index f97b03e7b7a6..aa57c741042e 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1872,8 +1872,6 @@ let address_key = address_t let bool_t = Bool_t -let bool_key = bool_t - let tx_rollup_l2_address_t = Tx_rollup_l2_address_t let tx_rollup_l2_address_key = tx_rollup_l2_address_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index b5aca08dc296..f8f105fecee1 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val bool_key : bool comparable_ty - val key_hash_key : public_key_hash comparable_ty val key_key : public_key comparable_ty -- GitLab From 8af1165286c23016769f27c4d83e6d29c1fd1ed0 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:00:47 +0100 Subject: [PATCH 10/17] Proto/Michelson: remove key_key and key_hash_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 4 ++-- src/proto_alpha/lib_protocol/script_ir_translator.ml | 4 ++-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 4 ---- src/proto_alpha/lib_protocol/script_typed_ir.mli | 4 ---- 4 files changed, 4 insertions(+), 12 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 2e057eab81fb..171ec86b1e2c 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -325,12 +325,12 @@ end) | `TAddress -> Ex_comparable_ty address_key | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key | `TTimestamp -> Ex_comparable_ty timestamp_key - | `TKey_hash -> Ex_comparable_ty key_hash_key + | `TKey_hash -> Ex_comparable_ty key_hash_t | `TMutez -> Ex_comparable_ty mutez_t | `TInt -> Ex_comparable_ty int_t | `TUnit -> Ex_comparable_ty unit_t | `TSignature -> Ex_comparable_ty signature_t - | `TKey -> Ex_comparable_ty key_key + | `TKey -> Ex_comparable_ty key_t | `TChain_id -> Ex_comparable_ty chain_id_key let rec m_type ~size : Script_ir_translator.ex_ty sampler = diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 629cc9f0dd7e..12b1c40d675c 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1060,9 +1060,9 @@ let[@coq_struct "ty"] rec parse_comparable_ty : check_type_annot loc annot >|? fun () -> (Ex_comparable_ty bool_t, ctxt) | Prim (loc, T_key_hash, [], annot) -> check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty key_hash_key, ctxt) + (Ex_comparable_ty key_hash_t, ctxt) | Prim (loc, T_key, [], annot) -> - check_type_annot loc annot >|? fun () -> (Ex_comparable_ty key_key, ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty key_t, ctxt) | Prim (loc, T_timestamp, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty timestamp_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index aa57c741042e..1bbdac983afd 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1856,12 +1856,8 @@ let mutez_t = Mutez_t let key_hash_t = Key_hash_t -let key_hash_key = key_hash_t - let key_t = Key_t -let key_key = key_t - let timestamp_t = Timestamp_t let timestamp_key = timestamp_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index f8f105fecee1..f4e7f0d8e227 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,10 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val key_hash_key : public_key_hash comparable_ty - -val key_key : public_key comparable_ty - val timestamp_key : Script_timestamp.t comparable_ty val chain_id_key : Script_chain_id.t comparable_ty -- GitLab From c7dedeb69b83229ac7ea5e9ed2ec6ff210b8c76e Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:01:20 +0100 Subject: [PATCH 11/17] Proto/Michelson: remove timestamp_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 171ec86b1e2c..72c30598dc77 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -324,7 +324,7 @@ end) | `TBool -> Ex_comparable_ty bool_t | `TAddress -> Ex_comparable_ty address_key | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key - | `TTimestamp -> Ex_comparable_ty timestamp_key + | `TTimestamp -> Ex_comparable_ty timestamp_t | `TKey_hash -> Ex_comparable_ty key_hash_t | `TMutez -> Ex_comparable_ty mutez_t | `TInt -> Ex_comparable_ty int_t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 12b1c40d675c..5f77fbd41700 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1065,7 +1065,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : check_type_annot loc annot >|? fun () -> (Ex_comparable_ty key_t, ctxt) | Prim (loc, T_timestamp, [], annot) -> check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty timestamp_key, ctxt) + (Ex_comparable_ty timestamp_t, ctxt) | Prim (loc, T_chain_id, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty chain_id_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 1bbdac983afd..f44f87b18327 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1860,8 +1860,6 @@ let key_t = Key_t let timestamp_t = Timestamp_t -let timestamp_key = timestamp_t - let address_t = Address_t let address_key = address_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index f4e7f0d8e227..9cf92b48f62b 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val timestamp_key : Script_timestamp.t comparable_ty - val chain_id_key : Script_chain_id.t comparable_ty val address_key : address comparable_ty -- GitLab From 8d2b8ec17d1967a951a30beae410f27634863626 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:02:03 +0100 Subject: [PATCH 12/17] Proto/Michelson: remove chain_id_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 72c30598dc77..3563dbe7edd5 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -331,7 +331,7 @@ end) | `TUnit -> Ex_comparable_ty unit_t | `TSignature -> Ex_comparable_ty signature_t | `TKey -> Ex_comparable_ty key_t - | `TChain_id -> Ex_comparable_ty chain_id_key + | `TChain_id -> Ex_comparable_ty chain_id_t let rec m_type ~size : Script_ir_translator.ex_ty sampler = let open Script_ir_translator in diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 5f77fbd41700..c77dbeb63379 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1068,7 +1068,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : (Ex_comparable_ty timestamp_t, ctxt) | Prim (loc, T_chain_id, [], annot) -> check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty chain_id_key, ctxt) + (Ex_comparable_ty chain_id_t, ctxt) | Prim (loc, T_address, [], annot) -> check_type_annot loc annot >|? fun () -> (Ex_comparable_ty address_key, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index f44f87b18327..e058ed65fe97 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1977,8 +1977,6 @@ let sapling_state_t ~memo_size = Sapling_state_t memo_size let chain_id_t = Chain_id_t -let chain_id_key = chain_id_t - let never_t = Never_t let bls12_381_g1_t = Bls12_381_g1_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 9cf92b48f62b..5dccc35ce1e5 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val chain_id_key : Script_chain_id.t comparable_ty - val address_key : address comparable_ty val tx_rollup_l2_address_key : tx_rollup_l2_address comparable_ty -- GitLab From 66dfbfda355bcc49908007b1148feba1c00849fe Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:02:47 +0100 Subject: [PATCH 13/17] Proto/Michelson: remove address_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 4 ++-- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 3563dbe7edd5..431a71601a47 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -322,7 +322,7 @@ end) | `TNat -> Ex_comparable_ty nat_t | `TBytes -> Ex_comparable_ty bytes_t | `TBool -> Ex_comparable_ty bool_t - | `TAddress -> Ex_comparable_ty address_key + | `TAddress -> Ex_comparable_ty address_t | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key | `TTimestamp -> Ex_comparable_ty timestamp_t | `TKey_hash -> Ex_comparable_ty key_hash_t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index c77dbeb63379..679c5b8175df 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1071,7 +1071,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : (Ex_comparable_ty chain_id_t, ctxt) | Prim (loc, T_address, [], annot) -> check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty address_key, ctxt) + (Ex_comparable_ty address_t, ctxt) | Prim (loc, T_tx_rollup_l2_address, [], annot) -> if Constants.tx_rollup_enable ctxt then check_type_annot loc annot >|? fun () -> @@ -2043,7 +2043,7 @@ let parse_uint11 = parse_uint ~nb_bits:11 (* This type is used to: - serialize and deserialize tickets when they are stored or transferred, - type the READ_TICKET instruction. *) -let opened_ticket_type loc ty = pair_3_key loc address_key ty nat_t +let opened_ticket_type loc ty = pair_3_key loc address_t ty nat_t (* -- parse data of primitive types -- *) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index e058ed65fe97..062ea95a489f 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1862,8 +1862,6 @@ let timestamp_t = Timestamp_t let address_t = Address_t -let address_key = address_t - let bool_t = Bool_t let tx_rollup_l2_address_t = Tx_rollup_l2_address_t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 5dccc35ce1e5..c490b0b8f1bb 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val address_key : address comparable_ty - val tx_rollup_l2_address_key : tx_rollup_l2_address comparable_ty val pair_key : -- GitLab From 74ec77439f51f5ebcdac2ab8c5fb361234cf7702 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:03:33 +0100 Subject: [PATCH 14/17] Proto/Michelson: remove tx_rollup_l2_address_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 -- src/proto_alpha/lib_protocol/script_typed_ir.mli | 2 -- 4 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 431a71601a47..f453a5415ff0 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -323,7 +323,7 @@ end) | `TBytes -> Ex_comparable_ty bytes_t | `TBool -> Ex_comparable_ty bool_t | `TAddress -> Ex_comparable_ty address_t - | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_key + | `TTx_rollup_l2_address -> Ex_comparable_ty tx_rollup_l2_address_t | `TTimestamp -> Ex_comparable_ty timestamp_t | `TKey_hash -> Ex_comparable_ty key_hash_t | `TMutez -> Ex_comparable_ty mutez_t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 679c5b8175df..5a5a5b75e399 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1075,7 +1075,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : | Prim (loc, T_tx_rollup_l2_address, [], annot) -> if Constants.tx_rollup_enable ctxt then check_type_annot loc annot >|? fun () -> - (Ex_comparable_ty tx_rollup_l2_address_key, ctxt) + (Ex_comparable_ty tx_rollup_l2_address_t, ctxt) else error @@ Tx_rollup_addresses_disabled loc | Prim ( loc, diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 062ea95a489f..4a3abedb7234 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1866,8 +1866,6 @@ let bool_t = Bool_t let tx_rollup_l2_address_t = Tx_rollup_l2_address_t -let tx_rollup_l2_address_key = tx_rollup_l2_address_t - let pair_t : type a ac b bc. Script.location -> (a, ac) ty -> (b, bc) ty -> (a, b) pair ty_ex_c tzresult diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index c490b0b8f1bb..14afc0b8d72a 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,8 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val tx_rollup_l2_address_key : tx_rollup_l2_address comparable_ty - val pair_key : Script.location -> 'a comparable_ty -> -- GitLab From 26492234e9383c83225c28ec252a145512485f5d Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:08:16 +0100 Subject: [PATCH 15/17] Proto/Michelson: rename pair_key into `comparable_pair_t` --- .../lib_benchmark/michelson_samplers.ml | 2 +- .../lib_benchmarks_proto/michelson_types.ml | 2 +- .../translator_benchmarks.ml | 4 ++- .../lib_protocol/script_ir_translator.ml | 5 ++-- .../lib_protocol/script_typed_ir.ml | 5 ++-- .../lib_protocol/script_typed_ir.mli | 26 +++++++++---------- .../michelson/test_typechecking.ml | 2 +- 7 files changed, 25 insertions(+), 21 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index f453a5415ff0..7b7d60aea87e 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -455,7 +455,7 @@ end) let size_right = size - size_left in let* (Ex_comparable_ty l) = m_comparable_type ~size:size_left in let* (Ex_comparable_ty r) = m_comparable_type ~size:size_right in - match pair_key (-1) l r with + match comparable_pair_t (-1) l r with | Error _ -> assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index b94a73ff1fea..b9b62487e4b4 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -92,7 +92,7 @@ let pair k1 k2 = (* comparable pair type constructor *) let cpair k1 k2 = - match pair_key (-1) k1 k2 with Error _ -> assert false | Ok t -> t + match comparable_pair_t (-1) k1 k2 with Error _ -> assert false | Ok t -> t (* union type constructor*) let union k1 k2 = diff --git a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml index a4c14e7ee035..2fbb2f6c48dd 100644 --- a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml @@ -652,7 +652,9 @@ let rec dummy_comparable_type_generator size = | Ex_comparable_ty r -> let l = unit_t in Ex_comparable_ty - (match pair_key (-1) l r with Error _ -> assert false | Ok t -> t) + (match comparable_pair_t (-1) l r with + | Error _ -> assert false + | Ok t -> t) module Parse_type_shared = struct type config = {max_size : int} diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 5a5a5b75e399..0983d96fc353 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1098,7 +1098,8 @@ let[@coq_struct "ty"] rec parse_comparable_ty : >>? fun (Ex_comparable_ty right, ctxt) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt left >>? fun (Ex_comparable_ty left, ctxt) -> - pair_key loc left right >|? fun ty -> (Ex_comparable_ty ty, ctxt) + comparable_pair_t loc left right >|? fun ty -> + (Ex_comparable_ty ty, ctxt) | Prim (loc, T_or, [left; right], annot) -> check_type_annot loc annot >>? fun () -> remove_field_annot left >>? fun left -> @@ -2043,7 +2044,7 @@ let parse_uint11 = parse_uint ~nb_bits:11 (* This type is used to: - serialize and deserialize tickets when they are stored or transferred, - type the READ_TICKET instruction. *) -let opened_ticket_type loc ty = pair_3_key loc address_t ty nat_t +let opened_ticket_type loc ty = comparable_pair_3_t loc address_t ty nat_t (* -- parse data of primitive types -- *) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 4a3abedb7234..f4c7863e3e2c 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1875,11 +1875,12 @@ let pair_t : let (Ex_dand cmp) = dand (is_comparable l) (is_comparable r) in Ty_ex_c (Pair_t (l, r, {size}, cmp)) -let pair_key loc l r = +let comparable_pair_t loc l r = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> Pair_t (l, r, {size}, YesYes) -let pair_3_key loc l m r = pair_key loc m r >>? fun r -> pair_key loc l r +let comparable_pair_3_t loc l m r = + comparable_pair_t loc m r >>? fun r -> comparable_pair_t loc l r let union_t : type a ac b bc. diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 14afc0b8d72a..0cbbab4b87c3 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,19 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val pair_key : - Script.location -> - 'a comparable_ty -> - 'b comparable_ty -> - ('a, 'b) pair comparable_ty tzresult - -val pair_3_key : - Script.location -> - 'a comparable_ty -> - 'b comparable_ty -> - 'c comparable_ty -> - ('a, ('b, 'c) pair) pair comparable_ty tzresult - val union_key : Script.location -> 'a comparable_ty -> @@ -1605,6 +1592,19 @@ val bool_t : bool comparable_ty val pair_t : Script.location -> ('a, _) ty -> ('b, _) ty -> ('a, 'b) pair ty_ex_c tzresult +val comparable_pair_t : + Script.location -> + 'a comparable_ty -> + 'b comparable_ty -> + ('a, 'b) pair comparable_ty tzresult + +val comparable_pair_3_t : + Script.location -> + 'a comparable_ty -> + 'b comparable_ty -> + 'c comparable_ty -> + ('a, ('b, 'c) pair) pair comparable_ty tzresult + val union_t : Script.location -> ('a, _) ty -> ('b, _) ty -> ('a, 'b) union ty_ex_c tzresult diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml index cf16b3d94e20..978e10fe7f48 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml @@ -309,7 +309,7 @@ let test_unparse_comb_comparable_type () = let nat_prim = Prim ((), T_nat, [], []) in let nat_ty = nat_t in let pair_prim l = Prim ((), T_pair, l, []) in - let pair_ty ty1 ty2 = pair_key (-1) ty1 ty2 in + let pair_ty ty1 ty2 = comparable_pair_t (-1) ty1 ty2 in let pair_prim2 a b = pair_prim [a; b] in let pair_nat_nat_prim = pair_prim2 nat_prim nat_prim in pair_ty nat_ty nat_ty >>??= fun pair_nat_nat_ty -> -- GitLab From 3453ef694e562b0dc199fac00e0da10c5d01ed94 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:10:52 +0100 Subject: [PATCH 16/17] Proto/Michelson: rename union_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- .../lib_benchmarks_proto/michelson_types.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 3 ++- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.mli | 12 ++++++------ 5 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 7b7d60aea87e..68e08fb8833a 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -467,7 +467,7 @@ end) let size_right = size - size_left in let* (Ex_comparable_ty l) = m_comparable_type ~size:size_left in let* (Ex_comparable_ty r) = m_comparable_type ~size:size_right in - match union_key (-1) l r with + match comparable_union_t (-1) l r with | Error _ -> assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index b9b62487e4b4..95af373691cc 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -100,7 +100,7 @@ let union k1 k2 = (* comparable union type constructor *) let cunion k1 k2 = - match union_key (-1) k1 k2 with Error _ -> assert false | Ok t -> t + match comparable_union_t (-1) k1 k2 with Error _ -> assert false | Ok t -> t let lambda x y = match lambda_t (-1) x y with Error _ -> assert false | Ok t -> t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 0983d96fc353..cc7455592c2c 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1108,7 +1108,8 @@ let[@coq_struct "ty"] rec parse_comparable_ty : >>? fun (Ex_comparable_ty right, ctxt) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt left >>? fun (Ex_comparable_ty left, ctxt) -> - union_key loc left right >|? fun ty -> (Ex_comparable_ty ty, ctxt) + comparable_union_t loc left right >|? fun ty -> + (Ex_comparable_ty ty, ctxt) | Prim (loc, ((T_pair | T_or) as prim), l, _) -> error (Invalid_arity (loc, prim, 2, List.length l)) | Prim (loc, T_option, [t], annot) -> diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index f4c7863e3e2c..42b1978016a7 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1894,7 +1894,7 @@ let union_t : let union_bytes_bool_t = Union_t (bytes_t, bool_t, {size = Type_size.three}, YesYes) -let union_key loc l r = +let comparable_union_t loc l r = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> Union_t (l, r, {size}, YesYes) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 0cbbab4b87c3..7c4467070c4a 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,12 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val union_key : - Script.location -> - 'a comparable_ty -> - 'b comparable_ty -> - ('a, 'b) union comparable_ty tzresult - val option_key : Script.location -> 'v comparable_ty -> 'v option comparable_ty tzresult @@ -1608,6 +1602,12 @@ val comparable_pair_3_t : val union_t : Script.location -> ('a, _) ty -> ('b, _) ty -> ('a, 'b) union ty_ex_c tzresult +val comparable_union_t : + Script.location -> + 'a comparable_ty -> + 'b comparable_ty -> + ('a, 'b) union comparable_ty tzresult + val union_bytes_bool_t : (Bytes.t, bool) union comparable_ty val lambda_t : -- GitLab From ceb5a4d792954740091b0fcc6c85881acab665e0 Mon Sep 17 00:00:00 2001 From: Mehdi Bouaziz Date: Sun, 27 Feb 2022 00:13:03 +0100 Subject: [PATCH 17/17] Proto/Michelson: rename option_key --- src/proto_alpha/lib_benchmark/michelson_samplers.ml | 2 +- src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.ml | 2 +- src/proto_alpha/lib_protocol/script_typed_ir.mli | 6 +++--- .../lib_protocol/test/pbt/test_script_comparison.ml | 4 +++- 5 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 68e08fb8833a..0ced7ddd8a71 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -443,7 +443,7 @@ end) let option_case size = let size = size - 1 in let* (Ex_comparable_ty t) = m_comparable_type ~size in - match option_key (-1) t with + match comparable_option_t (-1) t with | Error _ -> (* what should be done here? *) assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index cc7455592c2c..7036bc9a6aac 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1116,7 +1116,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : check_type_annot loc annot >>? fun () -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt t >>? fun (Ex_comparable_ty t, ctxt) -> - option_key loc t >|? fun ty -> (Ex_comparable_ty ty, ctxt) + comparable_option_t loc t >|? fun ty -> (Ex_comparable_ty ty, ctxt) | Prim (loc, T_option, l, _) -> error (Invalid_arity (loc, T_option, 1, List.length l)) | Prim diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 42b1978016a7..ee7e39bc3e5b 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -1939,7 +1939,7 @@ let option_pair_int_nat_t = {size = Type_size.four}, Yes ) -let option_key loc t = +let comparable_option_t loc t = Type_size.compound1 loc (ty_size t) >|? fun size -> Option_t (t, {size}, Yes) let list_t loc t = diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 7c4467070c4a..87f2c424bb26 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -1554,9 +1554,6 @@ val is_comparable : ('v, 'c) ty -> 'c dbool type 'v ty_ex_c = Ty_ex_c : ('v, _) ty -> 'v ty_ex_c [@@ocaml.unboxed] -val option_key : - Script.location -> 'v comparable_ty -> 'v option comparable_ty tzresult - val unit_t : unit comparable_ty val int_t : z num comparable_ty @@ -1618,6 +1615,9 @@ val lambda_t : val option_t : Script.location -> ('v, 'c) ty -> ('v option, 'c) ty tzresult +val comparable_option_t : + Script.location -> 'v comparable_ty -> 'v option comparable_ty tzresult + val option_mutez_t : Tez.t option comparable_ty val option_string_t : Script_string.t option comparable_ty diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml b/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml index 3031db1659ab..dc0c058730dc 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml @@ -342,7 +342,9 @@ let test_pack_unpack = comparable_data_arbitrary (fun (Ex_comparable_data (ty, x)) -> let oty = - match option_key (-1) ty with Ok ty -> ty | Error _ -> assert false + match comparable_option_t (-1) ty with + | Ok ty -> ty + | Error _ -> assert false in qcheck_eq ~cmp:(Script_comparable.compare_comparable oty) -- GitLab