From 2b123349dcfc095bb50636a0cd74efc00331a942 Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Fri, 22 Jun 2018 18:03:19 +0200
Subject: [PATCH] Michelson: fix error serialization

---
 .../src/script_tc_errors_registration.ml      | 50 +++++++++++++------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml b/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml
index 5b6fe8126..81ee38eeb 100644
--- a/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml
+++ b/src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml
@@ -27,15 +27,50 @@ let type_map_enc =
           (req "stackBefore" stack_enc)
           (req "stackAfter" stack_enc)))
 
+let rec strip_var_annots = function
+  | Int _ | String _ | Bytes _ as atom -> atom
+  | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args)
+  | Prim (loc, name, args, annots) ->
+      let not_var_annot s = Compare.Char.(String.get s 0 <> '@') in
+      let annots = List.filter not_var_annot annots in
+      Prim (loc, name, List.map strip_var_annots args, annots)
+
 let ex_ty_enc =
   Data_encoding.conv
-    (fun (Ex_ty ty) -> strip_locations (unparse_ty ty))
+    (fun (Ex_ty ty) ->
+       strip_locations (strip_var_annots (unparse_ty ty)))
     (fun expr ->
        match parse_ty ~allow_big_map:true ~allow_operation:true (root expr) with
        | Ok ty -> ty
        | _ -> assert false)
     Script.expr_encoding
 
+let var_annot_enc =
+  let open Data_encoding in
+  conv
+    (function `Var_annot x -> "@" ^ x)
+    (function x ->
+       assert (Compare.Int.(String.length x > 0) && Compare.Char.(String.get x 0 = '@')) ;
+       `Var_annot (String.sub x 1 (String.length x - 1)))
+    string
+
+let ex_stack_ty_enc =
+  let open Data_encoding in
+  let rec unfold = function
+    | Ex_stack_ty (Item_t (ty, rest, annot)) ->
+        (Ex_ty ty, annot) :: unfold (Ex_stack_ty rest)
+    | Ex_stack_ty Empty_t -> [] in
+  let rec fold = function
+    | (Ex_ty ty, annot) :: rest ->
+        let Ex_stack_ty rest = fold rest in
+        Ex_stack_ty (Item_t (ty, rest, annot))
+    | [] -> Ex_stack_ty Empty_t in
+  conv unfold fold
+    (list
+       (obj2
+          (req "type" ex_ty_enc)
+          (opt "annot" var_annot_enc)))
+
 (* main registration *)
 let () =
   let open Data_encoding in
@@ -65,19 +100,6 @@ let () =
                   "bytes", Bytes_kind ;
                   "primitiveApplication", Prim_kind ;
                   "sequence", Seq_kind ] in
-  let var_annot_enc =
-    conv (function `Var_annot x -> x)  (function x -> `Var_annot x) string in
-  let ex_stack_ty_enc =
-    let rec unfold = function
-      | Ex_stack_ty (Item_t (ty, rest, annot)) ->
-          (Ex_ty ty, annot) :: unfold (Ex_stack_ty rest)
-      | Ex_stack_ty Empty_t -> [] in
-    let rec fold = function
-      | (Ex_ty ty, annot) :: rest ->
-          let Ex_stack_ty rest = fold rest in
-          Ex_stack_ty (Item_t (ty, rest, annot))
-      | [] -> Ex_stack_ty Empty_t in
-    conv unfold fold (list (tup2 ex_ty_enc (option var_annot_enc))) in
   (* -- Structure errors ---------------------- *)
   (* Invalid arity *)
   register_error_kind