From 30fc436a6dfd798126a3b0b4ea14d25b92b781ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Rapha=C3=ABl=20Cauderlier?= Date: Tue, 31 Jan 2023 15:20:14 +0100 Subject: [PATCH] Proto/Michelson: internal renaming of "union" into "or" The Michelson type "or" is referred to as "union" in the protocol to avoid clashing with OCaml's keyword "or". This is inconsistent with the way all other Michelson types are treated. This commit renames all occurrences of "union" into "or" except the few ones that would clash with the OCaml keyword (the definition of the type used to interpret "or" in the IR: Script_typed_ir.union and two functions to construct "or" types outside of the protocol: Types.union in lib_benchmarks/lib_benchmark_type_inference and Michelson_types.union in lib_benchmarks_proto) which are renamed to "or_" instead. Co-authored-by: Julien Tesson --- devtools/get_contracts/get_contracts_alpha.ml | 2 +- src/proto_alpha/lib_benchmark/autocomp.ml | 6 +- .../lib_benchmark_type_inference/inference.ml | 24 ++++---- .../mikhailsky.ml | 6 +- .../lib_benchmark_type_inference/type.ml | 10 ++-- .../lib_benchmark_type_inference/type.mli | 4 +- .../lib_benchmark/michelson_samplers.ml | 22 +++---- .../lib_benchmark/michelson_samplers.mli | 2 +- .../lib_benchmark/michelson_samplers_base.mli | 2 +- .../lib_benchmark/mikhailsky_to_michelson.ml | 10 ++-- src/proto_alpha/lib_benchmark/rules.ml | 12 ++-- .../lib_benchmark/test/test_distribution.ml | 6 +- .../interpreter_benchmarks.ml | 8 +-- .../interpreter_workload.ml | 2 +- .../lib_benchmarks_proto/michelson_types.ml | 11 ++-- .../lib_benchmarks_proto/ticket_benchmarks.ml | 2 +- src/proto_alpha/lib_plugin/RPC.ml | 2 +- .../lib_plugin/script_interpreter_logging.ml | 14 ++--- .../lib_protocol/gas_comparable_input_size.ml | 2 +- .../lib_protocol/michelson_v1_gas.ml | 12 ++-- .../lib_protocol/sc_rollup_operations.ml | 4 +- .../lib_protocol/script_comparable.ml | 8 +-- .../lib_protocol/script_interpreter.ml | 2 +- .../lib_protocol/script_interpreter_defs.ml | 2 +- .../lib_protocol/script_ir_translator.ml | 60 +++++++++---------- .../lib_protocol/script_ir_unparser.ml | 14 ++--- .../lib_protocol/script_typed_ir.ml | 55 +++++++++-------- .../lib_protocol/script_typed_ir.mli | 44 +++++++------- .../lib_protocol/script_typed_ir_size.ml | 4 +- .../michelson/test_script_typed_ir_size.ml | 30 +++++----- .../test/pbt/test_script_comparison.ml | 8 +-- .../lib_protocol/ticket_scanner.ml | 16 ++--- tezt/tests/comparable_datatype.ml | 4 +- 33 files changed, 204 insertions(+), 206 deletions(-) diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index e44c612e3f89..f497e407cf44 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -242,7 +242,7 @@ module Proto = struct let g1 = List.map (fun g (v, _) -> g v) @@ find_lambda_tys t1 in let g2 = List.map (fun g (_, v) -> g v) @@ find_lambda_tys t2 in g1 @ g2 - | Union_t (t1, t2, _, _) -> + | Or_t (t1, t2, _, _) -> let g1 = List.map (fun g -> function L v -> g v | R _ -> []) @@ find_lambda_tys t1 diff --git a/src/proto_alpha/lib_benchmark/autocomp.ml b/src/proto_alpha/lib_benchmark/autocomp.ml index a5ffb8cf0e8b..0b3f0d8b62de 100644 --- a/src/proto_alpha/lib_benchmark/autocomp.ml +++ b/src/proto_alpha/lib_benchmark/autocomp.ml @@ -111,9 +111,9 @@ and replace_vars (ty : Type.Base.t) = | Type.Base.Pair_t (lt, rt) -> replace_vars lt >>= fun lt -> replace_vars rt >>= fun rt -> return (Type.pair lt rt) - | Type.Base.Union_t (lt, rt) -> + | Type.Base.Or_t (lt, rt) -> replace_vars lt >>= fun lt -> - replace_vars rt >>= fun rt -> return (Type.union lt rt) + replace_vars rt >>= fun rt -> return (Type.or_ lt rt) | Type.Base.List_t ty -> replace_vars ty >>= fun ty -> return (Type.list ty) | Type.Base.Set_t ty -> replace_vars ty >>= fun ty -> return (Type.set ty) | Type.Base.Map_t (k, v) -> @@ -207,7 +207,7 @@ struct | Pair_t (lty, rty) -> generate_data lty >>= fun lv -> generate_data rty >>= fun rv -> return (Mikhailsky.Data.pair lv rv) - | Union_t (lty, rty) -> + | Or_t (lty, rty) -> sample Base_samplers.uniform_bool >>= fun b -> if b then generate_data lty >>= fun v -> return (Mikhailsky.Data.left v) else generate_data rty >>= fun v -> return (Mikhailsky.Data.right v) diff --git a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/inference.ml b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/inference.ml index 88ba95c8db0f..d8c47801dca3 100644 --- a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/inference.ml +++ b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/inference.ml @@ -345,10 +345,10 @@ and instantiate_base (encountered : S.t) (ty : Type.Base.t) : Type.Base.t M.t = instantiate_base encountered lty >>= fun lty -> instantiate_base encountered rty >>= fun rty -> return (Type.pair lty rty) - | Union_t (lty, rty) -> + | Or_t (lty, rty) -> instantiate_base encountered lty >>= fun lty -> instantiate_base encountered rty >>= fun rty -> - return (Type.union lty rty) + return (Type.or_ lty rty) | Lambda_t (dom, range) -> instantiate_base encountered dom >>= fun dom -> instantiate_base encountered range >>= fun range -> @@ -430,7 +430,7 @@ and unify_base (x : Type.Base.t) (y : Type.Base.t) : unit M.t = unify_base kx ky >>= fun () -> unify_base vx vy | Pair_t (x, x'), Pair_t (y, y') -> unify_base x y >>= fun () -> unify_base x' y' - | Union_t (x, x'), Union_t (y, y') -> + | Or_t (x, x'), Or_t (y, y') -> unify_base x y >>= fun () -> unify_base x' y' | Lambda_t (x, x'), Lambda_t (y, y') -> unify_base x y >>= fun () -> unify_base x' y' @@ -531,7 +531,7 @@ and assert_comparability_aux lower_bound (ty : Type.Base.t) assert_comparability_aux Comparable l encountered >>= fun () -> assert_comparability_aux Comparable r encountered | Unconstrained | Not_comparable -> return ()) - | Union_t (l, r) -> ( + | Or_t (l, r) -> ( match lower_bound with | Comparable -> assert_comparability_aux Comparable l encountered >>= fun () -> @@ -551,7 +551,7 @@ and get_comparability (ty : Type.Base.t) : comparability M.t = return Comparable | List_t _ | Set_t _ | Map_t _ | Lambda_t _ | Key_t -> return Not_comparable | Option_t ty -> get_comparability ty - | Union_t (lt, rt) | Pair_t (lt, rt) -> ( + | Or_t (lt, rt) | Pair_t (lt, rt) -> ( get_comparability lt >>= fun lc -> get_comparability rt >>= fun rc -> match (lc, rc) with @@ -882,26 +882,26 @@ let rec generate_constraints (path : Mikhailsky.Path.t) (node : Mikhailsky.node) exists_stack () >>= fun rest -> unify bef Type.(item (pair a b) rest) >>= fun () -> unify aft Type.(item b rest) - (* Unions *) + (* Ors *) | Prim (_, I_LEFT, [], _) -> exists () >>= fun lt -> exists () >>= fun rt -> exists_stack () >>= fun rest -> unify bef (Type.item lt rest) >>= fun () -> - unify aft Type.(item (union lt rt) rest) >>= fun res -> return res + unify aft Type.(item (or_ lt rt) rest) >>= fun res -> return res | Prim (_, I_RIGHT, [], _) -> exists () >>= fun lt -> exists () >>= fun rt -> exists_stack () >>= fun rest -> unify bef Type.(item rt rest) >>= fun () -> - unify aft Type.(item (union lt rt) rest) + unify aft Type.(item (or_ lt rt) rest) | Prim (_, (I_LEFT | I_RIGHT), _ :: _, _) -> invalid_ast ~msg:__LOC__ path node | Prim (_, I_LOOP_LEFT, [body], _) -> exists () >>= fun l -> exists () >>= fun r -> exists_stack () >>= fun rest -> - unify bef Type.(item (union l r) rest) >>= fun () -> + unify bef Type.(item (or_ l r) rest) >>= fun () -> unify aft Type.(item r rest) >>= fun () -> generate_constraints (Mikhailsky.Path.at_index 0 path) @@ -912,7 +912,7 @@ let rec generate_constraints (path : Mikhailsky.Path.t) (node : Mikhailsky.node) exists () >>= fun a -> exists () >>= fun b -> exists_stack () >>= fun rest -> - unify bef Type.(item (union a b) rest) >>= fun () -> + unify bef Type.(item (or_ a b) rest) >>= fun () -> generate_constraints (Mikhailsky.Path.at_index 0 path) bt @@ -1031,12 +1031,12 @@ and generate_constraints_data (path : Mikhailsky.Path.t) exists () >>= fun lty -> exists () >>= fun rty -> generate_constraints_data (Mikhailsky.Path.at_index 0 path) term lty - >>= fun () -> unify_base ty (Type.union lty rty) + >>= fun () -> unify_base ty (Type.or_ lty rty) | Prim (_, D_Right, [term], _) -> exists () >>= fun lty -> exists () >>= fun rty -> generate_constraints_data (Mikhailsky.Path.at_index 0 path) term rty - >>= fun () -> unify_base ty (Type.union lty rty) + >>= fun () -> unify_base ty (Type.or_ lty rty) | Prim (_, D_None, [], _) -> exists () >>= fun elt_ty -> unify_base ty (Type.option elt_ty) | Prim (_, D_Some, [v], _) -> diff --git a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/mikhailsky.ml b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/mikhailsky.ml index 8395355273ce..83b38c9cedd6 100644 --- a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/mikhailsky.ml +++ b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/mikhailsky.ml @@ -89,7 +89,7 @@ let rec parse_ty : | Prim (_loc, T_or, [utl; utr], _annot) -> let lty = parse_ty ~allow_big_map ~allow_operation ~allow_contract utl in let rty = parse_ty ~allow_big_map ~allow_operation ~allow_contract utr in - Type.union lty rty + Type.or_ lty rty | Prim (_loc, T_set, [ut], _annot) -> let ut = parse_ty ~allow_big_map ~allow_operation ~allow_contract ut in Type.set ut @@ -134,7 +134,7 @@ let rec map_var f (x : Type.Base.t) = let lty = map_var f lty in let rty = map_var f rty in prim T_pair [lty; rty] [] - | Union_t (lty, rty) -> + | Or_t (lty, rty) -> let lty = map_var f lty in let rty = map_var f rty in prim T_or [lty; rty] [] @@ -279,7 +279,7 @@ module Instructions = struct let pair = prim I_PAIR [] [] - (* unions *) + (* ors *) let left = prim I_LEFT [] [] diff --git a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.ml b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.ml index 5f66f6ff5e7d..bc8d164c6c5c 100644 --- a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.ml +++ b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.ml @@ -44,7 +44,7 @@ module Base = struct | Key_t | Option_t of t | Pair_t of t * t - | Union_t of t * t + | Or_t of t * t | List_t of t | Set_t of t | Map_t of t * t @@ -69,7 +69,7 @@ module Base = struct true | Option_t ty1, Option_t ty2 -> ty1.tag = ty2.tag | Pair_t (l1, r1), Pair_t (l2, r2) -> l1.tag = l2.tag && r1.tag = r2.tag - | Union_t (l1, r1), Union_t (l2, r2) -> l1.tag = l2.tag && r1.tag = r2.tag + | Or_t (l1, r1), Or_t (l2, r2) -> l1.tag = l2.tag && r1.tag = r2.tag | List_t ty1, List_t ty2 -> ty1.tag = ty2.tag | Set_t ty1, Set_t ty2 -> ty1.tag = ty2.tag | Map_t (kty1, vty1), Map_t (kty2, vty2) -> @@ -101,7 +101,7 @@ module Base = struct | Option_t ty -> Format.fprintf fmtr "(option %a)" pp ty | List_t ty -> Format.fprintf fmtr "(list %a)" pp ty | Pair_t (lty, rty) -> Format.fprintf fmtr "(pair %a %a)" pp lty pp rty - | Union_t (lty, rty) -> Format.fprintf fmtr "(union %a %a)" pp lty pp rty + | Or_t (lty, rty) -> Format.fprintf fmtr "(or %a %a)" pp lty pp rty | Set_t ty -> Format.fprintf fmtr "(set %a)" pp ty | Map_t (kty, vty) -> Format.fprintf fmtr "(map %a %a)" pp kty pp vty | Lambda_t (dom, range) -> @@ -114,7 +114,7 @@ module Base = struct acc | Var_t v -> v :: acc | Option_t ty | List_t ty | Set_t ty -> vars ty acc - | Pair_t (lty, rty) | Union_t (lty, rty) -> vars lty (vars rty acc) + | Pair_t (lty, rty) | Or_t (lty, rty) -> vars lty (vars rty acc) | Map_t (kty, vty) -> vars kty (vars vty acc) | Lambda_t (dom, range) -> vars dom (vars range acc) @@ -182,7 +182,7 @@ let option ty = Base.Table.hashcons Base.table (Option_t ty) let pair lty rty = Base.Table.hashcons Base.table (Pair_t (lty, rty)) -let union lty rty = Base.Table.hashcons Base.table (Union_t (lty, rty)) +let or_ lty rty = Base.Table.hashcons Base.table (Or_t (lty, rty)) let list ty = Base.Table.hashcons Base.table (List_t ty) diff --git a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.mli b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.mli index 168ba97e4d21..bdc806590b25 100644 --- a/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.mli +++ b/src/proto_alpha/lib_benchmark/lib_benchmark_type_inference/type.mli @@ -45,7 +45,7 @@ module Base : sig | Key_t | Option_t of t | Pair_t of t * t - | Union_t of t * t + | Or_t of t * t | List_t of t | Set_t of t | Map_t of t * t @@ -94,7 +94,7 @@ val option : Base.t -> Base.t val pair : Base.t -> Base.t -> Base.t -val union : Base.t -> Base.t -> Base.t +val or_ : Base.t -> Base.t -> Base.t val list : Base.t -> Base.t diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index 27a0d98ef9da..0bad66b97944 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -67,7 +67,7 @@ type type_name = | `TAddress | `TBool | `TPair - | `TUnion + | `TOr | `TLambda | `TOption | `TList @@ -108,7 +108,7 @@ type atomic_type_name = type non_atomic_type_name = [ `TPair - | `TUnion + | `TOr | `TLambda | `TOption | `TList @@ -150,7 +150,7 @@ let all_atomic_type_names : atomic_type_name array = let all_non_atomic_type_names : non_atomic_type_name array = [| `TPair; - `TUnion; + `TOr; `TLambda; `TOption; `TList; @@ -176,7 +176,7 @@ type comparable_type_name = | `TChain_id | `TAddress | `TPair - | `TUnion + | `TOr | `TOption ] (* Ensure inclusion of comparable_type_name in type_name *) @@ -207,7 +207,7 @@ type 'a comparable_and_non_atomic = 'a constraint 'a = [< non_atomic_type_name] let all_comparable_non_atomic_type_names : 'a comparable_and_non_atomic array = - [|`TPair; `TUnion; `TOption|] + [|`TPair; `TOr; `TOption|] (* Ensure inclusion of comparable_and_atomic in type_name *) let (_ : 'a comparable_and_atomic -> type_name) = fun x -> (x :> type_name) @@ -378,11 +378,11 @@ end) match lambda_t (-1) domain range with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) - | `TUnion -> ( + | `TOr -> ( let* lsize, rsize = pick_split (size - 1) in let* (Ex_ty left) = m_type ~size:lsize in let* (Ex_ty right) = m_type ~size:rsize in - match union_t (-1) left right with + match or_t (-1) left right with | Error _ -> assert false | Ok (Ty_ex_c res_ty) -> return @@ Ex_ty res_ty) | `TOption -> ( @@ -452,7 +452,7 @@ end) | Error _ -> assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in - let union_case size = + let or_case size = let size = size - 1 in let* size_left = Base_samplers.sample_in_interval ~range:{min = 1; max = size - 1} @@ -460,7 +460,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 comparable_union_t (-1) l r with + match comparable_or_t (-1) l r with | Error _ -> assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in @@ -471,7 +471,7 @@ end) let* cmp_tn = uniform_comparable_non_atomic_type_name in match cmp_tn with | `TPair -> pair_case size - | `TUnion -> union_case size + | `TOr -> or_case size | `TOption -> option_case size end @@ -609,7 +609,7 @@ end) let* left_v = value left_t in let* right_v = value right_t in return (left_v, right_v)) - | Union_t (left_t, right_t, _, _) -> + | Or_t (left_t, right_t, _, _) -> fun rng_state -> if Base_samplers.uniform_bool rng_state then L (value left_t rng_state) diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.mli b/src/proto_alpha/lib_benchmark/michelson_samplers.mli index ed46ed8fe220..ea10e0e94dd9 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.mli +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.mli @@ -127,6 +127,6 @@ module Internal_for_tests : sig | `TString | `TTicket | `TTimestamp - | `TUnion + | `TOr | `TUnit ] end diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers_base.mli b/src/proto_alpha/lib_benchmark/michelson_samplers_base.mli index 18a150245cfc..ae7a79c00cad 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers_base.mli +++ b/src/proto_alpha/lib_benchmark/michelson_samplers_base.mli @@ -23,7 +23,7 @@ (* *) (*****************************************************************************) -(** Samplers for basic Michelson values (not including pairs, unions, tickets, big maps, etc) *) +(** Samplers for basic Michelson values (not including pairs, ors, tickets, big maps, etc) *) open Protocol open Base_samplers diff --git a/src/proto_alpha/lib_benchmark/mikhailsky_to_michelson.ml b/src/proto_alpha/lib_benchmark/mikhailsky_to_michelson.ml index 89741cd4ca0a..6ee761048306 100644 --- a/src/proto_alpha/lib_benchmark/mikhailsky_to_michelson.ml +++ b/src/proto_alpha/lib_benchmark/mikhailsky_to_michelson.ml @@ -37,10 +37,10 @@ let project_top (aft : Type.Stack.t) = | Type.Stack.Stack_var_t _ -> raise (Unexpected_stack_type "var") | Type.Stack.Item_t (top, _) -> top -let project_union (aft : Type.Stack.t) = +let project_or (aft : Type.Stack.t) = let top = project_top aft in match top.node with - | Type.Base.Union_t (l, r) -> (l, r) + | Type.Base.Or_t (l, r) -> (l, r) | _ -> raise Unexpected_base_type let project_lambda (aft : Type.Stack.t) = @@ -100,14 +100,14 @@ let rec convert : (* Fail on holes *) | Micheline.Prim (_, I_Hole, _, _) | Micheline.Prim (_, D_Hole, _, _) -> raise Mikhailsky.Term_contains_holes - (* Add type information to union injections *) + (* Add type information to or injections *) | Micheline.Prim (_, I_LEFT, [], annots) -> ( get_instr_annot path >>= fun ty_opt -> match ty_opt with | None -> raise (Cannot_get_type (node, path)) | Some {aft; _} -> Inference.instantiate aft >>= fun aft -> - let _, r = project_union aft in + let _, r = project_or aft in Inference.instantiate_base r >>= fun r -> Autocomp.replace_vars r >>= fun r -> let r = unparse_type r in @@ -119,7 +119,7 @@ let rec convert : | None -> raise (Cannot_get_type (node, path)) | Some {aft; _} -> Inference.instantiate aft >>= fun aft -> - let l, _ = project_union aft in + let l, _ = project_or aft in Inference.instantiate_base l >>= fun l -> Autocomp.replace_vars l >>= fun l -> let l = unparse_type l in diff --git a/src/proto_alpha/lib_benchmark/rules.ml b/src/proto_alpha/lib_benchmark/rules.ml index ce35900d5a20..88a148e0213e 100644 --- a/src/proto_alpha/lib_benchmark/rules.ml +++ b/src/proto_alpha/lib_benchmark/rules.ml @@ -335,7 +335,7 @@ module Instruction = struct replacement ~fresh:[Plain alpha; Plain beta] ~fresh_stack:[gamma] - ~bef:(item (union (var alpha) (var beta)) (stack_var gamma)) + ~bef:(item (or_ (var alpha) (var beta)) (stack_var gamma)) ~aft:(item (var beta) (stack_var gamma)) ~replacement:[Context_blind (fun () -> M.Instructions.(loop_left hole))] (); @@ -350,7 +350,7 @@ module Instruction = struct replacement ~fresh:[Plain alpha; Plain beta] ~fresh_stack:[gamma; delta] - ~bef:(item (union (var alpha) (var beta)) (stack_var gamma)) + ~bef:(item (or_ (var alpha) (var beta)) (stack_var gamma)) ~aft:(stack_var delta) ~replacement: [Context_blind (fun () -> M.Instructions.(if_left hole hole))] @@ -376,14 +376,14 @@ module Instruction = struct ~fresh:[Plain alpha; Plain beta] ~fresh_stack:[gamma] ~bef:(item (var alpha) (stack_var gamma)) - ~aft:(item (union (var alpha) (var beta)) (stack_var gamma)) + ~aft:(item (or_ (var alpha) (var beta)) (stack_var gamma)) ~replacement:[Context_blind (fun () -> M.Instructions.left)] (); replacement ~fresh:[Plain alpha; Plain beta] ~fresh_stack:[gamma] ~bef:(item (var beta) (stack_var gamma)) - ~aft:(item (union (var alpha) (var beta)) (stack_var gamma)) + ~aft:(item (or_ (var alpha) (var beta)) (stack_var gamma)) ~replacement:[Context_blind (fun () -> M.Instructions.right)] (); replacement @@ -725,13 +725,13 @@ struct let replace_by_left = replacement ~fresh:[alpha; beta] - ~typ:Type.(union (var alpha) (var beta)) + ~typ:Type.(or_ (var alpha) (var beta)) ~replacement:Mikhailsky.Data.(left hole) in let replace_by_right = replacement ~fresh:[alpha; beta] - ~typ:Type.(union (var alpha) (var beta)) + ~typ:Type.(or_ (var alpha) (var beta)) ~replacement:Mikhailsky.Data.(right hole) in let replace_by_some = diff --git a/src/proto_alpha/lib_benchmark/test/test_distribution.ml b/src/proto_alpha/lib_benchmark/test/test_distribution.ml index 4d2cf8452522..8c9e46c21fc7 100644 --- a/src/proto_alpha/lib_benchmark/test/test_distribution.ml +++ b/src/proto_alpha/lib_benchmark/test/test_distribution.ml @@ -11,7 +11,7 @@ let pp_type_name fmtr (t : type_name) = | `TPair -> "pair" | `TKey -> "key" | `TLambda -> "lambda" - | `TUnion -> "union" + | `TOr -> "or" | `TOperation -> "operation" | `TOption -> "option" | `TSapling_state -> "sapling_state" @@ -68,8 +68,8 @@ let rec tnames_of_type : | Script_typed_ir.Bool_t -> `TBool :: acc | Script_typed_ir.Pair_t (lty, rty, _, _) -> tnames_of_type lty (tnames_of_type rty (`TPair :: acc)) - | Script_typed_ir.Union_t (lty, rty, _, _) -> - tnames_of_type lty (tnames_of_type rty (`TUnion :: acc)) + | Script_typed_ir.Or_t (lty, rty, _, _) -> + tnames_of_type lty (tnames_of_type rty (`TOr :: acc)) | Script_typed_ir.Lambda_t (dom, range, _) -> tnames_of_type dom (tnames_of_type range (`TLambda :: acc)) | Script_typed_ir.Option_t (ty, _, _) -> tnames_of_type ty (`TOption :: acc) diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index a9219a27a954..99b055bb6d80 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -1048,7 +1048,7 @@ module Registration_section = struct () end - module Unions = struct + module Ors = struct let () = simple_benchmark ~name:Interpreter_workload.N_ILeft @@ -1066,7 +1066,7 @@ module Registration_section = struct let () = simple_benchmark ~name:Interpreter_workload.N_IIf_left - ~stack_type:(cunion unit unit @$ bot) + ~stack_type:(cor unit unit @$ bot) ~kinstr: (IIf_left { @@ -2182,7 +2182,7 @@ module Registration_section = struct let cons_r = ICons_right (dummy_loc, unit, halt) in simple_benchmark ~name:Interpreter_workload.N_ILoop_left - ~stack_type:(cunion unit unit @$ bot) + ~stack_type:(cor unit unit @$ bot) ~kinstr:(ILoop_left (dummy_loc, cons_r, halt)) () @@ -3297,7 +3297,7 @@ module Registration_section = struct KLoop_in_left (ICons_right (dummy_loc, unit, halt), KNil) in let stack = (R (), eos) in - let stack_type = cunion unit unit @$ bot in + let stack_type = cor unit unit @$ bot in fun () -> Ex_stack_and_cont {stack; cont; stack_type}) () diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml index 09a4c9ae9459..2cd89fc61fff 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml @@ -55,7 +55,7 @@ type instruction_name = | N_ICons_none | N_IIf_none | N_IOpt_map - (* unions *) + (* ors *) | N_ILeft | N_IRight | N_IIf_left diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index 95af373691cc..74a49958dbfe 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -94,13 +94,12 @@ let pair k1 k2 = let cpair k1 k2 = match comparable_pair_t (-1) k1 k2 with Error _ -> assert false | Ok t -> t -(* union type constructor*) -let union k1 k2 = - match union_t (-1) k1 k2 with Error _ -> assert false | Ok t -> t +(* or type constructor*) +let or_ k1 k2 = match or_t (-1) k1 k2 with Error _ -> assert false | Ok t -> t -(* comparable union type constructor *) -let cunion k1 k2 = - match comparable_union_t (-1) k1 k2 with Error _ -> assert false | Ok t -> t +(* comparable or type constructor *) +let cor k1 k2 = + match comparable_or_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_benchmarks_proto/ticket_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml index c7753478adc7..28b2bb8aa9df 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 ticket_ty = [pair int_or_ticket (pair int_or_ticket (pair int_or_ticket ...))] This is a worst case type for [type_has_tickets], though nested - unions, nested maps or nested lists would be just as bad. *) + ors, nested maps or nested lists would be just as bad. *) let rec dummy_type_generator ~rng_state size = let open Script_typed_ir in let ticket_or_int = diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index bb798eeaead4..f6adfc617609 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -632,7 +632,7 @@ module Scripts = struct let tl = unparse_ty ~loc utl in let tr = unparse_ty ~loc utr in return (T_pair, [tl; tr], annot) - | Union_t (utl, utr, _meta, _) -> + | Or_t (utl, utr, _meta, _) -> let annot = [] in let tl = unparse_ty ~loc utl in let tr = unparse_ty ~loc utr in diff --git a/src/proto_alpha/lib_plugin/script_interpreter_logging.ml b/src/proto_alpha/lib_plugin/script_interpreter_logging.ml index ac496687e854..cde10aacc3f0 100644 --- a/src/proto_alpha/lib_plugin/script_interpreter_logging.ml +++ b/src/proto_alpha/lib_plugin/script_interpreter_logging.ml @@ -263,7 +263,7 @@ module Stack_utils = struct reconstruct = (fun body k -> IOpt_map {loc; body; k}); } | ICons_left (loc, b, k), Item_t (a, s) -> - union_t dummy a b >|? fun (Ty_ex_c c) -> + or_t dummy a b >|? fun (Ty_ex_c c) -> let s = Item_t (c, s) in Ex_split_kinstr { @@ -272,7 +272,7 @@ module Stack_utils = struct reconstruct = (fun k -> ICons_left (loc, b, k)); } | ICons_right (loc, a, k), Item_t (b, s) -> - union_t dummy a b >|? fun (Ty_ex_c c) -> + or_t dummy a b >|? fun (Ty_ex_c c) -> let s = Item_t (c, s) in Ex_split_kinstr { @@ -281,7 +281,7 @@ module Stack_utils = struct reconstruct = (fun k -> ICons_right (loc, a, k)); } | ( IIf_left {loc; branch_if_left; branch_if_right; k}, - Item_t (Union_t (a, b, _meta, _), s) ) -> + Item_t (Or_t (a, b, _meta, _), s) ) -> ok @@ Ex_split_if { @@ -984,7 +984,7 @@ module Stack_utils = struct continuation = k; reconstruct = (fun body k -> ILoop (loc, body, k)); } - | ILoop_left (loc, kl, kr), Item_t (Union_t (a, b, _meta, _), s) -> + | ILoop_left (loc, kl, kr), Item_t (Or_t (a, b, _meta, _), s) -> ok @@ Ex_split_loop_may_fail { @@ -1693,7 +1693,7 @@ module Stack_utils = struct reconstruct = (fun k -> IJoin_tickets (loc, ty, k)); } | IOpen_chest (loc, k), Item_t (_, Item_t (_, Item_t (_, s))) -> - let s = Item_t (union_bytes_bool_t, s) in + let s = Item_t (or_bytes_bool_t, s) in ok @@ Ex_split_kinstr { @@ -1962,7 +1962,7 @@ module Logger (Base : Logger_base) = struct let k' = instrument_cont logger (assert_some sty) k in ok @@ KReturn (stack, sty, k') | KLoop_in_left (ki, k) -> - let (Item_t (Union_t (a_ty, b_ty, _, _), rest)) = stack_ty in + let (Item_t (Or_t (a_ty, b_ty, _, _), rest)) = stack_ty in let ki' = enable_log (Item_t (a_ty, rest)) ki in let k' = instrument_cont logger (Item_t (b_ty, rest)) k in ok @@ KLoop_in_left (ki', k') @@ -2065,7 +2065,7 @@ module Logger (Base : Logger_base) = struct in (step [@ocaml.tailcall]) g gas body ks' v stack) | IIf_left {branch_if_left; branch_if_right; k; _} -> ( - let (Item_t (Union_t (lty, rty, _, _), rest)) = sty in + let (Item_t (Or_t (lty, rty, _, _), rest)) = sty in branched_final_stack_type [ Ex_init_stack_ty (Item_t (lty, rest), branch_if_left); diff --git a/src/proto_alpha/lib_protocol/gas_comparable_input_size.ml b/src/proto_alpha/lib_protocol/gas_comparable_input_size.ml index 4a5cb467e4dc..d5b8121dcb71 100644 --- a/src/proto_alpha/lib_protocol/gas_comparable_input_size.ml +++ b/src/proto_alpha/lib_protocol/gas_comparable_input_size.ml @@ -127,7 +127,7 @@ let rec size_of_comparable_value : size_of_comparable_value leaf lv + size_of_comparable_value node rv in size + 1 - | Union_t (left, right, _, YesYes) -> + | Or_t (left, right, _, YesYes) -> let size = match v with | L v -> size_of_comparable_value left v diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index 5e55479b93ef..28936be172b9 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -454,7 +454,7 @@ module Cost_of = struct let compare_pair_tag = atomic_step_cost (S.safe_int 10) - let compare_union_tag = atomic_step_cost (S.safe_int 10) + let compare_or_tag = atomic_step_cost (S.safe_int 10) let compare_option_tag = atomic_step_cost (S.safe_int 10) @@ -543,14 +543,14 @@ module Cost_of = struct yl Gas.(acc +@ compare_pair_tag) (Compare (tr, xr, yr, k)) - | Union_t (tl, tr, _, YesYes) -> ( + | Or_t (tl, tr, _, YesYes) -> ( match (x, y) with | L x, L y -> - (compare [@tailcall]) tl x y Gas.(acc +@ compare_union_tag) k - | L _, R _ -> (apply [@tailcall]) Gas.(acc +@ compare_union_tag) k - | R _, L _ -> (apply [@tailcall]) Gas.(acc +@ compare_union_tag) k + (compare [@tailcall]) tl x y Gas.(acc +@ compare_or_tag) k + | L _, R _ -> (apply [@tailcall]) Gas.(acc +@ compare_or_tag) k + | R _, L _ -> (apply [@tailcall]) Gas.(acc +@ compare_or_tag) k | R x, R y -> - (compare [@tailcall]) tr x y Gas.(acc +@ compare_union_tag) k) + (compare [@tailcall]) tr x y Gas.(acc +@ compare_or_tag) k) | Option_t (t, _, Yes) -> ( match (x, y) with | None, None -> diff --git a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml index 32b1a96110dc..9a476f77d7ea 100644 --- a/src/proto_alpha/lib_protocol/sc_rollup_operations.ml +++ b/src/proto_alpha/lib_protocol/sc_rollup_operations.ml @@ -140,11 +140,11 @@ let rec validate_ty : no_entrypoints no_entrypoints k - | Union_t (ty1, ty2, _, _) -> + | Or_t (ty1, ty2, _, _) -> let entrypoints_l, entrypoints_r = match nested_entrypoints with | Entrypoints_None -> (no_entrypoints, no_entrypoints) - | Entrypoints_Union {left; right} -> (left, right) + | Entrypoints_Or {left; right} -> (left, right) in (validate_two_tys [@ocaml.tailcall]) ty1 diff --git a/src/proto_alpha/lib_protocol/script_comparable.ml b/src/proto_alpha/lib_protocol/script_comparable.ml index 2156d26610b5..d5e9e4632f0d 100644 --- a/src/proto_alpha/lib_protocol/script_comparable.ml +++ b/src/proto_alpha/lib_protocol/script_comparable.ml @@ -70,11 +70,11 @@ let compare_comparable : type a. a comparable_ty -> a -> a -> int = (Compare_comparable (tr, rx, ry, k)) lx ly - | Union_t (tl, _, _, YesYes), L x, L y -> + | Or_t (tl, _, _, YesYes), L x, L y -> (compare_comparable [@tailcall]) tl k x y - | Union_t _, L _, R _ -> -1 - | Union_t _, R _, L _ -> 1 - | Union_t (_, tr, _, YesYes), R x, R y -> + | Or_t _, L _, R _ -> -1 + | Or_t _, R _, L _ -> 1 + | Or_t (_, tr, _, YesYes), R x, R y -> (compare_comparable [@tailcall]) tr k x y | Option_t _, None, None -> (apply [@tailcall]) 0 k | Option_t _, None, Some _ -> -1 diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 4b6f7dd409e2..a10944f798d4 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -699,7 +699,7 @@ module Raw = struct | ICdr (_, k) -> let _, b = accu in (step [@ocaml.tailcall]) g gas k ks b stack - (* unions *) + (* ors *) | ICons_left (_, _tyb, k) -> (step [@ocaml.tailcall]) g gas k ks (L accu) stack | ICons_right (_, _tya, k) -> diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index bf82e1eb3d1a..147ff3b332c1 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -905,7 +905,7 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g) kloop_in_left_type = ('c, 'd, 'e, 'f) continuation -> ('a, 'g, 'c, 'd) kinstr -> ('b, 'g, 'e, 'f) continuation -> - ('a, 'b) union -> + ('a, 'b) or_ -> 'g -> ('e * 'f * outdated_context * local_gas_counter) tzresult Lwt.t diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 530862f52801..f71eda44dd51 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -182,7 +182,7 @@ let hash_comparable_data ctxt ty data = let check_dupable_comparable_ty : type a. a comparable_ty -> unit = function | Unit_t | Never_t | Int_t | Nat_t | Signature_t | String_t | Bytes_t | Mutez_t | Bool_t | Key_hash_t | Key_t | Timestamp_t | Chain_id_t | Address_t - | Tx_rollup_l2_address_t | Pair_t _ | Union_t _ | Option_t _ -> + | Tx_rollup_l2_address_t | Pair_t _ | Or_t _ | Option_t _ -> () let check_dupable_ty ctxt loc ty = @@ -220,7 +220,7 @@ let check_dupable_ty ctxt loc ty = | Pair_t (ty_a, ty_b, _, _) -> let* () = aux loc ty_a in aux loc ty_b - | Union_t (ty_a, ty_b, _, _) -> + | Or_t (ty_a, ty_b, _, _) -> let* () = aux loc ty_a in aux loc ty_b | Lambda_t (_, _, _) -> @@ -390,13 +390,13 @@ let rec ty_eq : let Eq = Dependent_bool.merge_dand cmp1 cmp2 in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) | Pair_t _, _ -> not_equal () - | Union_t (tal, tar, meta1, cmp1), Union_t (tbl, tbr, meta2, cmp2) -> + | Or_t (tal, tar, meta1, cmp1), Or_t (tbl, tbr, meta2, cmp2) -> let* () = type_metadata_eq meta1 meta2 in let* Eq = help tal tbl in let+ Eq = help tar tbr in let Eq = Dependent_bool.merge_dand cmp1 cmp2 in (Eq : ((ta, tac) ty, (tb, tbc) ty) eq) - | Union_t _, _ -> not_equal () + | Or_t _, _ -> not_equal () | Lambda_t (tal, tar, meta1), Lambda_t (tbl, tbr, meta2) -> let* () = type_metadata_eq meta1 meta2 in let* Eq = help tal tbl in @@ -715,7 +715,7 @@ let rec parse_ty : | Don't_parse_entrypoints -> let (Ex_ty tl) = parsed_l in let (Ex_ty tr) = parsed_r in - union_t loc tl tr >|? fun (Ty_ex_c ty) -> ((Ex_ty ty : ret), ctxt) + or_t loc tl tr >|? fun (Ty_ex_c ty) -> ((Ex_ty ty : ret), ctxt) | Parse_entrypoints -> let (Ex_parameter_ty_and_entrypoints_node {arg_type = tl; entrypoints = left}) = @@ -725,12 +725,12 @@ let rec parse_ty : {arg_type = tr; entrypoints = right}) = parsed_r in - union_t loc tl tr >|? fun (Ty_ex_c arg_type) -> + or_t loc tl tr >|? fun (Ty_ex_c arg_type) -> let entrypoints = let at_node = Option.map (fun name -> {name; original_type_expr = node}) name in - {at_node; nested = Entrypoints_Union {left; right}} + {at_node; nested = Entrypoints_Or {left; right}} in (Ex_parameter_ty_and_entrypoints_node {arg_type; entrypoints}, ctxt) ) @@ -1096,7 +1096,7 @@ let check_packable ~legacy loc root = | Bls12_381_g2_t -> Result.return_unit | Bls12_381_fr_t -> Result.return_unit | Pair_t (l_ty, r_ty, _, _) -> check l_ty >>? fun () -> check r_ty - | Union_t (l_ty, r_ty, _, _) -> check l_ty >>? fun () -> check r_ty + | Or_t (l_ty, r_ty, _, _) -> check l_ty >>? fun () -> check r_ty | Option_t (v_ty, _, _) -> check v_ty | List_t (elt_ty, _) -> check elt_ty | Map_t (_, elt_ty, _) -> check elt_ty @@ -1274,7 +1274,7 @@ let find_entrypoint (type full fullc error_context error_trace) | _, {at_node = Some {name; original_type_expr}; _} when Entrypoint.(name = entrypoint) -> return (Ex_ty_cstr {ty; construct = (fun e -> e); original_type_expr}) - | Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _} -> ( + | Or_t (tl, tr, _, _), {nested = Entrypoints_Or {left; right}; _} -> ( Gas_monad.bind_recover (find_entrypoint tl left entrypoint) @@ function | Ok (Ex_ty_cstr {ty; construct; original_type_expr}) -> return @@ -1339,7 +1339,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty) ( (if reachable then acc else match ty with - | Union_t _ -> acc + | Or_t _ -> acc | _ -> ( match first_unreachable with | None -> (Some (List.rev path), all) @@ -1359,7 +1359,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty) (prim list option * Entrypoint.Set.t) tzresult = fun t entrypoints path reachable acc -> match (t, entrypoints) with - | Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _} -> + | Or_t (tl, tr, _, _), {nested = Entrypoints_Or {left; right}; _} -> merge (D_Left :: path) tl left reachable acc >>? fun (acc, l_reachable) -> merge (D_Right :: path) tr right reachable acc @@ -1715,7 +1715,7 @@ let parse_pair (type r) parse_l parse_r ctxt ~legacy | Seq (loc, l) -> tzfail @@ Invalid_seq_arity (loc, 2, List.length l) | expr -> tzfail @@ unexpected expr [] Constant_namespace [D_Pair] -let parse_union parse_l parse_r ctxt ~legacy = function +let parse_or parse_l parse_r ctxt ~legacy = function | Prim (loc, D_Left, [v], annot) -> (if legacy then Result.return_unit else error_unexpected_annot loc annot) >>?= fun () -> @@ -2062,11 +2062,11 @@ let rec parse_data : let parse_l ctxt v = non_terminal_recursion ctxt tl v in let parse_r ctxt v = non_terminal_recursion ctxt tr v in traced @@ parse_pair parse_l parse_r ctxt ~legacy r_witness expr - (* Unions *) - | Union_t (tl, tr, _, _), expr -> + (* Ors *) + | Or_t (tl, tr, _, _), expr -> let parse_l ctxt v = non_terminal_recursion ctxt tl v in let parse_r ctxt v = non_terminal_recursion ctxt tr v in - traced @@ parse_union parse_l parse_r ctxt ~legacy expr + traced @@ parse_or parse_l parse_r ctxt ~legacy expr (* Lambdas *) | Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr) -> traced @@ -2831,13 +2831,13 @@ and parse_instr : check_destr_annot loc annot >>?= fun () -> let cdr = {apply = (fun k -> ICdr (loc, k))} in typed ctxt loc cdr (Item_t (b, rest)) - (* unions *) + (* ors *) | Prim (loc, I_LEFT, [tr], annot), Item_t (tl, rest) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tr >>?= fun (Ex_ty tr, ctxt) -> check_constr_annot loc annot >>?= fun () -> let cons_left = {apply = (fun k -> ICons_left (loc, tr, k))} in - union_t loc tl tr >>?= fun (Ty_ex_c ty) -> + or_t loc tl tr >>?= fun (Ty_ex_c ty) -> let stack_ty = Item_t (ty, rest) in typed ctxt loc cons_left stack_ty | Prim (loc, I_RIGHT, [tl], annot), Item_t (tr, rest) -> @@ -2845,11 +2845,11 @@ and parse_instr : >>?= fun (Ex_ty tl, ctxt) -> check_constr_annot loc annot >>?= fun () -> let cons_right = {apply = (fun k -> ICons_right (loc, tl, k))} in - union_t loc tl tr >>?= fun (Ty_ex_c ty) -> + or_t loc tl tr >>?= fun (Ty_ex_c ty) -> let stack_ty = Item_t (ty, rest) in typed ctxt loc cons_right stack_ty | ( Prim (loc, I_IF_LEFT, [bt; bf], annot), - (Item_t (Union_t (tl, tr, _, _), rest) as bef) ) -> + (Item_t (Or_t (tl, tr, _, _), rest) as bef) ) -> check_kind [Seq_kind] bt >>?= fun () -> check_kind [Seq_kind] bf >>?= fun () -> error_unexpected_annot loc annot >>?= fun () -> @@ -3316,7 +3316,7 @@ and parse_instr : in typed_no_lwt ctxt loc instr rest) | ( Prim (loc, I_LOOP_LEFT, [body], annot), - (Item_t (Union_t (tl, tr, _, _), rest) as stack) ) -> ( + (Item_t (Or_t (tl, tr, _, _), rest) as stack) ) -> ( check_kind [Seq_kind] body >>?= fun () -> check_var_annot loc annot >>?= fun () -> non_terminal_recursion tc_context ctxt body (Item_t (tl, rest)) @@ -4274,7 +4274,7 @@ and parse_instr : Item_t (Chest_key_t, Item_t (Chest_t, Item_t (Nat_t, rest))) ) -> if legacy then let instr = {apply = (fun k -> IOpen_chest (loc, k))} in - typed ctxt loc instr (Item_t (union_bytes_bool_t, rest)) + typed ctxt loc instr (Item_t (or_bytes_bool_t, rest)) else tzfail (Deprecated_instruction I_OPEN_CHEST) (* Events *) | Prim (loc, I_EMIT, [], annot), Item_t (data, rest) -> @@ -4902,7 +4902,7 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) ( (if reachable then acc else match ty with - | Union_t _ -> acc + | Or_t _ -> acc | _ -> (List.rev path :: unreachables, all)), reachable ) | Some {name; original_type_expr} -> @@ -4923,7 +4923,7 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) prim list list * (ex_ty * Script.node) Entrypoint.Map.t = fun t entrypoints path reachable acc -> match (t, entrypoints) with - | Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _} -> + | Or_t (tl, tr, _, _), {nested = Entrypoints_Or {left; right}; _} -> let acc, l_reachable = merge (D_Left :: path) tl left reachable acc in let acc, r_reachable = merge (D_Right :: path) tr right reachable acc in let acc = fold_tree tl left (D_Left :: path) l_reachable acc in @@ -5141,9 +5141,9 @@ type 'ty has_lazy_storage = | Pair_f : 'a has_lazy_storage * 'b has_lazy_storage -> ('a, 'b) pair has_lazy_storage - | Union_f : + | Or_f : 'a has_lazy_storage * 'b has_lazy_storage - -> ('a, 'b) union has_lazy_storage + -> ('a, 'b) or_ has_lazy_storage | Option_f : 'a has_lazy_storage -> 'a option has_lazy_storage | List_f : 'a has_lazy_storage -> 'a Script_list.t has_lazy_storage | Map_f : 'v has_lazy_storage -> (_, 'v) map has_lazy_storage @@ -5195,7 +5195,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = | Chest_key_t -> False_f | Chest_t -> False_f | Pair_t (l, r, _, _) -> aux2 (fun l r -> Pair_f (l, r)) l r - | Union_t (l, r, _, _) -> aux2 (fun l r -> Union_f (l, r)) l r + | Or_t (l, r, _, _) -> aux2 (fun l r -> Or_f (l, r)) l r | Option_t (t, _, _) -> aux1 (fun h -> Option_f h) t | List_t (t, _) -> aux1 (fun h -> List_f h) t | Map_t (_, t, _) -> aux1 (fun h -> Map_f h) t @@ -5254,10 +5254,10 @@ let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = aux ctxt mode ~temporary ids_to_copy acc tyr xr ~has_lazy_storage:hr >|=? fun (ctxt, xr, ids_to_copy, acc) -> (ctxt, (xl, xr), ids_to_copy, acc) - | Union_f (has_lazy_storage, _), Union_t (ty, _, _, _), L x -> + | Or_f (has_lazy_storage, _), Or_t (ty, _, _, _), L x -> aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage >|=? fun (ctxt, x, ids_to_copy, acc) -> (ctxt, L x, ids_to_copy, acc) - | Union_f (_, has_lazy_storage), Union_t (_, ty, _, _), R x -> + | Or_f (_, has_lazy_storage), Or_t (_, ty, _, _), R x -> aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage >|=? fun (ctxt, x, ids_to_copy, acc) -> (ctxt, R x, ids_to_copy, acc) | Option_f has_lazy_storage, Option_t (ty, _, _), Some x -> @@ -5349,9 +5349,9 @@ let rec fold_lazy_storage : | Fold_lazy_storage.Ok init -> fold_lazy_storage ~f ~init ctxt tyr xr ~has_lazy_storage:hr | Fold_lazy_storage.Error -> ok (init, ctxt)) - | Union_f (has_lazy_storage, _), Union_t (ty, _, _, _), L x -> + | Or_f (has_lazy_storage, _), Or_t (ty, _, _, _), L x -> fold_lazy_storage ~f ~init ctxt ty x ~has_lazy_storage - | Union_f (_, has_lazy_storage), Union_t (_, ty, _, _), R x -> + | Or_f (_, has_lazy_storage), Or_t (_, ty, _, _), R x -> fold_lazy_storage ~f ~init ctxt ty x ~has_lazy_storage | _, Option_t (_, _, _), None -> ok (Fold_lazy_storage.Ok init, ctxt) | Option_f has_lazy_storage, Option_t (ty, _, _), Some x -> diff --git a/src/proto_alpha/lib_protocol/script_ir_unparser.ml b/src/proto_alpha/lib_protocol/script_ir_unparser.ml index 6315ff10db35..0c17a6f566cb 100644 --- a/src/proto_alpha/lib_protocol/script_ir_unparser.ml +++ b/src/proto_alpha/lib_protocol/script_ir_unparser.ml @@ -82,11 +82,11 @@ let rec unparse_ty_and_entrypoints_uncarbonated : match tr with | Prim (_, T_pair, ts, []) -> (T_pair, tl :: ts) | _ -> (T_pair, [tl; tr])) - | Union_t (utl, utr, _meta, _) -> + | Or_t (utl, utr, _meta, _) -> let entrypoints_l, entrypoints_r = match nested_entrypoints with | Entrypoints_None -> (no_entrypoints, no_entrypoints) - | Entrypoints_Union {left; right} -> (left, right) + | Entrypoints_Or {left; right} -> (left, right) in let tl = unparse_ty_and_entrypoints_uncarbonated ~loc utl entrypoints_l @@ -377,7 +377,7 @@ let unparse_pair (type r) ~loc unparse_l unparse_r ctxt mode in (res, ctxt) -let unparse_union ~loc unparse_l unparse_r ctxt = function +let unparse_or ~loc unparse_l unparse_r ctxt = function | L l -> unparse_l ctxt l >|=? fun (l, ctxt) -> (Prim (loc, D_Left, [l], []), ctxt) | R r -> @@ -436,10 +436,10 @@ let rec unparse_comparable_data_rec : let unparse_l ctxt v = unparse_comparable_data_rec ~loc ctxt mode tl v in let unparse_r ctxt v = unparse_comparable_data_rec ~loc ctxt mode tr v in unparse_pair ~loc unparse_l unparse_r ctxt mode r_witness pair - | Union_t (tl, tr, _, YesYes), v -> + | Or_t (tl, tr, _, YesYes), v -> let unparse_l ctxt v = unparse_comparable_data_rec ~loc ctxt mode tl v in let unparse_r ctxt v = unparse_comparable_data_rec ~loc ctxt mode tr v in - unparse_union ~loc unparse_l unparse_r ctxt v + unparse_or ~loc unparse_l unparse_r ctxt v | Option_t (t, _, Yes), v -> let unparse_v ctxt v = unparse_comparable_data_rec ~loc ctxt mode t v in unparse_option ~loc unparse_v ctxt v @@ -525,10 +525,10 @@ module Data_unparser (P : MICHELSON_PARSER) = struct let unparse_l ctxt v = non_terminal_recursion ctxt mode tl v in let unparse_r ctxt v = non_terminal_recursion ctxt mode tr v in unparse_pair ~loc unparse_l unparse_r ctxt mode r_witness pair - | Union_t (tl, tr, _, _), v -> + | Or_t (tl, tr, _, _), v -> let unparse_l ctxt v = non_terminal_recursion ctxt mode tl v in let unparse_r ctxt v = non_terminal_recursion ctxt mode tr v in - unparse_union ~loc unparse_l unparse_r ctxt v + unparse_or ~loc unparse_l unparse_r ctxt v | Option_t (t, _, _), v -> let unparse_v ctxt v = non_terminal_recursion ctxt mode t v in unparse_option ~loc unparse_v ctxt v diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 6f5974dc7560..d8fd30e9f32b 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -98,7 +98,9 @@ type tx_rollup_l2_address = Tx_rollup_l2_address.Indexable.value type ('a, 'b) pair = 'a * 'b -type ('a, 'b) union = L of 'a | R of 'b +(* We cannot call this type "or" as in Michelson because "or" is an + OCaml keyword. *) +type ('a, 'b) or_ = L of 'a | R of 'b module Script_chain_id = struct type t = Chain_id_tag of Chain_id.t [@@ocaml.unboxed] @@ -435,11 +437,11 @@ type 'arg entrypoints_node = { } and 'arg nested_entrypoints = - | Entrypoints_Union : { + | Entrypoints_Or : { left : 'l entrypoints_node; right : 'r entrypoints_node; } - -> ('l, 'r) union nested_entrypoints + -> ('l, 'r) or_ nested_entrypoints | Entrypoints_None : _ nested_entrypoints let no_entrypoints = {at_node = None; nested = Entrypoints_None} @@ -509,14 +511,14 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = } -> ('a option, 's, 'c, 't) kinstr (* - Unions + Ors ------ *) | ICons_left : - Script.location * ('b, _) ty * (('a, 'b) union, 'c * 's, 'r, 'f) kinstr + Script.location * ('b, _) ty * (('a, 'b) or_, 'c * 's, 'r, 'f) kinstr -> ('a, 'c * 's, 'r, 'f) kinstr | ICons_right : - Script.location * ('a, _) ty * (('a, 'b) union, 'c * 's, 'r, 'f) kinstr + Script.location * ('a, _) ty * (('a, 'b) or_, 'c * 's, 'r, 'f) kinstr -> ('b, 'c * 's, 'r, 'f) kinstr | IIf_left : { loc : Script.location; @@ -524,7 +526,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = branch_if_right : ('b, 's, 'c, 't) kinstr; k : ('c, 't, 'r, 'f) kinstr; } - -> (('a, 'b) union, 's, 'r, 'f) kinstr + -> (('a, 'b) or_, 's, 'r, 'f) kinstr (* Lists ----- @@ -835,9 +837,9 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = -> (bool, 'a * 's, 'r, 'f) kinstr | ILoop_left : Script.location - * ('a, 's, ('a, 'b) union, 's) kinstr + * ('a, 's, ('a, 'b) or_, 's) kinstr * ('b, 's, 'r, 'f) kinstr - -> (('a, 'b) union, 's, 'r, 'f) kinstr + -> (('a, 'b) or_, 's, 'r, 'f) kinstr | IDip : Script.location * ('b, 's, 'c, 't) kinstr @@ -1117,7 +1119,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = Script.location * 'a comparable_ty * ('a ticket option, 's, 'r, 'f) kinstr -> ('a ticket * 'a ticket, 's, 'r, 'f) kinstr | IOpen_chest : - Script.location * ((bytes, bool) union, 's, 'r, 'f) kinstr + Script.location * ((bytes, bool) or_, 's, 'r, 'f) kinstr -> ( Script_timelock.chest_key, Script_timelock.chest * (n num * 's), 'r, @@ -1201,8 +1203,8 @@ and (_, _, _, _) continuation = ('a, 's, bool, 'a * 's) kinstr * ('a, 's, 'r, 'f) continuation -> (bool, 'a * 's, 'r, 'f) continuation | KLoop_in_left : - ('a, 's, ('a, 'b) union, 's) kinstr * ('b, 's, 'r, 'f) continuation - -> (('a, 'b) union, 's, 'r, 'f) continuation + ('a, 's, ('a, 'b) or_, 's) kinstr * ('b, 's, 'r, 'f) continuation + -> (('a, 'b) or_, 's, 'r, 'f) continuation | KIter : ('a, 'b * 's, 'b, 's) kinstr * ('a, _) ty option @@ -1328,12 +1330,12 @@ and ('ty, 'comparable) ty = * ('a, 'b) pair ty_metadata * ('ac, 'bc, 'rc) dand -> (('a, 'b) pair, 'rc) ty - | Union_t : + | Or_t : ('a, 'ac) ty * ('b, 'bc) ty - * ('a, 'b) union ty_metadata + * ('a, 'b) or_ ty_metadata * ('ac, 'bc, 'rc) dand - -> (('a, 'b) union, 'rc) ty + -> (('a, 'b) or_, 'rc) ty | Lambda_t : ('arg, _) ty * ('ret, _) ty * ('arg, 'ret) lambda ty_metadata -> (('arg, 'ret) lambda, no) ty @@ -1741,7 +1743,7 @@ let ty_metadata : type a ac. (a, ac) ty -> a ty_metadata = function | Tx_rollup_l2_address_t -> meta_basic | Pair_t (_, _, meta, _) -> meta - | Union_t (_, _, meta, _) -> meta + | Or_t (_, _, meta, _) -> meta | Option_t (_, meta, _) -> meta | Lambda_t (_, _, meta) -> meta | List_t (_, meta) -> meta @@ -1774,7 +1776,7 @@ let is_comparable : type v c. (v, c) ty -> c dbool = function | Address_t -> Yes | Tx_rollup_l2_address_t -> Yes | Pair_t (_, _, _, dand) -> dbool_of_dand dand - | Union_t (_, _, _, dand) -> dbool_of_dand dand + | Or_t (_, _, _, dand) -> dbool_of_dand dand | Option_t (_, _, cmp) -> cmp | Lambda_t _ -> No | List_t _ -> No @@ -1839,21 +1841,19 @@ let comparable_pair_t 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 : +let or_t : type a ac b bc. - Script.location -> (a, ac) ty -> (b, bc) ty -> (a, b) union ty_ex_c tzresult - = + Script.location -> (a, ac) ty -> (b, bc) ty -> (a, b) or_ ty_ex_c tzresult = fun loc l r -> Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> let (Ex_dand cmp) = dand (is_comparable l) (is_comparable r) in - Ty_ex_c (Union_t (l, r, {size}, cmp)) + Ty_ex_c (Or_t (l, r, {size}, cmp)) -let union_bytes_bool_t = - Union_t (bytes_t, bool_t, {size = Type_size.three}, YesYes) +let or_bytes_bool_t = Or_t (bytes_t, bool_t, {size = Type_size.three}, YesYes) -let comparable_union_t loc l r = +let comparable_or_t loc l r = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> - Union_t (l, r, {size}, YesYes) + Or_t (l, r, {size}, YesYes) let lambda_t loc l r = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> @@ -2163,8 +2163,7 @@ let ty_traverse = | Chest_key_t | Chest_t -> (continue [@ocaml.tailcall]) accu | Pair_t (ty1, ty2, _, _) -> (next2 [@ocaml.tailcall]) f accu ty1 ty2 continue - | Union_t (ty1, ty2, _, _) -> - (next2 [@ocaml.tailcall]) f accu ty1 ty2 continue + | Or_t (ty1, ty2, _, _) -> (next2 [@ocaml.tailcall]) f accu ty1 ty2 continue | Lambda_t (ty1, ty2, _) -> (next2 [@ocaml.tailcall]) f accu ty1 ty2 continue | Option_t (ty1, _, _) -> (next [@ocaml.tailcall]) f accu ty1 continue @@ -2244,7 +2243,7 @@ let value_traverse (type t tc) (ty : (t, tc) ty) (x : t) init f = (return [@ocaml.tailcall]) () | Pair_t (ty1, ty2, _, _) -> (next2 [@ocaml.tailcall]) ty1 ty2 (fst x) (snd x) - | Union_t (ty1, ty2, _, _) -> ( + | Or_t (ty1, ty2, _, _) -> ( match x with | L l -> (next [@ocaml.tailcall]) ty1 l | R r -> (next [@ocaml.tailcall]) ty2 r) diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 51cdffff227f..e5e2e43c41ff 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -96,7 +96,7 @@ type tx_rollup_l2_address = Tx_rollup_l2_address.Indexable.value type ('a, 'b) pair = 'a * 'b -type ('a, 'b) union = L of 'a | R of 'b +type ('a, 'b) or_ = L of 'a | R of 'b module Script_chain_id : sig (** [t] is made algebraic in order to distinguish it from the other type @@ -304,8 +304,8 @@ type entrypoint_info = {name : Entrypoint.t; original_type_expr : Script.node} ['arg]. [at_node] are entrypoint details at that node if it is not [None]. [nested] are the entrypoints below the node in the tree. - It is always [Entrypoints_None] for non-union nodes. - But it is also ok to have [Entrypoints_None] for a union node, it just + It is always [Entrypoints_None] for non-or nodes. + But it is also ok to have [Entrypoints_None] for an or node, it just means that there are no entrypoints below that node in the tree. *) type 'arg entrypoints_node = { @@ -314,11 +314,11 @@ type 'arg entrypoints_node = { } and 'arg nested_entrypoints = - | Entrypoints_Union : { + | Entrypoints_Or : { left : 'l entrypoints_node; right : 'r entrypoints_node; } - -> ('l, 'r) union nested_entrypoints + -> ('l, 'r) or_ nested_entrypoints | Entrypoints_None : _ nested_entrypoints (** [no_entrypoints] is [{at_node = None; nested = Entrypoints_None}] *) @@ -488,14 +488,14 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = } -> ('a option, 's, 'c, 't) kinstr (* - Unions + Ors ------ *) | ICons_left : - Script.location * ('b, _) ty * (('a, 'b) union, 'c * 's, 'r, 'f) kinstr + Script.location * ('b, _) ty * (('a, 'b) or_, 'c * 's, 'r, 'f) kinstr -> ('a, 'c * 's, 'r, 'f) kinstr | ICons_right : - Script.location * ('a, _) ty * (('a, 'b) union, 'c * 's, 'r, 'f) kinstr + Script.location * ('a, _) ty * (('a, 'b) or_, 'c * 's, 'r, 'f) kinstr -> ('b, 'c * 's, 'r, 'f) kinstr | IIf_left : { loc : Script.location; @@ -503,7 +503,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = branch_if_right : ('b, 's, 'c, 't) kinstr; k : ('c, 't, 'r, 'f) kinstr; } - -> (('a, 'b) union, 's, 'r, 'f) kinstr + -> (('a, 'b) or_, 's, 'r, 'f) kinstr (* Lists ----- @@ -810,9 +810,9 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = -> (bool, 'a * 's, 'r, 'f) kinstr | ILoop_left : Script.location - * ('a, 's, ('a, 'b) union, 's) kinstr + * ('a, 's, ('a, 'b) or_, 's) kinstr * ('b, 's, 'r, 'f) kinstr - -> (('a, 'b) union, 's, 'r, 'f) kinstr + -> (('a, 'b) or_, 's, 'r, 'f) kinstr | IDip : Script.location * ('b, 's, 'c, 't) kinstr @@ -1132,7 +1132,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = Script.location * 'a comparable_ty * ('a ticket option, 's, 'r, 'f) kinstr -> ('a ticket * 'a ticket, 's, 'r, 'f) kinstr | IOpen_chest : - Script.location * ((bytes, bool) union, 's, 'r, 'f) kinstr + Script.location * ((bytes, bool) or_, 's, 'r, 'f) kinstr -> ( Script_timelock.chest_key, Script_timelock.chest * (n num * 's), 'r, @@ -1279,8 +1279,8 @@ and (_, _, _, _) continuation = (* This continuation is executed at each iteration of a loop with a condition encoded by a sum type. *) | KLoop_in_left : - ('a, 's, ('a, 'b) union, 's) kinstr * ('b, 's, 'r, 'f) continuation - -> (('a, 'b) union, 's, 'r, 'f) continuation + ('a, 's, ('a, 'b) or_, 's) kinstr * ('b, 's, 'r, 'f) continuation + -> (('a, 'b) or_, 's, 'r, 'f) continuation (* This continuation is executed at each iteration of a traversal. (Used in List, Map and Set.) *) | KIter : @@ -1442,12 +1442,12 @@ and ('ty, 'comparable) ty = * ('a, 'b) pair ty_metadata * ('ac, 'bc, 'rc) dand -> (('a, 'b) pair, 'rc) ty - | Union_t : + | Or_t : ('a, 'ac) ty * ('b, 'bc) ty - * ('a, 'b) union ty_metadata + * ('a, 'b) or_ ty_metadata * ('ac, 'bc, 'rc) dand - -> (('a, 'b) union, 'rc) ty + -> (('a, 'b) or_, 'rc) ty | Lambda_t : ('arg, _) ty * ('ret, _) ty * ('arg, 'ret) lambda ty_metadata -> (('arg, 'ret) lambda, no) ty @@ -1756,16 +1756,16 @@ val comparable_pair_3_t : '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 +val or_t : + Script.location -> ('a, _) ty -> ('b, _) ty -> ('a, 'b) or_ ty_ex_c tzresult -val comparable_union_t : +val comparable_or_t : Script.location -> 'a comparable_ty -> 'b comparable_ty -> - ('a, 'b) union comparable_ty tzresult + ('a, 'b) or_ comparable_ty tzresult -val union_bytes_bool_t : (Bytes.t, bool) union comparable_ty +val or_bytes_bool_t : (Bytes.t, bool) or_ comparable_ty val lambda_t : Script.location -> diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml index f12f9578491a..883dbf33c5a8 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml @@ -64,7 +64,7 @@ let ty_traverse_f = | Chest_t -> ret_succ_adding accu base_basic | Pair_t (_ty1, _ty2, a, _) -> ret_succ_adding accu @@ (base_compound a +! (word_size *? 3)) - | Union_t (_ty1, _ty2, a, _) -> + | Or_t (_ty1, _ty2, a, _) -> ret_succ_adding accu @@ (base_compound a +! (word_size *? 3)) | Lambda_t (_ty1, _ty2, a) -> ret_succ_adding accu @@ (base_compound a +! (word_size *? 2)) @@ -286,7 +286,7 @@ let rec value_size : ret_succ_adding accu (tx_rollup_l2_address_size x) | Bool_t -> ret_succ accu | Pair_t (_, _, _, _) -> ret_succ_adding accu h2w - | Union_t (_, _, _, _) -> ret_succ_adding accu h1w + | Or_t (_, _, _, _) -> ret_succ_adding accu h1w | Lambda_t (_, _, _) -> (lambda_size [@ocaml.tailcall]) ~count_lambda_nodes (ret_succ accu) x | Option_t (_, _, _) -> ret_succ_adding accu (option_size (fun _ -> !!0) x) diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml index cd93f3f74078..df632d047654 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml @@ -344,30 +344,30 @@ let check_value_size () = }; ]) (* - Union_t + Or_t ======= *) @ (let module P = struct - type ('a, 'b) f = {apply : 'c. (('a, 'b) union, 'c) ty -> ex} + type ('a, 'b) f = {apply : 'c. (('a, 'b) or_, 'c) ty -> ex} end in - let on_union : type a b. (a, _) ty -> (b, _) ty -> (a, b) P.f -> ex = + let on_or : type a b. (a, _) ty -> (b, _) ty -> (a, b) P.f -> ex = fun ty1 ty2 f -> - let (Ty_ex_c ty) = is_ok @@ union_t dummy_loc ty1 ty2 in + let (Ty_ex_c ty) = is_ok @@ or_t dummy_loc ty1 ty2 in f.apply ty in let open Script_int in [ (* "int + int" *) - on_union + on_or int_t int_t {apply = (fun ty -> ex "L 0 : int + int" ty (L (of_int 0)))}; - on_union + on_or int_t int_t {apply = (fun ty -> ex "R 0 : int + int" ty (R (of_int 0)))}; (* "string + string" *) - on_union + on_or string_t string_t { @@ -376,7 +376,7 @@ let check_value_size () = let foo = gen_string "foo" in ex "L foo : string * string" ty (L foo)); }; - on_union + on_or string_t string_t { @@ -386,7 +386,7 @@ let check_value_size () = ex "R foo : string * string" ty (R foo)); }; (* "string + int" *) - on_union + on_or string_t int_t { @@ -396,13 +396,13 @@ let check_value_size () = ex "L foo : string * int" ty (L foo)); }; (* "int + int + int" *) - on_union + on_or int_t int_t { apply = (fun ty -> - on_union + on_or int_t ty { @@ -410,13 +410,13 @@ let check_value_size () = (fun ty -> ex "L 0 : int + int + int" ty (L (of_int 0))); }); }; - on_union + on_or int_t int_t { apply = (fun ty -> - on_union + on_or int_t ty { @@ -425,13 +425,13 @@ let check_value_size () = ex "R (L 0) : int + int + int" ty (R (L (of_int 0)))); }); }; - on_union + on_or int_t int_t { apply = (fun ty -> - on_union + on_or int_t 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 cd36907a6e4c..d9383feccef0 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 @@ -71,10 +71,10 @@ let rec reference_compare_comparable : type a. a comparable_ty -> a -> a -> int | Pair_t (tl, tr, _, YesYes), (lx, rx), (ly, ry) -> let cl = reference_compare_comparable tl lx ly in if Compare.Int.(cl = 0) then reference_compare_comparable tr rx ry else cl - | Union_t (tl, _, _, YesYes), L x, L y -> reference_compare_comparable tl x y - | Union_t _, L _, R _ -> -1 - | Union_t _, R _, L _ -> 1 - | Union_t (_, tr, _, YesYes), R x, R y -> reference_compare_comparable tr x y + | Or_t (tl, _, _, YesYes), L x, L y -> reference_compare_comparable tl x y + | Or_t _, L _, R _ -> -1 + | Or_t _, R _, L _ -> 1 + | Or_t (_, tr, _, YesYes), R x, R y -> reference_compare_comparable tr x y | Option_t _, None, None -> 0 | Option_t _, None, Some _ -> -1 | Option_t _, Some _, None -> 1 diff --git a/src/proto_alpha/lib_protocol/ticket_scanner.ml b/src/proto_alpha/lib_protocol/ticket_scanner.ml index 152e51c1c635..c55a5ffd362a 100644 --- a/src/proto_alpha/lib_protocol/ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/ticket_scanner.ml @@ -81,9 +81,9 @@ module Ticket_inspection = struct | Pair_ht : 'a has_tickets * 'b has_tickets -> ('a, 'b) Script_typed_ir.pair has_tickets - | Union_ht : + | Or_ht : 'a has_tickets * 'b has_tickets - -> ('a, 'b) Script_typed_ir.union has_tickets + -> ('a, 'b) Script_typed_ir.or_ has_tickets | Option_ht : 'a has_tickets -> 'a option has_tickets | List_ht : 'a has_tickets -> 'a Script_list.t has_tickets | Set_ht : 'k has_tickets -> 'k Script_typed_ir.set has_tickets @@ -102,7 +102,7 @@ module Ticket_inspection = struct case. Note that in case tickets are made comparable, this function needs to change - so that constructors like [Union_t] and [Pair_t] are traversed + so that constructors like [Or_t] and [Pair_t] are traversed recursively. *) let has_tickets_of_comparable : @@ -127,7 +127,7 @@ module Ticket_inspection = struct | Address_t -> (k [@ocaml.tailcall]) False_ht | Tx_rollup_l2_address_t -> (k [@ocaml.tailcall]) False_ht | Pair_t (_, _, _, YesYes) -> (k [@ocaml.tailcall]) False_ht - | Union_t (_, _, _, YesYes) -> (k [@ocaml.tailcall]) False_ht + | Or_t (_, _, _, YesYes) -> (k [@ocaml.tailcall]) False_ht | Option_t (_, _, Yes) -> (k [@ocaml.tailcall]) False_ht (* Short circuit pairing of two [has_tickets] values. @@ -171,11 +171,11 @@ module Ticket_inspection = struct ty2 ~pair:(fun ht1 ht2 -> Pair_ht (ht1, ht2)) k - | Union_t (ty1, ty2, _, _) -> + | Or_t (ty1, ty2, _, _) -> (has_tickets_of_pair [@ocaml.tailcall]) ty1 ty2 - ~pair:(fun ht1 ht2 -> Union_ht (ht1, ht2)) + ~pair:(fun ht1 ht2 -> Or_ht (ht1, ht2)) k | Lambda_t (_, _, _) -> (* As of H, closures cannot contain tickets because APPLY requires @@ -291,7 +291,7 @@ module Ticket_collection = struct | Address_t -> (k [@ocaml.tailcall]) ctxt acc | Tx_rollup_l2_address_t -> (k [@ocaml.tailcall]) ctxt acc | Pair_t (_, _, _, YesYes) -> (k [@ocaml.tailcall]) ctxt acc - | Union_t (_, _, _, YesYes) -> (k [@ocaml.tailcall]) ctxt acc + | Or_t (_, _, _, YesYes) -> (k [@ocaml.tailcall]) ctxt acc | Option_t (_, _, Yes) -> (k [@ocaml.tailcall]) ctxt acc let tickets_of_set : @@ -341,7 +341,7 @@ module Ticket_collection = struct r acc k) - | Union_ht (htyl, htyr), Union_t (tyl, tyr, _, _) -> ( + | Or_ht (htyl, htyr), Or_t (tyl, tyr, _, _) -> ( match x with | L v -> (tickets_of_value [@ocaml.tailcall]) diff --git a/tezt/tests/comparable_datatype.ml b/tezt/tests/comparable_datatype.ml index 8308a487f4b7..bba65985126c 100644 --- a/tezt/tests/comparable_datatype.ml +++ b/tezt/tests/comparable_datatype.ml @@ -63,7 +63,7 @@ let test_comparable_options client () = in unit -let test_comparable_unions client () = +let test_comparable_or client () = let* () = Client.typecheck_data ~data:"{}" ~typ:"(set (or unit bool))" client in @@ -318,7 +318,7 @@ let register ~protocols = [ ("Run `comparable_unit`", test_comparable_unit); ("Run `comparable_options`", test_comparable_options); - ("Run `comparable_unions`", test_comparable_unions); + ("Run `comparable_or`", test_comparable_or); ("Run `comparable_pair`", test_comparable_pair); ("Run `order_of_pairs`", test_order_of_pairs); ("Run `comparable_chain_id`", test_comparable_chain_id); -- GitLab