From f4e9287ea3b32291cec82a00786ff7c155e12040 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 15:40:11 +0200
Subject: [PATCH 01/27] Proto/Michelson: rename entrypoints type

We will need to add the original type at the root.
---
 .../lib_protocol/script_ir_translator.ml       | 18 ++++++++++--------
 .../lib_protocol/script_typed_ir.ml            |  8 +++++---
 .../lib_protocol/script_typed_ir.mli           | 10 ++++++----
 3 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 65b9f6bd1d23..9b95592bc387 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -224,7 +224,7 @@ let unparse_memo_size ~loc memo_size =
 
 let rec unparse_ty_entrypoints_uncarbonated :
     type a ac loc.
-    loc:loc -> (a, ac) ty -> a entrypoints -> loc Script.michelson_node =
+    loc:loc -> (a, ac) ty -> a entrypoints_node -> loc Script.michelson_node =
  fun ~loc ty {nested = nested_entrypoints; name = entrypoint_name} ->
   let (name, args) =
     match ty with
@@ -1924,7 +1924,7 @@ let find_entrypoint (type full fullc error_trace)
   let rec find_entrypoint :
       type t tc.
       (t, tc) ty ->
-      t entrypoints ->
+      t entrypoints_node ->
       Entrypoint.t ->
       (t ex_ty_cstr, unit) Gas_monad.t =
    fun ty entrypoints entrypoint ->
@@ -1977,8 +1977,9 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
 
 let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
     entrypoints =
-  let merge path (type t tc) (ty : (t, tc) ty) (entrypoints : t entrypoints)
-      reachable ((first_unreachable, all) as acc) =
+  let merge path (type t tc) (ty : (t, tc) ty)
+      (entrypoints : t entrypoints_node) reachable
+      ((first_unreachable, all) as acc) =
     match entrypoints.name with
     | None ->
         ok
@@ -1998,7 +1999,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
   let rec check :
       type t tc.
       (t, tc) ty ->
-      t entrypoints ->
+      t entrypoints_node ->
       prim list ->
       bool ->
       prim list option * Entrypoint.Set.t ->
@@ -5532,8 +5533,9 @@ let typecheck_code :
 
 let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
     (entrypoints : full entrypoints) =
-  let merge path (type t tc) (ty : (t, tc) ty) (entrypoints : t entrypoints)
-      reachable ((unreachables, all) as acc) =
+  let merge path (type t tc) (ty : (t, tc) ty)
+      (entrypoints : t entrypoints_node) reachable ((unreachables, all) as acc)
+      =
     match entrypoints.name with
     | None ->
         ok
@@ -5555,7 +5557,7 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
   let rec fold_tree :
       type t tc.
       (t, tc) ty ->
-      t entrypoints ->
+      t entrypoints_node ->
       prim list ->
       bool ->
       prim list list
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 1ef7eaf3759c..986aeeeeed0c 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -421,21 +421,23 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type 'arg entrypoints = {
+type 'arg entrypoints_node = {
   name : Entrypoint.t option;
   nested : 'arg nested_entrypoints;
 }
 
 and 'arg nested_entrypoints =
   | Entrypoints_Union : {
-      left : 'l entrypoints;
-      right : 'r entrypoints;
+      left : 'l entrypoints_node;
+      right : 'r entrypoints_node;
     }
       -> ('l, 'r) union nested_entrypoints
   | Entrypoints_None : _ nested_entrypoints
 
 let no_entrypoints = {name = None; nested = Entrypoints_None}
 
+type 'arg entrypoints = 'arg entrypoints_node
+
 type ('arg, 'storage) script =
   | Script : {
       code :
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 80ef6bcda3d6..fb75e952f885 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -287,21 +287,23 @@ type view_map = (Script_string.t, view) map
       But it is also ok to have [Entrypoints_None] for a union node, it just
       means that there are no entrypoints below that node in the tree.
 *)
-type 'arg entrypoints = {
+type 'arg entrypoints_node = {
   name : Entrypoint.t option;
   nested : 'arg nested_entrypoints;
 }
 
 and 'arg nested_entrypoints =
   | Entrypoints_Union : {
-      left : 'l entrypoints;
-      right : 'r entrypoints;
+      left : 'l entrypoints_node;
+      right : 'r entrypoints_node;
     }
       -> ('l, 'r) union nested_entrypoints
   | Entrypoints_None : _ nested_entrypoints
 
 (** [no_entrypoints] is [{name = None; nested = Entrypoints_None}] *)
-val no_entrypoints : _ entrypoints
+val no_entrypoints : _ entrypoints_node
+
+type 'arg entrypoints = 'arg entrypoints_node
 
 type ('arg, 'storage) script =
   | Script : {
-- 
GitLab


From d26c83235dfaab64f532d759c319f7621f8c41f2 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 16:44:18 +0200
Subject: [PATCH 02/27] Proto/Michelson: split ex_parameter_ty_and_entrypoints

The internal one works on nodes, the exposed one will contain the
original type of the root.
---
 .../lib_protocol/script_ir_translator.ml      | 37 +++++++++++--------
 1 file changed, 22 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 9b95592bc387..bcc4d4747c54 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1225,12 +1225,12 @@ let[@coq_struct "ty"] rec parse_comparable_ty :
 
 type ex_ty = Ex_ty : ('a, _) ty -> ex_ty
 
-type ex_parameter_ty_and_entrypoints =
-  | Ex_parameter_ty_and_entrypoints : {
+type ex_parameter_ty_and_entrypoints_node =
+  | Ex_parameter_ty_and_entrypoints_node : {
       arg_type : ('a, _) ty;
-      entrypoints : 'a entrypoints;
+      entrypoints : 'a entrypoints_node;
     }
-      -> ex_parameter_ty_and_entrypoints
+      -> ex_parameter_ty_and_entrypoints_node
 
 (** [parse_ty] can be used to parse regular types as well as parameter types
     together with their entrypoints.
@@ -1239,12 +1239,12 @@ type ex_parameter_ty_and_entrypoints =
     return an [ex_ty].
 
     In the second case, use [~ret:Parse_entrypoints], [parse_ty] will return
-    an [ex_parameter_ty_and_entrypoints].
+    an [ex_parameter_ty_and_entrypoints_node].
 *)
 type ('ret, 'name) parse_ty_ret =
   | Don't_parse_entrypoints : (ex_ty, unit) parse_ty_ret
   | Parse_entrypoints
-      : (ex_parameter_ty_and_entrypoints, Entrypoint.t option) parse_ty_ret
+      : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret
 
 let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty :
     type ret name.
@@ -1279,7 +1279,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
       match ret with
       | Don't_parse_entrypoints -> (Ex_ty ty, ctxt)
       | Parse_entrypoints ->
-          ( Ex_parameter_ty_and_entrypoints
+          ( Ex_parameter_ty_and_entrypoints_node
               {arg_type = ty; entrypoints = {name; nested = Entrypoints_None}},
             ctxt )
     in
@@ -1411,11 +1411,11 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
             let (Ex_ty tr) = parsed_r in
             union_t loc tl tr >|? fun (Ty_ex_c ty) -> ((Ex_ty ty : ret), ctxt)
         | Parse_entrypoints ->
-            let (Ex_parameter_ty_and_entrypoints
+            let (Ex_parameter_ty_and_entrypoints_node
                   {arg_type = tl; entrypoints = left}) =
               parsed_l
             in
-            let (Ex_parameter_ty_and_entrypoints
+            let (Ex_parameter_ty_and_entrypoints_node
                   {arg_type = tr; entrypoints = right}) =
               parsed_r
             in
@@ -1423,7 +1423,8 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
             let entrypoints =
               {name; nested = Entrypoints_Union {left; right}}
             in
-            (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, ctxt))
+            (Ex_parameter_ty_and_entrypoints_node {arg_type; entrypoints}, ctxt)
+        )
     | Prim (loc, T_lambda, [uta; utr], annot) ->
         parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy uta
         >>? fun (Ex_ty ta, ctxt) ->
@@ -2028,6 +2029,13 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
     | None -> Result.return_unit
     | Some path -> error (Unreachable_entrypoint path)
 
+type ex_parameter_ty_and_entrypoints =
+  | Ex_parameter_ty_and_entrypoints : {
+      arg_type : ('a, _) ty;
+      entrypoints : 'a entrypoints;
+    }
+      -> ex_parameter_ty_and_entrypoints
+
 let parse_parameter_ty_and_entrypoints :
     context ->
     stack_depth:int ->
@@ -2041,12 +2049,11 @@ let parse_parameter_ty_and_entrypoints :
     ~legacy
     node
     ~ret:Parse_entrypoints
-  >>? fun (res, ctxt) ->
+  >>? fun (Ex_parameter_ty_and_entrypoints_node {arg_type; entrypoints}, ctxt)
+    ->
   (if legacy then Result.return_unit
-  else
-    let (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}) = res in
-    well_formed_entrypoints arg_type entrypoints)
-  >|? fun () -> (res, ctxt)
+  else well_formed_entrypoints arg_type entrypoints)
+  >|? fun () -> (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, ctxt)
 
 let parse_passable_ty = parse_passable_ty ~ret:Don't_parse_entrypoints
 
-- 
GitLab


From 12052a043ffc57542545e5b45fbd9db35ac51cef Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 15:43:37 +0200
Subject: [PATCH 03/27] Proto/Michelson: wrap entrypoints

A field with the original type will be added later.
---
 .../lib_protocol/script_ir_translator.ml           | 14 ++++++++------
 src/proto_alpha/lib_protocol/script_typed_ir.ml    |  2 +-
 src/proto_alpha/lib_protocol/script_typed_ir.mli   |  2 +-
 3 files changed, 10 insertions(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index bcc4d4747c54..876368cfb96a 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -321,7 +321,7 @@ let unparse_comparable_ty ~loc ctxt comp_ty =
 
 let unparse_parameter_ty ~loc ctxt ty ~entrypoints =
   Gas.consume ctxt (Unparse_costs.unparse_type ty) >|? fun ctxt ->
-  (unparse_ty_entrypoints_uncarbonated ~loc ty entrypoints, ctxt)
+  (unparse_ty_entrypoints_uncarbonated ~loc ty entrypoints.root, ctxt)
 
 let serialize_ty_for_error ty =
   (*
@@ -1942,7 +1942,7 @@ let find_entrypoint (type full fullc error_trace)
             Ex_ty_cstr (t, fun e -> R (f e)))
     | (_, {nested = Entrypoints_None; _}) -> Gas_monad.of_result (Error ())
   in
-  Gas_monad.bind_recover (find_entrypoint full entrypoints entrypoint)
+  Gas_monad.bind_recover (find_entrypoint full entrypoints.root entrypoint)
   @@ function
   | Ok f_t -> return f_t
   | Error () ->
@@ -1963,7 +1963,7 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
   let* res = find_entrypoint ~error_details full entrypoints entrypoint in
   match res with
   | Ex_ty_cstr (ty, _) -> (
-      match entrypoints.name with
+      match entrypoints.root.name with
       | Some e when Entrypoint.is_root e && Entrypoint.is_default entrypoint ->
           Gas_monad.bind_recover
             (ty_eq ~error_details:Fast loc ty expected)
@@ -2053,7 +2053,9 @@ let parse_parameter_ty_and_entrypoints :
     ->
   (if legacy then Result.return_unit
   else well_formed_entrypoints arg_type entrypoints)
-  >|? fun () -> (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, ctxt)
+  >|? fun () ->
+  let entrypoints = {root = entrypoints} in
+  (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, ctxt)
 
 let parse_passable_ty = parse_passable_ty ~ret:Don't_parse_entrypoints
 
@@ -5585,11 +5587,11 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
   in
   unparse_ty ~loc:() ctxt full >>? fun (unparsed_full, _) ->
   let (init, reachable) =
-    match entrypoints.name with
+    match entrypoints.root.name with
     | None -> (Entrypoint.Map.empty, false)
     | Some name -> (Entrypoint.Map.singleton name ([], unparsed_full), true)
   in
-  fold_tree full entrypoints [] reachable ([], init)
+  fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
 
 (* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 986aeeeeed0c..92fa5e6709ba 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -436,7 +436,7 @@ and 'arg nested_entrypoints =
 
 let no_entrypoints = {name = None; nested = Entrypoints_None}
 
-type 'arg entrypoints = 'arg entrypoints_node
+type 'arg entrypoints = {root : 'arg entrypoints_node}
 
 type ('arg, 'storage) script =
   | Script : {
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index fb75e952f885..7f9c0393dee6 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -303,7 +303,7 @@ and 'arg nested_entrypoints =
 (** [no_entrypoints] is [{name = None; nested = Entrypoints_None}] *)
 val no_entrypoints : _ entrypoints_node
 
-type 'arg entrypoints = 'arg entrypoints_node
+type 'arg entrypoints = {root : 'arg entrypoints_node}
 
 type ('arg, 'storage) script =
   | Script : {
-- 
GitLab


From c830ad3a3cdbd6e89cae32a47c8b4dcaab88f150 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:18:14 +0200
Subject: [PATCH 04/27] Proto/Michelson: rename name field into at_node

The original type of present entrypoints will be added later.
---
 .../lib_protocol/script_ir_translator.ml      | 23 +++++++++++--------
 .../lib_protocol/script_typed_ir.ml           |  4 ++--
 .../lib_protocol/script_typed_ir.mli          |  6 ++---
 3 files changed, 18 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 876368cfb96a..b83df7d966be 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -225,7 +225,7 @@ let unparse_memo_size ~loc memo_size =
 let rec unparse_ty_entrypoints_uncarbonated :
     type a ac loc.
     loc:loc -> (a, ac) ty -> a entrypoints_node -> loc Script.michelson_node =
- fun ~loc ty {nested = nested_entrypoints; name = entrypoint_name} ->
+ fun ~loc ty {nested = nested_entrypoints; at_node} ->
   let (name, args) =
     match ty with
     | Unit_t -> (T_unit, [])
@@ -302,7 +302,7 @@ let rec unparse_ty_entrypoints_uncarbonated :
     | Chest_t -> (T_chest, [])
   in
   let annot =
-    match entrypoint_name with
+    match at_node with
     | None -> []
     | Some name -> [Entrypoint.unparse_as_field_annot name]
   in
@@ -1280,7 +1280,10 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
       | Don't_parse_entrypoints -> (Ex_ty ty, ctxt)
       | Parse_entrypoints ->
           ( Ex_parameter_ty_and_entrypoints_node
-              {arg_type = ty; entrypoints = {name; nested = Entrypoints_None}},
+              {
+                arg_type = ty;
+                entrypoints = {at_node = name; nested = Entrypoints_None};
+              },
             ctxt )
     in
     match node with
@@ -1421,7 +1424,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
             in
             union_t loc tl tr >|? fun (Ty_ex_c arg_type) ->
             let entrypoints =
-              {name; nested = Entrypoints_Union {left; right}}
+              {at_node = name; nested = Entrypoints_Union {left; right}}
             in
             (Ex_parameter_ty_and_entrypoints_node {arg_type; entrypoints}, ctxt)
         )
@@ -1931,7 +1934,7 @@ let find_entrypoint (type full fullc error_trace)
    fun ty entrypoints entrypoint ->
     let* () = Gas_monad.consume_gas Typecheck_costs.find_entrypoint_cycle in
     match (ty, entrypoints) with
-    | (_, {name = Some name; _}) when Entrypoint.(name = entrypoint) ->
+    | (_, {at_node = Some name; _}) when Entrypoint.(name = entrypoint) ->
         return (Ex_ty_cstr (ty, fun e -> e))
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
@@ -1963,7 +1966,7 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
   let* res = find_entrypoint ~error_details full entrypoints entrypoint in
   match res with
   | Ex_ty_cstr (ty, _) -> (
-      match entrypoints.root.name with
+      match entrypoints.root.at_node with
       | Some e when Entrypoint.is_root e && Entrypoint.is_default entrypoint ->
           Gas_monad.bind_recover
             (ty_eq ~error_details:Fast loc ty expected)
@@ -1981,7 +1984,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
   let merge path (type t tc) (ty : (t, tc) ty)
       (entrypoints : t entrypoints_node) reachable
       ((first_unreachable, all) as acc) =
-    match entrypoints.name with
+    match entrypoints.at_node with
     | None ->
         ok
           ( (if reachable then acc
@@ -2017,7 +2020,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
     | _ -> ok acc
   in
   let (init, reachable) =
-    match entrypoints.name with
+    match entrypoints.at_node with
     | None -> (Entrypoint.Set.empty, false)
     | Some name -> (Entrypoint.Set.singleton name, true)
   in
@@ -5545,7 +5548,7 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
   let merge path (type t tc) (ty : (t, tc) ty)
       (entrypoints : t entrypoints_node) reachable ((unreachables, all) as acc)
       =
-    match entrypoints.name with
+    match entrypoints.at_node with
     | None ->
         ok
           ( (if reachable then acc
@@ -5587,7 +5590,7 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
   in
   unparse_ty ~loc:() ctxt full >>? fun (unparsed_full, _) ->
   let (init, reachable) =
-    match entrypoints.root.name with
+    match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
     | Some name -> (Entrypoint.Map.singleton name ([], unparsed_full), true)
   in
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 92fa5e6709ba..608a89798a9e 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -422,7 +422,7 @@ type view = {
 type view_map = (Script_string.t, view) map
 
 type 'arg entrypoints_node = {
-  name : Entrypoint.t option;
+  at_node : Entrypoint.t option;
   nested : 'arg nested_entrypoints;
 }
 
@@ -434,7 +434,7 @@ and 'arg nested_entrypoints =
       -> ('l, 'r) union nested_entrypoints
   | Entrypoints_None : _ nested_entrypoints
 
-let no_entrypoints = {name = None; nested = Entrypoints_None}
+let no_entrypoints = {at_node = None; nested = Entrypoints_None}
 
 type 'arg entrypoints = {root : 'arg entrypoints_node}
 
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 7f9c0393dee6..83cf875edcb9 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -281,14 +281,14 @@ type view_map = (Script_string.t, view) map
 
 (** ['arg entrypoints] represents the tree of entrypoints of a parameter type
     ['arg].
-    [name] is the name of the entrypoint at that node if it is not [None].
+    [at_node] is the name of the entrypoint at that node if it is not [None].
     [nested] are the entrypoints below the node in the tree.
       It is always [Entrypoints_None] for non-union nodes.
       But it is also ok to have [Entrypoints_None] for a union node, it just
       means that there are no entrypoints below that node in the tree.
 *)
 type 'arg entrypoints_node = {
-  name : Entrypoint.t option;
+  at_node : Entrypoint.t option;
   nested : 'arg nested_entrypoints;
 }
 
@@ -300,7 +300,7 @@ and 'arg nested_entrypoints =
       -> ('l, 'r) union nested_entrypoints
   | Entrypoints_None : _ nested_entrypoints
 
-(** [no_entrypoints] is [{name = None; nested = Entrypoints_None}] *)
+(** [no_entrypoints] is [{at_node = None; nested = Entrypoints_None}] *)
 val no_entrypoints : _ entrypoints_node
 
 type 'arg entrypoints = {root : 'arg entrypoints_node}
-- 
GitLab


From 0f6839b4977bca91f8b54df0fc1a7cf324fdd6f0 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:26:15 +0200
Subject: [PATCH 05/27] Proto/Michelson: wrap at_node entrypoint name in a
 record

A field with the original type will be added later.
---
 .../lib_protocol/script_ir_translator.ml      | 21 +++++++++++--------
 .../lib_protocol/script_typed_ir.ml           |  4 +++-
 .../lib_protocol/script_typed_ir.mli          |  6 ++++--
 3 files changed, 19 insertions(+), 12 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index b83df7d966be..b8992cc02d0e 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -304,7 +304,7 @@ let rec unparse_ty_entrypoints_uncarbonated :
   let annot =
     match at_node with
     | None -> []
-    | Some name -> [Entrypoint.unparse_as_field_annot name]
+    | Some {name} -> [Entrypoint.unparse_as_field_annot name]
   in
   Prim (loc, name, args, annot)
 
@@ -1279,10 +1279,11 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
       match ret with
       | Don't_parse_entrypoints -> (Ex_ty ty, ctxt)
       | Parse_entrypoints ->
+          let at_node = Option.map (fun name -> {name}) name in
           ( Ex_parameter_ty_and_entrypoints_node
               {
                 arg_type = ty;
-                entrypoints = {at_node = name; nested = Entrypoints_None};
+                entrypoints = {at_node; nested = Entrypoints_None};
               },
             ctxt )
     in
@@ -1424,7 +1425,8 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
             in
             union_t loc tl tr >|? fun (Ty_ex_c arg_type) ->
             let entrypoints =
-              {at_node = name; nested = Entrypoints_Union {left; right}}
+              let at_node = Option.map (fun name -> {name}) name in
+              {at_node; nested = Entrypoints_Union {left; right}}
             in
             (Ex_parameter_ty_and_entrypoints_node {arg_type; entrypoints}, ctxt)
         )
@@ -1934,7 +1936,7 @@ let find_entrypoint (type full fullc error_trace)
    fun ty entrypoints entrypoint ->
     let* () = Gas_monad.consume_gas Typecheck_costs.find_entrypoint_cycle in
     match (ty, entrypoints) with
-    | (_, {at_node = Some name; _}) when Entrypoint.(name = entrypoint) ->
+    | (_, {at_node = Some {name}; _}) when Entrypoint.(name = entrypoint) ->
         return (Ex_ty_cstr (ty, fun e -> e))
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
@@ -1967,7 +1969,8 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
   match res with
   | Ex_ty_cstr (ty, _) -> (
       match entrypoints.root.at_node with
-      | Some e when Entrypoint.is_root e && Entrypoint.is_default entrypoint ->
+      | Some {name}
+        when Entrypoint.is_root name && Entrypoint.is_default entrypoint ->
           Gas_monad.bind_recover
             (ty_eq ~error_details:Fast loc ty expected)
             (function
@@ -1996,7 +1999,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
                   | None -> (Some (List.rev path), all)
                   | Some _ -> acc)),
             reachable )
-    | Some name ->
+    | Some {name} ->
         if Entrypoint.Set.mem name all then error (Duplicate_entrypoint name)
         else ok ((first_unreachable, Entrypoint.Set.add name all), true)
   in
@@ -2022,7 +2025,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
   let (init, reachable) =
     match entrypoints.at_node with
     | None -> (Entrypoint.Set.empty, false)
-    | Some name -> (Entrypoint.Set.singleton name, true)
+    | Some {name} -> (Entrypoint.Set.singleton name, true)
   in
   check full entrypoints [] reachable (None, init)
   >>? fun (first_unreachable, all) ->
@@ -5557,7 +5560,7 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
               | Union_t _ -> acc
               | _ -> (List.rev path :: unreachables, all)),
             reachable )
-    | Some name ->
+    | Some {name} ->
         (if Entrypoint.Map.mem name all then
          ok (List.rev path :: unreachables, all)
         else
@@ -5592,7 +5595,7 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
   let (init, reachable) =
     match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
-    | Some name -> (Entrypoint.Map.singleton name ([], unparsed_full), true)
+    | Some {name} -> (Entrypoint.Map.singleton name ([], unparsed_full), true)
   in
   fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 608a89798a9e..9ede4dd6ccab 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -421,8 +421,10 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
+type present_entrypoint = {name : Entrypoint.t}
+
 type 'arg entrypoints_node = {
-  at_node : Entrypoint.t option;
+  at_node : present_entrypoint option;
   nested : 'arg nested_entrypoints;
 }
 
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 83cf875edcb9..baa11f0caf58 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -279,16 +279,18 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
+type present_entrypoint = {name : Entrypoint.t}
+
 (** ['arg entrypoints] represents the tree of entrypoints of a parameter type
     ['arg].
-    [at_node] is the name of the entrypoint at that node if it is not [None].
+    [at_node] are entrypoint details at that node if it is not [None].
     [nested] are the entrypoints below the node in the tree.
       It is always [Entrypoints_None] for non-union nodes.
       But it is also ok to have [Entrypoints_None] for a union node, it just
       means that there are no entrypoints below that node in the tree.
 *)
 type 'arg entrypoints_node = {
-  at_node : Entrypoint.t option;
+  at_node : present_entrypoint option;
   nested : 'arg nested_entrypoints;
 }
 
-- 
GitLab


From b24124fee3fb15d0f9095cddc507327dbf758eeb Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:30:53 +0200
Subject: [PATCH 06/27] Proto/Michelson: add original_type to present
 entrypoints

Now we'll be able to show original types in the list_entrypoints RPC.
---
 .../lib_protocol/script_ir_translator.ml      | 24 ++++++++++++-------
 .../lib_protocol/script_typed_ir.ml           |  2 +-
 .../lib_protocol/script_typed_ir.mli          |  2 +-
 3 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index b8992cc02d0e..e01d046e5c57 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -304,7 +304,7 @@ let rec unparse_ty_entrypoints_uncarbonated :
   let annot =
     match at_node with
     | None -> []
-    | Some {name} -> [Entrypoint.unparse_as_field_annot name]
+    | Some {name; original_type = _} -> [Entrypoint.unparse_as_field_annot name]
   in
   Prim (loc, name, args, annot)
 
@@ -1279,7 +1279,9 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
       match ret with
       | Don't_parse_entrypoints -> (Ex_ty ty, ctxt)
       | Parse_entrypoints ->
-          let at_node = Option.map (fun name -> {name}) name in
+          let at_node =
+            Option.map (fun name -> {name; original_type = node}) name
+          in
           ( Ex_parameter_ty_and_entrypoints_node
               {
                 arg_type = ty;
@@ -1425,7 +1427,9 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
             in
             union_t loc tl tr >|? fun (Ty_ex_c arg_type) ->
             let entrypoints =
-              let at_node = Option.map (fun name -> {name}) name in
+              let at_node =
+                Option.map (fun name -> {name; original_type = node}) name
+              in
               {at_node; nested = Entrypoints_Union {left; right}}
             in
             (Ex_parameter_ty_and_entrypoints_node {arg_type; entrypoints}, ctxt)
@@ -1936,7 +1940,8 @@ let find_entrypoint (type full fullc error_trace)
    fun ty entrypoints entrypoint ->
     let* () = Gas_monad.consume_gas Typecheck_costs.find_entrypoint_cycle in
     match (ty, entrypoints) with
-    | (_, {at_node = Some {name}; _}) when Entrypoint.(name = entrypoint) ->
+    | (_, {at_node = Some {name; original_type = _}; _})
+      when Entrypoint.(name = entrypoint) ->
         return (Ex_ty_cstr (ty, fun e -> e))
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
@@ -1969,7 +1974,7 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
   match res with
   | Ex_ty_cstr (ty, _) -> (
       match entrypoints.root.at_node with
-      | Some {name}
+      | Some {name; original_type = _}
         when Entrypoint.is_root name && Entrypoint.is_default entrypoint ->
           Gas_monad.bind_recover
             (ty_eq ~error_details:Fast loc ty expected)
@@ -1999,7 +2004,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
                   | None -> (Some (List.rev path), all)
                   | Some _ -> acc)),
             reachable )
-    | Some {name} ->
+    | Some {name; original_type = _} ->
         if Entrypoint.Set.mem name all then error (Duplicate_entrypoint name)
         else ok ((first_unreachable, Entrypoint.Set.add name all), true)
   in
@@ -2025,7 +2030,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
   let (init, reachable) =
     match entrypoints.at_node with
     | None -> (Entrypoint.Set.empty, false)
-    | Some {name} -> (Entrypoint.Set.singleton name, true)
+    | Some {name; original_type = _} -> (Entrypoint.Set.singleton name, true)
   in
   check full entrypoints [] reachable (None, init)
   >>? fun (first_unreachable, all) ->
@@ -5560,7 +5565,7 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
               | Union_t _ -> acc
               | _ -> (List.rev path :: unreachables, all)),
             reachable )
-    | Some {name} ->
+    | Some {name; original_type = _} ->
         (if Entrypoint.Map.mem name all then
          ok (List.rev path :: unreachables, all)
         else
@@ -5595,7 +5600,8 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
   let (init, reachable) =
     match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
-    | Some {name} -> (Entrypoint.Map.singleton name ([], unparsed_full), true)
+    | Some {name; original_type = _} ->
+        (Entrypoint.Map.singleton name ([], unparsed_full), true)
   in
   fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 9ede4dd6ccab..712d3750b075 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -421,7 +421,7 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type present_entrypoint = {name : Entrypoint.t}
+type present_entrypoint = {name : Entrypoint.t; original_type : Script.node}
 
 type 'arg entrypoints_node = {
   at_node : present_entrypoint option;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index baa11f0caf58..57cd09cd72bb 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -279,7 +279,7 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type present_entrypoint = {name : Entrypoint.t}
+type present_entrypoint = {name : Entrypoint.t; original_type : Script.node}
 
 (** ['arg entrypoints] represents the tree of entrypoints of a parameter type
     ['arg].
-- 
GitLab


From d2a9607dc4b15bf3d736d0b08dea88857806e8ce Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:37:29 +0200
Subject: [PATCH 07/27] Proto/Michelson: use original_type in list_entrypoints

---
 .../lib_protocol/script_ir_translator.ml      | 22 ++++++++-----------
 .../lib_protocol/script_ir_translator.mli     |  3 +--
 2 files changed, 10 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index e01d046e5c57..3e40c3314916 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5551,7 +5551,7 @@ let typecheck_code :
   trace (Ill_typed_contract (code, !type_map)) views_result >|=? fun ctxt ->
   (!type_map, ctxt)
 
-let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
+let list_entrypoints _ctxt (type full fullc) (full : (full, fullc) ty)
     (entrypoints : full entrypoints) =
   let merge path (type t tc) (ty : (t, tc) ty)
       (entrypoints : t entrypoints_node) reachable ((unreachables, all) as acc)
@@ -5565,13 +5565,13 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
               | Union_t _ -> acc
               | _ -> (List.rev path :: unreachables, all)),
             reachable )
-    | Some {name; original_type = _} ->
+    | Some {name; original_type} ->
         (if Entrypoint.Map.mem name all then
          ok (List.rev path :: unreachables, all)
         else
-          unparse_ty ~loc:() ctxt ty >|? fun (unparsed_ty, _) ->
-          ( unreachables,
-            Entrypoint.Map.add name (List.rev path, unparsed_ty) all ))
+          ok
+            ( unreachables,
+              Entrypoint.Map.add name (List.rev path, original_type) all ))
         >|? fun unreachable_all -> (unreachable_all, true)
   in
   let rec fold_tree :
@@ -5580,11 +5580,8 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
       t entrypoints_node ->
       prim list ->
       bool ->
-      prim list list
-      * (prim list * Script.unlocated_michelson_node) Entrypoint.Map.t ->
-      (prim list list
-      * (prim list * Script.unlocated_michelson_node) Entrypoint.Map.t)
-      tzresult =
+      prim list list * (prim list * Script.node) Entrypoint.Map.t ->
+      (prim list list * (prim list * Script.node) Entrypoint.Map.t) tzresult =
    fun t entrypoints path reachable acc ->
     match (t, entrypoints) with
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _}) ->
@@ -5596,12 +5593,11 @@ let list_entrypoints ctxt (type full fullc) (full : (full, fullc) ty)
         fold_tree tr right (D_Right :: path) r_reachable acc
     | _ -> ok acc
   in
-  unparse_ty ~loc:() ctxt full >>? fun (unparsed_full, _) ->
   let (init, reachable) =
     match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
-    | Some {name; original_type = _} ->
-        (Entrypoint.Map.singleton name ([], unparsed_full), true)
+    | Some {name; original_type} ->
+        (Entrypoint.Map.singleton name ([], original_type), true)
   in
   fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index d6904f4765ea..c2b5961128cb 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -432,8 +432,7 @@ val list_entrypoints :
   ('t, _) Script_typed_ir.ty ->
   't Script_typed_ir.entrypoints ->
   (Michelson_v1_primitives.prim list list
-  * (Michelson_v1_primitives.prim list * Script.unlocated_michelson_node)
-    Entrypoint.Map.t)
+  * (Michelson_v1_primitives.prim list * Script.node) Entrypoint.Map.t)
   tzresult
 
 val pack_data :
-- 
GitLab


From a08b346b7f4ae12091beaaf16b10679110604185 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:38:21 +0200
Subject: [PATCH 08/27] Proto/Michelson: remove dead type
 unlocated_michelson_node

---
 src/proto_alpha/lib_protocol/alpha_context.mli | 2 --
 src/proto_alpha/lib_protocol/script_repr.ml    | 2 --
 src/proto_alpha/lib_protocol/script_repr.mli   | 2 --
 3 files changed, 6 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index a234da19ce32..c39229e56d6e 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -679,8 +679,6 @@ module Script : sig
 
   type 'location michelson_node = ('location, prim) Micheline.node
 
-  type unlocated_michelson_node = unit michelson_node
-
   type node = location michelson_node
 
   type t = {code : lazy_expr; storage : lazy_expr}
diff --git a/src/proto_alpha/lib_protocol/script_repr.ml b/src/proto_alpha/lib_protocol/script_repr.ml
index c286e56f9087..681d6d7c627a 100644
--- a/src/proto_alpha/lib_protocol/script_repr.ml
+++ b/src/proto_alpha/lib_protocol/script_repr.ml
@@ -36,8 +36,6 @@ type lazy_expr = expr Data_encoding.lazy_t
 type 'location michelson_node =
   ('location, Michelson_v1_primitives.prim) Micheline.node
 
-type unlocated_michelson_node = unit michelson_node
-
 type node = location michelson_node
 
 let expr_encoding =
diff --git a/src/proto_alpha/lib_protocol/script_repr.mli b/src/proto_alpha/lib_protocol/script_repr.mli
index 66569c6bf094..386cd0761c3c 100644
--- a/src/proto_alpha/lib_protocol/script_repr.mli
+++ b/src/proto_alpha/lib_protocol/script_repr.mli
@@ -50,8 +50,6 @@ type lazy_expr = expr Data_encoding.lazy_t
 type 'location michelson_node =
   ('location, Michelson_v1_primitives.prim) Micheline.node
 
-type unlocated_michelson_node = unit michelson_node
-
 (** Same as [expr], but used in different contexts, as required by Micheline's
     abstract interface. *)
 type node = location michelson_node
-- 
GitLab


From deb0652285dd0613ed182e79c7e756dc2817bd30 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:39:35 +0200
Subject: [PATCH 09/27] Proto/Michelson: list_entrypoints don't need a context

---
 src/proto_alpha/lib_plugin/plugin.ml                  | 2 +-
 src/proto_alpha/lib_protocol/contract_services.ml     | 3 +--
 src/proto_alpha/lib_protocol/script_ir_translator.ml  | 3 ++-
 src/proto_alpha/lib_protocol/script_ir_translator.mli | 1 -
 4 files changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 8bd6c0d76461..e894f5daac0f 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2643,7 +2643,7 @@ module RPC = struct
             ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type
             >>? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
               ->
-              Script_ir_translator.list_entrypoints ctxt arg_type entrypoints
+              Script_ir_translator.list_entrypoints arg_type entrypoints
               >|? fun (unreachable_entrypoint, map) ->
               ( unreachable_entrypoint,
                 Entrypoint.Map.fold
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 784582bc518d..57677a163032 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -422,8 +422,7 @@ let[@coq_axiom_with_reason "gadt"] register () =
             ( ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type
               >>? fun ( Ex_parameter_ty_and_entrypoints {arg_type; entrypoints},
                         _ ) ->
-                Script_ir_translator.list_entrypoints ctxt arg_type entrypoints
-              )
+                Script_ir_translator.list_entrypoints arg_type entrypoints )
             >|? fun (unreachable_entrypoint, map) ->
               Some
                 ( unreachable_entrypoint,
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 3e40c3314916..70c98dd33678 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5551,7 +5551,8 @@ let typecheck_code :
   trace (Ill_typed_contract (code, !type_map)) views_result >|=? fun ctxt ->
   (!type_map, ctxt)
 
-let list_entrypoints _ctxt (type full fullc) (full : (full, fullc) ty)
+(* Uncarbonated because used only in RPCs *)
+let list_entrypoints (type full fullc) (full : (full, fullc) ty)
     (entrypoints : full entrypoints) =
   let merge path (type t tc) (ty : (t, tc) ty)
       (entrypoints : t entrypoints_node) reachable ((unreachables, all) as acc)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index c2b5961128cb..ef80994e57ae 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -428,7 +428,6 @@ val find_entrypoint :
   ('t ex_ty_cstr, 'error_trace) Gas_monad.t
 
 val list_entrypoints :
-  context ->
   ('t, _) Script_typed_ir.ty ->
   't Script_typed_ir.entrypoints ->
   (Michelson_v1_primitives.prim list list
-- 
GitLab


From 99c1714639ff75b55ca6bec0b4ab08350c3a17ca Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Mon, 28 Mar 2022 18:45:20 +0200
Subject: [PATCH 10/27] Proto/Michelson: simplify list_entrypoints

No need for the error monad any more.
---
 src/proto_alpha/lib_plugin/plugin.ml          |  7 ++--
 .../lib_protocol/contract_services.ml         | 11 +++---
 .../lib_protocol/script_ir_translator.ml      | 38 +++++++++----------
 .../lib_protocol/script_ir_translator.mli     |  5 +--
 4 files changed, 30 insertions(+), 31 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index e894f5daac0f..e46ce51f05b2 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2641,10 +2641,11 @@ module RPC = struct
           parse_toplevel ~legacy ctxt expr >>=? fun ({arg_type; _}, ctxt) ->
           Lwt.return
             ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type
-            >>? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
+            >|? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
               ->
-              Script_ir_translator.list_entrypoints arg_type entrypoints
-              >|? fun (unreachable_entrypoint, map) ->
+              let (unreachable_entrypoint, map) =
+                Script_ir_translator.list_entrypoints arg_type entrypoints
+              in
               ( unreachable_entrypoint,
                 Entrypoint.Map.fold
                   (fun entry (_, ty) acc ->
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 57677a163032..5736de55d8cd 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -419,11 +419,12 @@ let[@coq_axiom_with_reason "gadt"] register () =
           >>?= fun (expr, _) ->
           parse_toplevel ctxt ~legacy expr >>=? fun ({arg_type; _}, ctxt) ->
           Lwt.return
-            ( ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type
-              >>? fun ( Ex_parameter_ty_and_entrypoints {arg_type; entrypoints},
-                        _ ) ->
-                Script_ir_translator.list_entrypoints arg_type entrypoints )
-            >|? fun (unreachable_entrypoint, map) ->
+            ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type
+            >|? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
+              ->
+              let (unreachable_entrypoint, map) =
+                Script_ir_translator.list_entrypoints arg_type entrypoints
+              in
               Some
                 ( unreachable_entrypoint,
                   Entrypoint.Map.fold
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 70c98dd33678..00f6eb3dfcb7 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5559,21 +5559,19 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
       =
     match entrypoints.at_node with
     | None ->
-        ok
-          ( (if reachable then acc
-            else
-              match ty with
-              | Union_t _ -> acc
-              | _ -> (List.rev path :: unreachables, all)),
-            reachable )
+        ( (if reachable then acc
+          else
+            match ty with
+            | Union_t _ -> acc
+            | _ -> (List.rev path :: unreachables, all)),
+          reachable )
     | Some {name; original_type} ->
-        (if Entrypoint.Map.mem name all then
-         ok (List.rev path :: unreachables, all)
-        else
-          ok
+        ( (if Entrypoint.Map.mem name all then
+           (List.rev path :: unreachables, all)
+          else
             ( unreachables,
-              Entrypoint.Map.add name (List.rev path, original_type) all ))
-        >|? fun unreachable_all -> (unreachable_all, true)
+              Entrypoint.Map.add name (List.rev path, original_type) all )),
+          true )
   in
   let rec fold_tree :
       type t tc.
@@ -5582,17 +5580,17 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
       prim list ->
       bool ->
       prim list list * (prim list * Script.node) Entrypoint.Map.t ->
-      (prim list list * (prim list * Script.node) Entrypoint.Map.t) tzresult =
+      prim list list * (prim list * Script.node) Entrypoint.Map.t =
    fun t entrypoints path reachable acc ->
     match (t, entrypoints) with
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _}) ->
-        merge (D_Left :: path) tl left reachable acc
-        >>? fun (acc, l_reachable) ->
-        merge (D_Right :: path) tr right reachable acc
-        >>? fun (acc, r_reachable) ->
-        fold_tree tl left (D_Left :: path) l_reachable acc >>? fun acc ->
+        let (acc, l_reachable) = merge (D_Left :: path) tl left reachable acc in
+        let (acc, r_reachable) =
+          merge (D_Right :: path) tr right reachable acc
+        in
+        let acc = fold_tree tl left (D_Left :: path) l_reachable acc in
         fold_tree tr right (D_Right :: path) r_reachable acc
-    | _ -> ok acc
+    | _ -> acc
   in
   let (init, reachable) =
     match entrypoints.root.at_node with
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index ef80994e57ae..8664bdacfd55 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -430,9 +430,8 @@ val find_entrypoint :
 val list_entrypoints :
   ('t, _) Script_typed_ir.ty ->
   't Script_typed_ir.entrypoints ->
-  (Michelson_v1_primitives.prim list list
-  * (Michelson_v1_primitives.prim list * Script.node) Entrypoint.Map.t)
-  tzresult
+  Michelson_v1_primitives.prim list list
+  * (Michelson_v1_primitives.prim list * Script.node) Entrypoint.Map.t
 
 val pack_data :
   context ->
-- 
GitLab


From 8185009e90bb0b2b14527fcc8cdfe9f312ed05e8 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 15:14:37 +0200
Subject: [PATCH 11/27] Proto/Michelson: name Ex_ty_cstr parameters

We will add another field later.
---
 src/proto_alpha/lib_plugin/plugin.ml          |  2 +-
 .../lib_protocol/contract_services.ml         |  2 +-
 .../lib_protocol/script_interpreter.ml        |  2 +-
 .../lib_protocol/script_ir_translator.ml      | 22 ++++++++++++-------
 .../lib_protocol/script_ir_translator.mli     |  6 ++++-
 .../lib_protocol/ticket_operations_diff.ml    |  2 +-
 6 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index e46ce51f05b2..df2f4569c51e 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2246,7 +2246,7 @@ module RPC = struct
                  entrypoints
                  entrypoint
             >>? fun (r, ctxt) ->
-            r >>? fun (Ex_ty_cstr (ty, _)) ->
+            r >>? fun (Ex_ty_cstr {ty; _}) ->
             unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _) ->
             Micheline.strip_locations ty_node )
       in
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 5736de55d8cd..3f170feda91e 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -400,7 +400,7 @@ let[@coq_axiom_with_reason "gadt"] register () =
                    entrypoint
               >>? fun (r, ctxt) ->
               r |> function
-              | Ok (Ex_ty_cstr (ty, _)) ->
+              | Ok (Ex_ty_cstr {ty; _}) ->
                   unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _) ->
                   Some (Micheline.strip_locations ty_node)
               | Error _ -> Result.return_none )) ;
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 3111b9d4cf29..992dc001fcc6 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1756,7 +1756,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal
     (find_entrypoint ~error_details:Informative arg_type entrypoints entrypoint)
   >>?= fun (r, ctxt) ->
   record_trace (Bad_contract_parameter step_constants.self) r
-  >>?= fun (Ex_ty_cstr (entrypoint_ty, box)) ->
+  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; box}) ->
   trace
     (Bad_contract_parameter step_constants.self)
     (lift_execution_arg ctxt ~internal entrypoint_ty box arg)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 00f6eb3dfcb7..4c1103cf6ae1 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1924,7 +1924,12 @@ let rec make_comb_set_proof_argument :
       let whole_stack = serialize_stack_for_error ctxt stack_ty in
       error (Bad_stack (loc, I_UPDATE, 2, whole_stack))
 
-type 'a ex_ty_cstr = Ex_ty_cstr : ('b, _) ty * ('b -> 'a) -> 'a ex_ty_cstr
+type 'a ex_ty_cstr =
+  | Ex_ty_cstr : {
+      ty : ('b, _) Script_typed_ir.ty;
+      box : 'b -> 'a;
+    }
+      -> 'a ex_ty_cstr
 
 let find_entrypoint (type full fullc error_trace)
     ~(error_details : error_trace error_details) (full : (full, fullc) ty)
@@ -1942,14 +1947,15 @@ let find_entrypoint (type full fullc error_trace)
     match (ty, entrypoints) with
     | (_, {at_node = Some {name; original_type = _}; _})
       when Entrypoint.(name = entrypoint) ->
-        return (Ex_ty_cstr (ty, fun e -> e))
+        return (Ex_ty_cstr {ty; box = (fun e -> e)})
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
         Gas_monad.bind_recover (find_entrypoint tl left entrypoint) @@ function
-        | Ok (Ex_ty_cstr (t, f)) -> return (Ex_ty_cstr (t, fun e -> L (f e)))
+        | Ok (Ex_ty_cstr {ty; box}) ->
+            return (Ex_ty_cstr {ty; box = (fun e -> L (box e))})
         | Error () ->
-            let+ (Ex_ty_cstr (t, f)) = find_entrypoint tr right entrypoint in
-            Ex_ty_cstr (t, fun e -> R (f e)))
+            let+ (Ex_ty_cstr {ty; box}) = find_entrypoint tr right entrypoint in
+            Ex_ty_cstr {ty; box = (fun e -> R (box e))})
     | (_, {nested = Entrypoints_None; _}) -> Gas_monad.of_result (Error ())
   in
   Gas_monad.bind_recover (find_entrypoint full entrypoints.root entrypoint)
@@ -1957,7 +1963,7 @@ let find_entrypoint (type full fullc error_trace)
   | Ok f_t -> return f_t
   | Error () ->
       if Entrypoint.is_default entrypoint then
-        return (Ex_ty_cstr (full, fun e -> e))
+        return (Ex_ty_cstr {ty = full; box = (fun e -> e)})
       else
         Gas_monad.of_result
         @@ Error
@@ -1972,7 +1978,7 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
   let open Gas_monad.Syntax in
   let* res = find_entrypoint ~error_details full entrypoints entrypoint in
   match res with
-  | Ex_ty_cstr (ty, _) -> (
+  | Ex_ty_cstr {ty; _} -> (
       match entrypoints.root.at_node with
       | Some {name; original_type = _}
         when Entrypoint.is_root name && Entrypoint.is_default entrypoint ->
@@ -4709,7 +4715,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr :
                    entrypoints
                    entrypoint
               >>? fun (r, ctxt) ->
-              r >>? fun (Ex_ty_cstr (param_type, _)) ->
+              r >>? fun (Ex_ty_cstr {ty = param_type; _}) ->
               contract_t loc param_type >>? fun res_ty ->
               let instr =
                 {
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 8664bdacfd55..cd7a2c362176 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -418,7 +418,11 @@ val parse_contract_for_script :
     existential. Typically, it will be used to go from the type of an
     entry-point to the full type of a contract. *)
 type 'a ex_ty_cstr =
-  | Ex_ty_cstr : ('b, _) Script_typed_ir.ty * ('b -> 'a) -> 'a ex_ty_cstr
+  | Ex_ty_cstr : {
+      ty : ('b, _) Script_typed_ir.ty;
+      box : 'b -> 'a;
+    }
+      -> 'a ex_ty_cstr
 
 val find_entrypoint :
   error_details:'error_trace error_details ->
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index 225e2a8eda8d..60837e56e172 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -199,7 +199,7 @@ let tickets_of_transaction ctxt ~destination ~entrypoint ~location
            entrypoints
            entrypoint)
       >>?= fun (res, ctxt) ->
-      res >>?= fun (Ex_ty_cstr (entry_arg_ty, _f)) ->
+      res >>?= fun (Ex_ty_cstr {ty = entry_arg_ty; _}) ->
       Ticket_scanner.type_has_tickets ctxt entry_arg_ty
       >>?= fun (has_tickets, ctxt) ->
       (* Check that the parameter's type matches that of the entry-point, and
-- 
GitLab


From 1791c8f520ec36194cdc38ae3a2dd30e00d8cb46 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 17:10:47 +0200
Subject: [PATCH 12/27] Proto/Michelson: add original_type to entrypoints

It is needed in find_entrypoint to return the original type of the
root when the default entrypoint is requested.
---
 src/proto_alpha/lib_protocol/script_ir_translator.ml | 2 +-
 src/proto_alpha/lib_protocol/script_typed_ir.ml      | 5 ++++-
 src/proto_alpha/lib_protocol/script_typed_ir.mli     | 5 ++++-
 3 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 4c1103cf6ae1..dc1012948151 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -2071,7 +2071,7 @@ let parse_parameter_ty_and_entrypoints :
   (if legacy then Result.return_unit
   else well_formed_entrypoints arg_type entrypoints)
   >|? fun () ->
-  let entrypoints = {root = entrypoints} in
+  let entrypoints = {root = entrypoints; original_type = node} in
   (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, ctxt)
 
 let parse_passable_ty = parse_passable_ty ~ret:Don't_parse_entrypoints
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 712d3750b075..fdb00f1d5850 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -438,7 +438,10 @@ and 'arg nested_entrypoints =
 
 let no_entrypoints = {at_node = None; nested = Entrypoints_None}
 
-type 'arg entrypoints = {root : 'arg entrypoints_node}
+type 'arg entrypoints = {
+  root : 'arg entrypoints_node;
+  original_type : Script.node;
+}
 
 type ('arg, 'storage) script =
   | Script : {
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 57cd09cd72bb..9849b1be8cc2 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -305,7 +305,10 @@ and 'arg nested_entrypoints =
 (** [no_entrypoints] is [{at_node = None; nested = Entrypoints_None}] *)
 val no_entrypoints : _ entrypoints_node
 
-type 'arg entrypoints = {root : 'arg entrypoints_node}
+type 'arg entrypoints = {
+  root : 'arg entrypoints_node;
+  original_type : Script.node;
+}
 
 type ('arg, 'storage) script =
   | Script : {
-- 
GitLab


From 0435f69a77a53f2366873b7e1546e7ac1b1b7ecf Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 17:13:46 +0200
Subject: [PATCH 13/27] Proto/Michelson: add original_type to Ex_ty_cstr

It will be needed for the find_entrypoint RPC.
---
 .../lib_protocol/script_interpreter.ml        |  2 +-
 .../lib_protocol/script_ir_translator.ml      | 21 +++++++++++--------
 .../lib_protocol/script_ir_translator.mli     |  1 +
 3 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 992dc001fcc6..3a6595d0b7dc 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1756,7 +1756,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal
     (find_entrypoint ~error_details:Informative arg_type entrypoints entrypoint)
   >>?= fun (r, ctxt) ->
   record_trace (Bad_contract_parameter step_constants.self) r
-  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; box}) ->
+  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; box; original_type = _}) ->
   trace
     (Bad_contract_parameter step_constants.self)
     (lift_execution_arg ctxt ~internal entrypoint_ty box arg)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index dc1012948151..208742f523de 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1928,6 +1928,7 @@ type 'a ex_ty_cstr =
   | Ex_ty_cstr : {
       ty : ('b, _) Script_typed_ir.ty;
       box : 'b -> 'a;
+      original_type : Script.node;
     }
       -> 'a ex_ty_cstr
 
@@ -1945,25 +1946,27 @@ let find_entrypoint (type full fullc error_trace)
    fun ty entrypoints entrypoint ->
     let* () = Gas_monad.consume_gas Typecheck_costs.find_entrypoint_cycle in
     match (ty, entrypoints) with
-    | (_, {at_node = Some {name; original_type = _}; _})
+    | (_, {at_node = Some {name; original_type}; _})
       when Entrypoint.(name = entrypoint) ->
-        return (Ex_ty_cstr {ty; box = (fun e -> e)})
+        return (Ex_ty_cstr {ty; box = (fun e -> e); original_type})
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
         Gas_monad.bind_recover (find_entrypoint tl left entrypoint) @@ function
-        | Ok (Ex_ty_cstr {ty; box}) ->
-            return (Ex_ty_cstr {ty; box = (fun e -> L (box e))})
+        | Ok (Ex_ty_cstr {ty; box; original_type}) ->
+            return (Ex_ty_cstr {ty; box = (fun e -> L (box e)); original_type})
         | Error () ->
-            let+ (Ex_ty_cstr {ty; box}) = find_entrypoint tr right entrypoint in
-            Ex_ty_cstr {ty; box = (fun e -> R (box e))})
+            let+ (Ex_ty_cstr {ty; box; original_type}) =
+              find_entrypoint tr right entrypoint
+            in
+            Ex_ty_cstr {ty; box = (fun e -> R (box e)); original_type})
     | (_, {nested = Entrypoints_None; _}) -> Gas_monad.of_result (Error ())
   in
-  Gas_monad.bind_recover (find_entrypoint full entrypoints.root entrypoint)
-  @@ function
+  let {root; original_type} = entrypoints in
+  Gas_monad.bind_recover (find_entrypoint full root entrypoint) @@ function
   | Ok f_t -> return f_t
   | Error () ->
       if Entrypoint.is_default entrypoint then
-        return (Ex_ty_cstr {ty = full; box = (fun e -> e)})
+        return (Ex_ty_cstr {ty = full; box = (fun e -> e); original_type})
       else
         Gas_monad.of_result
         @@ Error
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index cd7a2c362176..f9d8e3ee544b 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -421,6 +421,7 @@ type 'a ex_ty_cstr =
   | Ex_ty_cstr : {
       ty : ('b, _) Script_typed_ir.ty;
       box : 'b -> 'a;
+      original_type : Script.node;
     }
       -> 'a ex_ty_cstr
 
-- 
GitLab


From 2da0c6a82498e0bebb838264e96f8921ded34453 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 17:17:11 +0200
Subject: [PATCH 14/27] Proto/RPCs: have the entrypoint_type RPCs return the
 original type

---
 src/proto_alpha/lib_plugin/plugin.ml              | 7 +++----
 src/proto_alpha/lib_protocol/contract_services.ml | 7 +++----
 2 files changed, 6 insertions(+), 8 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index df2f4569c51e..95578184e795 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2245,10 +2245,9 @@ module RPC = struct
                  arg_type
                  entrypoints
                  entrypoint
-            >>? fun (r, ctxt) ->
-            r >>? fun (Ex_ty_cstr {ty; _}) ->
-            unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _) ->
-            Micheline.strip_locations ty_node )
+            >>? fun (r, _ctxt) ->
+            r >|? fun (Ex_ty_cstr {original_type; _}) ->
+            Micheline.strip_locations original_type )
       in
       Registration.register0
         ~chunked:true
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 3f170feda91e..452a44815788 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -398,11 +398,10 @@ let[@coq_axiom_with_reason "gadt"] register () =
                    arg_type
                    entrypoints
                    entrypoint
-              >>? fun (r, ctxt) ->
+              >>? fun (r, _ctxt) ->
               r |> function
-              | Ok (Ex_ty_cstr {ty; _}) ->
-                  unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _) ->
-                  Some (Micheline.strip_locations ty_node)
+              | Ok (Ex_ty_cstr {original_type; _}) ->
+                  ok (Some (Micheline.strip_locations original_type))
               | Error _ -> Result.return_none )) ;
   opt_register1 ~chunked:true S.list_entrypoints (fun ctxt v () () ->
       Contract.get_script_code ctxt v >>=? fun (_, expr) ->
-- 
GitLab


From 1912aa135b6f12d888de28e740c196dcbe0dce8d Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 18:58:33 +0200
Subject: [PATCH 15/27] Tezt: update regression tests outputs

---
 tezt/_regressions/rpc/alpha.client.contracts.out   | 14 ++++++++++----
 tezt/_regressions/rpc/alpha.light.contracts.out    | 14 ++++++++++----
 tezt/_regressions/rpc/alpha.proxy.contracts.out    | 14 ++++++++++----
 .../rpc/alpha.proxy_server_data_dir.contracts.out  | 14 ++++++++++----
 .../rpc/alpha.proxy_server_rpc.contracts.out       | 14 ++++++++++----
 5 files changed, 50 insertions(+), 20 deletions(-)

diff --git a/tezt/_regressions/rpc/alpha.client.contracts.out b/tezt/_regressions/rpc/alpha.client.contracts.out
index b7437c250bae..cb55c7abef4e 100644
--- a/tezt/_regressions/rpc/alpha.client.contracts.out
+++ b/tezt/_regressions/rpc/alpha.client.contracts.out
@@ -350,11 +350,15 @@ null
     { "rem_right": { "prim": "string" }, "rem_left": { "prim": "string" },
       "rem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%rem_left" ] },
+              { "prim": "string", "annots": [ "%rem_right" ] } ] },
       "mem_right": { "prim": "string" }, "mem_left": { "prim": "string" },
       "mem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%mem_left" ] },
+              { "prim": "string", "annots": [ "%mem_right" ] } ] },
       "default": { "prim": "unit" },
       "add_right":
         { "prim": "pair",
@@ -366,9 +370,11 @@ null
         { "prim": "or",
           "args":
             [ { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] },
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_left" ] },
               { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] } ] } } }
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_right" ] } ] } } }
 
 ./tezos-client rpc get '/chains/main/blocks/head/context/contracts/[CONTRACT_HASH]/script'
 { "code":
diff --git a/tezt/_regressions/rpc/alpha.light.contracts.out b/tezt/_regressions/rpc/alpha.light.contracts.out
index 30555ed188dc..a91680bc8109 100644
--- a/tezt/_regressions/rpc/alpha.light.contracts.out
+++ b/tezt/_regressions/rpc/alpha.light.contracts.out
@@ -387,11 +387,15 @@ protocol of light mode unspecified, using the node's protocol: ProtoALphaALphaAL
     { "rem_right": { "prim": "string" }, "rem_left": { "prim": "string" },
       "rem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%rem_left" ] },
+              { "prim": "string", "annots": [ "%rem_right" ] } ] },
       "mem_right": { "prim": "string" }, "mem_left": { "prim": "string" },
       "mem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%mem_left" ] },
+              { "prim": "string", "annots": [ "%mem_right" ] } ] },
       "default": { "prim": "unit" },
       "add_right":
         { "prim": "pair",
@@ -403,9 +407,11 @@ protocol of light mode unspecified, using the node's protocol: ProtoALphaALphaAL
         { "prim": "or",
           "args":
             [ { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] },
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_left" ] },
               { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] } ] } } }
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_right" ] } ] } } }
 protocol of light mode unspecified, using the node's protocol: ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK
 
 ./tezos-client --mode light rpc get '/chains/main/blocks/head/context/contracts/[CONTRACT_HASH]/script'
diff --git a/tezt/_regressions/rpc/alpha.proxy.contracts.out b/tezt/_regressions/rpc/alpha.proxy.contracts.out
index ac6cbff9836d..0497d6d7a573 100644
--- a/tezt/_regressions/rpc/alpha.proxy.contracts.out
+++ b/tezt/_regressions/rpc/alpha.proxy.contracts.out
@@ -387,11 +387,15 @@ protocol of proxy unspecified, using the node's protocol: ProtoALphaALphaALphaAL
     { "rem_right": { "prim": "string" }, "rem_left": { "prim": "string" },
       "rem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%rem_left" ] },
+              { "prim": "string", "annots": [ "%rem_right" ] } ] },
       "mem_right": { "prim": "string" }, "mem_left": { "prim": "string" },
       "mem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%mem_left" ] },
+              { "prim": "string", "annots": [ "%mem_right" ] } ] },
       "default": { "prim": "unit" },
       "add_right":
         { "prim": "pair",
@@ -403,9 +407,11 @@ protocol of proxy unspecified, using the node's protocol: ProtoALphaALphaALphaAL
         { "prim": "or",
           "args":
             [ { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] },
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_left" ] },
               { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] } ] } } }
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_right" ] } ] } } }
 protocol of proxy unspecified, using the node's protocol: ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK
 
 ./tezos-client --mode proxy rpc get '/chains/main/blocks/head/context/contracts/[CONTRACT_HASH]/script'
diff --git a/tezt/_regressions/rpc/alpha.proxy_server_data_dir.contracts.out b/tezt/_regressions/rpc/alpha.proxy_server_data_dir.contracts.out
index c41c98afe9f3..0e3a12f8a4b0 100644
--- a/tezt/_regressions/rpc/alpha.proxy_server_data_dir.contracts.out
+++ b/tezt/_regressions/rpc/alpha.proxy_server_data_dir.contracts.out
@@ -350,11 +350,15 @@ null
     { "rem_right": { "prim": "string" }, "rem_left": { "prim": "string" },
       "rem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%rem_left" ] },
+              { "prim": "string", "annots": [ "%rem_right" ] } ] },
       "mem_right": { "prim": "string" }, "mem_left": { "prim": "string" },
       "mem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%mem_left" ] },
+              { "prim": "string", "annots": [ "%mem_right" ] } ] },
       "default": { "prim": "unit" },
       "add_right":
         { "prim": "pair",
@@ -366,9 +370,11 @@ null
         { "prim": "or",
           "args":
             [ { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] },
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_left" ] },
               { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] } ] } } }
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_right" ] } ] } } }
 
 ./tezos-client rpc get '/chains/main/blocks/head/context/contracts/[CONTRACT_HASH]/script'
 { "code":
diff --git a/tezt/_regressions/rpc/alpha.proxy_server_rpc.contracts.out b/tezt/_regressions/rpc/alpha.proxy_server_rpc.contracts.out
index a097a4329a10..b255e2b9903b 100644
--- a/tezt/_regressions/rpc/alpha.proxy_server_rpc.contracts.out
+++ b/tezt/_regressions/rpc/alpha.proxy_server_rpc.contracts.out
@@ -350,11 +350,15 @@ null
     { "rem_right": { "prim": "string" }, "rem_left": { "prim": "string" },
       "rem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%rem_left" ] },
+              { "prim": "string", "annots": [ "%rem_right" ] } ] },
       "mem_right": { "prim": "string" }, "mem_left": { "prim": "string" },
       "mem":
         { "prim": "or",
-          "args": [ { "prim": "string" }, { "prim": "string" } ] },
+          "args":
+            [ { "prim": "string", "annots": [ "%mem_left" ] },
+              { "prim": "string", "annots": [ "%mem_right" ] } ] },
       "default": { "prim": "unit" },
       "add_right":
         { "prim": "pair",
@@ -366,9 +370,11 @@ null
         { "prim": "or",
           "args":
             [ { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] },
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_left" ] },
               { "prim": "pair",
-                "args": [ { "prim": "string" }, { "prim": "nat" } ] } ] } } }
+                "args": [ { "prim": "string" }, { "prim": "nat" } ],
+                "annots": [ "%add_right" ] } ] } } }
 
 ./tezos-client rpc get '/chains/main/blocks/head/context/contracts/[CONTRACT_HASH]/script'
 { "code":
-- 
GitLab


From db6d8d98681c72c1d657227711095127a1a43d75 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Tue, 29 Mar 2022 18:09:43 +0200
Subject: [PATCH 16/27] Proto/Michelson: remove unused paths from the
 entrypoints map

---
 src/proto_alpha/lib_plugin/plugin.ml                  |  2 +-
 src/proto_alpha/lib_protocol/contract_services.ml     |  2 +-
 src/proto_alpha/lib_protocol/script_ir_translator.ml  | 10 ++++------
 src/proto_alpha/lib_protocol/script_ir_translator.mli |  3 +--
 4 files changed, 7 insertions(+), 10 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 95578184e795..67f069285a92 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2647,7 +2647,7 @@ module RPC = struct
               in
               ( unreachable_entrypoint,
                 Entrypoint.Map.fold
-                  (fun entry (_, ty) acc ->
+                  (fun entry ty acc ->
                     (Entrypoint.to_string entry, Micheline.strip_locations ty)
                     :: acc)
                   map
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 452a44815788..e9257b220f50 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -427,7 +427,7 @@ let[@coq_axiom_with_reason "gadt"] register () =
               Some
                 ( unreachable_entrypoint,
                   Entrypoint.Map.fold
-                    (fun entry (_, ty) acc ->
+                    (fun entry ty acc ->
                       (Entrypoint.to_string entry, Micheline.strip_locations ty)
                       :: acc)
                     map
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 208742f523de..887061d99733 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5577,9 +5577,7 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
     | Some {name; original_type} ->
         ( (if Entrypoint.Map.mem name all then
            (List.rev path :: unreachables, all)
-          else
-            ( unreachables,
-              Entrypoint.Map.add name (List.rev path, original_type) all )),
+          else (unreachables, Entrypoint.Map.add name original_type all)),
           true )
   in
   let rec fold_tree :
@@ -5588,8 +5586,8 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
       t entrypoints_node ->
       prim list ->
       bool ->
-      prim list list * (prim list * Script.node) Entrypoint.Map.t ->
-      prim list list * (prim list * Script.node) Entrypoint.Map.t =
+      prim list list * Script.node Entrypoint.Map.t ->
+      prim list list * Script.node Entrypoint.Map.t =
    fun t entrypoints path reachable acc ->
     match (t, entrypoints) with
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _}) ->
@@ -5605,7 +5603,7 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
     match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
     | Some {name; original_type} ->
-        (Entrypoint.Map.singleton name ([], original_type), true)
+        (Entrypoint.Map.singleton name original_type, true)
   in
   fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index f9d8e3ee544b..b98d869f1e2e 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -435,8 +435,7 @@ val find_entrypoint :
 val list_entrypoints :
   ('t, _) Script_typed_ir.ty ->
   't Script_typed_ir.entrypoints ->
-  Michelson_v1_primitives.prim list list
-  * (Michelson_v1_primitives.prim list * Script.node) Entrypoint.Map.t
+  Michelson_v1_primitives.prim list list * Script.node Entrypoint.Map.t
 
 val pack_data :
   context ->
-- 
GitLab


From f8f56c93f51b4fd67119cc2510808305bf7d1d8f Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 14:55:01 +0200
Subject: [PATCH 17/27] Proto/RPCs: add normalize_types flag for
 entrypoint_type

This reverts part of 37b270d5e79b0d40125067bfbe46e58d86ae55eb
---
 .../lib_client/michelson_v1_entrypoints.ml    |  1 +
 .../lib_protocol/contract_services.ml         | 40 +++++++++++++++----
 .../lib_protocol/contract_services.mli        |  1 +
 3 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
index 190b42bfb515..46bdd31ae13d 100644
--- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
@@ -68,6 +68,7 @@ let contract_entrypoint_type cctxt ~(chain : Chain_services.chain) ~block
     (chain, block)
     contract
     entrypoint
+    ~normalize_types:false
   >>= function
   | Ok ty -> return_some ty
   | Error (RPC_context.Not_found _ :: _) -> return None
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index e9257b220f50..6a51f1b922cc 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -117,10 +117,23 @@ module S = struct
       ~output:Script.expr_encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "storage")
 
+  type normalize_types_query = {normalize_types : bool}
+
+  let normalize_types_query : normalize_types_query RPC_query.t =
+    let open RPC_query in
+    query (fun normalize_types -> {normalize_types})
+    |+ flag
+         ~descr:
+           "Whether types should be normalized (annotations removed, combs \
+            flattened) or kept as they appeared in the original script."
+         "normalize_types"
+         (fun t -> t.normalize_types)
+    |> seal
+
   let entrypoint_type =
     RPC_service.get_service
       ~description:"Return the type of the given entrypoint of the contract"
-      ~query:RPC_query.empty
+      ~query:normalize_types_query
       ~output:Script.expr_encoding
       RPC_path.(
         custom_root /: Contract.rpc_arg / "entrypoints" /: Entrypoint.rpc_arg)
@@ -374,7 +387,10 @@ let[@coq_axiom_with_reason "gadt"] register () =
             ctxt
             script.storage
           >>?= fun (storage, _ctxt) -> return_some storage) ;
-  opt_register2 ~chunked:true S.entrypoint_type (fun ctxt v entrypoint () () ->
+  opt_register2
+    ~chunked:true
+    S.entrypoint_type
+    (fun ctxt v entrypoint {normalize_types} () ->
       Contract.get_script_code ctxt v >>=? fun (_, expr) ->
       match expr with
       | None -> return_none
@@ -398,10 +414,13 @@ let[@coq_axiom_with_reason "gadt"] register () =
                    arg_type
                    entrypoints
                    entrypoint
-              >>? fun (r, _ctxt) ->
+              >>? fun (r, ctxt) ->
               r |> function
-              | Ok (Ex_ty_cstr {original_type; _}) ->
-                  ok (Some (Micheline.strip_locations original_type))
+              | Ok (Ex_ty_cstr {ty; original_type; _}) ->
+                  if normalize_types then
+                    unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _ctxt) ->
+                    Some (Micheline.strip_locations ty_node)
+                  else ok (Some (Micheline.strip_locations original_type))
               | Error _ -> Result.return_none )) ;
   opt_register1 ~chunked:true S.list_entrypoints (fun ctxt v () () ->
       Contract.get_script_code ctxt v >>=? fun (_, expr) ->
@@ -535,8 +554,15 @@ let script_opt ctxt block contract =
 let storage ctxt block contract =
   RPC_context.make_call1 S.storage ctxt block contract () ()
 
-let entrypoint_type ctxt block contract entrypoint =
-  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () ()
+let entrypoint_type ctxt block contract entrypoint ~normalize_types =
+  RPC_context.make_call2
+    S.entrypoint_type
+    ctxt
+    block
+    contract
+    entrypoint
+    {normalize_types}
+    ()
 
 let list_entrypoints ctxt block contract =
   RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()
diff --git a/src/proto_alpha/lib_protocol/contract_services.mli b/src/proto_alpha/lib_protocol/contract_services.mli
index 95471b297431..8aad15746f90 100644
--- a/src/proto_alpha/lib_protocol/contract_services.mli
+++ b/src/proto_alpha/lib_protocol/contract_services.mli
@@ -90,6 +90,7 @@ val entrypoint_type :
   'a ->
   Contract.t ->
   Entrypoint.t ->
+  normalize_types:bool ->
   Script.expr shell_tzresult Lwt.t
 
 val list_entrypoints :
-- 
GitLab


From fcfc390f63545708b5943cda7d860c3de5596eb0 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 15:30:42 +0200
Subject: [PATCH 18/27] Proto/Michelson: list_entrypoints return both the typed
 type and the original expr

---
 src/proto_alpha/lib_plugin/plugin.ml                  | 5 +++--
 src/proto_alpha/lib_protocol/contract_services.ml     | 5 +++--
 src/proto_alpha/lib_protocol/script_ir_translator.ml  | 9 +++++----
 src/proto_alpha/lib_protocol/script_ir_translator.mli | 3 ++-
 4 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 67f069285a92..fc8ecaaf45c3 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2647,8 +2647,9 @@ module RPC = struct
               in
               ( unreachable_entrypoint,
                 Entrypoint.Map.fold
-                  (fun entry ty acc ->
-                    (Entrypoint.to_string entry, Micheline.strip_locations ty)
+                  (fun entry (_ex_ty, original_type) acc ->
+                    ( Entrypoint.to_string entry,
+                      Micheline.strip_locations original_type )
                     :: acc)
                   map
                   [] ) ))
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 6a51f1b922cc..f967800b8348 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -446,8 +446,9 @@ let[@coq_axiom_with_reason "gadt"] register () =
               Some
                 ( unreachable_entrypoint,
                   Entrypoint.Map.fold
-                    (fun entry ty acc ->
-                      (Entrypoint.to_string entry, Micheline.strip_locations ty)
+                    (fun entry (_ex_ty, original_type) acc ->
+                      ( Entrypoint.to_string entry,
+                        Micheline.strip_locations original_type )
                       :: acc)
                     map
                     [] ) )) ;
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 887061d99733..2de1116e202c 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5577,7 +5577,8 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
     | Some {name; original_type} ->
         ( (if Entrypoint.Map.mem name all then
            (List.rev path :: unreachables, all)
-          else (unreachables, Entrypoint.Map.add name original_type all)),
+          else
+            (unreachables, Entrypoint.Map.add name (Ex_ty ty, original_type) all)),
           true )
   in
   let rec fold_tree :
@@ -5586,8 +5587,8 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
       t entrypoints_node ->
       prim list ->
       bool ->
-      prim list list * Script.node Entrypoint.Map.t ->
-      prim list list * Script.node Entrypoint.Map.t =
+      prim list list * (ex_ty * Script.node) Entrypoint.Map.t ->
+      prim list list * (ex_ty * Script.node) Entrypoint.Map.t =
    fun t entrypoints path reachable acc ->
     match (t, entrypoints) with
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _}) ->
@@ -5603,7 +5604,7 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
     match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
     | Some {name; original_type} ->
-        (Entrypoint.Map.singleton name original_type, true)
+        (Entrypoint.Map.singleton name (Ex_ty full, original_type), true)
   in
   fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index b98d869f1e2e..fbddb6a1173d 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -435,7 +435,8 @@ val find_entrypoint :
 val list_entrypoints :
   ('t, _) Script_typed_ir.ty ->
   't Script_typed_ir.entrypoints ->
-  Michelson_v1_primitives.prim list list * Script.node Entrypoint.Map.t
+  Michelson_v1_primitives.prim list list
+  * (ex_ty * Script.node) Entrypoint.Map.t
 
 val pack_data :
   context ->
-- 
GitLab


From 2ab94ab4a2478d7fe663d72d9434856b1f79b4ac Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 15:30:42 +0200
Subject: [PATCH 19/27] Proto/RPCs: add normalize_types flag to
 list_entrypoints

---
 .../lib_client/michelson_v1_entrypoints.ml    |  6 ++-
 .../lib_protocol/contract_services.ml         | 40 ++++++++++++-------
 .../lib_protocol/contract_services.mli        |  1 +
 3 files changed, 32 insertions(+), 15 deletions(-)

diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
index 46bdd31ae13d..e0a446b695f0 100644
--- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
@@ -107,7 +107,11 @@ let print_entrypoint_type (cctxt : #Client_context.printer)
   | Error errs -> on_errors errs
 
 let list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract =
-  Alpha_services.Contract.list_entrypoints cctxt (chain, block) contract
+  Alpha_services.Contract.list_entrypoints
+    cctxt
+    (chain, block)
+    contract
+    ~normalize_types:false
 
 let list_contract_unreachables cctxt ~chain ~block ~contract =
   list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index f967800b8348..b8675eb461cb 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -141,7 +141,7 @@ module S = struct
   let list_entrypoints =
     RPC_service.get_service
       ~description:"Return the list of entrypoints of the contract"
-      ~query:RPC_query.empty
+      ~query:normalize_types_query
       ~output:
         (obj2
            (dft
@@ -422,7 +422,10 @@ let[@coq_axiom_with_reason "gadt"] register () =
                     Some (Micheline.strip_locations ty_node)
                   else ok (Some (Micheline.strip_locations original_type))
               | Error _ -> Result.return_none )) ;
-  opt_register1 ~chunked:true S.list_entrypoints (fun ctxt v () () ->
+  opt_register1
+    ~chunked:true
+    S.list_entrypoints
+    (fun ctxt v {normalize_types} () ->
       Contract.get_script_code ctxt v >>=? fun (_, expr) ->
       match expr with
       | None -> return_none
@@ -438,20 +441,23 @@ let[@coq_axiom_with_reason "gadt"] register () =
           parse_toplevel ctxt ~legacy expr >>=? fun ({arg_type; _}, ctxt) ->
           Lwt.return
             ( parse_parameter_ty_and_entrypoints ctxt ~legacy arg_type
-            >|? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
+            >>? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
               ->
               let (unreachable_entrypoint, map) =
                 Script_ir_translator.list_entrypoints arg_type entrypoints
               in
-              Some
-                ( unreachable_entrypoint,
-                  Entrypoint.Map.fold
-                    (fun entry (_ex_ty, original_type) acc ->
-                      ( Entrypoint.to_string entry,
-                        Micheline.strip_locations original_type )
-                      :: acc)
-                    map
-                    [] ) )) ;
+              Entrypoint.Map.fold_e
+                (fun entry (Ex_ty ty, original_type) (acc, ctxt) ->
+                  (if normalize_types then
+                   unparse_ty ~loc:() ctxt ty >|? fun (ty_node, ctxt) ->
+                   (Micheline.strip_locations ty_node, ctxt)
+                  else ok (Micheline.strip_locations original_type, ctxt))
+                  >|? fun (ty_expr, ctxt) ->
+                  ((Entrypoint.to_string entry, ty_expr) :: acc, ctxt))
+                map
+                ([], ctxt)
+              >|? fun (entrypoint_types, _ctxt) ->
+              Some (unreachable_entrypoint, entrypoint_types) )) ;
   opt_register1
     ~chunked:true
     S.contract_big_map_get_opt
@@ -565,8 +571,14 @@ let entrypoint_type ctxt block contract entrypoint ~normalize_types =
     {normalize_types}
     ()
 
-let list_entrypoints ctxt block contract =
-  RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()
+let list_entrypoints ctxt block contract ~normalize_types =
+  RPC_context.make_call1
+    S.list_entrypoints
+    ctxt
+    block
+    contract
+    {normalize_types}
+    ()
 
 let storage_opt ctxt block contract =
   RPC_context.make_opt_call1 S.storage ctxt block contract () ()
diff --git a/src/proto_alpha/lib_protocol/contract_services.mli b/src/proto_alpha/lib_protocol/contract_services.mli
index 8aad15746f90..6f86556cb088 100644
--- a/src/proto_alpha/lib_protocol/contract_services.mli
+++ b/src/proto_alpha/lib_protocol/contract_services.mli
@@ -97,6 +97,7 @@ val list_entrypoints :
   'a #RPC_context.simple ->
   'a ->
   Contract.t ->
+  normalize_types:bool ->
   (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
   shell_tzresult
   Lwt.t
-- 
GitLab


From b8ac6e7e960a487c461bad3f3029e93dd89b7cd8 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 17:35:29 +0200
Subject: [PATCH 20/27] Proto/Client: push normalize_types flag further

true for internal use
false will be changed in later commits
---
 src/proto_alpha/lib_client/managed_contract.ml              | 3 +++
 src/proto_alpha/lib_client/michelson_v1_entrypoints.ml      | 6 ++++--
 src/proto_alpha/lib_client/michelson_v1_entrypoints.mli     | 1 +
 .../lib_client_commands/client_proto_context_commands.ml    | 1 +
 .../lib_client_commands/client_proto_multisig_commands.ml   | 1 +
 5 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_client/managed_contract.ml b/src/proto_alpha/lib_client/managed_contract.ml
index 7ed5db282c93..247af38850ae 100644
--- a/src/proto_alpha/lib_client/managed_contract.ml
+++ b/src/proto_alpha/lib_client/managed_contract.ml
@@ -110,6 +110,7 @@ let build_delegate_operation (cctxt : #full) ~chain ~block ?fee
      ~block
      ~contract
      ~entrypoint
+     ~normalize_types:true
    >>=? function
    | Some _ ->
        (* their is a "do" entrypoint (we could check its type here)*)
@@ -128,6 +129,7 @@ let build_delegate_operation (cctxt : #full) ~chain ~block ?fee
          ~block
          ~contract
          ~entrypoint
+         ~normalize_types:true
        >>=? function
        | Some _ ->
            (*  their is a "set/remove_delegate" entrypoint *)
@@ -245,6 +247,7 @@ let build_transaction_operation (cctxt : #full) ~chain ~block ~contract
          ~block
          ~contract:destination
          ~entrypoint
+         ~normalize_types:true
        >>=? function
        | None ->
            cctxt#error
diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
index e0a446b695f0..eda4302480df 100644
--- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
@@ -62,13 +62,13 @@ let script_entrypoint_type cctxt ~(chain : Chain_services.chain) ~block
   | Error _ as err -> Lwt.return err
 
 let contract_entrypoint_type cctxt ~(chain : Chain_services.chain) ~block
-    ~contract ~entrypoint =
+    ~contract ~entrypoint ~normalize_types =
   Alpha_services.Contract.entrypoint_type
     cctxt
     (chain, block)
     contract
     entrypoint
-    ~normalize_types:false
+    ~normalize_types
   >>= function
   | Ok ty -> return_some ty
   | Error (RPC_context.Not_found _ :: _) -> return None
@@ -118,6 +118,7 @@ let list_contract_unreachables cctxt ~chain ~block ~contract =
   >>=? fun (unreachables, _) -> return unreachables
 
 let list_contract_entrypoints cctxt ~chain ~block ~contract =
+  let normalize_types = false in
   list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract
   >>=? fun (_, entrypoints) ->
   if not @@ List.mem_assoc ~equal:String.equal "default" entrypoints then
@@ -127,6 +128,7 @@ let list_contract_entrypoints cctxt ~chain ~block ~contract =
       ~block
       ~contract
       ~entrypoint:Entrypoint.default
+      ~normalize_types
     >>= function
     | Ok (Some ty) -> return (("default", ty) :: entrypoints)
     | Ok None -> return entrypoints
diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli b/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli
index 83dfe900e3b3..5ab2797f33de 100644
--- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli
+++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli
@@ -41,6 +41,7 @@ val contract_entrypoint_type :
   block:Block_services.block ->
   contract:Alpha_context.Contract.t ->
   entrypoint:Alpha_context.Entrypoint.t ->
+  normalize_types:bool ->
   Alpha_context.Script.expr option tzresult Lwt.t
 
 val print_entrypoint_type :
diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
index ead66538a211..a4761a278312 100644
--- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
+++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
@@ -396,6 +396,7 @@ let commands_ro () =
           ~block:cctxt#block
           ~contract
           ~entrypoint
+          ~normalize_types:false
         >>= Michelson_v1_entrypoints.print_entrypoint_type
               cctxt
               ~emacs:false
diff --git a/src/proto_alpha/lib_client_commands/client_proto_multisig_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_multisig_commands.ml
index a03e5a04c396..d20ca7fa7de4 100644
--- a/src/proto_alpha/lib_client_commands/client_proto_multisig_commands.ml
+++ b/src/proto_alpha/lib_client_commands/client_proto_multisig_commands.ml
@@ -153,6 +153,7 @@ let get_parameter_type (cctxt : #Protocol_client_context.full) ~destination
         ~block:cctxt#block
         ~contract:destination
         ~entrypoint
+        ~normalize_types:true
       >>=? function
       | None ->
           cctxt#error
-- 
GitLab


From d36e27365624e8c33c0e5b5e6a476ff99b3d3124 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 17:36:10 +0200
Subject: [PATCH 21/27] Proto/Client: add --normalize-types switch to get
 contract entrypoint type of

---
 .../client_proto_context_commands.ml            | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
index a4761a278312..5ab79632d56a 100644
--- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
+++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
@@ -35,6 +35,14 @@ open Client_proto_args
 let encrypted_switch =
   Clic.switch ~long:"encrypted" ~doc:"encrypt the key on-disk" ()
 
+let normalize_types_switch =
+  Clic.switch
+    ~long:"normalize-types"
+    ~doc:
+      "Whether types should be normalized (annotations removed, combs \
+       flattened) or kept as they appeared in the original script."
+    ()
+
 let report_michelson_errors ?(no_print_source = false) ~msg
     (cctxt : #Client_context.full) = function
   | Error errs ->
@@ -380,7 +388,7 @@ let commands_ro () =
     command
       ~group
       ~desc:"Get the type of an entrypoint of a contract."
-      no_options
+      (args1 normalize_types_switch)
       (prefixes ["get"; "contract"; "entrypoint"; "type"; "of"]
       @@ Clic.param
            ~name:"entrypoint"
@@ -389,14 +397,17 @@ let commands_ro () =
       @@ prefixes ["for"]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
-      (fun () entrypoint (_, contract) (cctxt : Protocol_client_context.full) ->
+      (fun normalize_types
+           entrypoint
+           (_, contract)
+           (cctxt : Protocol_client_context.full) ->
         Michelson_v1_entrypoints.contract_entrypoint_type
           cctxt
           ~chain:cctxt#chain
           ~block:cctxt#block
           ~contract
           ~entrypoint
-          ~normalize_types:false
+          ~normalize_types
         >>= Michelson_v1_entrypoints.print_entrypoint_type
               cctxt
               ~emacs:false
-- 
GitLab


From 7998474d883684ce5c52ca7e1e7de3a8386fdee8 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 17:40:59 +0200
Subject: [PATCH 22/27] Proto/Client: push normalize_types flag further

---
 .../lib_client/client_proto_fa12.ml           |  1 +
 .../lib_client/michelson_v1_entrypoints.ml    | 28 ++++++++++++++-----
 .../lib_client/michelson_v1_entrypoints.mli   |  1 +
 .../client_proto_context_commands.ml          |  1 +
 4 files changed, 24 insertions(+), 7 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..957fb78c75e8 100644
--- a/src/proto_alpha/lib_client/client_proto_fa12.ml
+++ b/src/proto_alpha/lib_client/client_proto_fa12.ml
@@ -724,6 +724,7 @@ let contract_has_fa12_interface :
         ~chain
         ~block
         ~contract
+        ~normalize_types:true
       >>=? fun entrypoints ->
       List.iter_e (check_entrypoint entrypoints) standard_entrypoints
       |> Lwt.return
diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
index eda4302480df..2104fc101705 100644
--- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
+++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.ml
@@ -106,20 +106,34 @@ let print_entrypoint_type (cctxt : #Client_context.printer)
       >>= fun () -> return_unit
   | Error errs -> on_errors errs
 
-let list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract =
+let list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract
+    ~normalize_types =
   Alpha_services.Contract.list_entrypoints
     cctxt
     (chain, block)
     contract
-    ~normalize_types:false
+    ~normalize_types
 
 let list_contract_unreachables cctxt ~chain ~block ~contract =
-  list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract
-  >>=? fun (unreachables, _) -> return unreachables
+  let normalize_types =
+    (* no need to normalize types as typed entrypoints are ignored *)
+    false
+  in
+  list_contract_unreachables_and_entrypoints
+    cctxt
+    ~chain
+    ~block
+    ~contract
+    ~normalize_types
+  >>=? fun (unreachables, _typed_entrypoints) -> return unreachables
 
-let list_contract_entrypoints cctxt ~chain ~block ~contract =
-  let normalize_types = false in
-  list_contract_unreachables_and_entrypoints cctxt ~chain ~block ~contract
+let list_contract_entrypoints cctxt ~chain ~block ~contract ~normalize_types =
+  list_contract_unreachables_and_entrypoints
+    cctxt
+    ~chain
+    ~block
+    ~contract
+    ~normalize_types
   >>=? fun (_, entrypoints) ->
   if not @@ List.mem_assoc ~equal:String.equal "default" entrypoints then
     contract_entrypoint_type
diff --git a/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli b/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli
index 5ab2797f33de..03ed32851ed2 100644
--- a/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli
+++ b/src/proto_alpha/lib_client/michelson_v1_entrypoints.mli
@@ -88,6 +88,7 @@ val list_contract_entrypoints :
   chain:Chain_services.chain ->
   block:Block_services.block ->
   contract:Alpha_context.Contract.t ->
+  normalize_types:bool ->
   (string * Alpha_context.Script.expr) list tzresult Lwt.t
 
 (** List the script entrypoints with their types.  *)
diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
index 5ab79632d56a..4ba09d931b9a 100644
--- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
+++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
@@ -426,6 +426,7 @@ let commands_ro () =
           ~chain:cctxt#chain
           ~block:cctxt#block
           ~contract
+          ~normalize_types:false
         >>= Michelson_v1_entrypoints.print_entrypoints_list
               cctxt
               ~emacs:false
-- 
GitLab


From 39d54c52694c4c784290f502a5dc7a2d502c6598 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 17:42:19 +0200
Subject: [PATCH 23/27] Proto/Client: add --normalize-types switch to get
 contract entrypoints for

---
 .../lib_client_commands/client_proto_context_commands.ml    | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
index 4ba09d931b9a..f16883d8b9ce 100644
--- a/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
+++ b/src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
@@ -416,17 +416,17 @@ let commands_ro () =
     command
       ~group
       ~desc:"Get the entrypoint list of a contract."
-      no_options
+      (args1 normalize_types_switch)
       (prefixes ["get"; "contract"; "entrypoints"; "for"]
       @@ ContractAlias.destination_param ~name:"src" ~desc:"source contract"
       @@ stop)
-      (fun () (_, contract) (cctxt : Protocol_client_context.full) ->
+      (fun normalize_types (_, contract) (cctxt : Protocol_client_context.full) ->
         Michelson_v1_entrypoints.list_contract_entrypoints
           cctxt
           ~chain:cctxt#chain
           ~block:cctxt#block
           ~contract
-          ~normalize_types:false
+          ~normalize_types
         >>= Michelson_v1_entrypoints.print_entrypoints_list
               cctxt
               ~emacs:false
-- 
GitLab


From 51b08826dd1b74ae066dd529ff6f976682a04e57 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 18:14:01 +0200
Subject: [PATCH 24/27] Proto/Michelson: rename present_entrypoint into
 entrypoint_info

---
 src/proto_alpha/lib_protocol/script_typed_ir.ml  | 4 ++--
 src/proto_alpha/lib_protocol/script_typed_ir.mli | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index fdb00f1d5850..a7f64b80785c 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -421,10 +421,10 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type present_entrypoint = {name : Entrypoint.t; original_type : Script.node}
+type entrypoint_info = {name : Entrypoint.t; original_type : Script.node}
 
 type 'arg entrypoints_node = {
-  at_node : present_entrypoint option;
+  at_node : entrypoint_info option;
   nested : 'arg nested_entrypoints;
 }
 
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 9849b1be8cc2..bd13158f8ee4 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -279,7 +279,7 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type present_entrypoint = {name : Entrypoint.t; original_type : Script.node}
+type entrypoint_info = {name : Entrypoint.t; original_type : Script.node}
 
 (** ['arg entrypoints] represents the tree of entrypoints of a parameter type
     ['arg].
@@ -290,7 +290,7 @@ type present_entrypoint = {name : Entrypoint.t; original_type : Script.node}
       means that there are no entrypoints below that node in the tree.
 *)
 type 'arg entrypoints_node = {
-  at_node : present_entrypoint option;
+  at_node : entrypoint_info option;
   nested : 'arg nested_entrypoints;
 }
 
-- 
GitLab


From 484708d9bcc9139c56041c0c4413809158d521e7 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 18:16:09 +0200
Subject: [PATCH 25/27] Proto/Michelson: rename original_type into
 original_type_expr

---
 src/proto_alpha/lib_plugin/plugin.ml          |  8 ++--
 .../lib_protocol/contract_services.ml         |  8 ++--
 .../lib_protocol/script_interpreter.ml        |  2 +-
 .../lib_protocol/script_ir_translator.ml      | 44 ++++++++++---------
 .../lib_protocol/script_ir_translator.mli     |  2 +-
 .../lib_protocol/script_typed_ir.ml           |  4 +-
 .../lib_protocol/script_typed_ir.mli          |  4 +-
 7 files changed, 38 insertions(+), 34 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index fc8ecaaf45c3..551202e1d262 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2246,8 +2246,8 @@ module RPC = struct
                  entrypoints
                  entrypoint
             >>? fun (r, _ctxt) ->
-            r >|? fun (Ex_ty_cstr {original_type; _}) ->
-            Micheline.strip_locations original_type )
+            r >|? fun (Ex_ty_cstr {original_type_expr; _}) ->
+            Micheline.strip_locations original_type_expr )
       in
       Registration.register0
         ~chunked:true
@@ -2647,9 +2647,9 @@ module RPC = struct
               in
               ( unreachable_entrypoint,
                 Entrypoint.Map.fold
-                  (fun entry (_ex_ty, original_type) acc ->
+                  (fun entry (_ex_ty, original_type_expr) acc ->
                     ( Entrypoint.to_string entry,
-                      Micheline.strip_locations original_type )
+                      Micheline.strip_locations original_type_expr )
                     :: acc)
                   map
                   [] ) ))
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index b8675eb461cb..4c78c84b5461 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -416,11 +416,11 @@ let[@coq_axiom_with_reason "gadt"] register () =
                    entrypoint
               >>? fun (r, ctxt) ->
               r |> function
-              | Ok (Ex_ty_cstr {ty; original_type; _}) ->
+              | Ok (Ex_ty_cstr {ty; original_type_expr; _}) ->
                   if normalize_types then
                     unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _ctxt) ->
                     Some (Micheline.strip_locations ty_node)
-                  else ok (Some (Micheline.strip_locations original_type))
+                  else ok (Some (Micheline.strip_locations original_type_expr))
               | Error _ -> Result.return_none )) ;
   opt_register1
     ~chunked:true
@@ -447,11 +447,11 @@ let[@coq_axiom_with_reason "gadt"] register () =
                 Script_ir_translator.list_entrypoints arg_type entrypoints
               in
               Entrypoint.Map.fold_e
-                (fun entry (Ex_ty ty, original_type) (acc, ctxt) ->
+                (fun entry (Ex_ty ty, original_type_expr) (acc, ctxt) ->
                   (if normalize_types then
                    unparse_ty ~loc:() ctxt ty >|? fun (ty_node, ctxt) ->
                    (Micheline.strip_locations ty_node, ctxt)
-                  else ok (Micheline.strip_locations original_type, ctxt))
+                  else ok (Micheline.strip_locations original_type_expr, ctxt))
                   >|? fun (ty_expr, ctxt) ->
                   ((Entrypoint.to_string entry, ty_expr) :: acc, ctxt))
                 map
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 3a6595d0b7dc..2e0e5ef9fdaf 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1756,7 +1756,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal
     (find_entrypoint ~error_details:Informative arg_type entrypoints entrypoint)
   >>?= fun (r, ctxt) ->
   record_trace (Bad_contract_parameter step_constants.self) r
-  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; box; original_type = _}) ->
+  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; box; original_type_expr = _}) ->
   trace
     (Bad_contract_parameter step_constants.self)
     (lift_execution_arg ctxt ~internal entrypoint_ty box arg)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 2de1116e202c..52d0227153c9 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -304,7 +304,8 @@ let rec unparse_ty_entrypoints_uncarbonated :
   let annot =
     match at_node with
     | None -> []
-    | Some {name; original_type = _} -> [Entrypoint.unparse_as_field_annot name]
+    | Some {name; original_type_expr = _} ->
+        [Entrypoint.unparse_as_field_annot name]
   in
   Prim (loc, name, args, annot)
 
@@ -1280,7 +1281,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
       | Don't_parse_entrypoints -> (Ex_ty ty, ctxt)
       | Parse_entrypoints ->
           let at_node =
-            Option.map (fun name -> {name; original_type = node}) name
+            Option.map (fun name -> {name; original_type_expr = node}) name
           in
           ( Ex_parameter_ty_and_entrypoints_node
               {
@@ -1428,7 +1429,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty
             union_t loc tl tr >|? fun (Ty_ex_c arg_type) ->
             let entrypoints =
               let at_node =
-                Option.map (fun name -> {name; original_type = node}) name
+                Option.map (fun name -> {name; original_type_expr = node}) name
               in
               {at_node; nested = Entrypoints_Union {left; right}}
             in
@@ -1928,7 +1929,7 @@ type 'a ex_ty_cstr =
   | Ex_ty_cstr : {
       ty : ('b, _) Script_typed_ir.ty;
       box : 'b -> 'a;
-      original_type : Script.node;
+      original_type_expr : Script.node;
     }
       -> 'a ex_ty_cstr
 
@@ -1946,27 +1947,28 @@ let find_entrypoint (type full fullc error_trace)
    fun ty entrypoints entrypoint ->
     let* () = Gas_monad.consume_gas Typecheck_costs.find_entrypoint_cycle in
     match (ty, entrypoints) with
-    | (_, {at_node = Some {name; original_type}; _})
+    | (_, {at_node = Some {name; original_type_expr}; _})
       when Entrypoint.(name = entrypoint) ->
-        return (Ex_ty_cstr {ty; box = (fun e -> e); original_type})
+        return (Ex_ty_cstr {ty; box = (fun e -> e); original_type_expr})
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
         Gas_monad.bind_recover (find_entrypoint tl left entrypoint) @@ function
-        | Ok (Ex_ty_cstr {ty; box; original_type}) ->
-            return (Ex_ty_cstr {ty; box = (fun e -> L (box e)); original_type})
+        | Ok (Ex_ty_cstr {ty; box; original_type_expr}) ->
+            return
+              (Ex_ty_cstr {ty; box = (fun e -> L (box e)); original_type_expr})
         | Error () ->
-            let+ (Ex_ty_cstr {ty; box; original_type}) =
+            let+ (Ex_ty_cstr {ty; box; original_type_expr}) =
               find_entrypoint tr right entrypoint
             in
-            Ex_ty_cstr {ty; box = (fun e -> R (box e)); original_type})
+            Ex_ty_cstr {ty; box = (fun e -> R (box e)); original_type_expr})
     | (_, {nested = Entrypoints_None; _}) -> Gas_monad.of_result (Error ())
   in
-  let {root; original_type} = entrypoints in
+  let {root; original_type_expr} = entrypoints in
   Gas_monad.bind_recover (find_entrypoint full root entrypoint) @@ function
   | Ok f_t -> return f_t
   | Error () ->
       if Entrypoint.is_default entrypoint then
-        return (Ex_ty_cstr {ty = full; box = (fun e -> e); original_type})
+        return (Ex_ty_cstr {ty = full; box = (fun e -> e); original_type_expr})
       else
         Gas_monad.of_result
         @@ Error
@@ -1983,7 +1985,7 @@ let find_entrypoint_for_type (type full fullc exp expc error_trace)
   match res with
   | Ex_ty_cstr {ty; _} -> (
       match entrypoints.root.at_node with
-      | Some {name; original_type = _}
+      | Some {name; original_type_expr = _}
         when Entrypoint.is_root name && Entrypoint.is_default entrypoint ->
           Gas_monad.bind_recover
             (ty_eq ~error_details:Fast loc ty expected)
@@ -2013,7 +2015,7 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
                   | None -> (Some (List.rev path), all)
                   | Some _ -> acc)),
             reachable )
-    | Some {name; original_type = _} ->
+    | Some {name; original_type_expr = _} ->
         if Entrypoint.Set.mem name all then error (Duplicate_entrypoint name)
         else ok ((first_unreachable, Entrypoint.Set.add name all), true)
   in
@@ -2039,7 +2041,8 @@ let well_formed_entrypoints (type full fullc) (full : (full, fullc) ty)
   let (init, reachable) =
     match entrypoints.at_node with
     | None -> (Entrypoint.Set.empty, false)
-    | Some {name; original_type = _} -> (Entrypoint.Set.singleton name, true)
+    | Some {name; original_type_expr = _} ->
+        (Entrypoint.Set.singleton name, true)
   in
   check full entrypoints [] reachable (None, init)
   >>? fun (first_unreachable, all) ->
@@ -2074,7 +2077,7 @@ let parse_parameter_ty_and_entrypoints :
   (if legacy then Result.return_unit
   else well_formed_entrypoints arg_type entrypoints)
   >|? fun () ->
-  let entrypoints = {root = entrypoints; original_type = node} in
+  let entrypoints = {root = entrypoints; original_type_expr = node} in
   (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, ctxt)
 
 let parse_passable_ty = parse_passable_ty ~ret:Don't_parse_entrypoints
@@ -5574,11 +5577,12 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
             | Union_t _ -> acc
             | _ -> (List.rev path :: unreachables, all)),
           reachable )
-    | Some {name; original_type} ->
+    | Some {name; original_type_expr} ->
         ( (if Entrypoint.Map.mem name all then
            (List.rev path :: unreachables, all)
           else
-            (unreachables, Entrypoint.Map.add name (Ex_ty ty, original_type) all)),
+            ( unreachables,
+              Entrypoint.Map.add name (Ex_ty ty, original_type_expr) all )),
           true )
   in
   let rec fold_tree :
@@ -5603,8 +5607,8 @@ let list_entrypoints (type full fullc) (full : (full, fullc) ty)
   let (init, reachable) =
     match entrypoints.root.at_node with
     | None -> (Entrypoint.Map.empty, false)
-    | Some {name; original_type} ->
-        (Entrypoint.Map.singleton name (Ex_ty full, original_type), true)
+    | Some {name; original_type_expr} ->
+        (Entrypoint.Map.singleton name (Ex_ty full, original_type_expr), true)
   in
   fold_tree full entrypoints.root [] reachable ([], init)
   [@@coq_axiom_with_reason "unsupported syntax"]
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index fbddb6a1173d..b155c95aafda 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -421,7 +421,7 @@ type 'a ex_ty_cstr =
   | Ex_ty_cstr : {
       ty : ('b, _) Script_typed_ir.ty;
       box : 'b -> 'a;
-      original_type : Script.node;
+      original_type_expr : Script.node;
     }
       -> 'a ex_ty_cstr
 
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index a7f64b80785c..35e736a0f32e 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -421,7 +421,7 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type entrypoint_info = {name : Entrypoint.t; original_type : Script.node}
+type entrypoint_info = {name : Entrypoint.t; original_type_expr : Script.node}
 
 type 'arg entrypoints_node = {
   at_node : entrypoint_info option;
@@ -440,7 +440,7 @@ let no_entrypoints = {at_node = None; nested = Entrypoints_None}
 
 type 'arg entrypoints = {
   root : 'arg entrypoints_node;
-  original_type : Script.node;
+  original_type_expr : Script.node;
 }
 
 type ('arg, 'storage) script =
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index bd13158f8ee4..7d69f8ada1e6 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -279,7 +279,7 @@ type view = {
 
 type view_map = (Script_string.t, view) map
 
-type entrypoint_info = {name : Entrypoint.t; original_type : Script.node}
+type entrypoint_info = {name : Entrypoint.t; original_type_expr : Script.node}
 
 (** ['arg entrypoints] represents the tree of entrypoints of a parameter type
     ['arg].
@@ -307,7 +307,7 @@ val no_entrypoints : _ entrypoints_node
 
 type 'arg entrypoints = {
   root : 'arg entrypoints_node;
-  original_type : Script.node;
+  original_type_expr : Script.node;
 }
 
 type ('arg, 'storage) script =
-- 
GitLab


From 38edb7d87503d1ca7a8204fd523da351c1631b28 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 18:18:12 +0200
Subject: [PATCH 26/27] Proto/Michelson: rename list_entrypoints into
 list_entrypoints_uncarbonated

---
 src/proto_alpha/lib_plugin/plugin.ml                  | 4 +++-
 src/proto_alpha/lib_protocol/contract_services.ml     | 4 +++-
 src/proto_alpha/lib_protocol/script_ir_translator.ml  | 2 +-
 src/proto_alpha/lib_protocol/script_ir_translator.mli | 2 +-
 4 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 551202e1d262..6967251399eb 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2643,7 +2643,9 @@ module RPC = struct
             >|? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
               ->
               let (unreachable_entrypoint, map) =
-                Script_ir_translator.list_entrypoints arg_type entrypoints
+                Script_ir_translator.list_entrypoints_uncarbonated
+                  arg_type
+                  entrypoints
               in
               ( unreachable_entrypoint,
                 Entrypoint.Map.fold
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 4c78c84b5461..080c82530cae 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -444,7 +444,9 @@ let[@coq_axiom_with_reason "gadt"] register () =
             >>? fun (Ex_parameter_ty_and_entrypoints {arg_type; entrypoints}, _)
               ->
               let (unreachable_entrypoint, map) =
-                Script_ir_translator.list_entrypoints arg_type entrypoints
+                Script_ir_translator.list_entrypoints_uncarbonated
+                  arg_type
+                  entrypoints
               in
               Entrypoint.Map.fold_e
                 (fun entry (Ex_ty ty, original_type_expr) (acc, ctxt) ->
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 52d0227153c9..d6dda770081a 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -5564,7 +5564,7 @@ let typecheck_code :
   (!type_map, ctxt)
 
 (* Uncarbonated because used only in RPCs *)
-let list_entrypoints (type full fullc) (full : (full, fullc) ty)
+let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty)
     (entrypoints : full entrypoints) =
   let merge path (type t tc) (ty : (t, tc) ty)
       (entrypoints : t entrypoints_node) reachable ((unreachables, all) as acc)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index b155c95aafda..a9642c09464a 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -432,7 +432,7 @@ val find_entrypoint :
   Entrypoint.t ->
   ('t ex_ty_cstr, 'error_trace) Gas_monad.t
 
-val list_entrypoints :
+val list_entrypoints_uncarbonated :
   ('t, _) Script_typed_ir.ty ->
   't Script_typed_ir.entrypoints ->
   Michelson_v1_primitives.prim list list
-- 
GitLab


From 813b7eb79a544b836800219db5f0beae94394aa5 Mon Sep 17 00:00:00 2001
From: Mehdi Bouaziz <mehdi.bouaziz@nomadic-labs.com>
Date: Wed, 30 Mar 2022 18:20:04 +0200
Subject: [PATCH 27/27] Proto/Michelson: rename box into construct

---
 .../lib_protocol/script_interpreter.ml        |  9 ++++----
 .../lib_protocol/script_ir_translator.ml      | 21 ++++++++++++-------
 .../lib_protocol/script_ir_translator.mli     |  2 +-
 3 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 2e0e5ef9fdaf..a47fa7de1b54 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1701,7 +1701,7 @@ type execution_arg =
   | Untyped_arg : Script.expr -> execution_arg
 
 let lift_execution_arg (type a ac) ctxt ~internal (entrypoint_ty : (a, ac) ty)
-    (box : a -> 'b) arg : ('b * context) tzresult Lwt.t =
+    (construct : a -> 'b) arg : ('b * context) tzresult Lwt.t =
   (match arg with
   | Untyped_arg arg ->
       let arg = Micheline.root arg in
@@ -1718,7 +1718,7 @@ let lift_execution_arg (type a ac) ctxt ~internal (entrypoint_ty : (a, ac) ty)
       res >>?= fun Eq ->
       let parsed_arg : a = parsed_arg in
       return (parsed_arg, ctxt))
-  >>=? fun (entrypoint_arg, ctxt) -> return (box entrypoint_arg, ctxt)
+  >>=? fun (entrypoint_arg, ctxt) -> return (construct entrypoint_arg, ctxt)
 
 type execution_result = {
   script : Script_ir_translator.ex_script;
@@ -1756,10 +1756,11 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal
     (find_entrypoint ~error_details:Informative arg_type entrypoints entrypoint)
   >>?= fun (r, ctxt) ->
   record_trace (Bad_contract_parameter step_constants.self) r
-  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; box; original_type_expr = _}) ->
+  >>?= fun (Ex_ty_cstr {ty = entrypoint_ty; construct; original_type_expr = _})
+    ->
   trace
     (Bad_contract_parameter step_constants.self)
-    (lift_execution_arg ctxt ~internal entrypoint_ty box arg)
+    (lift_execution_arg ctxt ~internal entrypoint_ty construct arg)
   >>=? fun (arg, ctxt) ->
   Script_ir_translator.collect_lazy_storage ctxt arg_type arg
   >>?= fun (to_duplicate, ctxt) ->
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index d6dda770081a..bf2dd91fab05 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1928,7 +1928,7 @@ let rec make_comb_set_proof_argument :
 type 'a ex_ty_cstr =
   | Ex_ty_cstr : {
       ty : ('b, _) Script_typed_ir.ty;
-      box : 'b -> 'a;
+      construct : 'b -> 'a;
       original_type_expr : Script.node;
     }
       -> 'a ex_ty_cstr
@@ -1949,18 +1949,24 @@ let find_entrypoint (type full fullc error_trace)
     match (ty, entrypoints) with
     | (_, {at_node = Some {name; original_type_expr}; _})
       when Entrypoint.(name = entrypoint) ->
-        return (Ex_ty_cstr {ty; box = (fun e -> e); original_type_expr})
+        return (Ex_ty_cstr {ty; construct = (fun e -> e); original_type_expr})
     | (Union_t (tl, tr, _, _), {nested = Entrypoints_Union {left; right}; _})
       -> (
         Gas_monad.bind_recover (find_entrypoint tl left entrypoint) @@ function
-        | Ok (Ex_ty_cstr {ty; box; original_type_expr}) ->
+        | Ok (Ex_ty_cstr {ty; construct; original_type_expr}) ->
             return
-              (Ex_ty_cstr {ty; box = (fun e -> L (box e)); original_type_expr})
+              (Ex_ty_cstr
+                 {
+                   ty;
+                   construct = (fun e -> L (construct e));
+                   original_type_expr;
+                 })
         | Error () ->
-            let+ (Ex_ty_cstr {ty; box; original_type_expr}) =
+            let+ (Ex_ty_cstr {ty; construct; original_type_expr}) =
               find_entrypoint tr right entrypoint
             in
-            Ex_ty_cstr {ty; box = (fun e -> R (box e)); original_type_expr})
+            Ex_ty_cstr
+              {ty; construct = (fun e -> R (construct e)); original_type_expr})
     | (_, {nested = Entrypoints_None; _}) -> Gas_monad.of_result (Error ())
   in
   let {root; original_type_expr} = entrypoints in
@@ -1968,7 +1974,8 @@ let find_entrypoint (type full fullc error_trace)
   | Ok f_t -> return f_t
   | Error () ->
       if Entrypoint.is_default entrypoint then
-        return (Ex_ty_cstr {ty = full; box = (fun e -> e); original_type_expr})
+        return
+          (Ex_ty_cstr {ty = full; construct = (fun e -> e); original_type_expr})
       else
         Gas_monad.of_result
         @@ Error
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index a9642c09464a..2d88ed80ebaf 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -420,7 +420,7 @@ val parse_contract_for_script :
 type 'a ex_ty_cstr =
   | Ex_ty_cstr : {
       ty : ('b, _) Script_typed_ir.ty;
-      box : 'b -> 'a;
+      construct : 'b -> 'a;
       original_type_expr : Script.node;
     }
       -> 'a ex_ty_cstr
-- 
GitLab