diff --git a/src/lib_micheline/micheline.ml b/src/lib_micheline/micheline.ml index 2f073ec72..ab0b28453 100644 --- a/src/lib_micheline/micheline.ml +++ b/src/lib_micheline/micheline.ml @@ -20,7 +20,7 @@ type 'p canonical = Canonical of (canonical_location, 'p) node let canonical_location_encoding = let open Data_encoding in def - "canonicalExpressionLocation" @@ + "micheline.location" @@ describe ~title: "Canonical location in a Micheline expression" @@ -113,7 +113,7 @@ let rec map_node fl fp = function | Prim (loc, name, seq, annot) -> Prim (fl loc, fp name, List.map (map_node fl fp) seq, annot) -let canonical_encoding prim_encoding = +let canonical_encoding ~variant prim_encoding = let open Data_encoding in let int_encoding = obj1 (req "int" string) in @@ -139,9 +139,9 @@ let canonical_encoding prim_encoding = (function Prim (_, prim, args, annot) -> Some (prim, args, annot) | _ -> None) (fun (prim, args, annot) -> Prim (0, prim, args, annot)) in - let node_encoding = mu "tezosScriptExpression" (fun expr_encoding -> + let node_encoding = mu ("micheline." ^ variant ^ ".expression") (fun expr_encoding -> describe - ~title: "Script expression (data, type or code)" @@ + ~title: ("Micheline expression (" ^ variant ^ " variant)") @@ splitted ~json:(union ~tag_size:`Uint8 [ int_encoding Json_only; @@ -210,7 +210,7 @@ let canonical_encoding prim_encoding = (fun node -> strip_locations node) node_encoding -let table_encoding location_encoding prim_encoding = +let table_encoding ~variant location_encoding prim_encoding = let open Data_encoding in conv (fun node -> @@ -221,12 +221,12 @@ let table_encoding location_encoding prim_encoding = let table = Array.of_list table in inject_locations (fun i -> table.(i)) canon) (obj2 - (req "expression" (canonical_encoding prim_encoding)) + (req "expression" (canonical_encoding ~variant prim_encoding)) (req "locations" (list location_encoding))) -let erased_encoding default_location prim_encoding = +let erased_encoding ~variant default_location prim_encoding = let open Data_encoding in conv (fun node -> strip_locations node) (fun canon -> inject_locations (fun _ -> default_location) canon) - (canonical_encoding prim_encoding) + (canonical_encoding ~variant prim_encoding) diff --git a/src/lib_micheline/micheline.mli b/src/lib_micheline/micheline.mli index 291dbe634..93e7862e6 100644 --- a/src/lib_micheline/micheline.mli +++ b/src/lib_micheline/micheline.mli @@ -17,15 +17,17 @@ type ('l, 'p) node = | Seq of 'l * ('l, 'p) node list * string option (** Encoding for expressions, as their {!canonical} encoding. - Locations are stored in a side table. *) -val table_encoding : + Locations are stored in a side table. + See {!canonical_encoding} for the [variant] parameter. *) +val table_encoding : variant:string -> 'l Data_encoding.encoding -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding (** Encoding for expressions, as their {!canonical} encoding. Locations are erased when serialized, and restored to a provided - default value when deserialized. *) -val erased_encoding : + default value when deserialized. + See {!canonical_encoding} for the [variant] parameter. *) +val erased_encoding : variant:string -> 'l -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding (** Extract the location of the node. *) @@ -48,8 +50,11 @@ type canonical_location = int (** Encoding for canonical integer locations. *) val canonical_location_encoding : canonical_location Data_encoding.encoding -(** Encoding for expressions in canonical form. *) -val canonical_encoding : 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding +(** Encoding for expressions in canonical form. The first parameter + is a name used to produce named definitions in the schemas. Make + sure to use different names if two expression variants with + different primitive encodings are used in the same schema. *) +val canonical_encoding : variant:string -> 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding (** Compute the canonical form of an expression. Drops the concrete locations completely. *) diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index b1fd2d90c..6000af44a 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -340,7 +340,8 @@ let tokenize source = type node = (location, string) Micheline.node -let node_encoding = Micheline.table_encoding location_encoding Data_encoding.string +let node_encoding = + Micheline.table_encoding ~variant:"generic" location_encoding Data_encoding.string (* Beginning of a sequence of consecutive primitives *) let min_point : node list -> point = function @@ -766,7 +767,7 @@ let () = or sequence." ~pp:(fun ppf node -> Format.fprintf ppf "%a, misaligned expression" print_location (location node)) - Data_encoding.(obj1 (req "expression" node_encoding)) + Data_encoding.(obj1 (req "expression" node_encoding)) (function Misaligned node -> Some node | _ -> None) (fun node -> Misaligned node) ; register_error_kind `Permanent diff --git a/src/lib_protocol_environment/sigs/v1/micheline.mli b/src/lib_protocol_environment/sigs/v1/micheline.mli index 50d301d1c..d95f7865e 100644 --- a/src/lib_protocol_environment/sigs/v1/micheline.mli +++ b/src/lib_protocol_environment/sigs/v1/micheline.mli @@ -18,9 +18,9 @@ type canonical_location = int val root : 'p canonical -> (canonical_location, 'p) node val canonical_location_encoding : canonical_location Data_encoding.encoding -val canonical_encoding : 'l Data_encoding.encoding -> 'l canonical Data_encoding.encoding -val erased_encoding : 'l -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding -val table_encoding : 'l Data_encoding.encoding -> 'p Data_encoding.encoding -> ('l, 'p) node Data_encoding.encoding +val canonical_encoding : 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 annotation : ('l, 'p) node -> string option diff --git a/src/proto_alpha/lib_protocol/src/script_repr.ml b/src/proto_alpha/lib_protocol/src/script_repr.ml index adffb38c5..3650aea60 100644 --- a/src/proto_alpha/lib_protocol/src/script_repr.ml +++ b/src/proto_alpha/lib_protocol/src/script_repr.ml @@ -15,7 +15,10 @@ type expr = Michelson_v1_primitives.prim Micheline.canonical type node = (location, Michelson_v1_primitives.prim) Micheline.node -let expr_encoding = Micheline.canonical_encoding Michelson_v1_primitives.prim_encoding +let expr_encoding = + Micheline.canonical_encoding + ~variant:"michelson_v1" + Michelson_v1_primitives.prim_encoding type t = { code : expr ; storage : expr }