From 3d430a47d91bc541dcd6576063471c44fc457bf9 Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot
Date: Thu, 20 Aug 2020 17:25:35 +0200
Subject: Add a heterogeneous map function over Dyn.Map.

---
 clib/dyn.ml  | 17 +++++++++++++++++
 clib/dyn.mli |  6 ++++++
 2 files changed, 23 insertions(+)

diff --git a/clib/dyn.ml b/clib/dyn.ml
index 1ddbe5a7c2..8ef90a366e 100644
--- a/clib/dyn.ml
+++ b/clib/dyn.ml
@@ -49,6 +49,13 @@ sig
 
   module Map(Value : ValueS) :
     MapS with type 'a key = 'a tag and type 'a value = 'a Value.t
+
+  module HMap (V1 : ValueS)(V2 : ValueS) :
+    sig
+      type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t }
+      val map : map -> Map(V1).t -> Map(V2).t
+    end
+
 end
 
 module type S =
@@ -132,6 +139,16 @@ module Self : PreS = struct
     let iter f m = Int.Map.iter (fun k v -> f (Any (k, v))) m
     let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu
   end
+
+  module HMap (V1 : ValueS) (V2 : ValueS) =
+  struct
+    type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t }
+
+    let map (f : map) (m : Map(V1).t) : Map(V2).t =
+      Int.Map.mapi f.map m
+
+  end
+
 end
 include Self
 
diff --git a/clib/dyn.mli b/clib/dyn.mli
index 926d0f3135..4fd33b5242 100644
--- a/clib/dyn.mli
+++ b/clib/dyn.mli
@@ -75,6 +75,12 @@ sig
     MapS with type 'a key = 'a tag and type 'a value = 'a Value.t
   (** Map from type tags to values parameterized by the tag type *)
 
+  module HMap (V1 : ValueS)(V2 : ValueS) :
+    sig
+      type map = { map : 'a. 'a tag -> 'a V1.t -> 'a V2.t }
+      val map : map -> Map(V1).t -> Map(V2).t
+    end
+
   module Easy : sig
     (* To create a dynamic type on the fly *)
     val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag
-- 
cgit v1.2.3