Data_encoding: add lazy_encoding combinator

src/lib_data_encoding/data_encoding.ml

@@ -60,6 +60,47 @@ struct
 
   end
 
+  type 'a lazy_state =
+    | Value of 'a
+    | Bytes of MBytes.t
+    | Both of MBytes.t * 'a
+  type 'a lazy_t =
+    { mutable state : 'a lazy_state ;
+      encoding : 'a t }
+  let force_decode le =
+    match le.state with
+    | Value value -> Some value
+    | Both (_, value) -> Some value
+    | Bytes bytes ->
+        match Binary_reader.of_bytes le.encoding bytes with
+        | Some expr -> le.state <- Both (bytes, expr) ; Some expr
+        | None -> None
+  let force_bytes le =
+    match le.state with
+    | Bytes bytes -> bytes
+    | Both (bytes, _) -> bytes
+    | Value value ->
+        let bytes = Binary_writer.to_bytes_exn le.encoding value in
+        le.state <- Both (bytes, value) ;
+        bytes
+  let lazy_encoding encoding =
+    let binary =
+      Encoding.conv
+        force_bytes
+        (fun bytes -> { state = Bytes bytes ; encoding })
+        Encoding.bytes in
+    let json =
+      Encoding.conv
+        (fun le ->
+           match force_decode le with
+           | Some r -> r
+           | None -> raise Exit)
+        (fun value -> { state = Value value ; encoding })
+        encoding in
+    splitted ~json ~binary
+  let make_lazy encoding value =
+    { encoding ; state = Value value }
+
 end
 
 include Encoding

src/lib_data_encoding/data_encoding.mli

@@ -459,6 +459,25 @@ module Encoding: sig
   (** Give a name to an encoding. *)
   val def : string -> 'a encoding -> 'a encoding
 
+  (** See {!lazy_encoding} below.*)
+  type 'a lazy_t
+
+  (** Combinator to have a part of the binary encoding lazily deserialized.
+      This is transparent on the JSON side. *)
+  val lazy_encoding : 'a encoding -> 'a lazy_t encoding
+
+  (** Force the decoding (memoized for later calls), and return the
+      value if successful. *)
+  val force_decode : 'a lazy_t -> 'a option
+
+  (** Obtain the bytes without actually deserializing.  Will serialize
+      and memoize the result if the value is not the result of a lazy
+      deserialization. *)
+  val force_bytes : 'a lazy_t -> MBytes.t
+
+  (** Make a lazy value from an immediate one. *)
+  val make_lazy : 'a encoding -> 'a -> 'a lazy_t
+
 end
 
 include module type of Encoding with type 'a t = 'a Encoding.t

src/lib_protocol_environment/sigs/v1/data_encoding.mli

@@ -184,6 +184,13 @@ val conv :
 
 val mu : string -> ('a encoding -> 'a encoding) -> 'a encoding
 
+type 'a lazy_t
+
+val lazy_encoding : 'a encoding -> 'a lazy_t encoding
+val force_decode : 'a lazy_t -> 'a option
+val force_bytes : 'a lazy_t -> MBytes.t
+val make_lazy : 'a encoding -> 'a -> 'a lazy_t
+
 module Json : sig
 
   val schema : 'a encoding -> json_schema

src/lib_protocol_environment/tezos_protocol_environment.ml

@@ -109,6 +109,7 @@ module Make (Context : CONTEXT) = struct
     include Tezos_protocol_environment_sigs.V1.T
       with type Format.formatter = Format.formatter
        and type 'a Data_encoding.t = 'a Data_encoding.t
+       and type 'a Data_encoding.lazy_t = 'a Data_encoding.lazy_t
        and type 'a Lwt.t = 'a Lwt.t
        and type ('a, 'b) Pervasives.result = ('a, 'b) result
        and type Block_hash.t = Block_hash.t

src/lib_protocol_environment/tezos_protocol_environment.mli

@@ -102,6 +102,7 @@ module Make (Context : CONTEXT) : sig
     include Tezos_protocol_environment_sigs.V1.T
       with type Format.formatter = Format.formatter
        and type 'a Data_encoding.t = 'a Data_encoding.t
+       and type 'a Data_encoding.lazy_t = 'a Data_encoding.lazy_t
        and type 'a Lwt.t = 'a Lwt.t
        and type ('a, 'b) Pervasives.result = ('a, 'b) result
        and type Block_hash.t = Block_hash.t