diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index fbc0f09091c59a02d6e485279749070ab916dcd7..e44c612e3f892aaa3cfb6f9c952bb5ec59457ced 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -257,7 +257,8 @@ module Proto = struct List.map (fun g -> function None -> [] | Some v -> g v) @@ find_lambda_tys t | List_t (t, _) -> - List.map (fun g l -> List.flatten @@ List.map g l.elements) + List.map (fun g l -> + List.flatten @@ List.map g @@ Script_list.to_list l) @@ find_lambda_tys t | Map_t (_, tv, _) -> find_lambda_tys_map tv diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index bfcda8b0b58d8b8293657ef633e4fce26b0cefb7..672588f78d607bac3924106c7d5e7a2cc48cc4c3 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -684,16 +684,15 @@ end) and generate_list : type elt eltc. - (elt, eltc) Script_typed_ir.ty -> elt Script_typed_ir.boxed_list sampler - = + (elt, eltc) Script_typed_ir.ty -> elt Script_list.t sampler = fun elt_type -> let open M in - let* length, elements = + let* _, elements = Structure_samplers.list ~range:P.parameters.list_size ~sampler:(value elt_type) in - return Script_typed_ir.{elements; length} + return @@ Script_list.of_list elements (* Note that we might very well generate sets smaller than the specified range (consider the case of a set of type [unit]). *) diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index 3d6bfcdc4027faff3c745c5fcdafebf1bb0661b7..a3a783976aff3e3f97bc892598e3d80e8228ec4f 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -3181,7 +3181,8 @@ module Registration_section = struct let kbody = halt in fun () -> let cont = - KList_enter_body (kbody, [()], [], Some (list unit), 1, KNil) + KList_enter_body + (kbody, [()], Script_list.empty, Some (list unit), 1, KNil) in Ex_stack_and_cont {stack = ((), eos); stack_type = unit @$ bot; cont}) @@ -3203,8 +3204,7 @@ module Registration_section = struct fun () -> let ys = Samplers.Random_value.value (list unit) rng_state in let cont = - KList_enter_body - (kbody, [], ys.elements, Some (list unit), ys.length, KNil) + KList_enter_body (kbody, [], ys, Some (list unit), ys.length, KNil) in Ex_stack_and_cont {stack = ((), eos); stack_type = unit @$ bot; cont}) @@ -3225,7 +3225,8 @@ module Registration_section = struct let kbody = halt in fun () -> let cont = - KList_enter_body (kbody, [], [], Some (list unit), 1, KNil) + KList_enter_body + (kbody, [], Script_list.empty, Some (list unit), 1, KNil) in Ex_stack_and_cont {stack = ((), eos); stack_type = unit @$ bot; cont}) @@ -3246,7 +3247,8 @@ module Registration_section = struct ~cont_and_stack_sampler:(fun _cfg _rng_state -> let kbody = halt in let cont = - KList_exit_body (kbody, [], [], Some (list unit), 1, KNil) + KList_exit_body + (kbody, [], Script_list.empty, Some (list unit), 1, KNil) in fun () -> Ex_stack_and_cont diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml index 93d9fae52deefec6148b4d1aa515836e1824bf63..221e1789050ab52ac1478a784226ffddf72766ce 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml @@ -1454,7 +1454,7 @@ let extract_control_trace (type bef_top bef aft_top aft) | KList_enter_body (_, xs, ys, _, _, _) -> Control.list_enter_body (Size.of_int (List.length xs)) - (Size.of_int (List.length ys)) + (Size.of_int (Script_list.length ys)) | KList_exit_body (_, _, _, _, _, _) -> Control.list_exit_body | KMap_enter_body (_, xs, _, _, _) -> Control.map_enter_body (Size.of_int (List.length xs)) diff --git a/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml index 3a472f44fca2abc8f4fde34eac18035a160672ad..bbe425a30711b4f240877ec7cfcf1dd6b4aaf099 100644 --- a/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/ticket_benchmarks.ml @@ -269,16 +269,16 @@ module Collect_tickets_benchmark : Benchmark.S = struct let ty = match list_t (-1) ticket_ty with Error _ -> assert false | Ok t -> t in - let length, elements = + let _, elements = Structure_samplers.list ~range:{min = 0; max = config.max_size} ~sampler:ticket_sampler rng_state in - let boxed_ticket_list = {elements; length} in + let boxed_ticket_list = Script_list.of_list elements in Environment.wrap_tzresult @@ let* has_tickets, ctxt = Ticket_scanner.type_has_tickets ctxt ty in - let workload = {nodes = length} in + let workload = {nodes = Script_list.length boxed_ticket_list} in let closure () = ignore (Lwt_main.run diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index 28da979c38740259c5fc24299621c46ea6c68637..83bf16e25dd939c74403a527638a33f6f1458959 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -193,6 +193,7 @@ "Gas_monad", "Script_ir_annot", "Dependent_bool", + "Script_list", "Script_typed_ir", "Script_comparable", "Gas_comparable_input_size", @@ -204,7 +205,6 @@ "Michelson_v1_gas_costs_generated", "Michelson_v1_gas_costs", "Michelson_v1_gas", - "Script_list", "Script_tc_context", "Ticket_token", "Ticket_receipt", diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune index 90310f78555123963e890d46aeb8ffd8d212dc6d..71eca07e7f03153f898fe01d1779bc4645401e43 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -206,6 +206,7 @@ Gas_monad Script_ir_annot Dependent_bool + Script_list Script_typed_ir Script_comparable Gas_comparable_input_size @@ -217,7 +218,6 @@ Michelson_v1_gas_costs_generated Michelson_v1_gas_costs Michelson_v1_gas - Script_list Script_tc_context Ticket_token Ticket_receipt @@ -475,6 +475,7 @@ gas_monad.ml gas_monad.mli script_ir_annot.ml script_ir_annot.mli dependent_bool.ml dependent_bool.mli + script_list.ml script_list.mli script_typed_ir.ml script_typed_ir.mli script_comparable.ml script_comparable.mli gas_comparable_input_size.ml gas_comparable_input_size.mli @@ -486,7 +487,6 @@ michelson_v1_gas_costs_generated.ml michelson_v1_gas_costs.ml michelson_v1_gas.ml michelson_v1_gas.mli - script_list.ml script_list.mli script_tc_context.ml script_tc_context.mli ticket_token.ml ticket_token.mli ticket_receipt.ml ticket_receipt.mli @@ -724,6 +724,7 @@ gas_monad.ml gas_monad.mli script_ir_annot.ml script_ir_annot.mli dependent_bool.ml dependent_bool.mli + script_list.ml script_list.mli script_typed_ir.ml script_typed_ir.mli script_comparable.ml script_comparable.mli gas_comparable_input_size.ml gas_comparable_input_size.mli @@ -735,7 +736,6 @@ michelson_v1_gas_costs_generated.ml michelson_v1_gas_costs.ml michelson_v1_gas.ml michelson_v1_gas.mli - script_list.ml script_list.mli script_tc_context.ml script_tc_context.mli ticket_token.ml ticket_token.mli ticket_receipt.ml ticket_receipt.mli @@ -978,6 +978,7 @@ gas_monad.ml gas_monad.mli script_ir_annot.ml script_ir_annot.mli dependent_bool.ml dependent_bool.mli + script_list.ml script_list.mli script_typed_ir.ml script_typed_ir.mli script_comparable.ml script_comparable.mli gas_comparable_input_size.ml gas_comparable_input_size.mli @@ -989,7 +990,6 @@ michelson_v1_gas_costs_generated.ml michelson_v1_gas_costs.ml michelson_v1_gas.ml michelson_v1_gas.mli - script_list.ml script_list.mli script_tc_context.ml script_tc_context.mli ticket_token.ml ticket_token.mli ticket_receipt.ml ticket_receipt.mli diff --git a/src/proto_alpha/lib_protocol/gas_input_size.ml b/src/proto_alpha/lib_protocol/gas_input_size.ml index 1a35ae6ea9e13d920d3ee52cc4c7952a289a7243..d4105ef06ca12e59af16f76e3ec391e8f3d22500 100644 --- a/src/proto_alpha/lib_protocol/gas_input_size.ml +++ b/src/proto_alpha/lib_protocol/gas_input_size.ml @@ -25,8 +25,7 @@ include Gas_comparable_input_size -let list (list : 'a Script_typed_ir.boxed_list) : t = - list.Script_typed_ir.length +let list (list : 'a Script_list.t) : t = list.Script_list.length let set (set : 'a Script_typed_ir.set) : t = let res = Script_int.to_int (Script_set.size set) in diff --git a/src/proto_alpha/lib_protocol/gas_input_size.mli b/src/proto_alpha/lib_protocol/gas_input_size.mli index 48961e1a2966ba9fbeb62ff819b1f7b07c170a78..6d3ba74fa43f8c85a26e9bc4c457750fbf5ed753 100644 --- a/src/proto_alpha/lib_protocol/gas_input_size.mli +++ b/src/proto_alpha/lib_protocol/gas_input_size.mli @@ -34,7 +34,7 @@ include module type of Gas_comparable_input_size (* ------------------------------------------------------------------------- *) -val list : 'a Script_typed_ir.boxed_list -> t +val list : 'a Script_list.t -> t val set : 'a Script_typed_ir.set -> t diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index d31ddd7e1e5503e3eb6c9d287d0bb6f5dc611cb3..2498a4ab6aa94dcd93acb7ee9c3739213a3419b7 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -78,12 +78,12 @@ module Cost_of = struct let if_cons = atomic_step_cost cost_N_IIf_cons - let list_map : 'a Script_typed_ir.boxed_list -> Gas.cost = + let list_map : 'a Script_list.t -> Gas.cost = fun _ -> atomic_step_cost cost_N_IList_map let list_size = atomic_step_cost cost_N_IList_size - let list_iter : 'a Script_typed_ir.boxed_list -> Gas.cost = + let list_iter : 'a Script_list.t -> Gas.cost = fun _ -> atomic_step_cost cost_N_IList_iter let empty_set = atomic_step_cost cost_N_IEmpty_set @@ -308,7 +308,7 @@ module Cost_of = struct let neq = atomic_step_cost cost_N_INeq - let pairing_check_bls12_381 (l : 'a Script_typed_ir.boxed_list) = + let pairing_check_bls12_381 (l : 'a Script_list.t) = atomic_step_cost (cost_N_IPairing_check_bls12_381 l.length) let comb n = atomic_step_cost (cost_N_IComb n) @@ -633,7 +633,7 @@ module Cost_of = struct list of strings to compute the total allocated cost. [concat_string_precheck] corresponds to the meta-gas cost of this computation. *) - let concat_string_precheck (l : 'a Script_typed_ir.boxed_list) = + let concat_string_precheck (l : 'a Script_list.t) = (* we set the precheck to be slightly more expensive than cost_N_IList_iter *) atomic_step_cost (S.mul (S.safe_int l.length) (S.safe_int 10)) diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli index d15851a04ad6f176a0c02185fe4983aadf042dfc..bef843924505d937a10d71119110b834917d4eb9 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli @@ -70,12 +70,12 @@ module Cost_of : sig val if_cons : Gas.cost (* The argument of this function is ignored when calculating gas cost. *) - val list_map : 'a Script_typed_ir.boxed_list -> Gas.cost + val list_map : 'a Script_list.t -> Gas.cost val list_size : Gas.cost (* The argument of this function is ignored when calculating gas cost. *) - val list_iter : 'a Script_typed_ir.boxed_list -> Gas.cost + val list_iter : 'a Script_list.t -> Gas.cost val empty_set : Gas.cost @@ -255,7 +255,7 @@ module Cost_of : sig val neq : Gas.cost - val pairing_check_bls12_381 : 'a Script_typed_ir.boxed_list -> Gas.cost + val pairing_check_bls12_381 : 'a Script_list.t -> Gas.cost val comb : int -> Gas.cost @@ -269,7 +269,7 @@ module Cost_of : sig val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost - val concat_string_precheck : 'a Script_typed_ir.boxed_list -> Gas.cost + val concat_string_precheck : 'a Script_list.t -> Gas.cost val concat_string : Saturation_repr.may_saturate Saturation_repr.t -> Gas.cost diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index a0ed820f8f8e774393d9ba7813c363a7fe6040be..76b33e1c92914eb478e870180803cbcdc1d52a82 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -274,7 +274,8 @@ and kmap_enter : type a b c d f i j k. (a, b, c, d, f, i, j, k) kmap_enter_type and klist_exit : type a b c d e i j. (a, b, c, d, e, i, j) klist_exit_type = fun instrument g gas body xs ys ty len ks accu stack -> - let ks = instrument @@ KList_enter_body (body, xs, accu :: ys, ty, len, ks) in + let ys = Script_list.cons accu ys in + let ks = instrument @@ KList_enter_body (body, xs, ys, ty, len, ks) in let accu, stack = stack in (next [@ocaml.tailcall]) g gas ks accu stack [@@inline] @@ -283,7 +284,7 @@ and klist_enter : type a b c d e f j. (a, b, c, d, e, f, j) klist_enter_type = fun instrument g gas body xs ys ty len ks' accu stack -> match xs with | [] -> - let ys = {elements = List.rev ys; length = len} in + let ys = Script_list.rev ys in (next [@ocaml.tailcall]) g gas ks' ys (accu, stack) | x :: xs -> let ks = instrument @@ KList_exit_body (body, xs, ys, ty, len, ks') in @@ -391,7 +392,7 @@ and ilist_map : type a b c d e f g h i. (a, b, c, d, e, f, g, h, i) ilist_map_type = fun instrument g gas body k ks ty accu stack -> let xs = accu.elements in - let ys = [] in + let ys = Script_list.empty in let len = accu.length in let ks = instrument @@ KList_enter_body (body, xs, ys, ty, len, KCons (k, ks)) @@ -694,8 +695,8 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let accu = Script_list.empty in (step [@ocaml.tailcall]) g gas k ks accu stack | IIf_cons {branch_if_cons; branch_if_nil; k; _} -> ( - match accu.elements with - | [] -> + match Script_list.uncons accu with + | None -> let accu, stack = stack in (step [@ocaml.tailcall]) g @@ -704,8 +705,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = (KCons (k, ks)) accu stack - | hd :: tl -> - let tl = {elements = tl; length = accu.length - 1} in + | Some (hd, tl) -> (step [@ocaml.tailcall]) g gas @@ -1682,12 +1682,11 @@ and log : Script_interpreter_logging.instrument_cont logger sty' @@ KCons (k, ks) in - match accu.elements with - | [] -> + match Script_list.uncons accu with + | None -> let accu, stack = stack in (step [@ocaml.tailcall]) g gas branch_if_nil k' accu stack - | hd :: tl -> - let tl = {elements = tl; length = accu.length - 1} in + | Some (hd, tl) -> (step [@ocaml.tailcall]) g gas branch_if_cons k' hd (tl, stack)) | IList_map (_, body, ty, k) -> let (Item_t (_, sty')) = sty in diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 0a87b0a382130b244414f0d7df82fa546bf88427..fc13757c117a4e8c2f92667778de7f96db589851 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -811,10 +811,10 @@ type ('a, 'b, 'c, 'd, 'e, 'i, 'j) klist_exit_type = local_gas_counter -> ('i, 'a * 'b, 'j, 'a * 'b) kinstr -> 'i list -> - 'j list -> - ('j boxed_list, 'e) ty option -> + 'j Script_list.t -> + ('j Script_list.t, 'e) ty option -> int -> - ('j boxed_list, 'a * 'b, 'c, 'd) continuation -> + ('j Script_list.t, 'a * 'b, 'c, 'd) continuation -> 'j -> 'a * 'b -> ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t @@ -825,10 +825,10 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'j) klist_enter_type = local_gas_counter -> ('j, 'a * 'c, 'b, 'a * 'c) kinstr -> 'j list -> - 'b list -> - ('b boxed_list, 'f) ty option -> + 'b Script_list.t -> + ('b Script_list.t, 'f) ty option -> int -> - ('b boxed_list, 'a * 'c, 'd, 'e) continuation -> + ('b Script_list.t, 'a * 'c, 'd, 'e) continuation -> 'a -> 'c -> ('d * 'e * outdated_context * local_gas_counter) tzresult Lwt.t @@ -870,10 +870,10 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i) ilist_map_type = outdated_context * step_constants -> local_gas_counter -> ('e, 'a * 'b, 'f, 'a * 'b) kinstr -> - ('f boxed_list, 'a * 'b, 'g, 'h) kinstr -> + ('f Script_list.t, 'a * 'b, 'g, 'h) kinstr -> ('g, 'h, 'c, 'd) continuation -> - ('f boxed_list, 'i) ty option -> - 'e boxed_list -> + ('f Script_list.t, 'i) ty option -> + 'e Script_list.t -> 'a * 'b -> ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t @@ -885,7 +885,7 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'cmp) ilist_iter_type = ('e, 'cmp) ty option -> ('a, 'b, 'f, 'g) kinstr -> ('f, 'g, 'c, 'd) continuation -> - 'e boxed_list -> + 'e Script_list.t -> 'a * 'b -> ('c * 'd * 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 41453d7ec67e6b181a8241ae6a96cafa3b843149..87051202dad47ee7f3732879ecd30125679b025f 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -1117,7 +1117,7 @@ type toplevel = { type ('arg, 'storage) code = | Code : { code : - (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda; + (('arg, 'storage) pair, (operation Script_list.t, 'storage) pair) lambda; arg_type : ('arg, _) ty; storage_type : ('storage, _) ty; views : view_map; @@ -5076,7 +5076,7 @@ type 'ty has_lazy_storage = 'a has_lazy_storage * 'b has_lazy_storage -> ('a, 'b) union has_lazy_storage | Option_f : 'a has_lazy_storage -> 'a option has_lazy_storage - | List_f : 'a has_lazy_storage -> 'a boxed_list 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 (** @@ -5203,7 +5203,7 @@ let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = (ctxt, Script_list.empty, ids_to_copy, acc) l.elements >|=? fun (ctxt, l, ids_to_copy, acc) -> - let reversed = {length = l.length; elements = List.rev l.elements} in + let reversed = Script_list.rev l in (ctxt, reversed, ids_to_copy, acc) | Map_f has_lazy_storage, Map_t (_, ty, _), map -> let (module M) = Script_map.get_module map in diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli index 6a65a2e20669aa944f7c1d7f21f32f40342192dc..dd9af56c6fdc32fcb42a625b7a554efac43e19fa 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.mli +++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli @@ -94,7 +94,7 @@ type ('arg, 'storage) code = | Code : { code : ( ('arg, 'storage) Script_typed_ir.pair, - ( Script_typed_ir.operation Script_typed_ir.boxed_list, + ( Script_typed_ir.operation Script_list.t, 'storage ) Script_typed_ir.pair ) Script_typed_ir.lambda; diff --git a/src/proto_alpha/lib_protocol/script_list.ml b/src/proto_alpha/lib_protocol/script_list.ml index 7e9cbdeb22140b9b7414f692560642afa76c4a00..66d97bdbffbcddb011adcf86e1b5a37824d32818 100644 --- a/src/proto_alpha/lib_protocol/script_list.ml +++ b/src/proto_alpha/lib_protocol/script_list.ml @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* Copyright (c) 2020 Metastate AG *) +(* Copyright (c) 2021-2022 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -24,9 +25,23 @@ (* *) (*****************************************************************************) -open Script_typed_ir +type 'elt t = {elements : 'elt list; length : int} -let empty : 'a boxed_list = {elements = []; length = 0} +let of_list l = {elements = l; length = List.length l} [@@inline always] -let cons : 'a -> 'a boxed_list -> 'a boxed_list = +let to_list {elements; length = _} = elements [@@inline always] + +let empty : 'a t = {elements = []; length = 0} + +let cons : 'a -> 'a t -> 'a t = fun elt l -> {length = 1 + l.length; elements = elt :: l.elements} + +let length {elements = _; length} = length [@@inline always] + +let uncons = function + | {elements = []; length = _} -> None + | {elements = hd :: tl; length} -> + Some (hd, {elements = tl; length = length - 1}) + +let rev {elements; length} = {elements = List.rev elements; length} + [@@inline always] diff --git a/src/proto_alpha/lib_protocol/script_list.mli b/src/proto_alpha/lib_protocol/script_list.mli index 01a4670df6b47072f6aeed0c62c3dc7f4fc4bae4..dbd19d6467c00a49aa735456286bccb407526f1a 100644 --- a/src/proto_alpha/lib_protocol/script_list.mli +++ b/src/proto_alpha/lib_protocol/script_list.mli @@ -3,6 +3,7 @@ (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) (* Copyright (c) 2020 Metastate AG *) +(* Copyright (c) 2021-2022 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -24,8 +25,26 @@ (* *) (*****************************************************************************) +type 'elt t = private {elements : 'elt list; length : int} + +(** Convert an OCaml list into Michelson list. *) +val of_list : 'a list -> 'a t + +(** Convert a Michelson list to an OCaml list. *) +val to_list : 'a t -> 'a list + +(** [length l] returns the number of elements in [l] as [int]. *) +val length : 'a t -> int + (** Empty list. *) -val empty : 'a Script_typed_ir.boxed_list +val empty : 'a t (** Prepend an element. *) -val cons : 'a -> 'a Script_typed_ir.boxed_list -> 'a Script_typed_ir.boxed_list +val cons : 'a -> 'a t -> 'a t + +(** [uncons l] returns [Some (hd, tl)] where [hd :: tl = l] if [l] is + not empty or [None] otherwise. *) +val uncons : 'a t -> ('a * 'a t) option + +(** [rev l] returns a list containing all elements of [l] in reversed order. *) +val rev : 'a t -> 'a t diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index aaded94994b13fd5689cd622de511428eb822b94..3c75ade275fa976d44a0cb3e8980f10fdfe3729a 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -418,8 +418,6 @@ type ('key, 'value) big_map_overlay = { size : int; } -type 'elt boxed_list = {elements : 'elt list; length : int} - type view = { input_ty : Script.node; output_ty : Script.node; @@ -531,33 +529,33 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = ----- *) | ICons_list : - Script.location * ('a boxed_list, 's, 'r, 'f) kinstr - -> ('a, 'a boxed_list * 's, 'r, 'f) kinstr + Script.location * ('a Script_list.t, 's, 'r, 'f) kinstr + -> ('a, 'a Script_list.t * 's, 'r, 'f) kinstr | INil : - Script.location * ('b, _) ty * ('b boxed_list, 'a * 's, 'r, 'f) kinstr + Script.location * ('b, _) ty * ('b Script_list.t, 'a * 's, 'r, 'f) kinstr -> ('a, 's, 'r, 'f) kinstr | IIf_cons : { loc : Script.location; - branch_if_cons : ('a, 'a boxed_list * ('b * 's), 'c, 't) kinstr; + branch_if_cons : ('a, 'a Script_list.t * ('b * 's), 'c, 't) kinstr; branch_if_nil : ('b, 's, 'c, 't) kinstr; k : ('c, 't, 'r, 'f) kinstr; } - -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr + -> ('a Script_list.t, 'b * 's, 'r, 'f) kinstr | IList_map : Script.location * ('a, 'c * 's, 'b, 'c * 's) kinstr - * ('b boxed_list, _) ty option - * ('b boxed_list, 'c * 's, 'r, 'f) kinstr - -> ('a boxed_list, 'c * 's, 'r, 'f) kinstr + * ('b Script_list.t, _) ty option + * ('b Script_list.t, 'c * 's, 'r, 'f) kinstr + -> ('a Script_list.t, 'c * 's, 'r, 'f) kinstr | IList_iter : Script.location * ('a, _) ty option * ('a, 'b * 's, 'b, 's) kinstr * ('b, 's, 'r, 'f) kinstr - -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr + -> ('a Script_list.t, 'b * 's, 'r, 'f) kinstr | IList_size : Script.location * (n num, 's, 'r, 'f) kinstr - -> ('a boxed_list, 's, 'r, 'f) kinstr + -> ('a Script_list.t, 's, 'r, 'f) kinstr (* Sets ---- @@ -645,7 +643,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = *) | IConcat_string : Script.location * (Script_string.t, 's, 'r, 'f) kinstr - -> (Script_string.t boxed_list, 's, 'r, 'f) kinstr + -> (Script_string.t Script_list.t, 's, 'r, 'f) kinstr | IConcat_string_pair : Script.location * (Script_string.t, 's, 'r, 'f) kinstr -> (Script_string.t, Script_string.t * 's, 'r, 'f) kinstr @@ -661,7 +659,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = *) | IConcat_bytes : Script.location * (bytes, 's, 'r, 'f) kinstr - -> (bytes boxed_list, 's, 'r, 'f) kinstr + -> (bytes Script_list.t, 's, 'r, 'f) kinstr | IConcat_bytes_pair : Script.location * (bytes, 's, 'r, 'f) kinstr -> (bytes, bytes * 's, 'r, 'f) kinstr @@ -1033,7 +1031,11 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = -> (Script_bls.Fr.t, 's, 'r, 'f) kinstr | IPairing_check_bls12_381 : Script.location * (bool, 's, 'r, 'f) kinstr - -> ((Script_bls.G1.t, Script_bls.G2.t) pair boxed_list, 's, 'r, 'f) kinstr + -> ( (Script_bls.G1.t, Script_bls.G2.t) pair Script_list.t, + 's, + 'r, + 'f ) + kinstr | IComb : Script.location * int @@ -1174,18 +1176,18 @@ and (_, _, _, _) continuation = | KList_enter_body : ('a, 'c * 's, 'b, 'c * 's) kinstr * 'a list - * 'b list - * ('b boxed_list, _) ty option + * 'b Script_list.t + * ('b Script_list.t, _) ty option * int - * ('b boxed_list, 'c * 's, 'r, 'f) continuation + * ('b Script_list.t, 'c * 's, 'r, 'f) continuation -> ('c, 's, 'r, 'f) continuation | KList_exit_body : ('a, 'c * 's, 'b, 'c * 's) kinstr * 'a list - * 'b list - * ('b boxed_list, _) ty option + * 'b Script_list.t + * ('b Script_list.t, _) ty option * int - * ('b boxed_list, 'c * 's, 'r, 'f) continuation + * ('b Script_list.t, 'c * 's, 'r, 'f) continuation -> ('b, 'c * 's, 'r, 'f) continuation | KMap_enter_body : ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr @@ -1260,7 +1262,9 @@ and ('ty, 'comparable) ty = | Option_t : ('v, 'c) ty * 'v option ty_metadata * 'c dbool -> ('v option, 'c) ty - | List_t : ('v, _) ty * 'v boxed_list ty_metadata -> ('v boxed_list, no) ty + | List_t : + ('v, _) ty * 'v Script_list.t ty_metadata + -> ('v Script_list.t, no) ty | Set_t : 'v comparable_ty * 'v set ty_metadata -> ('v set, no) ty | Map_t : 'k comparable_ty * ('v, _) ty * ('k, 'v) map ty_metadata @@ -1444,7 +1448,7 @@ type ex_ty = Ex_ty : ('a, _) ty -> ex_ty type ('arg, 'storage) script = | Script : { code : - (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda; + (('arg, 'storage) pair, (operation Script_list.t, 'storage) pair) lambda; arg_type : ('arg, _) ty; storage : 'storage; storage_type : ('storage, _) ty; diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 5cd6815538db4be844de4854f98aef43ff03c9fb..874cb08556e870eabbb53d4812086fdaf773914e 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -29,15 +29,34 @@ open Alpha_context open Script_int open Dependent_bool +(* + + The step function of the interpreter is parametrized by a bunch of values called the step constants. + These values are indeed constants during the call of a smart contract with the notable exception of + the IView instruction which modifies `source`, `self`, and `amount` and the KView_exit continuation + which restores them. + ====================== + +*) type step_constants = { source : Contract.t; + (** The address calling this contract, as returned by SENDER. *) payer : Signature.public_key_hash; + (** The address of the implicit account that initiated the chain of contract calls, as returned by SOURCE. *) self : Contract_hash.t; + (** The address of the contract being executed, as returned by SELF and SELF_ADDRESS. + Also used: + - as ticketer in TICKET + - as caller in VIEW, TRANSFER_TOKENS, and CREATE_CONTRACT *) amount : Tez.t; - balance : Tez.t; + (** The amount of the current transaction, as returned by AMOUNT. *) + balance : Tez.t; (** The balance of the contract as returned by BALANCE. *) chain_id : Chain_id.t; + (** The chain id of the chain, as returned by CHAIN_ID. *) now : Script_timestamp.t; + (** The earliest time at which the current block could have been timestamped, as returned by NOW. *) level : Script_int.n Script_int.num; + (** The level of the current block, as returned by LEVEL. *) } (* Preliminary definitions. *) @@ -271,8 +290,6 @@ type ('key, 'value) big_map_overlay = { size : int; } -type 'elt boxed_list = {elements : 'elt list; length : int} - type view = { input_ty : Script.node; output_ty : Script.node; @@ -492,33 +509,33 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = ----- *) | ICons_list : - Script.location * ('a boxed_list, 's, 'r, 'f) kinstr - -> ('a, 'a boxed_list * 's, 'r, 'f) kinstr + Script.location * ('a Script_list.t, 's, 'r, 'f) kinstr + -> ('a, 'a Script_list.t * 's, 'r, 'f) kinstr | INil : - Script.location * ('b, _) ty * ('b boxed_list, 'a * 's, 'r, 'f) kinstr + Script.location * ('b, _) ty * ('b Script_list.t, 'a * 's, 'r, 'f) kinstr -> ('a, 's, 'r, 'f) kinstr | IIf_cons : { loc : Script.location; - branch_if_cons : ('a, 'a boxed_list * ('b * 's), 'c, 't) kinstr; + branch_if_cons : ('a, 'a Script_list.t * ('b * 's), 'c, 't) kinstr; branch_if_nil : ('b, 's, 'c, 't) kinstr; k : ('c, 't, 'r, 'f) kinstr; } - -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr + -> ('a Script_list.t, 'b * 's, 'r, 'f) kinstr | IList_map : Script.location * ('a, 'c * 's, 'b, 'c * 's) kinstr - * ('b boxed_list, _) ty option - * ('b boxed_list, 'c * 's, 'r, 'f) kinstr - -> ('a boxed_list, 'c * 's, 'r, 'f) kinstr + * ('b Script_list.t, _) ty option + * ('b Script_list.t, 'c * 's, 'r, 'f) kinstr + -> ('a Script_list.t, 'c * 's, 'r, 'f) kinstr | IList_iter : Script.location * ('a, _) ty option * ('a, 'b * 's, 'b, 's) kinstr * ('b, 's, 'r, 'f) kinstr - -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr + -> ('a Script_list.t, 'b * 's, 'r, 'f) kinstr | IList_size : Script.location * (n num, 's, 'r, 'f) kinstr - -> ('a boxed_list, 's, 'r, 'f) kinstr + -> ('a Script_list.t, 's, 'r, 'f) kinstr (* Sets ---- @@ -606,7 +623,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = *) | IConcat_string : Script.location * (Script_string.t, 's, 'r, 'f) kinstr - -> (Script_string.t boxed_list, 's, 'r, 'f) kinstr + -> (Script_string.t Script_list.t, 's, 'r, 'f) kinstr | IConcat_string_pair : Script.location * (Script_string.t, 's, 'r, 'f) kinstr -> (Script_string.t, Script_string.t * 's, 'r, 'f) kinstr @@ -622,7 +639,7 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = *) | IConcat_bytes : Script.location * (bytes, 's, 'r, 'f) kinstr - -> (bytes boxed_list, 's, 'r, 'f) kinstr + -> (bytes Script_list.t, 's, 'r, 'f) kinstr | IConcat_bytes_pair : Script.location * (bytes, 's, 'r, 'f) kinstr -> (bytes, bytes * 's, 'r, 'f) kinstr @@ -1030,7 +1047,11 @@ and ('before_top, 'before, 'result_top, 'result) kinstr = -> (Script_bls.Fr.t, 's, 'r, 'f) kinstr | IPairing_check_bls12_381 : Script.location * (bool, 's, 'r, 'f) kinstr - -> ((Script_bls.G1.t, Script_bls.G2.t) pair boxed_list, 's, 'r, 'f) kinstr + -> ( (Script_bls.G1.t, Script_bls.G2.t) pair Script_list.t, + 's, + 'r, + 'f ) + kinstr | IComb : Script.location * int @@ -1237,19 +1258,19 @@ and (_, _, _, _) continuation = | KList_enter_body : ('a, 'c * 's, 'b, 'c * 's) kinstr * 'a list - * 'b list - * ('b boxed_list, _) ty option + * 'b Script_list.t + * ('b Script_list.t, _) ty option * int - * ('b boxed_list, 'c * 's, 'r, 'f) continuation + * ('b Script_list.t, 'c * 's, 'r, 'f) continuation -> ('c, 's, 'r, 'f) continuation (* This continuation represents what is done after each step of a List.map. *) | KList_exit_body : ('a, 'c * 's, 'b, 'c * 's) kinstr * 'a list - * 'b list - * ('b boxed_list, _) ty option + * 'b Script_list.t + * ('b Script_list.t, _) ty option * int - * ('b boxed_list, 'c * 's, 'r, 'f) continuation + * ('b Script_list.t, 'c * 's, 'r, 'f) continuation -> ('b, 'c * 's, 'r, 'f) continuation (* This continuation represents each step of a Map.map. *) | KMap_enter_body : @@ -1357,7 +1378,9 @@ and ('ty, 'comparable) ty = | Option_t : ('v, 'c) ty * 'v option ty_metadata * 'c dbool -> ('v option, 'c) ty - | List_t : ('v, _) ty * 'v boxed_list ty_metadata -> ('v boxed_list, no) ty + | List_t : + ('v, _) ty * 'v Script_list.t ty_metadata + -> ('v Script_list.t, no) ty | Set_t : 'v comparable_ty * 'v set ty_metadata -> ('v set, no) ty | Map_t : 'k comparable_ty * ('v, _) ty * ('k, 'v) map ty_metadata @@ -1578,7 +1601,7 @@ and operation = { type ('arg, 'storage) script = | Script : { code : - (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda; + (('arg, 'storage) pair, (operation Script_list.t, 'storage) pair) lambda; arg_type : ('arg, _) ty; storage : 'storage; storage_type : ('storage, _) ty; @@ -1684,9 +1707,9 @@ val option_pair_mutez_mutez_t : (Tez.t, Tez.t) pair option comparable_ty val option_pair_int_nat_t : (z num, n num) pair option comparable_ty -val list_t : Script.location -> ('v, _) ty -> ('v boxed_list, no) ty tzresult +val list_t : Script.location -> ('v, _) ty -> ('v Script_list.t, no) ty tzresult -val list_operation_t : (operation boxed_list, no) ty +val list_operation_t : (operation Script_list.t, no) ty val set_t : Script.location -> 'v comparable_ty -> ('v set, no) ty tzresult diff --git a/src/proto_alpha/lib_protocol/test/helpers/script_list.ml b/src/proto_alpha/lib_protocol/test/helpers/script_list.ml deleted file mode 100644 index b224d784226bbd2a328edb66d3204cbfccf72c1b..0000000000000000000000000000000000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/script_list.ml +++ /dev/null @@ -1,29 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2020 Metastate AG *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -open Protocol.Script_typed_ir (* For record fields *) - -let of_list xs = {elements = xs; length = List.length xs} diff --git a/src/proto_alpha/lib_protocol/test/helpers/script_list.mli b/src/proto_alpha/lib_protocol/test/helpers/script_list.mli deleted file mode 100644 index fecdbe0072c1f130a1524960a95403095e77e758..0000000000000000000000000000000000000000 --- a/src/proto_alpha/lib_protocol/test/helpers/script_list.mli +++ /dev/null @@ -1,28 +0,0 @@ -(*****************************************************************************) -(* *) -(* Open Source License *) -(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) -(* Copyright (c) 2020 Metastate AG *) -(* *) -(* Permission is hereby granted, free of charge, to any person obtaining a *) -(* copy of this software and associated documentation files (the "Software"),*) -(* to deal in the Software without restriction, including without limitation *) -(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) -(* and/or sell copies of the Software, and to permit persons to whom the *) -(* Software is furnished to do so, subject to the following conditions: *) -(* *) -(* The above copyright notice and this permission notice shall be included *) -(* in all copies or substantial portions of the Software. *) -(* *) -(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) -(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) -(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) -(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) -(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) -(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) -(* DEALINGS IN THE SOFTWARE. *) -(* *) -(*****************************************************************************) - -(** Convert a standard list to a Script IR list. *) -val of_list : 'a list -> 'a Protocol.Script_typed_ir.boxed_list 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 1e0342d85d7be7efac3f20ec649ee21ba7be8105..4f455ac1b9f29c6d12e123a008d7a27b9af297ae 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 @@ -481,7 +481,7 @@ let check_value_size () = ====== *) @ (let module P = struct - type 'a f = {apply : 'c. ('a boxed_list, 'c) ty -> ex list} + type 'a f = {apply : 'c. ('a Script_list.t, 'c) ty -> ex list} end in let on_list : type a. (a, _) ty -> a P.f -> ex list = fun ty f -> f.apply @@ is_ok @@ list_t dummy_loc ty @@ -492,7 +492,9 @@ let check_value_size () = { apply = (fun ty -> - let show fmt l = Format.pp_print_list show_elt fmt l.elements in + let show fmt l = + Format.pp_print_list show_elt fmt @@ Script_list.to_list l + in exs nsample show ty ": list _"); } in 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 ac711717acdd8a8669efd8e8467f0ca47548b1a9..618766fb1db5f7eaa0d2faf3a628da28a4ac79c5 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 @@ -431,8 +431,7 @@ let ticket_string_list_type = Result.value_f ~default:(fun _ -> assert false) @@ Script_typed_ir.list_t (-1) ticket_string_type -let boxed_list elements = - {Script_typed_ir.elements; length = List.length elements} +let boxed_list = Script_list.of_list let big_map_type ~key_type ~value_type = Environment.wrap_tzresult 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 81c853bff6c0c482428b0183d081ded3fb328d1d..1612fb26a89daa74da67baacf667305794e3d92f 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 @@ -408,7 +408,7 @@ let make_ticket (ticketer, contents, amount) = let make_tickets ts = let* elements = List.map_es make_ticket ts in - return {elements; length = List.length elements} + return @@ Script_list.of_list elements let transfer_tickets_operation ~incr ~src ~destination tickets = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/ticket_scanner.ml b/src/proto_alpha/lib_protocol/ticket_scanner.ml index 04075d107f457631896a3dd35a300a82559ac993..3b2106187fc47594ab658709e34cb3d3d4c740b8 100644 --- a/src/proto_alpha/lib_protocol/ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/ticket_scanner.ml @@ -85,7 +85,7 @@ module Ticket_inspection = struct 'a has_tickets * 'b has_tickets -> ('a, 'b) Script_typed_ir.union has_tickets | Option_ht : 'a has_tickets -> 'a option has_tickets - | List_ht : 'a has_tickets -> 'a Script_typed_ir.boxed_list 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 | Map_ht : 'k has_tickets * 'v has_tickets @@ -375,7 +375,7 @@ module Ticket_collection = struct k | None -> (k [@ocaml.tailcall]) ctxt acc) | List_ht el_hty, List_t (el_ty, _) -> - let {elements; _} = x in + let elements = Script_list.to_list x in (tickets_of_list [@ocaml.tailcall]) ctxt ~include_lazy