From d3a2dfbbc31cda2f5606a3b08eedc2e8c54d9b0f Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:20:28 +0200 Subject: [PATCH 01/13] Proto: Uncurry kmap_exit Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 7 +++---- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 5 ++++- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 26646df03f42..3aa085d57f94 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -250,7 +250,7 @@ let () = let rec kmap_exit : type a b c d e f g h m n o. (a, b, c, d, e, f, g, h, m, n, o) kmap_exit_type = - fun mk g gas (body, xs, ys, yk) ks accu stack -> + fun mk g gas body xs ys yk ks accu stack -> let ys = Script_map.update yk (Some accu) ys in let ks = mk (KMap_enter_body (body, xs, ys, ks)) in let accu, stack = stack in @@ -347,8 +347,7 @@ and next : let extra = (body, xs, ys) in (kmap_enter [@ocaml.tailcall]) id g gas extra ks accu stack | KMap_exit_body (body, xs, ys, yk, ks) -> - let extra = (body, xs, ys, yk) in - (kmap_exit [@ocaml.tailcall]) id g gas extra ks accu stack + (kmap_exit [@ocaml.tailcall]) id g gas body xs ys yk ks accu stack | KView_exit (orig_step_constants, ks) -> let g = (fst g, orig_step_constants) in (next [@ocaml.tailcall]) g gas ks accu stack) @@ -1626,7 +1625,7 @@ and klog : (kmap_enter [@ocaml.tailcall]) mk g gas (body, xs, ys) ks' accu stack | KMap_exit_body (body, xs, ys, yk, ks') -> let ks' = mk ks' in - (kmap_exit [@ocaml.tailcall]) mk g gas (body, xs, ys, yk) ks' accu stack + (kmap_exit [@ocaml.tailcall]) mk g gas body xs ys yk ks' accu stack | KView_exit (orig_step_constants, ks') -> let g = (fst g, orig_step_constants) in (next [@ocaml.tailcall]) g gas ks' accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index e5647d2a096e..23da2a8618a4 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -735,7 +735,10 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'm, 'n, 'o) kmap_exit_type = (('c, 'd, 'e, 'f) continuation -> ('a, 'b, 'g, 'h) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('m * 'n, 'c * 'd, 'o, 'c * 'd) kinstr * ('m * 'n) list * ('m, 'o) map * 'm -> + ('m * 'n, 'c * 'd, 'o, 'c * 'd) kinstr -> + ('m * 'n) list -> + ('m, 'o) map -> + 'm -> (('m, 'o) map, 'c * 'd, 'e, 'f) continuation -> 'o -> 'a * 'b -> -- GitLab From 3fd18839a665b9cfe43b26576d2804000cfde1a5 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:24:23 +0200 Subject: [PATCH 02/13] Proto: Uncurry kmap_enter Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 7 +++---- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 4 +++- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 3aa085d57f94..763cddf5ebba 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -258,7 +258,7 @@ let rec kmap_exit : [@@inline] and kmap_enter : type a b c d i j k. (a, b, c, d, i, j, k) kmap_enter_type = - fun mk g gas (body, xs, ys) ks accu stack -> + fun mk g gas body xs ys ks accu stack -> match xs with | [] -> (next [@ocaml.tailcall]) g gas ks ys (accu, stack) | (xk, xv) :: xs -> @@ -344,8 +344,7 @@ and next : let extra = (body, xs, ys, len) in (klist_exit [@ocaml.tailcall]) id g gas extra ks accu stack | KMap_enter_body (body, xs, ys, ks) -> - let extra = (body, xs, ys) in - (kmap_enter [@ocaml.tailcall]) id g gas extra ks accu stack + (kmap_enter [@ocaml.tailcall]) id g gas body xs ys ks accu stack | KMap_exit_body (body, xs, ys, yk, ks) -> (kmap_exit [@ocaml.tailcall]) id g gas body xs ys yk ks accu stack | KView_exit (orig_step_constants, ks) -> @@ -1622,7 +1621,7 @@ and klog : (klist_exit [@ocaml.tailcall]) mk g gas extra ks' accu stack | KMap_enter_body (body, xs, ys, ks') -> let ks' = mk ks' in - (kmap_enter [@ocaml.tailcall]) mk g gas (body, xs, ys) ks' accu stack + (kmap_enter [@ocaml.tailcall]) mk g gas body xs ys ks' accu stack | KMap_exit_body (body, xs, ys, yk, ks') -> let ks' = mk ks' in (kmap_exit [@ocaml.tailcall]) mk g gas body xs ys yk ks' accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 23da2a8618a4..f719826abfe9 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -748,7 +748,9 @@ type ('a, 'b, 'c, 'd, 'e, 'j, 'k) kmap_enter_type = (('a, 'b * 'c, 'd, 'e) continuation -> ('a, 'b * 'c, 'd, 'e) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('j * 'k, 'b * 'c, 'a, 'b * 'c) kinstr * ('j * 'k) list * ('j, 'a) map -> + ('j * 'k, 'b * 'c, 'a, 'b * 'c) kinstr -> + ('j * 'k) list -> + ('j, 'a) map -> (('j, 'a) map, 'b * 'c, 'd, 'e) continuation -> 'b -> 'c -> -- GitLab From ccf5525cce9062bcf3b1f30fb0bd3c35a04c5acd Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:29:45 +0200 Subject: [PATCH 03/13] Proto: Uncurry klist_exit Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 8 +++----- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 5 ++++- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 763cddf5ebba..cf2c5b280f03 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -269,7 +269,7 @@ and kmap_enter : type a b c d i j k. (a, b, c, d, i, j, k) kmap_enter_type = [@@inline] and klist_exit : type a b c d i j. (a, b, c, d, i, j) klist_exit_type = - fun mk g gas (body, xs, ys, len) ks accu stack -> + fun mk g gas body xs ys len ks accu stack -> let ks = mk (KList_enter_body (body, xs, accu :: ys, len, ks)) in let accu, stack = stack in (next [@ocaml.tailcall]) g gas ks accu stack @@ -341,8 +341,7 @@ and next : let extra = (body, xs, ys, len) in (klist_enter [@ocaml.tailcall]) id g gas extra ks accu stack | KList_exit_body (body, xs, ys, len, ks) -> - let extra = (body, xs, ys, len) in - (klist_exit [@ocaml.tailcall]) id g gas extra ks accu stack + (klist_exit [@ocaml.tailcall]) id g gas body xs ys len ks accu stack | KMap_enter_body (body, xs, ys, ks) -> (kmap_enter [@ocaml.tailcall]) id g gas body xs ys ks accu stack | KMap_exit_body (body, xs, ys, yk, ks) -> @@ -1617,8 +1616,7 @@ and klog : (klist_enter [@ocaml.tailcall]) mk g gas extra ks' accu stack | KList_exit_body (body, xs, ys, len, ks') -> let ks' = mk ks' in - let extra = (body, xs, ys, len) in - (klist_exit [@ocaml.tailcall]) mk g gas extra ks' accu stack + (klist_exit [@ocaml.tailcall]) mk g gas body xs ys len ks' accu stack | KMap_enter_body (body, xs, ys, ks') -> let ks' = mk ks' in (kmap_enter [@ocaml.tailcall]) mk g gas body xs ys ks' accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index f719826abfe9..6405261a8f4e 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -760,7 +760,10 @@ type ('a, 'b, 'c, 'd, 'i, 'j) klist_exit_type = (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('i, 'a * 'b, 'j, 'a * 'b) kinstr * 'i list * 'j list * int -> + ('i, 'a * 'b, 'j, 'a * 'b) kinstr -> + 'i list -> + 'j list -> + int -> ('j boxed_list, 'a * 'b, 'c, 'd) continuation -> 'j -> 'a * 'b -> -- GitLab From ee5f64ad49d1daa620098dab26cc98047768e602 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:36:00 +0200 Subject: [PATCH 04/13] Proto: Uncurry klist_enter Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 8 +++----- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 5 ++++- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index cf2c5b280f03..85799834131e 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -276,7 +276,7 @@ and klist_exit : type a b c d i j. (a, b, c, d, i, j) klist_exit_type = [@@inline] and klist_enter : type a b c d e j. (a, b, c, d, e, j) klist_enter_type = - fun mk g gas (body, xs, ys, len) ks' accu stack -> + fun mk g gas body xs ys len ks' accu stack -> match xs with | [] -> let ys = {elements = List.rev ys; length = len} in @@ -338,8 +338,7 @@ and next : let extra = (body, xs) in (kiter [@ocaml.tailcall]) id g gas extra ks accu stack | KList_enter_body (body, xs, ys, len, ks) -> - let extra = (body, xs, ys, len) in - (klist_enter [@ocaml.tailcall]) id g gas extra ks accu stack + (klist_enter [@ocaml.tailcall]) id g gas body xs ys len ks accu stack | KList_exit_body (body, xs, ys, len, ks) -> (klist_exit [@ocaml.tailcall]) id g gas body xs ys len ks accu stack | KMap_enter_body (body, xs, ys, ks) -> @@ -1612,8 +1611,7 @@ and klog : (kiter [@ocaml.tailcall]) mk g gas (body, xs) ks' accu stack | KList_enter_body (body, xs, ys, len, ks') -> let ks' = mk ks' in - let extra = (body, xs, ys, len) in - (klist_enter [@ocaml.tailcall]) mk g gas extra ks' accu stack + (klist_enter [@ocaml.tailcall]) mk g gas body xs ys len ks' accu stack | KList_exit_body (body, xs, ys, len, ks') -> let ks' = mk ks' in (klist_exit [@ocaml.tailcall]) mk g gas body xs ys len ks' accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 6405261a8f4e..61739c9fbafe 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -773,7 +773,10 @@ type ('a, 'b, 'c, 'd, 'e, 'j) klist_enter_type = (('b, 'a * 'c, 'd, 'e) continuation -> ('b, 'a * 'c, 'd, 'e) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('j, 'a * 'c, 'b, 'a * 'c) kinstr * 'j list * 'b list * int -> + ('j, 'a * 'c, 'b, 'a * 'c) kinstr -> + 'j list -> + 'b list -> + int -> ('b boxed_list, 'a * 'c, 'd, 'e) continuation -> 'a -> 'c -> -- GitLab From 38b139948c05e5716e3770016884a4b0b2813a4c Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:41:04 +0200 Subject: [PATCH 05/13] Proto: Uncurry kiter Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 13 ++++++------- .../lib_protocol/script_interpreter_defs.ml | 6 ++++-- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 85799834131e..25dde5557463 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -302,7 +302,7 @@ and kloop_in : type a b c r f s. (a, b, c, r, f, s) kloop_in_type = [@@inline] and kiter : type a b s r f. (a, b, s, r, f) kiter_type = - fun mk g gas (body, xs) ks accu stack -> + fun mk g gas body xs ks accu stack -> match xs with | [] -> (next [@ocaml.tailcall]) g gas ks accu stack | x :: xs -> @@ -335,8 +335,7 @@ and next : (kloop_in_left [@ocaml.tailcall]) g gas ks0 ki ks' accu stack | KUndip (x, ks) -> (next [@ocaml.tailcall]) g gas ks x (accu, stack) | KIter (body, xs, ks) -> - let extra = (body, xs) in - (kiter [@ocaml.tailcall]) id g gas extra ks accu stack + (kiter [@ocaml.tailcall]) id g gas body xs ks accu stack | KList_enter_body (body, xs, ys, len, ks) -> (klist_enter [@ocaml.tailcall]) id g gas body xs ys len ks accu stack | KList_exit_body (body, xs, ys, len, ks) -> @@ -363,7 +362,7 @@ and next : *) and ilist_map : type a b c d e f g h. (a, b, c, d, e, f, g, h) ilist_map_type = - fun log_if_needed g gas (body, k) ks accu stack -> + fun log_if_needed g gas body k ks accu stack -> let xs = accu.elements in let ys = [] in let len = accu.length in @@ -579,7 +578,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = hd (tl, stack)) | IList_map (_, body, k) -> - (ilist_map [@ocaml.tailcall]) id g gas (body, k) ks accu stack + (ilist_map [@ocaml.tailcall]) id g gas body k ks accu stack | IList_size (_, k) -> let list = accu in let len = Script_int.(abs (of_int list.length)) in @@ -1533,7 +1532,7 @@ and log : let with_log k = match k with KLog _ -> k | _ -> KLog (k, logger) in match k with | IList_map (_, body, k) -> - (ilist_map [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack + (ilist_map [@ocaml.tailcall]) with_log g gas body k ks accu stack | IList_iter (_, body, k) -> (ilist_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack | ISet_iter (_, body, k) -> @@ -1608,7 +1607,7 @@ and klog : | KIter (body, xs, ks') -> let ks' = mk ks' in let body = enable_log body in - (kiter [@ocaml.tailcall]) mk g gas (body, xs) ks' accu stack + (kiter [@ocaml.tailcall]) mk g gas body xs ks' accu stack | KList_enter_body (body, xs, ys, len, ks') -> let ks' = mk ks' in (klist_enter [@ocaml.tailcall]) mk g gas body xs ys len ks' accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 61739c9fbafe..d9e3c1a93766 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -806,7 +806,8 @@ type ('a, 'b, 's, 'r, 'f) kiter_type = (('a, 's, 'r, 'f) continuation -> ('a, 's, 'r, 'f) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('b, 'a * 's, 'a, 's) kinstr * 'b list -> + ('b, 'a * 's, 'a, 's) kinstr -> + 'b list -> ('a, 's, 'r, 'f) continuation -> 'a -> 's -> @@ -816,7 +817,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) ilist_map_type = (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('e, 'a * 'b, 'f, 'a * 'b) kinstr * ('f boxed_list, 'a * 'b, 'g, 'h) kinstr -> + ('e, 'a * 'b, 'f, 'a * 'b) kinstr -> + ('f boxed_list, 'a * 'b, 'g, 'h) kinstr -> ('g, 'h, 'c, 'd) continuation -> 'e boxed_list -> 'a * 'b -> -- GitLab From 149ddd9d0bc98cda3ae0d70d5db513e60ab3ff8d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:46:27 +0200 Subject: [PATCH 06/13] Proto: Uncurry ilist_iter Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 6 +++--- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 3 ++- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 25dde5557463..913653395b66 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -374,7 +374,7 @@ and ilist_map : type a b c d e f g h. (a, b, c, d, e, f, g, h) ilist_map_type = [@@inline] and ilist_iter : type a b c d e f g. (a, b, c, d, e, f, g) ilist_iter_type = - fun log_if_needed g gas (body, k) ks accu stack -> + fun log_if_needed g gas body k ks accu stack -> let xs = accu.elements in let ks = log_if_needed (KIter (body, xs, KCons (k, ks))) in let accu, stack = stack in @@ -584,7 +584,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let len = Script_int.(abs (of_int list.length)) in (step [@ocaml.tailcall]) g gas k ks len stack | IList_iter (_, body, k) -> - (ilist_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack + (ilist_iter [@ocaml.tailcall]) id g gas body k ks accu stack (* sets *) | IEmpty_set (_, ty, k) -> let res = Script_set.empty ty in @@ -1534,7 +1534,7 @@ and log : | IList_map (_, body, k) -> (ilist_map [@ocaml.tailcall]) with_log g gas body k ks accu stack | IList_iter (_, body, k) -> - (ilist_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack + (ilist_iter [@ocaml.tailcall]) with_log g gas body k ks accu stack | ISet_iter (_, body, k) -> (iset_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack | IMap_map (_, body, k) -> diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index d9e3c1a93766..b9a42f30ea19 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -828,7 +828,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g) ilist_iter_type = (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('e, 'a * 'b, 'a, 'b) kinstr * ('a, 'b, 'f, 'g) kinstr -> + ('e, 'a * 'b, 'a, 'b) kinstr -> + ('a, 'b, 'f, 'g) kinstr -> ('f, 'g, 'c, 'd) continuation -> 'e boxed_list -> 'a * 'b -> -- GitLab From bbf63a8b81235f64fa7b5129085097a7204e3240 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:48:39 +0200 Subject: [PATCH 07/13] Proto: Uncurry iset_iter Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 6 +++--- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 3 ++- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 913653395b66..1391757c5381 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -382,7 +382,7 @@ and ilist_iter : type a b c d e f g. (a, b, c, d, e, f, g) ilist_iter_type = [@@inline] and iset_iter : type a b c d e f g. (a, b, c, d, e, f, g) iset_iter_type = - fun log_if_needed g gas (body, k) ks accu stack -> + fun log_if_needed g gas body k ks accu stack -> let set = accu in let l = List.rev (Script_set.fold (fun e acc -> e :: acc) set []) in let ks = log_if_needed (KIter (body, l, KCons (k, ks))) in @@ -591,7 +591,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let stack = (accu, stack) in (step [@ocaml.tailcall]) g gas k ks res stack | ISet_iter (_, body, k) -> - (iset_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack + (iset_iter [@ocaml.tailcall]) id g gas body k ks accu stack | ISet_mem (_, k) -> let set, stack = stack in let res = Script_set.mem accu set in @@ -1536,7 +1536,7 @@ and log : | IList_iter (_, body, k) -> (ilist_iter [@ocaml.tailcall]) with_log g gas body k ks accu stack | ISet_iter (_, body, k) -> - (iset_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack + (iset_iter [@ocaml.tailcall]) with_log g gas body k ks accu stack | IMap_map (_, body, k) -> (imap_map [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack | IMap_iter (_, body, k) -> diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index b9a42f30ea19..14401e8dc319 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -839,7 +839,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g) iset_iter_type = (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('e, 'a * 'b, 'a, 'b) kinstr * ('a, 'b, 'f, 'g) kinstr -> + ('e, 'a * 'b, 'a, 'b) kinstr -> + ('a, 'b, 'f, 'g) kinstr -> ('f, 'g, 'c, 'd) continuation -> 'e set -> 'a * 'b -> -- GitLab From d5bfc9b9948338f372a7ed539c989d35a0a56b2b Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 16:55:30 +0200 Subject: [PATCH 08/13] Proto: Uncurry imap_imap Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 6 +++--- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 1391757c5381..56c34456ab37 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -392,7 +392,7 @@ and iset_iter : type a b c d e f g. (a, b, c, d, e, f, g) iset_iter_type = and imap_map : type a b c d e f g h i. (a, b, c, d, e, f, g, h, i) imap_map_type = - fun log_if_needed g gas (body, k) ks accu stack -> + fun log_if_needed g gas body k ks accu stack -> let map = accu in let xs = List.rev (Script_map.fold (fun k v a -> (k, v) :: a) map []) in let ys = Script_map.empty_from map in @@ -608,7 +608,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let res = Script_map.empty ty and stack = (accu, stack) in (step [@ocaml.tailcall]) g gas k ks res stack | IMap_map (_, body, k) -> - (imap_map [@ocaml.tailcall]) id g gas (body, k) ks accu stack + (imap_map [@ocaml.tailcall]) id g gas body k ks accu stack | IMap_iter (_, body, k) -> (imap_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack | IMap_mem (_, k) -> @@ -1538,7 +1538,7 @@ and log : | ISet_iter (_, body, k) -> (iset_iter [@ocaml.tailcall]) with_log g gas body k ks accu stack | IMap_map (_, body, k) -> - (imap_map [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack + (imap_map [@ocaml.tailcall]) with_log g gas body k ks accu stack | IMap_iter (_, body, k) -> (imap_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack | ILoop (_, body, k) -> diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 14401e8dc319..d25cc10775fc 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -850,8 +850,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i) imap_map_type = (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('e * 'f, 'a * 'b, 'g, 'a * 'b) kinstr - * (('e, 'g) map, 'a * 'b, 'h, 'i) kinstr -> + ('e * 'f, 'a * 'b, 'g, 'a * 'b) kinstr -> + (('e, 'g) map, 'a * 'b, 'h, 'i) kinstr -> ('h, 'i, 'c, 'd) continuation -> ('e, 'f) map -> 'a * 'b -> -- GitLab From 51d0124bf01211f0ef8ce4478d806381dceea707 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 17:02:15 +0200 Subject: [PATCH 09/13] Proto: Uncurry imap_iter Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 56c34456ab37..0e2cf46f98f0 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -402,7 +402,7 @@ and imap_map : type a b c d e f g h i. (a, b, c, d, e, f, g, h, i) imap_map_type [@@inline] and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type = - fun log_if_needed g gas (body, k) ks accu stack -> + fun log_if_needed g gas body k ks accu stack -> let map = accu in let l = List.rev (Script_map.fold (fun k v a -> (k, v) :: a) map []) in let ks = log_if_needed (KIter (body, l, KCons (k, ks))) in @@ -610,7 +610,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = | IMap_map (_, body, k) -> (imap_map [@ocaml.tailcall]) id g gas body k ks accu stack | IMap_iter (_, body, k) -> - (imap_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack + (imap_iter [@ocaml.tailcall]) id g gas body k ks accu stack | IMap_mem (_, k) -> let map, stack = stack in let res = Script_map.mem accu map in @@ -1540,7 +1540,7 @@ and log : | IMap_map (_, body, k) -> (imap_map [@ocaml.tailcall]) with_log g gas body k ks accu stack | IMap_iter (_, body, k) -> - (imap_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack + (imap_iter [@ocaml.tailcall]) with_log g gas body k ks accu stack | ILoop (_, body, k) -> let ks = with_log (KLoop_in (body, KCons (k, ks))) in (next [@ocaml.tailcall]) g gas ks accu stack -- GitLab From 51b7e09aa9a1684a3ffbfc05e80fb7dbbe389145 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 17:02:34 +0200 Subject: [PATCH 10/13] Proto: Uncurry imul_teznat Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 8 +++----- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 6 ++++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 0e2cf46f98f0..ce40112f7c07 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -411,7 +411,7 @@ and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type = [@@inline] and imul_teznat : type a b c d e f. (a, b, c, d, e, f) imul_teznat_type = - fun logger g gas (kinfo, k) ks accu stack -> + fun logger g gas kinfo k ks accu stack -> let x = accu in let y, stack = stack in match Script_int.to_int64 y with @@ -766,8 +766,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let y, stack = stack in Tez.(x -? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack - | IMul_teznat (kinfo, k) -> - imul_teznat None g gas (kinfo, k) ks accu stack + | IMul_teznat (kinfo, k) -> imul_teznat None g gas kinfo k ks accu stack | IMul_nattez (kinfo, k) -> imul_nattez None g gas (kinfo, k) ks accu stack (* boolean operations *) @@ -1548,8 +1547,7 @@ and log : let ks = with_log (KLoop_in_left (bl, KCons (br, ks))) in (next [@ocaml.tailcall]) g gas ks accu stack | IMul_teznat (kinfo, k) -> - let extra = (kinfo, k) in - (imul_teznat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack + (imul_teznat [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | IMul_nattez (kinfo, k) -> let extra = (kinfo, k) in (imul_nattez [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index d25cc10775fc..4a92fa55b6a0 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -861,7 +861,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type = (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) -> outdated_context * step_constants -> local_gas_counter -> - ('e * 'f, 'a * 'b, 'a, 'b) kinstr * ('a, 'b, 'g, 'h) kinstr -> + ('e * 'f, 'a * 'b, 'a, 'b) kinstr -> + ('a, 'b, 'g, 'h) kinstr -> ('g, 'h, 'c, 'd) continuation -> ('e, 'f) map -> 'a * 'b -> @@ -871,7 +872,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f) imul_teznat_type = logger option -> outdated_context * step_constants -> local_gas_counter -> - (Tez.t, 'a) kinfo * (Tez.t, 'b, 'c, 'd) kinstr -> + (Tez.t, 'a) kinfo -> + (Tez.t, 'b, 'c, 'd) kinstr -> ('c, 'd, 'e, 'f) continuation -> Tez.t -> Script_int.n Script_int.num * 'b -> -- GitLab From 8cf511c4c57ebf8b2e0694a0f5814d3998b419d2 Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 17:05:47 +0200 Subject: [PATCH 11/13] Proto: Uncurry imul_nattez Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 8 +++----- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 3 ++- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index ce40112f7c07..2120629e53df 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -420,7 +420,7 @@ and imul_teznat : type a b c d e f. (a, b, c, d, e, f) imul_teznat_type = Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack and imul_nattez : type a b c d e f. (a, b, c, d, e, f) imul_nattez_type = - fun logger g gas (kinfo, k) ks accu stack -> + fun logger g gas kinfo k ks accu stack -> let y = accu in let x, stack = stack in match Script_int.to_int64 y with @@ -767,8 +767,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = Tez.(x -? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack | IMul_teznat (kinfo, k) -> imul_teznat None g gas kinfo k ks accu stack - | IMul_nattez (kinfo, k) -> - imul_nattez None g gas (kinfo, k) ks accu stack + | IMul_nattez (kinfo, k) -> imul_nattez None g gas kinfo k ks accu stack (* boolean operations *) | IOr (_, k) -> let x = accu in @@ -1549,8 +1548,7 @@ and log : | IMul_teznat (kinfo, k) -> (imul_teznat [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | IMul_nattez (kinfo, k) -> - let extra = (kinfo, k) in - (imul_nattez [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack + (imul_nattez [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | ILsl_nat (kinfo, k) -> let extra = (kinfo, k) in (ilsl_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 4a92fa55b6a0..0fd9c3e484e1 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -883,7 +883,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f) imul_nattez_type = logger option -> outdated_context * step_constants -> local_gas_counter -> - (Script_int.n Script_int.num, 'a) kinfo * (Tez.t, 'b, 'c, 'd) kinstr -> + (Script_int.n Script_int.num, 'a) kinfo -> + (Tez.t, 'b, 'c, 'd) kinstr -> ('c, 'd, 'e, 'f) continuation -> Script_int.n Script_int.num -> Tez.t * 'b -> -- GitLab From 85572ebe3299ad24ce3f5939f9cb7a629d9c748d Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 17:08:43 +0200 Subject: [PATCH 12/13] Proto: Uncurry ilsl_nat Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 7 +++---- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 4 ++-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 2120629e53df..ca2ac6437c02 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -429,7 +429,7 @@ and imul_nattez : type a b c d e f. (a, b, c, d, e, f) imul_nattez_type = Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack and ilsl_nat : type a b c d e f. (a, b, c, d, e, f) ilsl_nat_type = - fun logger g gas (kinfo, k) ks accu stack -> + fun logger g gas kinfo k ks accu stack -> let x = accu and y, stack = stack in match Script_int.shift_left_n x y with | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log)) @@ -863,7 +863,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let x = accu and y, stack = stack in let res = Script_int.ediv_n x y in (step [@ocaml.tailcall]) g gas k ks res stack - | ILsl_nat (kinfo, k) -> ilsl_nat None g gas (kinfo, k) ks accu stack + | ILsl_nat (kinfo, k) -> ilsl_nat None g gas kinfo k ks accu stack | ILsr_nat (kinfo, k) -> ilsr_nat None g gas (kinfo, k) ks accu stack | IOr_nat (_, k) -> let x = accu and y, stack = stack in @@ -1550,8 +1550,7 @@ and log : | IMul_nattez (kinfo, k) -> (imul_nattez [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | ILsl_nat (kinfo, k) -> - let extra = (kinfo, k) in - (ilsl_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack + (ilsl_nat [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | ILsr_nat (kinfo, k) -> let extra = (kinfo, k) in (ilsr_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 0fd9c3e484e1..ad5b7e6fc1f1 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -894,8 +894,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f) ilsl_nat_type = logger option -> outdated_context * step_constants -> local_gas_counter -> - (Script_int.n Script_int.num, 'a) kinfo - * (Script_int.n Script_int.num, 'b, 'c, 'd) kinstr -> + (Script_int.n Script_int.num, 'a) kinfo -> + (Script_int.n Script_int.num, 'b, 'c, 'd) kinstr -> ('c, 'd, 'e, 'f) continuation -> Script_int.n Script_int.num -> Script_int.n Script_int.num * 'b -> -- GitLab From c024f975c21a76b50c036e8c749118ffb3ac18cb Mon Sep 17 00:00:00 2001 From: Yann Regis-Gianas Date: Tue, 24 May 2022 17:11:54 +0200 Subject: [PATCH 13/13] Proto: Uncurry ilsr_nat Signed-off-by: Yann Regis-Gianas --- src/proto_alpha/lib_protocol/script_interpreter.ml | 7 +++---- src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 4 ++-- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index ca2ac6437c02..34db31cf3b3c 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -436,7 +436,7 @@ and ilsl_nat : type a b c d e f. (a, b, c, d, e, f) ilsl_nat_type = | Some x -> (step [@ocaml.tailcall]) g gas k ks x stack and ilsr_nat : type a b c d e f. (a, b, c, d, e, f) ilsr_nat_type = - fun logger g gas (kinfo, k) ks accu stack -> + fun logger g gas kinfo k ks accu stack -> let x = accu and y, stack = stack in match Script_int.shift_right_n x y with | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log)) @@ -864,7 +864,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = let res = Script_int.ediv_n x y in (step [@ocaml.tailcall]) g gas k ks res stack | ILsl_nat (kinfo, k) -> ilsl_nat None g gas kinfo k ks accu stack - | ILsr_nat (kinfo, k) -> ilsr_nat None g gas (kinfo, k) ks accu stack + | ILsr_nat (kinfo, k) -> ilsr_nat None g gas kinfo k ks accu stack | IOr_nat (_, k) -> let x = accu and y, stack = stack in let res = Script_int.logor x y in @@ -1552,8 +1552,7 @@ and log : | ILsl_nat (kinfo, k) -> (ilsl_nat [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | ILsr_nat (kinfo, k) -> - let extra = (kinfo, k) in - (ilsr_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack + (ilsr_nat [@ocaml.tailcall]) (Some logger) g gas kinfo k ks accu stack | IFailwith (_, kloc, tv) -> let {ifailwith} = ifailwith in (ifailwith [@ocaml.tailcall]) (Some logger) g gas kloc tv accu diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index ad5b7e6fc1f1..e629a28bf519 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -905,8 +905,8 @@ type ('a, 'b, 'c, 'd, 'e, 'f) ilsr_nat_type = logger option -> outdated_context * step_constants -> local_gas_counter -> - (Script_int.n Script_int.num, 'a) kinfo - * (Script_int.n Script_int.num, 'b, 'c, 'd) kinstr -> + (Script_int.n Script_int.num, 'a) kinfo -> + (Script_int.n Script_int.num, 'b, 'c, 'd) kinstr -> ('c, 'd, 'e, 'f) continuation -> Script_int.n Script_int.num -> Script_int.n Script_int.num * 'b -> -- GitLab