made Conv GADTs private, and simplified some internal code

conv.ml

@@ -38,13 +38,13 @@ let __error msg =
 
 module Sink = struct
   (** A specific sink that requires a given shape to produce
-   * a value of type 'a *)
+      a value of type 'a *)
   type 'a t =
-    | Unit : 'a -> 'a t
+    | Unit : unit t
-    | Bool : (bool -> 'a) -> 'a t
+    | Bool : bool t
-    | Float : (float -> 'a) -> 'a t
+    | Float : float t
-    | Int : (int -> 'a) -> 'a t
+    | Int : int t
-    | String : (string -> 'a) -> 'a t
+    | String : string t
     | List : (('b t -> 'b list) -> 'a) -> 'a t
     | Record : 'a record_sink -> 'a t
     | Tuple : 'a hlist -> 'a t
@@ -61,11 +61,11 @@ module Sink = struct
     | HNil : 't -> 't hlist
 
   let rec __expected : type a. a t -> string = function
-    | Unit _ -> "unit"
+    | Unit -> "unit"
-    | Bool _ -> "bool"
+    | Bool -> "bool"
-    | Float _ -> "float"
+    | Float -> "float"
-    | Int _ -> "int"
+    | Int -> "int"
-    | String _ -> "string"
+    | String -> "string"
     | List _ -> "list"
     | Record _ -> "record"
     | Tuple _ -> "tuple"
@@ -73,13 +73,11 @@ module Sink = struct
     | Map (sink', _) -> __expected sink'
     | (Fix f) as sink -> __expected (f sink)
 
-  let __id x = x
+  let unit_ = Unit
-
+  let bool_ = Bool
-  let unit_ = Unit ()
+  let float_ = Float
-  let bool_ = Bool __id
+  let int_ = Int
-  let float_ = Float __id
+  let string_ = String
-  let int_ = Int __id
-  let string_ = String __id
   let list_ e =
     List (fun k -> let l = k e in l)
 
@@ -145,12 +143,12 @@ module Sink = struct
     | ExpectList
     | ExpectSum
 
-  let rec expected : 'a. 'a t -> expected = function
+  let rec expected : type a. a t -> expected = function
-    | Unit _ -> ExpectUnit
+    | Unit -> ExpectUnit
-    | Bool _ -> ExpectBool
+    | Bool -> ExpectBool
-    | Int _ -> ExpectInt
+    | Int -> ExpectInt
-    | Float _ -> ExpectFloat
+    | Float -> ExpectFloat
-    | String _ -> ExpectString
+    | String -> ExpectString
     | Record _ -> ExpectRecord
     | Tuple _ -> ExpectTuple
     | Sum _ -> ExpectSum
@@ -255,53 +253,53 @@ module Source = struct
       __error "record field %s not found in source" name
 
   class virtual ['a] universal = object(self)
-    method private unit_ : 'b. 'b Sink.t -> 'b
+    method private unit_ : type b. b Sink.t -> b
       = fun sink -> match sink with
-      | Sink.Unit u -> u
+      | Sink.Unit -> ()
-      | Sink.Int f -> f 0
+      | Sink.Int -> 0
       | Sink.Map (sink', f) -> f (self#unit_ sink')
       | Sink.Fix f -> self#unit_ (f sink)
       | _ -> __error "get Unit, but expected %s" (Sink.__expected sink)
 
-    method private bool_ : 'b. 'b Sink.t -> bool -> 'b
+    method private bool_ : type b. b Sink.t -> bool -> b
       = fun sink b -> match sink with
-      | Sink.Bool f -> f b
+      | Sink.Bool -> b
-      | Sink.Int f -> f (if b then 1 else 0)
+      | Sink.Int -> if b then 1 else 0
-      | Sink.String f -> f (string_of_bool b)
+      | Sink.String -> string_of_bool b
       | Sink.Map (sink', f) -> f (self#bool_ sink' b)
       | Sink.Fix f -> self#bool_ (f sink) b
       | _ -> __error "get Bool, but expected %s" (Sink.__expected sink)
 
-    method private float_ : 'b. 'b Sink.t -> float -> 'b
+    method private float_ : type b. b Sink.t -> float -> b
       = fun sink x -> match sink with
-      | Sink.Float f -> f x
+      | Sink.Float -> x
-      | Sink.String f -> f (string_of_float x)
+      | Sink.String -> string_of_float x
       | Sink.Map (sink', f) -> f (self#float_ sink' x)
       | Sink.Fix f -> self#float_ (f sink) x
       | _ -> __error "get Float, but expected %s" (Sink.__expected sink)
 
-    method private int_ : 'b. 'b Sink.t -> int -> 'b
+    method private int_ : type b. b Sink.t -> int -> b
       = fun sink i -> match sink with
-      | Sink.Int f -> f i
+      | Sink.Int -> i
-      | Sink.Bool f -> f (i <> 0)
+      | Sink.Bool -> i <> 0
-      | Sink.String f -> f (string_of_int i)
+      | Sink.String -> string_of_int i
       | Sink.Map (sink', f) -> f (self#int_ sink' i)
       | Sink.Fix f -> self#int_ (f sink) i
       | _ -> __error "get Int, but expected %s" (Sink.__expected sink)
 
-    method private string_ : 'b. 'b Sink.t -> string -> 'b
+    method private string_ : type b. b Sink.t -> string -> b
       = fun sink s -> match sink with
-      | Sink.String f -> f s
+      | Sink.String -> s
-      | Sink.Int f ->
+      | Sink.Int ->
-        begin try f (int_of_string s)
+        begin try int_of_string s
         with Invalid_argument _ -> __error "get String, but expected Int"
         end
-      | Sink.Bool f ->
+      | Sink.Bool ->
-        begin try f (bool_of_string s)
+        begin try bool_of_string s
         with Invalid_argument _ -> __error "get String, but expected Bool"
         end
-      | Sink.Float f ->
+      | Sink.Float ->
-        begin try f (float_of_string s)
+        begin try float_of_string s
         with Invalid_argument _ -> __error "get String, but expected Float"
         end
       | Sink.Map (sink', f) -> f (self#string_ sink' s)

conv.mli

@@ -33,18 +33,7 @@ A sink is used to traverse values of some type 'a *)
 module Sink : sig
   (** A specific sink that requires a given shape to produce
      a value of type 'a *)
-  type 'a t = private
+  type 'a t
-    | Unit : 'a -> 'a t
-    | Bool : (bool -> 'a) -> 'a t
-    | Float : (float -> 'a) -> 'a t
-    | Int : (int -> 'a) -> 'a t
-    | String : (string -> 'a) -> 'a t
-    | List : (('b t -> 'b list) -> 'a) -> 'a t
-    | Record : 'a record_sink -> 'a t
-    | Tuple : 'a hlist -> 'a t
-    | Sum : (string -> 'a hlist) -> 'a t
-    | Map : 'a t * ('a -> 'b) -> 'b t
-    | Fix : ('a t -> 'a t) -> 'a t
 
   and 'r record_sink =
     | RecordField : string * 'a t * ('a -> 'r record_sink) -> 'r record_sink
@@ -117,18 +106,7 @@ end
 A source is used to build values of some type 'a *)
 module Source : sig
   (** A specific source that follows the shape of the type 'a *)
-  type 'a t = private
+  type 'a t
-    | Unit : unit t
-    | Bool : bool t
-    | Float : float t
-    | Int : int t
-    | String : string t
-    | List : 'a t -> 'a list t
-    | Record : 'a record_src -> 'a t
-    | Tuple : 'a tuple_src -> 'a t
-    | Sum : ('a -> string * sum_src) -> 'a t
-    | Map : 'a t * ('b -> 'a) -> 'b t
-    | Fix : ('a t -> 'a t) -> 'a t
 
   and 'r record_src =
     | RecordField : string * ('r -> 'a) * 'a t * 'r record_src -> 'r record_src