Dyn: simplify API introducing an Easy submodule

Now the casual Dyn user does not need to be a GADT guru

3 files changed, 55 insertions, 10 deletions

diff --git a/lib/dyn.ml b/lib/dyn.ml
index 676467e464..65d1442ac6 100644
--- a/lib/dyn.ml
+++ b/lib/dyn.ml
@@ -11,7 +11,7 @@ sig
   type 'a t
 end
 
-module type S =
+module type PreS =
 sig
 type 'a tag
 type t = Dyn : 'a tag * 'a -> t
@@ -44,10 +44,23 @@ sig
 end
 
 val dump : unit -> (int * string) list
+
 end
 
-module Make(M : CSig.EmptyS) =
-struct
+module type S =
+sig
+  include PreS
+
+  module Easy : sig
+    val make_dyn : string -> ('a -> t) * (t -> 'a)
+    val inj : 'a -> 'a tag -> t
+    val prj : t -> 'a tag -> 'a option
+  end
+
+end
+
+module Make(M : CSig.EmptyS) = struct
+module Self : PreS = struct
 (* Dynamics, programmed with DANGER !!! *)
 
 type 'a tag = int
@@ -108,3 +121,28 @@ let fold f m accu = Int.Map.fold (fun k v accu -> f (Any (k, v)) accu) m accu
 end
 
 end
+include Self
+
+module Easy = struct
+(* now tags are opaque, we can do the trick *)
+let make_dyn (s : string) =
+ (fun (type a) (tag : a tag) ->
+  let infun : (a -> t) = fun x -> Dyn (tag, x) in
+  let outfun : (t -> a) = fun (Dyn (t, x)) ->
+    match eq tag t with
+    | None -> assert false
+    | Some CSig.Refl -> x
+  in
+  (infun, outfun))
+ (create s)
+
+let inj x tag = Dyn(tag,x)
+let prj : type a. t -> a tag -> a option =
+    fun (Dyn(tag',x)) tag ->
+    match eq tag tag' with
+    | None -> None
+    | Some CSig.Refl -> Some x
+end
+
+end
+
diff --git a/lib/dyn.mli b/lib/dyn.mli
index c94fa764ba..448b11a18f 100644
--- a/lib/dyn.mli
+++ b/lib/dyn.mli
@@ -6,7 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** Dynamics. Use with extreme care. Not for kids. *)
+(** Dynamically typed values *)
+
 module type TParam =
 sig
   type 'a t
@@ -46,6 +47,16 @@ end
 
 val dump : unit -> (int * string) list
 
+module Easy : sig
+
+  (* To create a dynamic type on the fly *)
+  val make_dyn : string -> ('a -> t) * (t -> 'a)
+
+  (* For types declared with the [create] function above *)
+  val inj : 'a -> 'a tag -> t
+  val prj : t -> 'a tag -> 'a option
+end
+
 end
 
 (** FIXME: use OCaml 4.02 generative functors when available *)
diff --git a/lib/pp.ml b/lib/pp.ml
index c7cf9b8d0e..e4c78ba73f 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -57,12 +57,8 @@ module Dyn = Dyn.Make(struct end)
 type t = Dyn.t
 type 'a key = 'a Dyn.tag
 let create = Dyn.create
-let inj x k = Dyn.Dyn (k, x)
-let prj : type a. t -> a key -> a option = fun dyn k ->
-  let Dyn.Dyn (k', x) = dyn in
-  match Dyn.eq k k' with
-  | None -> None
-  | Some CSig.Refl -> Some x
+let inj = Dyn.Easy.inj
+let prj = Dyn.Easy.prj
 
 end