Micheline: versioned serializer for retrocompatibility

src/lib_micheline/micheline.ml

@@ -141,7 +141,9 @@ let rec map_node fl fp = function
   | Prim (loc, name, seq, annots) ->
       Prim (fl loc, fp name, List.map (map_node fl fp) seq, annots)
 
-let canonical_encoding ~variant prim_encoding =
+type semantics = V0 | V1
+
+let internal_canonical_encoding ~semantics ~variant prim_encoding =
   let open Data_encoding in
   let int_encoding =
     obj1 (req "int" z) in
@@ -171,7 +173,7 @@ let canonical_encoding ~variant prim_encoding =
       (fun args -> Seq (0, args)) in
   let annots_encoding =
     let split s =
-      if s = "" then []
+      if s = "" && semantics <> V0 then []
       else
         let annots = String.split_on_char ' ' s in
         List.iter (fun a ->
@@ -270,6 +272,13 @@ let canonical_encoding ~variant prim_encoding =
     (fun node -> strip_locations node)
     node_encoding
 
+let canonical_encoding ~variant prim_encoding =
+  internal_canonical_encoding ~semantics:V1 ~variant prim_encoding
+let canonical_encoding_v1 ~variant prim_encoding =
+  internal_canonical_encoding ~semantics:V1 ~variant prim_encoding
+let canonical_encoding_v0 ~variant prim_encoding =
+  internal_canonical_encoding ~semantics:V0 ~variant prim_encoding
+
 let table_encoding ~variant location_encoding prim_encoding =
   let open Data_encoding in
   conv

src/lib_micheline/micheline.mli

@@ -75,6 +75,13 @@ val canonical_location_encoding : canonical_location Data_encoding.encoding
     different primitive encodings are used in the same schema. *)
 val canonical_encoding : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
 
+(** Old version of {!canonical_encoding} for retrocompatibility.
+    Do not use in new code. *)
+val canonical_encoding_v0 : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+
+(** Alias for {!canonical_encoding}. *)
+val canonical_encoding_v1 : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+
 (** Compute the canonical form of an expression.
     Drops the concrete locations completely. *)
 val strip_locations : (_, 'p) node -> 'p canonical

src/lib_protocol_environment/sigs/v1/micheline.mli

@@ -38,9 +38,11 @@ type canonical_location = int
 val root : 'p canonical -> (canonical_location, 'p) node
 val canonical_location_encoding : canonical_location Data_encoding.encoding
 val canonical_encoding : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+val canonical_encoding_v1 : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding
+(*
 val erased_encoding : variant:string -> 'l -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding
 val table_encoding : variant:string -> 'l Data_encoding.encoding -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding
-
+*)
 val location : ('l, 'p) node -> 'l
 val annotations : ('l, 'p) node -> string list
 

src/lib_protocol_environment/tezos_protocol_environment.ml

@@ -600,7 +600,11 @@ module Make (Context : CONTEXT) = struct
         | Ok v -> Lwt.return (Ok (Some v))
 
     end
-    module Micheline = Micheline
+    module Micheline = struct
+      include Micheline
+      let canonical_encoding_v1 = canonical_encoding_v1
+      let canonical_encoding = canonical_encoding_v0
+    end
     module Logging = Logging.Make(Param)
 
     module Updater = struct

src/proto_alpha/lib_protocol/src/script_repr.ml

@@ -35,8 +35,10 @@ type lazy_expr = expr Data_encoding.lazy_t
 
 type node = (location, Michelson_v1_primitives.prim) Micheline.node
 
+
+
 let expr_encoding =
-  Micheline.canonical_encoding
+  Micheline.canonical_encoding_v1
     ~variant:"michelson_v1"
     Michelson_v1_primitives.prim_encoding