From bd3191059be12a1faf1ce304ac616c31b294552d Mon Sep 17 00:00:00 2001
From: Benjamin Canou <benjamin@canou.fr>
Date: Wed, 21 Feb 2018 11:43:55 +0100
Subject: [PATCH] Data_encoding: make more combinators transparent to
 is_tup/is_obj

---
 src/lib_data_encoding/data_encoding.ml | 70 +++++++++++++++-----------
 1 file changed, 42 insertions(+), 28 deletions(-)

diff --git a/src/lib_data_encoding/data_encoding.ml b/src/lib_data_encoding/data_encoding.ml
index bf805463b..9f55cc972 100644
--- a/src/lib_data_encoding/data_encoding.ml
+++ b/src/lib_data_encoding/data_encoding.ml
@@ -162,7 +162,8 @@ type 'a desc =
             encoding : 'a t } -> 'a desc
   | Splitted :
       { encoding : 'a t ;
-        json_encoding : 'a Json_encoding.encoding } -> 'a desc
+        json_encoding : 'a Json_encoding.encoding ;
+        is_obj : bool ; is_tup : bool } -> 'a desc
   | Dynamic_size : 'a t -> 'a desc
   | Delayed : (unit -> 'a t) -> 'a desc
 
@@ -595,11 +596,48 @@ module Encoding = struct
     Dft (n, describe ?title ?description t, d)
 
   let raw_splitted ~json ~binary =
-    make @@ Splitted { encoding = binary ; json_encoding = json }
+    make @@ Splitted { encoding = binary ;
+                       json_encoding = json ;
+                       is_obj = false ;
+                       is_tup = false }
+
+  let rec is_obj : type a. a t -> bool = fun e ->
+    match e.encoding with
+    | Obj _ -> true
+    | Objs _ (* by construction *) -> true
+    | Conv { encoding = e } -> is_obj e
+    | Dynamic_size e  -> is_obj e
+    | Union (_,_,cases) ->
+        List.for_all (fun (Case { encoding = e }) -> is_obj e) cases
+    | Empty -> true
+    | Ignore -> true
+    | Mu (_,_,self) -> is_obj (self e)
+    | Splitted { is_obj } -> is_obj
+    | Delayed f -> is_obj (f ())
+    | Describe { encoding } -> is_obj encoding
+    | Def { encoding } -> is_obj encoding
+    | _ -> false
+
+  let rec is_tup : type a. a t -> bool = fun e ->
+    match e.encoding with
+    | Tup _ -> true
+    | Tups _ (* by construction *) -> true
+    | Conv { encoding = e } -> is_tup e
+    | Dynamic_size e  -> is_tup e
+    | Union (_,_,cases) ->
+        List.for_all (function Case { encoding = e} -> is_tup e) cases
+    | Mu (_,_,self) -> is_tup (self e)
+    | Splitted { is_tup } -> is_tup
+    | Delayed f -> is_tup (f ())
+    | Describe { encoding } -> is_tup encoding
+    | Def { encoding } -> is_tup encoding
+    | _ -> false
 
   let splitted ~json ~binary =
-    let json = Json.convert json in
-    raw_splitted ~binary ~json
+    make @@ Splitted { encoding = binary ;
+                       json_encoding = Json.convert json ;
+                       is_obj = is_obj json ;
+                       is_tup = is_tup json }
 
   let json =
     let binary =
@@ -655,30 +693,6 @@ module Encoding = struct
   let obj10 f10 f9 f8 f7 f6 f5 f4 f3 f2 f1 =
     raw_merge_objs (obj2 f10 f9) (obj8 f8 f7 f6 f5 f4 f3 f2 f1)
 
-  let rec is_obj : type a. a t -> bool = fun e ->
-    match e.encoding with
-    | Obj _ -> true
-    | Objs _ (* by construction *) -> true
-    | Conv { encoding = e } -> is_obj e
-    | Dynamic_size e  -> is_obj e
-    | Union (_,_,cases) ->
-        List.for_all (fun (Case { encoding = e }) -> is_obj e) cases
-    | Empty -> true
-    | Ignore -> true
-    | Mu (_,_,self) -> is_obj (self e)
-    | _ -> false
-
-  let rec is_tup : type a. a t -> bool = fun e ->
-    match e.encoding with
-    | Tup _ -> true
-    | Tups _ (* by construction *) -> true
-    | Conv { encoding = e } -> is_tup e
-    | Dynamic_size e  -> is_tup e
-    | Union (_,_,cases) ->
-        List.for_all (function Case { encoding = e} -> is_tup e) cases
-    | Mu (_,_,self) -> is_tup (self e)
-    | _ -> false
-
   let merge_objs o1 o2 =
     if is_obj o1 && is_obj o2 then
       raw_merge_objs o1 o2