From 353513fcd9550d647af48c1d88c30236cb3f629b Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:11:09 +0100
Subject: [PATCH 01/10] Proto/Michelson: remove stack type from Overflow error

---
 .../lib_client/michelson_v1_error_reporter.ml | 19 +++----------------
 .../lib_protocol/script_interpreter.ml        | 18 ++++++++----------
 .../lib_protocol/script_interpreter.mli       |  2 +-
 .../michelson/test_interpretation.ml          |  2 +-
 4 files changed, 13 insertions(+), 28 deletions(-)

diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
index 9510cf87059b..f93d71b80c2b 100644
--- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
@@ -101,7 +101,7 @@ let collect_error_locations errs =
         | Invalid_syntactic_constant (loc, _, _)
         | Invalid_contract (loc, _)
         | Comparable_type_expected (loc, _)
-        | Overflow (loc, _)
+        | Overflow loc
         | Reject (loc, _, _)
         | Pair_bad_argument loc
         | Unpair_bad_argument loc
@@ -772,21 +772,8 @@ let report_errors ~details ~show_source ?parsed ppf errs =
                       print_execution_trace
                       trace)
               trace
-        | Overflow (loc, trace) ->
-            Format.fprintf
-              ppf
-              "%aunexpected arithmetic overflow%a"
-              print_loc
-              loc
-              (fun ppf -> function
-                | None -> ()
-                | Some trace ->
-                    Format.fprintf
-                      ppf
-                      "@,@[<v 2>trace@,%a@]"
-                      print_execution_trace
-                      trace)
-              trace
+        | Overflow loc ->
+            Format.fprintf ppf "%aunexpected arithmetic overflow" print_loc loc
         | err -> Format.fprintf ppf "%a" Environment.Error_monad.pp err) ;
         if rest <> [] then Format.fprintf ppf "@," ;
         print_trace locations rest
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 9fdafa8e9453..4f90f5cc8983 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -104,7 +104,7 @@ type step_constants = Script_typed_ir.step_constants = {
 
 type error += Reject of Script.location * Script.expr * execution_trace option
 
-type error += Overflow of Script.location * execution_trace option
+type error += Overflow of Script.location
 
 type error += Runtime_contract_error of Contract.t
 
@@ -144,11 +144,9 @@ let () =
     ~title:"Script failed (overflow error)"
     ~description:
       "A FAIL instruction was reached due to the detection of an overflow"
-    (obj2
-       (req "location" Script.location_encoding)
-       (opt "trace" trace_encoding))
-    (function Overflow (loc, trace) -> Some (loc, trace) | _ -> None)
-    (fun (loc, trace) -> Overflow (loc, trace)) ;
+    (obj1 (req "location" Script.location_encoding))
+    (function Overflow loc -> Some loc | _ -> None)
+    (fun loc -> Overflow loc) ;
   (* Runtime contract error *)
   register_error_kind
     `Temporary
@@ -420,7 +418,7 @@ and imul_teznat : type a b c d e f. (a, b, c, d, e, f) imul_teznat_type =
   let x = accu in
   let (y, stack) = stack in
   match Script_int.to_int64 y with
-  | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))
+  | None -> get_log logger >>=? fun _log -> fail (Overflow kinfo.iloc)
   | Some y ->
       Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack
 
@@ -429,7 +427,7 @@ and imul_nattez : type a b c d e f. (a, b, c, d, e, f) imul_nattez_type =
   let y = accu in
   let (x, stack) = stack in
   match Script_int.to_int64 y with
-  | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))
+  | None -> get_log logger >>=? fun _log -> fail (Overflow kinfo.iloc)
   | Some y ->
       Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack
 
@@ -437,14 +435,14 @@ 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 ->
   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))
+  | None -> get_log logger >>=? fun _log -> fail (Overflow kinfo.iloc)
   | 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 ->
   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))
+  | None -> get_log logger >>=? fun _log -> fail (Overflow kinfo.iloc)
   | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack
 
 and ifailwith : ifailwith_type =
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.mli b/src/proto_alpha/lib_protocol/script_interpreter.mli
index c57869e469d0..09f9a9c689c7 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.mli
+++ b/src/proto_alpha/lib_protocol/script_interpreter.mli
@@ -38,7 +38,7 @@ open Script_typed_ir
 
 type error += Reject of Script.location * Script.expr * execution_trace option
 
-type error += Overflow of Script.location * execution_trace option
+type error += Overflow of Script.location
 
 type error += Runtime_contract_error of Contract.t
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml
index 2736fa2f42ac..3483515eef9c 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml
@@ -228,7 +228,7 @@ let error_encoding_tests =
         (test_json_roundtrip_err name e))
     [
       ("Reject", Reject (0, script_expr_int, None));
-      ("Overflow", Overflow (0, None));
+      ("Overflow", Overflow 0);
       ("Runtime_contract_error", Runtime_contract_error contract_zero);
       ("Bad_contract_parameter", Bad_contract_parameter contract_zero);
       ("Cannot_serialize_failure", Cannot_serialize_failure);
-- 
GitLab


From bfc033ee02099c2f59d0a2e01f71da814eca0327 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:14:02 +0100
Subject: [PATCH 02/10] Proto/Michelson: remove stack type from Reject error

---
 .../lib_client/client_proto_fa12.ml           |  3 +--
 .../lib_client/michelson_v1_error_reporter.ml | 15 +++-----------
 .../lib_protocol/script_interpreter.ml        | 20 ++++++-------------
 .../lib_protocol/script_interpreter.mli       |  2 +-
 .../michelson/test_interpretation.ml          |  2 +-
 5 files changed, 12 insertions(+), 30 deletions(-)

diff --git a/src/proto_alpha/lib_client/client_proto_fa12.ml b/src/proto_alpha/lib_client/client_proto_fa12.ml
index db0ab1d3b280..4644c3d044b7 100644
--- a/src/proto_alpha/lib_client/client_proto_fa12.ml
+++ b/src/proto_alpha/lib_client/client_proto_fa12.ml
@@ -754,8 +754,7 @@ let extract_error trace =
   TzTrace.fold
     (fun _ error ->
       match error with
-      | Environment.Ecoproto_error (Script_interpreter.Reject (loc, param, _))
-        -> (
+      | Environment.Ecoproto_error (Script_interpreter.Reject (loc, param)) -> (
           match root param with
           | Prim (_, Script.D_Pair, [String (_, error); res], _) ->
               parse_error (error, res)
diff --git a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
index f93d71b80c2b..2f0519f394c5 100644
--- a/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
@@ -102,7 +102,7 @@ let collect_error_locations errs =
         | Invalid_contract (loc, _)
         | Comparable_type_expected (loc, _)
         | Overflow loc
-        | Reject (loc, _, _)
+        | Reject (loc, _)
         | Pair_bad_argument loc
         | Unpair_bad_argument loc
         | Dup_n_bad_argument loc )
@@ -755,23 +755,14 @@ let report_errors ~details ~show_source ?parsed ppf errs =
               tya
               print_ty
               tyb
-        | Reject (loc, v, trace) ->
+        | Reject (loc, v) ->
             Format.fprintf
               ppf
-              "%ascript reached FAILWITH instruction@ @[<hov 2>with@ %a@]%a"
+              "%ascript reached FAILWITH instruction@ @[<hov 2>with@ %a@]"
               print_loc
               loc
               print_expr
               v
-              (fun ppf -> function
-                | None -> ()
-                | Some trace ->
-                    Format.fprintf
-                      ppf
-                      "@,@[<v 2>trace@,%a@]"
-                      print_execution_trace
-                      trace)
-              trace
         | Overflow loc ->
             Format.fprintf ppf "%aunexpected arithmetic overflow" print_loc loc
         | err -> Format.fprintf ppf "%a" Environment.Error_monad.pp err) ;
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 4f90f5cc8983..3947d8a75101 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -102,7 +102,7 @@ type step_constants = Script_typed_ir.step_constants = {
 
 (* ---- Run-time errors -----------------------------------------------------*)
 
-type error += Reject of Script.location * Script.expr * execution_trace option
+type error += Reject of Script.location * Script.expr
 
 type error += Overflow of Script.location
 
@@ -118,25 +118,17 @@ type error += Michelson_too_many_recursive_calls
 
 let () =
   let open Data_encoding in
-  let trace_encoding =
-    list
-    @@ obj3
-         (req "location" Script.location_encoding)
-         (req "gas" Gas.encoding)
-         (req "stack" (list Script.expr_encoding))
-  in
   (* Reject *)
   register_error_kind
     `Temporary
     ~id:"michelson_v1.script_rejected"
     ~title:"Script failed"
     ~description:"A FAILWITH instruction was reached"
-    (obj3
+    (obj2
        (req "location" Script.location_encoding)
-       (req "with" Script.expr_encoding)
-       (opt "trace" trace_encoding))
-    (function Reject (loc, v, trace) -> Some (loc, v, trace) | _ -> None)
-    (fun (loc, v, trace) -> Reject (loc, v, trace)) ;
+       (req "with" Script.expr_encoding))
+    (function Reject (loc, v) -> Some (loc, v) | _ -> None)
+    (fun (loc, v) -> Reject (loc, v)) ;
   (* Overflow *)
   register_error_kind
     `Temporary
@@ -454,7 +446,7 @@ and ifailwith : ifailwith_type =
         trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
         >>=? fun (v, _ctxt) ->
         let v = Micheline.strip_locations v in
-        get_log logger >>=? fun log -> fail (Reject (kloc, v, log)));
+        get_log logger >>=? fun _log -> fail (Reject (kloc, v)));
   }
 
 and iexec : type a b c d e f g. (a, b, c, d, e, f, g) iexec_type =
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.mli b/src/proto_alpha/lib_protocol/script_interpreter.mli
index 09f9a9c689c7..e59285f43649 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.mli
+++ b/src/proto_alpha/lib_protocol/script_interpreter.mli
@@ -36,7 +36,7 @@
 open Alpha_context
 open Script_typed_ir
 
-type error += Reject of Script.location * Script.expr * execution_trace option
+type error += Reject of Script.location * Script.expr
 
 type error += Overflow of Script.location
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml
index 3483515eef9c..1a9d95ca6777 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml
@@ -227,7 +227,7 @@ let error_encoding_tests =
         `Quick
         (test_json_roundtrip_err name e))
     [
-      ("Reject", Reject (0, script_expr_int, None));
+      ("Reject", Reject (0, script_expr_int));
       ("Overflow", Overflow 0);
       ("Runtime_contract_error", Runtime_contract_error contract_zero);
       ("Bad_contract_parameter", Bad_contract_parameter contract_zero);
-- 
GitLab


From beb14b967b9e6880370cf6cc9fa67e058bce9125 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:17:57 +0100
Subject: [PATCH 03/10] Proto/Michelson: remove useless calls to get_log

---
 .../lib_protocol/script_interpreter.ml        | 20 +++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 3947d8a75101..55d7e74a6b4c 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -406,47 +406,47 @@ 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
-  | None -> get_log logger >>=? fun _log -> fail (Overflow kinfo.iloc)
+  | None -> fail (Overflow kinfo.iloc)
   | Some y ->
       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
-  | None -> get_log logger >>=? fun _log -> fail (Overflow kinfo.iloc)
+  | None -> fail (Overflow kinfo.iloc)
   | Some y ->
       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)
+  | None -> fail (Overflow kinfo.iloc)
   | 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)
+  | None -> fail (Overflow kinfo.iloc)
   | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack
 
 and ifailwith : ifailwith_type =
   {
     ifailwith =
-      (fun logger (ctxt, _) gas kloc tv accu ->
+      (fun _logger (ctxt, _) gas kloc tv accu ->
         let v = accu in
         let ctxt = update_context gas ctxt in
         trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
         >>=? fun (v, _ctxt) ->
         let v = Micheline.strip_locations v in
-        get_log logger >>=? fun _log -> fail (Reject (kloc, v)));
+        fail (Reject (kloc, v)));
   }
 
 and iexec : type a b c d e f g. (a, b, c, d, e, f, g) iexec_type =
-- 
GitLab


From 2d5765b42d52c4a737eac7c795e2c4735dec419e Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:19:31 +0100
Subject: [PATCH 04/10] Proto/Michelson: remove dead get_log

---
 src/proto_alpha/lib_protocol/script_interpreter_defs.ml | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 6a19b4143379..2e9aee6d88c7 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -400,11 +400,6 @@ let log_exit logger ctxt gas kinfo_prev k accu stack =
 
 let log_control logger ks = logger.log_control ks
 
-let get_log = function
-  | None -> Lwt.return (Ok None)
-  | Some logger -> logger.get_log ()
-  [@@ocaml.inline always]
-
 (* [log_kinstr logger i] emits an instruction to instrument the
    execution of [i] with [logger]. *)
 let log_kinstr logger i = ILog (kinfo_of_kinstr i, LogEntry, logger, i)
-- 
GitLab


From 63b58d11ff6232ff89cfe707104ca921e48660b4 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:28:26 +0100
Subject: [PATCH 05/10] Proto/Michelson: remove useless logger parameter

---
 .../lib_protocol/script_interpreter.ml        | 37 +++++--------------
 .../lib_protocol/script_interpreter_defs.ml   |  5 ---
 2 files changed, 10 insertions(+), 32 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 55d7e74a6b4c..140ccce95a58 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -406,7 +406,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 g gas (kinfo, k) ks accu stack ->
   let x = accu in
   let (y, stack) = stack in
   match Script_int.to_int64 y with
@@ -415,7 +415,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 g gas (kinfo, k) ks accu stack ->
   let y = accu in
   let (x, stack) = stack in
   match Script_int.to_int64 y with
@@ -424,14 +424,14 @@ 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 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 -> fail (Overflow kinfo.iloc)
   | 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 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 -> fail (Overflow kinfo.iloc)
@@ -440,7 +440,7 @@ and ilsr_nat : type a b c d e f. (a, b, c, d, e, f) ilsr_nat_type =
 and ifailwith : ifailwith_type =
   {
     ifailwith =
-      (fun _logger (ctxt, _) gas kloc tv accu ->
+      (fun (ctxt, _) gas kloc tv accu ->
         let v = accu in
         let ctxt = update_context gas ctxt in
         trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
@@ -761,10 +761,8 @@ 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_nattez (kinfo, k) ->
-          imul_nattez None g gas (kinfo, k) ks accu stack
+      | IMul_teznat (kinfo, k) -> imul_teznat g gas (kinfo, k) ks accu stack
+      | IMul_nattez (kinfo, k) -> imul_nattez g gas (kinfo, k) ks accu stack
       (* boolean operations *)
       | IOr (_, k) ->
           let x = accu in
@@ -860,8 +858,8 @@ 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
-      | ILsr_nat (kinfo, k) -> ilsr_nat None g gas (kinfo, k) ks accu stack
+      | ILsl_nat (kinfo, k) -> ilsl_nat g gas (kinfo, k) ks accu stack
+      | ILsr_nat (kinfo, k) -> ilsr_nat 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
@@ -922,7 +920,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           (step [@ocaml.tailcall]) g gas k ks lam (accu, stack)
       | IFailwith (_, kloc, tv) ->
           let {ifailwith} = ifailwith in
-          ifailwith None g gas kloc tv accu
+          ifailwith g gas kloc tv accu
       (* comparison *)
       | ICompare (_, ty, k) ->
           let a = accu in
@@ -1563,21 +1561,6 @@ and log :
   | ILoop_left (_, bl, br) ->
       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_nattez (kinfo, k) ->
-      let extra = (kinfo, k) in
-      (imul_nattez [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack
-  | ILsl_nat (kinfo, k) ->
-      let extra = (kinfo, k) in
-      (ilsl_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack
-  | ILsr_nat (kinfo, k) ->
-      let extra = (kinfo, k) in
-      (ilsr_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack
-  | IFailwith (_, kloc, tv) ->
-      let {ifailwith} = ifailwith in
-      (ifailwith [@ocaml.tailcall]) (Some logger) g gas kloc tv accu
   | IExec (_, k) ->
       (iexec [@ocaml.tailcall]) (Some logger) g gas k ks accu stack
   | _ -> (step [@ocaml.tailcall]) g gas k (with_log 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 2e9aee6d88c7..e78fb070baed 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -853,7 +853,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =
   ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t
 
 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 ->
@@ -863,7 +862,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f) imul_teznat_type =
   ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
 
 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 ->
@@ -873,7 +871,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f) imul_nattez_type =
   ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
 
 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
@@ -884,7 +881,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f) ilsl_nat_type =
   ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
 
 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
@@ -897,7 +893,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f) ilsr_nat_type =
 type ifailwith_type = {
   ifailwith :
     'a 'ac 'b.
-    logger option ->
     outdated_context * step_constants ->
     local_gas_counter ->
     Script.location ->
-- 
GitLab


From 2fc728c8ab1c6bf2c54f480fd49c6d8e7662eae2 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:37:21 +0100
Subject: [PATCH 06/10] Proto/Michelson: inline imul_teznat

---
 .../lib_protocol/script_interpreter.ml         | 18 ++++++++----------
 .../lib_protocol/script_interpreter_defs.ml    |  9 ---------
 2 files changed, 8 insertions(+), 19 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 140ccce95a58..7e600cc7cb06 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -405,15 +405,6 @@ and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type =
   (next [@ocaml.tailcall]) g gas ks accu stack
  [@@inline]
 
-and imul_teznat : type a b c d e f. (a, b, c, d, e, f) imul_teznat_type =
- fun g gas (kinfo, k) ks accu stack ->
-  let x = accu in
-  let (y, stack) = stack in
-  match Script_int.to_int64 y with
-  | None -> fail (Overflow kinfo.iloc)
-  | Some y ->
-      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 g gas (kinfo, k) ks accu stack ->
   let y = accu in
@@ -761,7 +752,14 @@ 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 g gas (kinfo, k) ks accu stack
+      | IMul_teznat (kinfo, k) -> (
+          let x = accu in
+          let (y, stack) = stack in
+          match Script_int.to_int64 y with
+          | None -> fail (Overflow kinfo.iloc)
+          | Some y ->
+              Tez.(x *? y) >>?= fun res ->
+              (step [@ocaml.tailcall]) g gas k ks res stack)
       | IMul_nattez (kinfo, k) -> imul_nattez g gas (kinfo, k) ks accu stack
       (* boolean operations *)
       | IOr (_, k) ->
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index e78fb070baed..2d5b655bec9b 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -852,15 +852,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =
   'a * 'b ->
   ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t
 
-type ('a, 'b, 'c, 'd, 'e, 'f) imul_teznat_type =
-  outdated_context * step_constants ->
-  local_gas_counter ->
-  (Tez.t, 'a) kinfo * (Tez.t, 'b, 'c, 'd) kinstr ->
-  ('c, 'd, 'e, 'f) continuation ->
-  Tez.t ->
-  Script_int.n Script_int.num * 'b ->
-  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
-
 type ('a, 'b, 'c, 'd, 'e, 'f) imul_nattez_type =
   outdated_context * step_constants ->
   local_gas_counter ->
-- 
GitLab


From 2aacbffc01b8a807d54929a3fe4bf9423f13925b Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:38:28 +0100
Subject: [PATCH 07/10] Proto/Michelson: inline imul_nattez

---
 .../lib_protocol/script_interpreter.ml         | 18 ++++++++----------
 .../lib_protocol/script_interpreter_defs.ml    |  9 ---------
 2 files changed, 8 insertions(+), 19 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 7e600cc7cb06..8ed7946b2b2a 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -405,15 +405,6 @@ and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type =
   (next [@ocaml.tailcall]) g gas ks accu stack
  [@@inline]
 
-and imul_nattez : type a b c d e f. (a, b, c, d, e, f) imul_nattez_type =
- fun g gas (kinfo, k) ks accu stack ->
-  let y = accu in
-  let (x, stack) = stack in
-  match Script_int.to_int64 y with
-  | None -> fail (Overflow kinfo.iloc)
-  | Some y ->
-      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 g gas (kinfo, k) ks accu stack ->
   let x = accu and (y, stack) = stack in
@@ -760,7 +751,14 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           | Some y ->
               Tez.(x *? y) >>?= fun res ->
               (step [@ocaml.tailcall]) g gas k ks res stack)
-      | IMul_nattez (kinfo, k) -> imul_nattez g gas (kinfo, k) ks accu stack
+      | IMul_nattez (kinfo, k) -> (
+          let y = accu in
+          let (x, stack) = stack in
+          match Script_int.to_int64 y with
+          | None -> fail (Overflow kinfo.iloc)
+          | Some y ->
+              Tez.(x *? y) >>?= fun res ->
+              (step [@ocaml.tailcall]) g gas k ks res stack)
       (* boolean operations *)
       | IOr (_, k) ->
           let x = accu in
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 2d5b655bec9b..e302bb2ac81e 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -852,15 +852,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =
   'a * 'b ->
   ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t
 
-type ('a, 'b, 'c, 'd, 'e, 'f) imul_nattez_type =
-  outdated_context * step_constants ->
-  local_gas_counter ->
-  (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 ->
-  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
-
 type ('a, 'b, 'c, 'd, 'e, 'f) ilsl_nat_type =
   outdated_context * step_constants ->
   local_gas_counter ->
-- 
GitLab


From f2b2d3f706fc9647b03251632e87521ba58d2afc Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:39:24 +0100
Subject: [PATCH 08/10] Proto/Michelson: inline ilsl_nat

---
 src/proto_alpha/lib_protocol/script_interpreter.ml  | 13 +++++--------
 .../lib_protocol/script_interpreter_defs.ml         | 10 ----------
 2 files changed, 5 insertions(+), 18 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 8ed7946b2b2a..b34858e7eb9c 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -405,13 +405,6 @@ and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type =
   (next [@ocaml.tailcall]) g gas ks accu stack
  [@@inline]
 
-and ilsl_nat : type a b c d e f. (a, b, c, d, e, f) ilsl_nat_type =
- fun 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 -> fail (Overflow kinfo.iloc)
-  | 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 g gas (kinfo, k) ks accu stack ->
   let x = accu and (y, stack) = stack in
@@ -854,7 +847,11 @@ 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 g gas (kinfo, k) ks accu stack
+      | ILsl_nat (kinfo, k) -> (
+          let x = accu and (y, stack) = stack in
+          match Script_int.shift_left_n x y with
+          | None -> fail (Overflow kinfo.iloc)
+          | Some x -> (step [@ocaml.tailcall]) g gas k ks x stack)
       | ILsr_nat (kinfo, k) -> ilsr_nat g gas (kinfo, k) ks accu stack
       | IOr_nat (_, k) ->
           let x = accu and (y, stack) = stack in
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index e302bb2ac81e..5e60232bdb6d 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -852,16 +852,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =
   'a * 'b ->
   ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t
 
-type ('a, 'b, 'c, 'd, 'e, 'f) ilsl_nat_type =
-  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 ->
-  ('c, 'd, 'e, 'f) continuation ->
-  Script_int.n Script_int.num ->
-  Script_int.n Script_int.num * 'b ->
-  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
-
 type ('a, 'b, 'c, 'd, 'e, 'f) ilsr_nat_type =
   outdated_context * step_constants ->
   local_gas_counter ->
-- 
GitLab


From 4c720250d895f537ac8a893b03f979c518738cca Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:40:37 +0100
Subject: [PATCH 09/10] Proto/Michelson: inline ilsr_nat

---
 src/proto_alpha/lib_protocol/script_interpreter.ml  | 13 +++++--------
 .../lib_protocol/script_interpreter_defs.ml         | 10 ----------
 2 files changed, 5 insertions(+), 18 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index b34858e7eb9c..57a6dafd29f6 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -405,13 +405,6 @@ and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type =
   (next [@ocaml.tailcall]) g gas ks accu stack
  [@@inline]
 
-and ilsr_nat : type a b c d e f. (a, b, c, d, e, f) ilsr_nat_type =
- fun 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 -> fail (Overflow kinfo.iloc)
-  | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack
-
 and ifailwith : ifailwith_type =
   {
     ifailwith =
@@ -852,7 +845,11 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           match Script_int.shift_left_n x y with
           | None -> fail (Overflow kinfo.iloc)
           | Some x -> (step [@ocaml.tailcall]) g gas k ks x stack)
-      | ILsr_nat (kinfo, k) -> ilsr_nat g gas (kinfo, k) ks accu stack
+      | ILsr_nat (kinfo, k) -> (
+          let x = accu and (y, stack) = stack in
+          match Script_int.shift_right_n x y with
+          | None -> fail (Overflow kinfo.iloc)
+          | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack)
       | IOr_nat (_, k) ->
           let x = accu and (y, stack) = stack in
           let res = Script_int.logor x y in
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 5e60232bdb6d..caa78daad74c 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -852,16 +852,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =
   'a * 'b ->
   ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t
 
-type ('a, 'b, 'c, 'd, 'e, 'f) ilsr_nat_type =
-  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 ->
-  ('c, 'd, 'e, 'f) continuation ->
-  Script_int.n Script_int.num ->
-  Script_int.n Script_int.num * 'b ->
-  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
-
 type ifailwith_type = {
   ifailwith :
     'a 'ac 'b.
-- 
GitLab


From d0cfe72c13445f8e562da9b1af7b907811c3705a Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 23 Mar 2022 14:42:43 +0100
Subject: [PATCH 10/10] Proto/Michelson: inline ifailwith

---
 .../lib_protocol/script_interpreter.ml        | 20 ++++++-------------
 .../lib_protocol/script_interpreter_defs.ml   | 12 -----------
 2 files changed, 6 insertions(+), 26 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 57a6dafd29f6..9a0a9366e895 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -405,18 +405,6 @@ and imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type =
   (next [@ocaml.tailcall]) g gas ks accu stack
  [@@inline]
 
-and ifailwith : ifailwith_type =
-  {
-    ifailwith =
-      (fun (ctxt, _) gas kloc tv accu ->
-        let v = accu in
-        let ctxt = update_context gas ctxt in
-        trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
-        >>=? fun (v, _ctxt) ->
-        let v = Micheline.strip_locations v in
-        fail (Reject (kloc, v)));
-  }
-
 and iexec : type a b c d e f g. (a, b, c, d, e, f, g) iexec_type =
  fun logger g gas k ks accu stack ->
   let arg = accu and (code, stack) = stack in
@@ -909,8 +897,12 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
       | ILambda (_, lam, k) ->
           (step [@ocaml.tailcall]) g gas k ks lam (accu, stack)
       | IFailwith (_, kloc, tv) ->
-          let {ifailwith} = ifailwith in
-          ifailwith g gas kloc tv accu
+          let v = accu in
+          let ctxt = update_context gas ctxt in
+          trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
+          >>=? fun (v, _ctxt) ->
+          let v = Micheline.strip_locations v in
+          fail (Reject (kloc, v))
       (* comparison *)
       | ICompare (_, ty, k) ->
           let a = accu in
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index caa78daad74c..eee3a2191c89 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -852,18 +852,6 @@ type ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =
   'a * 'b ->
   ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t
 
-type ifailwith_type = {
-  ifailwith :
-    'a 'ac 'b.
-    outdated_context * step_constants ->
-    local_gas_counter ->
-    Script.location ->
-    ('a, 'ac) ty ->
-    'a ->
-    ('b, error trace) result Lwt.t;
-}
-[@@unboxed]
-
 type ('a, 'b, 'c, 'd, 'e, 'f, 'g) iexec_type =
   logger option ->
   outdated_context * step_constants ->
-- 
GitLab