From 64092493a97b69143da3e8aedacdfed2edc72a18 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 15:17:23 +0200
Subject: [PATCH 01/13] Proto/Michelson: simplify parse_view_returning

No need to wrap in a lambda, only the kdescr is used
---
 .../lib_protocol/script_interpreter.ml        | 124 +++++++++---------
 .../lib_protocol/script_ir_translator.ml      |  17 ++-
 .../lib_protocol/script_ir_translator.mli     |   8 +-
 3 files changed, 75 insertions(+), 74 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 2eb11de5eb1e..9a1b8fa3c96a 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1063,7 +1063,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                   | None -> (return_none [@ocaml.tailcall]) ctxt
                   | Some view -> (
                       let view_result =
-                        Script_ir_translator.parse_view_returning
+                        Script_ir_translator.parse_view_kdescr
                           ctxt
                           ~legacy:true
                           storage_type
@@ -1074,68 +1074,66 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                           Script_tc_errors.Ill_typed_contract
                             (Micheline.strip_locations view.view_code, []))
                         view_result
-                      >>=? fun (Ex_view f, ctxt) ->
-                      match f with
-                      | Lam
-                          ( {
-                              kloc;
-                              kaft = Item_t (aft_ty, Bot_t);
-                              kbef = Item_t (bef_ty, Bot_t);
-                              kinstr;
-                            },
-                            _script_view ) -> (
-                          pair_t kloc input_ty storage_type
-                          >>?= fun (Ty_ex_c pair_ty) ->
-                          let io_ty =
-                            let open Gas_monad.Syntax in
-                            let* out_eq =
-                              Script_ir_translator.ty_eq
-                                ~error_details:Fast
-                                kloc
-                                aft_ty
-                                output_ty
-                            in
-                            let+ in_eq =
-                              ty_eq ~error_details:Fast kloc bef_ty pair_ty
-                            in
-                            (out_eq, in_eq)
-                          in
-                          Gas_monad.run ctxt io_ty >>?= fun (eq, ctxt) ->
-                          match eq with
-                          | Error Inconsistent_types_fast ->
-                              (return_none [@ocaml.tailcall]) ctxt
-                          | Ok (Eq, Eq) -> (
-                              let kkinfo = kinfo_of_kinstr k in
-                              match kkinfo.kstack_ty with
-                              | Item_t (_, s) ->
-                                  let kstack_ty = Item_t (output_ty, s) in
-                                  let kkinfo = {kkinfo with kstack_ty} in
-                                  let ks = KCons (ICons_some (kkinfo, k), ks) in
-                                  Contract.get_balance_carbonated ctxt c
-                                  >>=? fun (ctxt, balance) ->
-                                  let (gas, ctxt) =
-                                    local_gas_counter_and_outdated_context ctxt
-                                  in
-                                  (step [@ocaml.tailcall])
-                                    ( ctxt,
-                                      {
-                                        source = sc.self;
-                                        self = c;
-                                        amount = Tez.zero;
-                                        balance;
-                                        (* The following remain unchanged, but let's
-                                           list them anyway, so that we don't forget
-                                           to update something added later. *)
-                                        payer = sc.payer;
-                                        chain_id = sc.chain_id;
-                                        now = sc.now;
-                                        level = sc.level;
-                                      } )
-                                    gas
-                                    kinstr
-                                    (KView_exit (sc, KReturn (stack, ks)))
-                                    (input, storage)
-                                    (EmptyCell, EmptyCell))))))
+                      >>=? fun ( Ex_view
+                                   {
+                                     kloc;
+                                     kaft = Item_t (aft_ty, Bot_t);
+                                     kbef = Item_t (bef_ty, Bot_t);
+                                     kinstr;
+                                   },
+                                 ctxt ) ->
+                      pair_t kloc input_ty storage_type
+                      >>?= fun (Ty_ex_c pair_ty) ->
+                      let io_ty =
+                        let open Gas_monad.Syntax in
+                        let* out_eq =
+                          Script_ir_translator.ty_eq
+                            ~error_details:Fast
+                            kloc
+                            aft_ty
+                            output_ty
+                        in
+                        let+ in_eq =
+                          ty_eq ~error_details:Fast kloc bef_ty pair_ty
+                        in
+                        (out_eq, in_eq)
+                      in
+                      Gas_monad.run ctxt io_ty >>?= fun (eq, ctxt) ->
+                      match eq with
+                      | Error Inconsistent_types_fast ->
+                          (return_none [@ocaml.tailcall]) ctxt
+                      | Ok (Eq, Eq) -> (
+                          let kkinfo = kinfo_of_kinstr k in
+                          match kkinfo.kstack_ty with
+                          | Item_t (_, s) ->
+                              let kstack_ty = Item_t (output_ty, s) in
+                              let kkinfo = {kkinfo with kstack_ty} in
+                              let ks = KCons (ICons_some (kkinfo, k), ks) in
+                              Contract.get_balance_carbonated ctxt c
+                              >>=? fun (ctxt, balance) ->
+                              let (gas, ctxt) =
+                                local_gas_counter_and_outdated_context ctxt
+                              in
+                              (step [@ocaml.tailcall])
+                                ( ctxt,
+                                  {
+                                    source = sc.self;
+                                    self = c;
+                                    amount = Tez.zero;
+                                    balance;
+                                    (* The following remain unchanged, but let's
+                                       list them anyway, so that we don't forget
+                                       to update something added later. *)
+                                    payer = sc.payer;
+                                    chain_id = sc.chain_id;
+                                    now = sc.now;
+                                    level = sc.level;
+                                  } )
+                                gas
+                                kinstr
+                                (KView_exit (sc, KReturn (stack, ks)))
+                                (input, storage)
+                                (EmptyCell, EmptyCell)))))
           | Tx_rollup _ -> (return_none [@ocaml.tailcall]) ctxt)
       | ICreate_contract {storage_type; code; k; kinfo = _} ->
           (* Removed the instruction's arguments manager, spendable and delegatable *)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index ef520d06b763..bdf4523705b6 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1817,7 +1817,7 @@ type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
 type 'storage ex_view =
   | Ex_view :
-      ('input * 'storage, 'output) Script_typed_ir.lambda
+      ('input * 'storage, end_of_stack, 'output, end_of_stack) kdescr
       -> 'storage ex_view
 
 type (_, _) dig_proof_argument =
@@ -2952,7 +2952,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data :
   | (Chest_t, expr) ->
       traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))
 
-and parse_view_returning :
+and parse_view_kdescr :
     type storage storagec.
     ?type_logger:type_logger ->
     context ->
@@ -2989,11 +2989,10 @@ and parse_view_returning :
   @@
   match judgement with
   | Failed {descr} ->
-      let cur_view' =
-        Ex_view
-          (Lam (close_descr (descr (Item_t (output_ty', Bot_t))), view_code))
+      let cur_view =
+        Ex_view (close_descr (descr (Item_t (output_ty', Bot_t))))
       in
-      ok (cur_view', ctxt)
+      ok (cur_view, ctxt)
   | Typed ({loc; aft; _} as descr) -> (
       let ill_type_view loc stack_ty () =
         let actual = serialize_stack_for_error ctxt stack_ty in
@@ -3009,7 +3008,7 @@ and parse_view_returning :
                (ill_type_view loc aft : unit -> _)
           @@ ty_eq ~error_details:Informative loc ty output_ty'
           >>? fun (eq, ctxt) ->
-          eq >|? fun Eq -> (Ex_view (Lam (close_descr descr, view_code)), ctxt)
+          eq >|? fun Eq -> (Ex_view (close_descr descr), ctxt)
       | _ -> error (ill_type_view loc aft ()))
 
 and typecheck_views :
@@ -3022,8 +3021,8 @@ and typecheck_views :
     context tzresult Lwt.t =
  fun ?type_logger ctxt ~legacy storage_type views ->
   let aux _name cur_view ctxt =
-    parse_view_returning ?type_logger ctxt ~legacy storage_type cur_view
-    >|=? fun (_parsed_view, ctxt) -> ctxt
+    parse_view_kdescr ?type_logger ctxt ~legacy storage_type cur_view
+    >|=? fun (Ex_view _parsed_view, ctxt) -> ctxt
   in
   Script_map.fold_es aux views ctxt
 
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index a2504a6d7128..3150c255a187 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -116,7 +116,11 @@ type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
 type 'storage ex_view =
   | Ex_view :
-      ('input * 'storage, 'output) Script_typed_ir.lambda
+      ( 'input * 'storage,
+        Script_typed_ir.end_of_stack,
+        'output,
+        Script_typed_ir.end_of_stack )
+      Script_typed_ir.kdescr
       -> 'storage ex_view
 
 type ('a, 's, 'b, 'u) cinstr = {
@@ -293,7 +297,7 @@ val parse_view_output_ty :
   Script.node ->
   (ex_ty * context) tzresult
 
-val parse_view_returning :
+val parse_view_kdescr :
   ?type_logger:type_logger ->
   context ->
   legacy:bool ->
-- 
GitLab


From 4f9d2a542059c9c18d572a5b2b2eb4e0ce8d2650 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 16:15:40 +0200
Subject: [PATCH 02/13] Proto/Michelson: rename ex_view into typed_view

---
 src/proto_alpha/lib_protocol/script_interpreter.ml |  2 +-
 .../lib_protocol/script_ir_translator.ml           | 14 +++++++-------
 .../lib_protocol/script_ir_translator.mli          |  8 ++++----
 3 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 9a1b8fa3c96a..a3cc1cf931d1 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1074,7 +1074,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                           Script_tc_errors.Ill_typed_contract
                             (Micheline.strip_locations view.view_code, []))
                         view_result
-                      >>=? fun ( Ex_view
+                      >>=? fun ( Typed_view
                                    {
                                      kloc;
                                      kaft = Item_t (aft_ty, Bot_t);
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index bdf4523705b6..3405926ec6d1 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1815,10 +1815,10 @@ type ex_script = Ex_script : ('a, 'c) Script_typed_ir.script -> ex_script
 
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
-type 'storage ex_view =
-  | Ex_view :
+type 'storage typed_view =
+  | Typed_view :
       ('input * 'storage, end_of_stack, 'output, end_of_stack) kdescr
-      -> 'storage ex_view
+      -> 'storage typed_view
 
 type (_, _) dig_proof_argument =
   | Dig_proof_argument :
@@ -2959,7 +2959,7 @@ and parse_view_kdescr :
     legacy:bool ->
     (storage, storagec) ty ->
     view ->
-    (storage ex_view * context) tzresult Lwt.t =
+    (storage typed_view * context) tzresult Lwt.t =
  fun ?type_logger ctxt ~legacy storage_type {input_ty; output_ty; view_code} ->
   let input_ty_loc = location input_ty in
   record_trace_eval
@@ -2990,7 +2990,7 @@ and parse_view_kdescr :
   match judgement with
   | Failed {descr} ->
       let cur_view =
-        Ex_view (close_descr (descr (Item_t (output_ty', Bot_t))))
+        Typed_view (close_descr (descr (Item_t (output_ty', Bot_t))))
       in
       ok (cur_view, ctxt)
   | Typed ({loc; aft; _} as descr) -> (
@@ -3008,7 +3008,7 @@ and parse_view_kdescr :
                (ill_type_view loc aft : unit -> _)
           @@ ty_eq ~error_details:Informative loc ty output_ty'
           >>? fun (eq, ctxt) ->
-          eq >|? fun Eq -> (Ex_view (close_descr descr), ctxt)
+          eq >|? fun Eq -> (Typed_view (close_descr descr), ctxt)
       | _ -> error (ill_type_view loc aft ()))
 
 and typecheck_views :
@@ -3022,7 +3022,7 @@ and typecheck_views :
  fun ?type_logger ctxt ~legacy storage_type views ->
   let aux _name cur_view ctxt =
     parse_view_kdescr ?type_logger ctxt ~legacy storage_type cur_view
-    >|=? fun (Ex_view _parsed_view, ctxt) -> ctxt
+    >|=? fun (Typed_view _parsed_view, ctxt) -> ctxt
   in
   Script_map.fold_es aux views ctxt
 
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 3150c255a187..7197e4d6ed5f 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -114,14 +114,14 @@ type ('arg, 'storage) code =
 
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
-type 'storage ex_view =
-  | Ex_view :
+type 'storage typed_view =
+  | Typed_view :
       ( 'input * 'storage,
         Script_typed_ir.end_of_stack,
         'output,
         Script_typed_ir.end_of_stack )
       Script_typed_ir.kdescr
-      -> 'storage ex_view
+      -> 'storage typed_view
 
 type ('a, 's, 'b, 'u) cinstr = {
   apply :
@@ -303,7 +303,7 @@ val parse_view_kdescr :
   legacy:bool ->
   ('storage, _) Script_typed_ir.ty ->
   Script_typed_ir.view ->
-  ('storage ex_view * context) tzresult Lwt.t
+  ('storage typed_view * context) tzresult Lwt.t
 
 val typecheck_views :
   ?type_logger:type_logger ->
-- 
GitLab


From 1d9bb03b3803b48130c420488e65ade2c6766e49 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 16:26:58 +0200
Subject: [PATCH 03/13] Proto: add utility Script_map.map_es_in_context

---
 src/proto_alpha/lib_protocol/script_map.ml  | 28 +++++++++++++++++++++
 src/proto_alpha/lib_protocol/script_map.mli |  6 +++++
 2 files changed, 34 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/script_map.ml b/src/proto_alpha/lib_protocol/script_map.ml
index 6aaa7afedb7d..1a9aa5018fcf 100644
--- a/src/proto_alpha/lib_protocol/script_map.ml
+++ b/src/proto_alpha/lib_protocol/script_map.ml
@@ -115,3 +115,31 @@ let fold_es :
 
 let size : type key value. (key, value) map -> Script_int.n Script_int.num =
  fun (Map_tag (module Box)) -> Script_int.(abs (of_int Box.size))
+
+let map_es_in_context :
+    type context key value value'.
+    (context -> key -> value -> (value' * context) tzresult Lwt.t) ->
+    context ->
+    (key, value) map ->
+    ((key, value') map * context) tzresult Lwt.t =
+ fun f ctxt (Map_tag (module Box)) ->
+  Box.OPS.fold_es
+    (fun key value (map, ctxt) ->
+      f ctxt key value >|=? fun (value, ctxt) ->
+      (Box.OPS.add key value map, ctxt))
+    Box.boxed
+    (Box.OPS.empty, ctxt)
+  >|=? fun (map, ctxt) ->
+  ( Map_tag
+      (module struct
+        type key = Box.key
+
+        type value = value'
+
+        module OPS = Box.OPS
+
+        let boxed = map
+
+        let size = Box.size
+      end),
+    ctxt )
diff --git a/src/proto_alpha/lib_protocol/script_map.mli b/src/proto_alpha/lib_protocol/script_map.mli
index a889610a5363..fcf6a0af2453 100644
--- a/src/proto_alpha/lib_protocol/script_map.mli
+++ b/src/proto_alpha/lib_protocol/script_map.mli
@@ -54,3 +54,9 @@ val mem : 'key -> ('key, 'value) map -> bool
 val get : 'key -> ('key, 'value) map -> 'value option
 
 val size : ('a, 'b) map -> Script_int.n Script_int.num
+
+val map_es_in_context :
+  ('context -> 'key -> 'value1 -> ('value2 * 'context) tzresult Lwt.t) ->
+  'context ->
+  ('key, 'value1) map ->
+  (('key, 'value2) map * 'context) tzresult Lwt.t
-- 
GitLab


From 73d6bbb916977992adef94787f781937b0cf7488 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 15:47:05 +0200
Subject: [PATCH 04/13] Proto/Michelson: typed views

---
 src/proto_alpha/lib_protocol/apply.ml         |  8 +--
 .../lib_protocol/script_interpreter.ml        |  2 +-
 .../lib_protocol/script_ir_translator.ml      | 49 ++++++++++---------
 .../lib_protocol/script_ir_translator.mli     |  9 ++--
 4 files changed, 35 insertions(+), 33 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index f3ff86ed51f9..ba6b66f451d7 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1429,16 +1429,12 @@ let apply_external_manager_operation_content :
       >>?= fun (unparsed_code, ctxt) ->
       let (Script {storage_type; views; storage; _}) = parsed_script in
       let views_result =
-        Script_ir_translator.typecheck_views
-          ctxt
-          ~legacy:false
-          storage_type
-          views
+        Script_ir_translator.parse_views ctxt ~legacy:false storage_type views
       in
       trace
         (Script_tc_errors.Ill_typed_contract (unparsed_code, []))
         views_result
-      >>=? fun ctxt ->
+      >>=? fun (_typed_views, ctxt) ->
       apply_origination
         ~ctxt
         ~storage_type
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index a3cc1cf931d1..afd46f0985ee 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1063,7 +1063,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                   | None -> (return_none [@ocaml.tailcall]) ctxt
                   | Some view -> (
                       let view_result =
-                        Script_ir_translator.parse_view_kdescr
+                        Script_ir_translator.parse_view
                           ctxt
                           ~legacy:true
                           storage_type
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 3405926ec6d1..9c6911ad3301 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1820,6 +1820,8 @@ type 'storage typed_view =
       ('input * 'storage, end_of_stack, 'output, end_of_stack) kdescr
       -> 'storage typed_view
 
+type 'storage typed_view_map = (Script_string.t, 'storage typed_view) map
+
 type (_, _) dig_proof_argument =
   | Dig_proof_argument :
       ('x, 'a * 's, 'a, 's, 'b, 't, 'c, 'u) stack_prefix_preservation_witness
@@ -2952,7 +2954,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data :
   | (Chest_t, expr) ->
       traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))
 
-and parse_view_kdescr :
+and parse_view :
     type storage storagec.
     ?type_logger:type_logger ->
     context ->
@@ -2967,15 +2969,15 @@ and parse_view_kdescr :
       Ill_formed_type
         (Some "arg of view", strip_locations input_ty, input_ty_loc))
     (parse_view_input_ty ctxt ~stack_depth:0 ~legacy input_ty)
-  >>?= fun (Ex_ty input_ty', ctxt) ->
+  >>?= fun (Ex_ty input_ty, ctxt) ->
   let output_ty_loc = location output_ty in
   record_trace_eval
     (fun () ->
       Ill_formed_type
         (Some "return of view", strip_locations output_ty, output_ty_loc))
     (parse_view_output_ty ctxt ~stack_depth:0 ~legacy output_ty)
-  >>?= fun (Ex_ty output_ty', ctxt) ->
-  pair_t input_ty_loc input_ty' storage_type >>?= fun (Ty_ex_c pair_ty) ->
+  >>?= fun (Ex_ty output_ty, ctxt) ->
+  pair_t input_ty_loc input_ty storage_type >>?= fun (Ty_ex_c pair_ty) ->
   parse_instr
     ?type_logger
     ~stack_depth:0
@@ -2989,14 +2991,12 @@ and parse_view_kdescr :
   @@
   match judgement with
   | Failed {descr} ->
-      let cur_view =
-        Typed_view (close_descr (descr (Item_t (output_ty', Bot_t))))
-      in
-      ok (cur_view, ctxt)
+      let kdescr = close_descr (descr (Item_t (output_ty, Bot_t))) in
+      ok (Typed_view kdescr, ctxt)
   | Typed ({loc; aft; _} as descr) -> (
       let ill_type_view loc stack_ty () =
         let actual = serialize_stack_for_error ctxt stack_ty in
-        let expected_stack = Item_t (output_ty', Bot_t) in
+        let expected_stack = Item_t (output_ty, Bot_t) in
         let expected = serialize_stack_for_error ctxt expected_stack in
         Ill_typed_view {loc; actual; expected}
       in
@@ -3006,25 +3006,29 @@ and parse_view_kdescr :
           @@ Gas_monad.record_trace_eval
                ~error_details:Informative
                (ill_type_view loc aft : unit -> _)
-          @@ ty_eq ~error_details:Informative loc ty output_ty'
+          @@ ty_eq ~error_details:Informative loc ty output_ty
           >>? fun (eq, ctxt) ->
-          eq >|? fun Eq -> (Typed_view (close_descr descr), ctxt)
+          eq >|? fun Eq ->
+          let kdescr = close_descr descr in
+          (Typed_view kdescr, ctxt)
       | _ -> error (ill_type_view loc aft ()))
 
-and typecheck_views :
+and parse_views :
     type storage storagec.
     ?type_logger:type_logger ->
     context ->
     legacy:bool ->
     (storage, storagec) ty ->
     view_map ->
-    context tzresult Lwt.t =
+    (storage typed_view_map * context) tzresult Lwt.t =
  fun ?type_logger ctxt ~legacy storage_type views ->
-  let aux _name cur_view ctxt =
-    parse_view_kdescr ?type_logger ctxt ~legacy storage_type cur_view
-    >|=? fun (Typed_view _parsed_view, ctxt) -> ctxt
+  let aux ctxt name cur_view =
+    Gas.consume
+      ctxt
+      (Michelson_v1_gas.Cost_of.Interpreter.view_update name views)
+    >>?= fun ctxt -> parse_view ?type_logger ctxt ~legacy storage_type cur_view
   in
-  Script_map.fold_es aux views ctxt
+  Script_map.map_es_in_context aux ctxt views
 
 and[@coq_axiom_with_reason "gadt"] parse_returning :
     type arg argc ret retc.
@@ -4632,10 +4636,10 @@ and[@coq_axiom_with_reason "gadt"] parse_instr :
                      _ ),
                  ctxt ) ->
       let views_result =
-        typecheck_views ctxt ?type_logger ~legacy storage_type views
+        parse_views ctxt ?type_logger ~legacy storage_type views
       in
       trace (Ill_typed_contract (canonical_code, [])) views_result
-      >>=? fun ctxt ->
+      >>=? fun (_typed_views, ctxt) ->
       (Gas_monad.run ctxt
       @@
       let open Gas_monad.Syntax in
@@ -5570,10 +5574,9 @@ let typecheck_code :
       code_field
   in
   trace (Ill_typed_contract (code, !type_map)) result >>=? fun (Lam _, ctxt) ->
-  let views_result =
-    typecheck_views ctxt ?type_logger ~legacy storage_type views
-  in
-  trace (Ill_typed_contract (code, !type_map)) views_result >|=? fun ctxt ->
+  let views_result = parse_views ctxt ?type_logger ~legacy storage_type views in
+  trace (Ill_typed_contract (code, !type_map)) views_result
+  >|=? fun (_typed_views, ctxt) ->
   ( Typechecked_code_internal
       {toplevel; arg_type; storage_type; entrypoints; type_map = !type_map},
     ctxt )
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 7197e4d6ed5f..2b415c9e4f3b 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -123,6 +123,9 @@ type 'storage typed_view =
       Script_typed_ir.kdescr
       -> 'storage typed_view
 
+type 'storage typed_view_map =
+  (Script_string.t, 'storage typed_view) Script_typed_ir.map
+
 type ('a, 's, 'b, 'u) cinstr = {
   apply :
     'r 'f.
@@ -297,7 +300,7 @@ val parse_view_output_ty :
   Script.node ->
   (ex_ty * context) tzresult
 
-val parse_view_kdescr :
+val parse_view :
   ?type_logger:type_logger ->
   context ->
   legacy:bool ->
@@ -305,13 +308,13 @@ val parse_view_kdescr :
   Script_typed_ir.view ->
   ('storage typed_view * context) tzresult Lwt.t
 
-val typecheck_views :
+val parse_views :
   ?type_logger:type_logger ->
   context ->
   legacy:bool ->
   ('storage, _) Script_typed_ir.ty ->
   Script_typed_ir.view_map ->
-  context tzresult Lwt.t
+  ('storage typed_view_map * context) tzresult Lwt.t
 
 (**
   [parse_ty] allowing big_map values, operations, contract and tickets.
-- 
GitLab


From 278fb45d3e061bda8255529cb2b992fd5dd319b8 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 15:47:05 +0200
Subject: [PATCH 05/13] Proto/Michelson: add types in typed view

---
 .../lib_protocol/script_interpreter.ml           | 13 +++++++++----
 .../lib_protocol/script_ir_translator.ml         | 11 +++++++----
 .../lib_protocol/script_ir_translator.mli        | 16 ++++++++++------
 3 files changed, 26 insertions(+), 14 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index afd46f0985ee..4bf8b455a1c6 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1076,10 +1076,15 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                         view_result
                       >>=? fun ( Typed_view
                                    {
-                                     kloc;
-                                     kaft = Item_t (aft_ty, Bot_t);
-                                     kbef = Item_t (bef_ty, Bot_t);
-                                     kinstr;
+                                     input_ty = _;
+                                     output_ty = _;
+                                     kdescr =
+                                       {
+                                         kloc;
+                                         kaft = Item_t (aft_ty, Bot_t);
+                                         kbef = Item_t (bef_ty, Bot_t);
+                                         kinstr;
+                                       };
                                    },
                                  ctxt ) ->
                       pair_t kloc input_ty storage_type
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 9c6911ad3301..8afe1de01f40 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1816,8 +1816,11 @@ type ex_script = Ex_script : ('a, 'c) Script_typed_ir.script -> ex_script
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
 type 'storage typed_view =
-  | Typed_view :
-      ('input * 'storage, end_of_stack, 'output, end_of_stack) kdescr
+  | Typed_view : {
+      input_ty : ('input, _) ty;
+      output_ty : ('output, _) ty;
+      kdescr : ('input * 'storage, end_of_stack, 'output, end_of_stack) kdescr;
+    }
       -> 'storage typed_view
 
 type 'storage typed_view_map = (Script_string.t, 'storage typed_view) map
@@ -2992,7 +2995,7 @@ and parse_view :
   match judgement with
   | Failed {descr} ->
       let kdescr = close_descr (descr (Item_t (output_ty, Bot_t))) in
-      ok (Typed_view kdescr, ctxt)
+      ok (Typed_view {input_ty; output_ty; kdescr}, ctxt)
   | Typed ({loc; aft; _} as descr) -> (
       let ill_type_view loc stack_ty () =
         let actual = serialize_stack_for_error ctxt stack_ty in
@@ -3010,7 +3013,7 @@ and parse_view :
           >>? fun (eq, ctxt) ->
           eq >|? fun Eq ->
           let kdescr = close_descr descr in
-          (Typed_view kdescr, ctxt)
+          (Typed_view {input_ty; output_ty; kdescr}, ctxt)
       | _ -> error (ill_type_view loc aft ()))
 
 and parse_views :
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 2b415c9e4f3b..781d5281dc19 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -115,12 +115,16 @@ type ('arg, 'storage) code =
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
 type 'storage typed_view =
-  | Typed_view :
-      ( 'input * 'storage,
-        Script_typed_ir.end_of_stack,
-        'output,
-        Script_typed_ir.end_of_stack )
-      Script_typed_ir.kdescr
+  | Typed_view : {
+      input_ty : ('input, _) Script_typed_ir.ty;
+      output_ty : ('output, _) Script_typed_ir.ty;
+      kdescr :
+        ( 'input * 'storage,
+          Script_typed_ir.end_of_stack,
+          'output,
+          Script_typed_ir.end_of_stack )
+        Script_typed_ir.kdescr;
+    }
       -> 'storage typed_view
 
 type 'storage typed_view_map =
-- 
GitLab


From cd581a6b6140067686e455ceef6cef53aaf84346 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 16:50:39 +0200
Subject: [PATCH 06/13] Proto/Michelson: save a pair_t

---
 src/proto_alpha/lib_protocol/script_interpreter.ml | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 4bf8b455a1c6..ca0429e36ede 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1076,19 +1076,17 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                         view_result
                       >>=? fun ( Typed_view
                                    {
-                                     input_ty = _;
+                                     input_ty = input_ty';
                                      output_ty = _;
                                      kdescr =
                                        {
                                          kloc;
                                          kaft = Item_t (aft_ty, Bot_t);
-                                         kbef = Item_t (bef_ty, Bot_t);
+                                         kbef = Item_t (_, Bot_t);
                                          kinstr;
                                        };
                                    },
                                  ctxt ) ->
-                      pair_t kloc input_ty storage_type
-                      >>?= fun (Ty_ex_c pair_ty) ->
                       let io_ty =
                         let open Gas_monad.Syntax in
                         let* out_eq =
@@ -1099,7 +1097,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                             output_ty
                         in
                         let+ in_eq =
-                          ty_eq ~error_details:Fast kloc bef_ty pair_ty
+                          ty_eq ~error_details:Fast kloc input_ty input_ty'
                         in
                         (out_eq, in_eq)
                       in
-- 
GitLab


From ed51d43a02a6d85e6ffea9d9887aeaa44461ce82 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 16:48:23 +0200
Subject: [PATCH 07/13] Proto/Michelson: simplify Typed_view

---
 .../lib_protocol/script_interpreter.ml        | 19 +++++--------------
 .../lib_protocol/script_ir_translator.ml      | 10 +++++-----
 .../lib_protocol/script_ir_translator.mli     |  4 ++--
 3 files changed, 12 insertions(+), 21 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index ca0429e36ede..398a847e2d25 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1077,27 +1077,18 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                       >>=? fun ( Typed_view
                                    {
                                      input_ty = input_ty';
-                                     output_ty = _;
-                                     kdescr =
-                                       {
-                                         kloc;
-                                         kaft = Item_t (aft_ty, Bot_t);
-                                         kbef = Item_t (_, Bot_t);
-                                         kinstr;
-                                       };
+                                     output_ty = output_ty';
+                                     kinstr;
                                    },
                                  ctxt ) ->
+                      let loc = Micheline.location view.view_code in
                       let io_ty =
                         let open Gas_monad.Syntax in
                         let* out_eq =
-                          Script_ir_translator.ty_eq
-                            ~error_details:Fast
-                            kloc
-                            aft_ty
-                            output_ty
+                          ty_eq ~error_details:Fast loc output_ty' output_ty
                         in
                         let+ in_eq =
-                          ty_eq ~error_details:Fast kloc input_ty input_ty'
+                          ty_eq ~error_details:Fast loc input_ty input_ty'
                         in
                         (out_eq, in_eq)
                       in
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 8afe1de01f40..4bed3aa0237c 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1819,7 +1819,7 @@ type 'storage typed_view =
   | Typed_view : {
       input_ty : ('input, _) ty;
       output_ty : ('output, _) ty;
-      kdescr : ('input * 'storage, end_of_stack, 'output, end_of_stack) kdescr;
+      kinstr : ('input * 'storage, end_of_stack, 'output, end_of_stack) kinstr;
     }
       -> 'storage typed_view
 
@@ -2994,8 +2994,8 @@ and parse_view :
   @@
   match judgement with
   | Failed {descr} ->
-      let kdescr = close_descr (descr (Item_t (output_ty, Bot_t))) in
-      ok (Typed_view {input_ty; output_ty; kdescr}, ctxt)
+      let {kinstr; _} = close_descr (descr (Item_t (output_ty, Bot_t))) in
+      ok (Typed_view {input_ty; output_ty; kinstr}, ctxt)
   | Typed ({loc; aft; _} as descr) -> (
       let ill_type_view loc stack_ty () =
         let actual = serialize_stack_for_error ctxt stack_ty in
@@ -3012,8 +3012,8 @@ and parse_view :
           @@ ty_eq ~error_details:Informative loc ty output_ty
           >>? fun (eq, ctxt) ->
           eq >|? fun Eq ->
-          let kdescr = close_descr descr in
-          (Typed_view {input_ty; output_ty; kdescr}, ctxt)
+          let {kinstr; _} = close_descr descr in
+          (Typed_view {input_ty; output_ty; kinstr}, ctxt)
       | _ -> error (ill_type_view loc aft ()))
 
 and parse_views :
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 781d5281dc19..8d2da3f7690e 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -118,12 +118,12 @@ type 'storage typed_view =
   | Typed_view : {
       input_ty : ('input, _) Script_typed_ir.ty;
       output_ty : ('output, _) Script_typed_ir.ty;
-      kdescr :
+      kinstr :
         ( 'input * 'storage,
           Script_typed_ir.end_of_stack,
           'output,
           Script_typed_ir.end_of_stack )
-        Script_typed_ir.kdescr;
+        Script_typed_ir.kinstr;
     }
       -> 'storage typed_view
 
-- 
GitLab


From 98dc23dc25ae56441b9ad4d50346737f5ddd17db Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 17:27:47 +0200
Subject: [PATCH 08/13] Proto/Michelson: add original code expr to typed view

---
 src/proto_alpha/lib_protocol/script_interpreter.ml    |  1 +
 src/proto_alpha/lib_protocol/script_ir_translator.ml  | 10 ++++++++--
 src/proto_alpha/lib_protocol/script_ir_translator.mli |  1 +
 3 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 398a847e2d25..dbe35717b19c 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1079,6 +1079,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                                      input_ty = input_ty';
                                      output_ty = output_ty';
                                      kinstr;
+                                     original_code_expr = _;
                                    },
                                  ctxt ) ->
                       let loc = Micheline.location view.view_code in
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 4bed3aa0237c..093a4937183b 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1820,6 +1820,7 @@ type 'storage typed_view =
       input_ty : ('input, _) ty;
       output_ty : ('output, _) ty;
       kinstr : ('input * 'storage, end_of_stack, 'output, end_of_stack) kinstr;
+      original_code_expr : Script.node;
     }
       -> 'storage typed_view
 
@@ -2995,7 +2996,10 @@ and parse_view :
   match judgement with
   | Failed {descr} ->
       let {kinstr; _} = close_descr (descr (Item_t (output_ty, Bot_t))) in
-      ok (Typed_view {input_ty; output_ty; kinstr}, ctxt)
+      ok
+        ( Typed_view
+            {input_ty; output_ty; kinstr; original_code_expr = view_code},
+          ctxt )
   | Typed ({loc; aft; _} as descr) -> (
       let ill_type_view loc stack_ty () =
         let actual = serialize_stack_for_error ctxt stack_ty in
@@ -3013,7 +3017,9 @@ and parse_view :
           >>? fun (eq, ctxt) ->
           eq >|? fun Eq ->
           let {kinstr; _} = close_descr descr in
-          (Typed_view {input_ty; output_ty; kinstr}, ctxt)
+          ( Typed_view
+              {input_ty; output_ty; kinstr; original_code_expr = view_code},
+            ctxt )
       | _ -> error (ill_type_view loc aft ()))
 
 and parse_views :
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 8d2da3f7690e..9ab18aeeaeec 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -124,6 +124,7 @@ type 'storage typed_view =
           'output,
           Script_typed_ir.end_of_stack )
         Script_typed_ir.kinstr;
+      original_code_expr : Script.node;
     }
       -> 'storage typed_view
 
-- 
GitLab


From cb723ca59d7cba77cbd8ff9ca85fd31518eb5be6 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 17:59:22 +0200
Subject: [PATCH 09/13] Proto/Michelson: rewrite of
 parse_and_unparse_script_unaccounted

Move more stuff in the Lwt.t monad.
---
 .../lib_protocol/script_ir_translator.ml      | 80 +++++++++----------
 1 file changed, 39 insertions(+), 41 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 093a4937183b..6d19b56c8ab6 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5938,47 +5938,45 @@ let parse_and_unparse_script_unaccounted ctxt ~legacy ~allow_forged_in_storage
   unparse_code ctxt ~stack_depth:0 mode code_field >>=? fun (code, ctxt) ->
   unparse_data ctxt ~stack_depth:0 mode storage_type storage
   >>=? fun (storage, ctxt) ->
-  Lwt.return
-    (let loc = Micheline.dummy_location in
-     (if normalize_types then
-      unparse_parameter_ty ~loc ctxt arg_type ~entrypoints
-      >>? fun (arg_type, ctxt) ->
-      unparse_ty ~loc ctxt storage_type >|? fun (storage_type, ctxt) ->
-      (arg_type, storage_type, ctxt)
-     else ok (original_arg_type_expr, original_storage_type_expr, ctxt))
-     >|? fun (arg_type, storage_type, ctxt) ->
-     let open Micheline in
-     let unparse_view_unaccounted name {input_ty; output_ty; view_code} views =
-       Prim
-         ( loc,
-           K_view,
-           [
-             String (loc, Script_string.to_string name);
-             input_ty;
-             output_ty;
-             view_code;
-           ],
-           [] )
-       :: views
-     in
-     let views =
-       Script_map.fold unparse_view_unaccounted views [] |> List.rev
-     in
-     let code =
-       Seq
-         ( loc,
-           [
-             Prim (loc, K_parameter, [arg_type], []);
-             Prim (loc, K_storage, [storage_type], []);
-             Prim (loc, K_code, [code], []);
-           ]
-           @ views )
-     in
-     ( {
-         code = lazy_expr (strip_locations code);
-         storage = lazy_expr (strip_locations storage);
-       },
-       ctxt ))
+  let loc = Micheline.dummy_location in
+  (if normalize_types then
+   unparse_parameter_ty ~loc ctxt arg_type ~entrypoints
+   >>?= fun (arg_type, ctxt) ->
+   unparse_ty ~loc ctxt storage_type >>?= fun (storage_type, ctxt) ->
+   return (arg_type, storage_type, ctxt)
+  else return (original_arg_type_expr, original_storage_type_expr, ctxt))
+  >>=? fun (arg_type, storage_type, ctxt) ->
+  let open Micheline in
+  let unparse_view_unaccounted name {input_ty; output_ty; view_code} views =
+    Prim
+      ( loc,
+        K_view,
+        [
+          String (loc, Script_string.to_string name);
+          input_ty;
+          output_ty;
+          view_code;
+        ],
+        [] )
+    :: views
+  in
+  let views = Script_map.fold unparse_view_unaccounted views [] |> List.rev in
+  let code =
+    Seq
+      ( loc,
+        [
+          Prim (loc, K_parameter, [arg_type], []);
+          Prim (loc, K_storage, [storage_type], []);
+          Prim (loc, K_code, [code], []);
+        ]
+        @ views )
+  in
+  return
+    ( {
+        code = lazy_expr (strip_locations code);
+        storage = lazy_expr (strip_locations storage);
+      },
+      ctxt )
 
 let pack_data_with_mode ctxt ty data ~mode =
   unparse_data ~stack_depth:0 ctxt mode ty data >>=? fun (unparsed, ctxt) ->
-- 
GitLab


From 3d0c8d06048a48874643213765f64cf583dc2e83 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 17:46:40 +0200
Subject: [PATCH 10/13] Proto/Michelson: allow to normalize types of views

---
 .../lib_protocol/script_ir_translator.ml      | 29 +++++++++++++++----
 1 file changed, 24 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 6d19b56c8ab6..3185b2dd6d17 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5536,6 +5536,7 @@ type typechecked_code_internal =
       arg_type : ('arg, _) ty;
       storage_type : ('storage, _) ty;
       entrypoints : 'arg entrypoints;
+      typed_views : 'storage typed_view_map;
       type_map : type_map;
     }
       -> typechecked_code_internal
@@ -5585,9 +5586,16 @@ let typecheck_code :
   trace (Ill_typed_contract (code, !type_map)) result >>=? fun (Lam _, ctxt) ->
   let views_result = parse_views ctxt ?type_logger ~legacy storage_type views in
   trace (Ill_typed_contract (code, !type_map)) views_result
-  >|=? fun (_typed_views, ctxt) ->
+  >|=? fun (typed_views, ctxt) ->
   ( Typechecked_code_internal
-      {toplevel; arg_type; storage_type; entrypoints; type_map = !type_map},
+      {
+        toplevel;
+        arg_type;
+        storage_type;
+        entrypoints;
+        typed_views;
+        type_map = !type_map;
+      },
     ctxt )
 
 (* Uncarbonated because used only in RPCs *)
@@ -5925,6 +5933,7 @@ let parse_and_unparse_script_unaccounted ctxt ~legacy ~allow_forged_in_storage
                  arg_type;
                  storage_type;
                  entrypoints;
+                 typed_views;
                  type_map = _;
                },
              ctxt ) ->
@@ -5943,9 +5952,19 @@ let parse_and_unparse_script_unaccounted ctxt ~legacy ~allow_forged_in_storage
    unparse_parameter_ty ~loc ctxt arg_type ~entrypoints
    >>?= fun (arg_type, ctxt) ->
    unparse_ty ~loc ctxt storage_type >>?= fun (storage_type, ctxt) ->
-   return (arg_type, storage_type, ctxt)
-  else return (original_arg_type_expr, original_storage_type_expr, ctxt))
-  >>=? fun (arg_type, storage_type, ctxt) ->
+   Script_map.map_es_in_context
+     (fun ctxt
+          _name
+          (Typed_view {input_ty; output_ty; kinstr = _; original_code_expr}) ->
+       Lwt.return
+         ( unparse_ty ~loc ctxt input_ty >>? fun (input_ty, ctxt) ->
+           unparse_ty ~loc ctxt output_ty >|? fun (output_ty, ctxt) ->
+           ({input_ty; output_ty; view_code = original_code_expr}, ctxt) ))
+     ctxt
+     typed_views
+   >|=? fun (views, ctxt) -> (arg_type, storage_type, views, ctxt)
+  else return (original_arg_type_expr, original_storage_type_expr, views, ctxt))
+  >>=? fun (arg_type, storage_type, views, ctxt) ->
   let open Micheline in
   let unparse_view_unaccounted name {input_ty; output_ty; view_code} views =
     Prim
-- 
GitLab


From 937592e825b9b2136c4d7a288d120fd7c168857e Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Thu, 31 Mar 2022 18:15:01 +0200
Subject: [PATCH 11/13] Proto/Michelson: also normalize view code according to
 unparsing_mode

---
 src/proto_alpha/lib_protocol/script_ir_translator.ml | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 3185b2dd6d17..1c99eb32003d 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5965,6 +5965,13 @@ let parse_and_unparse_script_unaccounted ctxt ~legacy ~allow_forged_in_storage
    >|=? fun (views, ctxt) -> (arg_type, storage_type, views, ctxt)
   else return (original_arg_type_expr, original_storage_type_expr, views, ctxt))
   >>=? fun (arg_type, storage_type, views, ctxt) ->
+  Script_map.map_es_in_context
+    (fun ctxt _name {input_ty; output_ty; view_code} ->
+      unparse_code ctxt ~stack_depth:0 mode view_code
+      >|=? fun (view_code, ctxt) -> ({input_ty; output_ty; view_code}, ctxt))
+    ctxt
+    views
+  >>=? fun (views, ctxt) ->
   let open Micheline in
   let unparse_view_unaccounted name {input_ty; output_ty; view_code} views =
     Prim
-- 
GitLab


From 0a78b83b0ac7eedbb606a3b6a5e83df6b9bb7cdd Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 4 Apr 2022 14:15:25 +0200
Subject: [PATCH 12/13] Tests/Python: update gas in regression traces

---
 ...k::test_typecheck[opcodes--create_contract_with_view.tz].out | 2 +-
 ...ract.TestTypecheck::test_typecheck[opcodes--view_rec.tz].out | 2 +-
 ...Typecheck::test_typecheck[opcodes--view_toplevel_lib.tz].out | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--create_contract_with_view.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--create_contract_with_view.tz].out
index c5047af5fab7..b39adfae8536 100644
--- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--create_contract_with_view.tz].out
+++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--create_contract_with_view.tz].out
@@ -1,7 +1,7 @@
 tests_alpha/test_contract.py::TestTypecheck::test_typecheck[opcodes/create_contract_with_view.tz]
 
 Well typed
-Gas remaining: 1039990.616 units remaining
+Gas remaining: 1039990.516 units remaining
 { parameter unit ;
   storage (option address) ;
   code { /* [ pair unit unit ] */
diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_rec.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_rec.tz].out
index d8a77bc835a6..873938b33135 100644
--- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_rec.tz].out
+++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_rec.tz].out
@@ -1,7 +1,7 @@
 tests_alpha/test_contract.py::TestTypecheck::test_typecheck[opcodes/view_rec.tz]
 
 Well typed
-Gas remaining: 1039988.536 units remaining
+Gas remaining: 1039988.440 units remaining
 { parameter unit ;
   storage unit ;
   view "loop"
diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_toplevel_lib.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_toplevel_lib.tz].out
index 7da661cfaa71..cabc26a8e72d 100644
--- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_toplevel_lib.tz].out
+++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--view_toplevel_lib.tz].out
@@ -1,7 +1,7 @@
 tests_alpha/test_contract.py::TestTypecheck::test_typecheck[opcodes/view_toplevel_lib.tz]
 
 Well typed
-Gas remaining: 1039947.763 units remaining
+Gas remaining: 1039946.819 units remaining
 { parameter nat ;
   storage nat ;
   code { CAR
-- 
GitLab


From b3fa5a59ad8f44b88aab6750f51d244248d85fc7 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 4 Apr 2022 14:16:39 +0200
Subject: [PATCH 13/13] Tezt: update gas in regression traces

---
 tezt/_regressions/run_views.out | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/tezt/_regressions/run_views.out b/tezt/_regressions/run_views.out
index e5a184579103..0d14e2ae939a 100644
--- a/tezt/_regressions/run_views.out
+++ b/tezt/_regressions/run_views.out
@@ -14,7 +14,7 @@ view "calls_count" unit nat { CDR ; SIZE };
 view "last_caller" unit (option address) { CDR ; IF_CONS { DIP { DROP } ; SOME } { NONE address } };
 ' --init '{}' --burn-cap 1
 Node is bootstrapped.
-Estimated gas: 1426.629 units (will add 100 for safety)
+Estimated gas: 1426.921 units (will add 100 for safety)
 Estimated storage: 409 bytes added (will add 20 for safety)
 Operation successfully injected in the node.
 Operation hash is 'oow4SAcGS9xTtTqPKayDoSUrkfkNQRoPKE1pN1JuviFG2YrF6GY'
@@ -51,7 +51,7 @@ This sequence of operations was run:
           KT1LfQjDNgPpdwMHbhzyQcD8GTE2L4rwxxpN
         Storage size: 152 bytes
         Paid storage size diff: 152 bytes
-        Consumed gas: 1426.629
+        Consumed gas: 1426.921
         Balance updates:
           tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx ... -ꜩ0.038
           storage fees ........................... +ꜩ0.038
@@ -146,7 +146,7 @@ Contract memorized as check_caller.
 
 ./tezos-client --mode mockup --base-dir '<masked>' --wait none transfer 1 from bootstrap1 to KT1RdnquZZf4Y4ZDJvaEuY4cbam3xor3CffU --burn-cap 1 --arg '"KT1LfQjDNgPpdwMHbhzyQcD8GTE2L4rwxxpN"'
 Node is bootstrapped.
-Estimated gas: 4418.891 units (will add 100 for safety)
+Estimated gas: 4418.531 units (will add 100 for safety)
 Estimated storage: no bytes added
 Operation successfully injected in the node.
 Operation hash is 'opKVxALX6z77kHy3Tft1d16KCmivKgyyVcVm9hXuauAs5Mx2FsS'
@@ -172,7 +172,7 @@ This sequence of operations was run:
       This transaction was successfully applied
       Updated storage: None
       Storage size: 208 bytes
-      Consumed gas: 4419.689
+      Consumed gas: 4419.329
       Balance updates:
         tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx ... -ꜩ1
         KT1RdnquZZf4Y4ZDJvaEuY4cbam3xor3CffU ... +ꜩ1
@@ -216,20 +216,20 @@ This sequence of operations was run:
 
 ./tezos-client --mode mockup --base-dir '<masked>' --wait none transfer 1 from bootstrap1 to KT1RdnquZZf4Y4ZDJvaEuY4cbam3xor3CffU --burn-cap 1 --arg '"KT1LfQjDNgPpdwMHbhzyQcD8GTE2L4rwxxpN"'
 Node is bootstrapped.
-Estimated gas: 4422.148 units (will add 100 for safety)
+Estimated gas: 4421.788 units (will add 100 for safety)
 Estimated storage: 27 bytes added (will add 20 for safety)
 Operation successfully injected in the node.
-Operation hash is 'onu8BqYeBJKc2KGG4UxNC7NAt1HDXj7FixJThwTVL3HZeGRkuhg'
+Operation hash is 'onfWynbTF2Mhv5YXKRge4vS8dqsm8X75Q6ogUBLw4iVYDgAuvBx'
 NOT waiting for the operation to be included.
 Use command
-  tezos-client wait for onu8BqYeBJKc2KGG4UxNC7NAt1HDXj7FixJThwTVL3HZeGRkuhg to be included --confirmations 1 --branch BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU
+  tezos-client wait for onfWynbTF2Mhv5YXKRge4vS8dqsm8X75Q6ogUBLw4iVYDgAuvBx to be included --confirmations 1 --branch BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU
 and/or an external block explorer to make sure that it has been included.
 This sequence of operations was run:
   Manager signed operations:
     From: tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx
     Fee to the baker: ꜩ0.000749
     Expected counter: 5
-    Gas limit: 4523
+    Gas limit: 4522
     Storage limit: 47 bytes
     Balance updates:
       tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx ... -ꜩ0.000749
@@ -243,7 +243,7 @@ This sequence of operations was run:
       Updated storage: (Some 0x000002298c03ed7d454a101eb7022bc95f7e5f41ac78)
       Storage size: 235 bytes
       Paid storage size diff: 27 bytes
-      Consumed gas: 4422.946
+      Consumed gas: 4422.586
       Balance updates:
         tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx ... -ꜩ0.00675
         storage fees ........................... +ꜩ0.00675
-- 
GitLab