get rid of objects

conv.ml

@@ -157,16 +157,18 @@ module Sink = struct
     | Map (sink', _) -> expected sink'
 
   (** Universal sink, such as a serialization format *)
-  class type ['a] universal = object
+  module Universal = struct
-    method unit_ : 'a
+    type 'a t = {
-    method bool_ : bool -> 'a
+      unit_ : 'a;
-    method float_ : float -> 'a
+      bool_ : bool -> 'a;
-    method int_ : int -> 'a
+      float_ : float -> 'a;
-    method string_ : string -> 'a
+      int_ : int -> 'a;
-    method list_ : 'a list -> 'a
+      string_ : string -> 'a;
-    method record : (string*'a) list -> 'a
+      list_ : 'a list -> 'a;
-    method tuple : 'a list -> 'a
+      record : (string*'a) list -> 'a;
-    method sum : string -> 'a list -> 'a
+      tuple : 'a list -> 'a;
+      sum : string -> 'a list -> 'a;
+    }
   end
 end
 
@@ -252,43 +254,47 @@ module Source = struct
     with Not_found ->
       __error "record field %s not found in source" name
 
-  class virtual ['a] universal = object(self)
+  module Universal = struct
-    method private unit_ : type b. b Sink.t -> b
+    type 'a t = {
-      = fun sink -> match sink with
+      visit : 'b. 'b Sink.t -> 'a -> 'b;
+    }
+
+    let rec unit_ : type b. b Sink.t -> b
+    = fun sink -> match sink with
       | Sink.Unit -> ()
       | Sink.Int -> 0
-      | Sink.Map (sink', f) -> f (self#unit_ sink')
+      | Sink.Map (sink', f) -> f (unit_ sink')
-      | Sink.Fix f -> self#unit_ (f sink)
+      | Sink.Fix f -> unit_ (f sink)
       | _ -> __error "get Unit, but expected %s" (Sink.__expected sink)
 
-    method private bool_ : type b. b Sink.t -> bool -> b
+    let rec bool_ : type b. b Sink.t -> bool -> b
-      = fun sink b -> match sink with
+    = fun sink b -> match sink with
       | Sink.Bool -> b
       | Sink.Int -> if b then 1 else 0
       | Sink.String -> string_of_bool b
-      | Sink.Map (sink', f) -> f (self#bool_ sink' b)
+      | Sink.Map (sink', f) -> f (bool_ sink' b)
-      | Sink.Fix f -> self#bool_ (f sink) b
+      | Sink.Fix f -> bool_ (f sink) b
       | _ -> __error "get Bool, but expected %s" (Sink.__expected sink)
 
-    method private float_ : type b. b Sink.t -> float -> b
+    let rec float_ : type b. b Sink.t -> float -> b
-      = fun sink x -> match sink with
+    = fun sink x -> match sink with
       | Sink.Float -> x
       | Sink.String -> string_of_float x
-      | Sink.Map (sink', f) -> f (self#float_ sink' x)
+      | Sink.Map (sink', f) -> f (float_ sink' x)
-      | Sink.Fix f -> self#float_ (f sink) x
+      | Sink.Fix f -> float_ (f sink) x
       | _ -> __error "get Float, but expected %s" (Sink.__expected sink)
 
-    method private int_ : type b. b Sink.t -> int -> b
+    let rec int_ : type b. b Sink.t -> int -> b
-      = fun sink i -> match sink with
+    = fun sink i -> match sink with
       | Sink.Int -> i
       | Sink.Bool -> i <> 0
       | Sink.String -> string_of_int i
-      | Sink.Map (sink', f) -> f (self#int_ sink' i)
+      | Sink.Map (sink', f) -> f (int_ sink' i)
-      | Sink.Fix f -> self#int_ (f sink) i
+      | Sink.Fix f -> int_ (f sink) i
       | _ -> __error "get Int, but expected %s" (Sink.__expected sink)
 
-    method private string_ : type b. b Sink.t -> string -> b
+    let rec string_ : type b. b Sink.t -> string -> b
-      = fun sink s -> match sink with
+    = fun sink s -> match sink with
       | Sink.String -> s
       | Sink.Int ->
         begin try int_of_string s
@@ -302,84 +308,82 @@ module Source = struct
         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)
+      | Sink.Map (sink', f) -> f (string_ sink' s)
-      | Sink.Fix f -> self#string_ (f sink) s
+      | Sink.Fix f -> string_ (f sink) s
-      | Sink.Sum _ -> self#sum sink s []
       | _ -> __error "get String, but expected %s" (Sink.__expected sink)
 
-    method private list_ : 'b. 'b Sink.t -> 'a list -> 'b
+    let rec list_ : type b. src:'a t -> b Sink.t -> 'a list -> b
-      = fun sink l -> match sink with
+    = fun ~src sink l -> match sink with
       | Sink.List f ->
-        f (fun sink' -> List.map (self#visit sink') l)
+        f (fun sink' -> List.map (src.visit sink') l)
-      | Sink.Tuple _ -> self#tuple sink l
+      | Sink.Tuple _ -> tuple ~src sink l
-      | Sink.Map (sink', f) -> f (self#list_ sink' l)
+      | Sink.Map (sink', f) -> f (list_ ~src sink' l)
-      | Sink.Fix f -> self#list_ (f sink) l
+      | Sink.Fix f -> list_ ~src (f sink) l
       | _ -> __error "get List, but expected %s" (Sink.__expected sink)
 
-    method private record : 'b. 'b Sink.t -> (string*'a) list -> 'b
+    and record : type b. src:'a t -> b Sink.t -> (string*'a) list -> b
-      = fun sink l -> match sink with
+    = fun ~src sink l -> match sink with
       | Sink.Record r ->
         (* fold over the expected record fields *)
-        let rec build_record : 'r. 'r Sink.record_sink -> 'r
+        let rec build_record 
         = function
           | Sink.RecordStop x -> x
           | Sink.RecordField (name, sink', cont) ->
               let src_field = _get_field l name in
-              let sink_field = self#visit sink' src_field in
+              let sink_field = src.visit sink' src_field in
               build_record (cont sink_field)
         in build_record r
-      | Sink.Map (sink', f) -> f (self#record sink' l)
+      | Sink.Map (sink', f) -> f (record ~src sink' l)
-      | Sink.Fix f -> self#record (f sink) l
+      | Sink.Fix f -> record ~src (f sink) l
       | _ -> __error "get Record, but expected %s" (Sink.__expected sink)
 
-    method private build_hlist : 't. 'a list -> 't Sink.hlist -> 't
+    and build_hlist : 't. src:'a t -> 'a list -> 't Sink.hlist -> 't
-        = fun l t_sink -> match l, t_sink with
+        = fun ~src l t_sink -> match l, t_sink with
           | [], Sink.HNil t -> t
           | [], _ ->
               __error "not enough tuple components"
           | _::_, Sink.HNil _ ->
               __error "too many tuple components (%d too many)" (List.length l)
           | x::l', Sink.HCons (sink', cont) ->
-              let y = self#visit sink' x in
+              let y = src.visit sink' x in
-              self#build_hlist l' (cont y)
+              build_hlist ~src l' (cont y)
 
-    method private tuple : 'b. 'b Sink.t -> 'a list -> 'b
+    and tuple : type b. src:'a t -> b Sink.t -> 'a list -> b
-      = fun sink l -> match sink with
+    = fun ~src sink l -> match sink with
       | Sink.Tuple t_sink ->
         (* fold over the expected tuple component *)
-        self#build_hlist l t_sink
+        build_hlist ~src l t_sink
-      | Sink.List _ -> self#list_ sink l  (* adapt *)
+      | Sink.List _ -> list_ ~src sink l  (* adapt *)
-      | Sink.Map (sink', f) -> f (self#tuple sink' l)
+      | Sink.Map (sink', f) -> f (tuple ~src sink' l)
-      | Sink.Fix f -> self#tuple (f sink) l
+      | Sink.Fix f -> tuple ~src (f sink) l
       | _ -> __error "get Tuple, but expected %s" (Sink.__expected sink)
 
-    method private sum : 'b. 'b Sink.t -> string -> 'a list -> 'b
+    and sum : type b. src:'a t -> b Sink.t -> string -> 'a list -> b
-      = fun sink name s -> match sink with
+    = fun ~src sink name s -> match sink with
       | Sink.Sum f ->
           let l_sink = f name in
-          self#build_hlist s l_sink
+          build_hlist ~src s l_sink
-      | Sink.Map (sink', f) -> f (self#sum sink' name s)
+      | Sink.Map (sink', f) -> f (sum ~src sink' name s)
-      | Sink.Fix f -> self#sum (f sink) name s
+      | Sink.Fix f -> sum ~src (f sink) name s
       | _ -> __error "get Sum(%s), but expected %s" name (Sink.__expected sink)
-
-    method virtual visit : 'b. 'b Sink.t -> 'a -> 'b
   end
 end
 
-let rec into : type a b. a Source.t -> b Sink.universal -> a -> b =
+let rec into : type a b. a Source.t -> b Sink.Universal.t -> a -> b =
+  let open Sink.Universal in
   fun src sink x -> match src with
-  | Source.Unit -> sink#unit_
+  | Source.Unit -> sink.unit_
-  | Source.Bool -> sink#bool_ x
+  | Source.Bool -> sink.bool_ x
-  | Source.Float -> sink#float_ x
+  | Source.Float -> sink.float_ x
-  | Source.Int -> sink#int_ x
+  | Source.Int -> sink.int_ x
-  | Source.String -> sink#string_ x
+  | Source.String -> sink.string_ x
   | Source.List src' ->
       let l = List.map (into src' sink) x in
-      sink#list_ l
+      sink.list_ l
   | Source.Record r ->
       let rec conv_fields : (string*b)list -> a Source.record_src -> b
       = fun acc r -> match r with
-      | Source.RecordStop -> sink#record (List.rev acc)
+      | Source.RecordStop -> sink.record (List.rev acc)
       | Source.RecordField (name,get,src',r') ->
           let acc = (name, into src' sink (get x)) :: acc in
           conv_fields acc r'
@@ -387,7 +391,7 @@ let rec into : type a b. a Source.t -> b Sink.universal -> a -> b =
   | Source.Tuple t ->
       let rec conv_tuple : b list -> a Source.tuple_src -> b
       = fun acc t -> match t with
-      | Source.TupleStop -> sink#tuple (List.rev acc)
+      | Source.TupleStop -> sink.tuple (List.rev acc)
       | Source.TupleField (src',get,t') ->
           let acc = into src' sink (get x) :: acc in
           conv_tuple acc t'
@@ -395,7 +399,7 @@ let rec into : type a b. a Source.t -> b Sink.universal -> a -> b =
   | Source.Sum f ->
       let rec conv_sum : string -> b list -> Source.sum_src -> b
       = fun name acc sum -> match sum with
-      | Source.SumNil -> sink#sum name (List.rev acc)
+      | Source.SumNil -> sink.sum name (List.rev acc)
       | Source.SumCons (src',x,sum') ->
           let acc = into src' sink x :: acc in
           conv_sum name acc sum'
@@ -407,7 +411,8 @@ let rec into : type a b. a Source.t -> b Sink.universal -> a -> b =
       let src' = f src in
       into src' sink x
 
-let from (src:'a Source.universal) (sink:'b Sink.t) (x:'a) : 'b = src#visit sink x
+let from (src:'a Source.Universal.t) (sink:'b Sink.t) (x:'a) : 'b =
+  src.Source.Universal.visit sink x
 
 (** {6 Exemples} *)
 
@@ -422,36 +427,43 @@ module Json = struct
     | `Assoc of (string * t) list
   ]
 
-  let source = object(self)
+  let source =
-    inherit [t] Source.universal
+    let module U = Source.Universal in
-    method visit sink (x:t) = match x with
+    let rec visit : type b. b Sink.t -> t -> b =
-      | `Int i -> self#int_ sink i
+    fun sink x -> match x with
-      | `Float f -> self#float_ sink f
+      | `Int i -> U.int_ sink i
-      | `Bool b -> self#bool_ sink b
+      | `Float f -> U.float_ sink f
-      | `Null -> self#unit_ sink
+      | `Bool b -> U.bool_ sink b
-      | `String s -> self#string_ sink s
+      | `Null -> U.unit_ sink
+      | `String s ->
+          begin match Sink.expected sink with
+          | Sink.ExpectSum -> U.sum ~src sink s []
+          | _ -> U.string_ sink s
+          end
       | `List ((`String name :: l) as l') ->
           begin match Sink.expected sink with
-          | Sink.ExpectSum -> self#sum sink name l
+          | Sink.ExpectSum -> U.sum ~src sink name l
-          | _ -> self#list_ sink l'
+          | _ -> U.list_ ~src sink l'
           end
-      | `List l -> self#list_ sink l
+      | `List l -> U.list_ ~src sink l
-      | `Assoc l -> self#record sink l
+      | `Assoc l -> U.record ~src sink l
-  end
+    and src = { U.visit=visit; } in
+    src
 
-  let sink : t Sink.universal = object
+  let sink : t Sink.Universal.t =
-    method unit_ = `Null
+    let open Sink.Universal in
-    method bool_ b = `Bool b
+    { unit_ = `Null;
-    method float_ f = `Float f
+      bool_ = (fun b -> `Bool b);
-    method int_ i = `Int i
+      float_ = (fun f -> `Float f);
-    method string_ s = `String s
+      int_ = (fun i -> `Int i);
-    method list_ l = `List l
+      string_ = (fun s -> `String s);
-    method record l = `Assoc l
+      list_ = (fun l -> `List l);
-    method tuple l = `List l
+      record = (fun l -> `Assoc l);
-    method sum name l = match l with
+      tuple = (fun l -> `List l);
-      | [] -> `String name
+      sum = (fun name l -> match l with
-      | _::_ -> `List (`String name :: l)
+        | [] -> `String name
-  end
+        | _::_ -> `List (`String name :: l));
+    }
 end
 
 module Sexp = struct
@@ -459,35 +471,37 @@ module Sexp = struct
     | Atom of string
     | List of t list
 
-  let source = object(self)
+  let source =
-    inherit [t] Source.universal
+    let module U = Source.Universal in
-    method visit: 'a. 'a Sink.t -> t -> 'a = fun sink x ->
+    let rec visit : type b. b Sink.t -> t -> b =
-      match x, Sink.expected sink with
+    fun sink x -> match x, Sink.expected sink with
-      | Atom s, Sink.ExpectSum -> self#sum sink s []
+      | Atom s, Sink.ExpectSum -> U.sum ~src sink s []
-      | List (Atom name :: l), Sink.ExpectSum -> self#sum sink name l
+      | List (Atom name :: l), Sink.ExpectSum -> U.sum ~src sink name l
       | List l, Sink.ExpectRecord ->
           let l' = List.map (function
             | List [Atom name; x] -> name, x
             | _ -> __error "get List, but expected Record") l
-          in self#record sink l'
+          in U.record ~src sink l'
-      | Atom s, _ -> self#string_ sink s
+      | Atom s, _ -> U.string_ sink s
-      | List [], Sink.ExpectUnit -> self#unit_ sink
+      | List [], Sink.ExpectUnit -> U.unit_ sink
-      | List l, _ -> self#list_ sink l
+      | List l, _ -> U.list_ ~src sink l
-  end
+    and src = { U.visit=visit; } in
+    src
 
-  let sink = object
+  let sink =
-    method unit_ = List []
+    let open Sink.Universal in
-    method bool_ b = Atom (string_of_bool b)
+    { unit_ = List [];
-    method int_ i = Atom (string_of_int i)
+      bool_ = (fun b -> Atom (string_of_bool b));
-    method float_ f = Atom (string_of_float f)
+      float_ = (fun f -> Atom (string_of_float f));
-    method string_ s = Atom (String.escaped s)
+      int_ = (fun i -> Atom (string_of_int i));
-    method list_ l = List l
+      string_ = (fun s -> Atom (String.escaped s));
-    method tuple l = List l
+      list_ = (fun l -> List l);
-    method record l = List (List.map (fun (a,b) -> List [Atom a; b]) l)
+      record = (fun l -> List (List.map (fun (a,b) -> List [Atom a; b]) l));
-    method sum name l = match l with
+      tuple = (fun l -> List l);
-      | [] -> Atom name
+      sum = (fun name l -> match l with
-      | _::_ -> List (Atom name::l)
+        | [] -> Atom name
-  end
+        | _::_ -> List (Atom name :: l));
+    }
 
   let rec fmt out = function
     | Atom s -> Format.pp_print_string out s
@@ -506,32 +520,35 @@ module Bencode = struct
     | List of t list
     | Assoc of (string * t) list
 
-  let source = object(self)
+  let source =
-    inherit [t] Source.universal
+    let module U = Source.Universal in
-    method visit: 'a. 'a Sink.t -> t -> 'a = fun sink x ->
+    let rec visit : type b. b Sink.t -> t -> b =
-      match x, Sink.expected sink with
+    fun sink x -> match x, Sink.expected sink with
-      | String s, Sink.ExpectSum -> self#sum sink s []
+      | String s, Sink.ExpectSum -> U.sum ~src sink s []
-      | List (String name :: l), Sink.ExpectSum -> self#sum sink name l
+      | List (String name :: l), Sink.ExpectSum -> U.sum ~src sink name l
-      | Assoc l, _ -> self#record sink l
+      | Assoc l, _ -> U.record ~src sink l
-      | String s, _ -> self#string_ sink s
+      | String s, _ -> U.string_ sink s
-      | Int 0, Sink.ExpectUnit -> self#unit_ sink
+      | List [], Sink.ExpectUnit -> U.unit_ sink
-      | Int i, _ -> self#int_ sink i
+      | List l, _ -> U.list_ ~src sink l
-      | List l, _ -> self#list_ sink l
+      | Int 0, Sink.ExpectUnit -> U.unit_ sink
-  end
+      | Int i, _ -> U.int_ sink i
+    and src = { U.visit=visit; } in
+    src
 
-  let sink = object
+  let sink =
-    method unit_ = Int 0
+    let open Sink.Universal in
-    method bool_ b = Int (if b then 1 else 0)
+    { unit_ = Int 0;
-    method int_ i = Int i
+      bool_ = (fun b -> Int (if b then 1 else 0));
-    method float_ f = String (string_of_float f)
+      float_ = (fun f -> String (string_of_float f));
-    method string_ s = String s
+      int_ = (fun i -> Int i);
-    method list_ l = List l
+      string_ = (fun s -> String s);
-    method tuple l = List l
+      list_ = (fun l -> List l);
-    method record l = Assoc l
+      record = (fun l -> Assoc l);
-    method sum name l = match l with
+      tuple = (fun l -> List l);
-      | [] -> String name
+      sum = (fun name l -> match l with
-      | _::_ -> List (String name :: l)
+        | [] -> String name
-  end
+        | _::_ -> List (String name :: l));
+    }
 end
 
 (* tests *)

conv.mli

@@ -89,16 +89,18 @@ module Sink : sig
         maps and fixpoints are unrolled. *)
 
   (** Universal sink, such as a serialization format *)
-  class type ['a] universal = object
+  module Universal : sig
-    method unit_ : 'a
+    type 'a t = {
-    method bool_ : bool -> 'a
+      unit_ : 'a;
-    method float_ : float -> 'a
+      bool_ : bool -> 'a;
-    method int_ : int -> 'a
+      float_ : float -> 'a;
-    method string_ : string -> 'a
+      int_ : int -> 'a;
-    method list_ : 'a list -> 'a
+      string_ : string -> 'a;
-    method record : (string*'a) list -> 'a
+      list_ : 'a list -> 'a;
-    method tuple : 'a list -> 'a
+      record : (string*'a) list -> 'a;
-    method sum : string -> 'a list -> 'a
+      tuple : 'a list -> 'a;
+      sum : string -> 'a list -> 'a;
+    }
   end
 end
 
@@ -150,28 +152,31 @@ module Source : sig
 
   val opt : 'a t -> 'a option t
 
-  (** Universal source from type 'a. A universal type should inherit from it
+  (** Universal source from type 'a. A universal type should use
-      and implement the visit method by calling self-methods. *)
+      combinators to implement the visitor pattern. *)
-  class virtual ['a] universal : object
+  module Universal : sig
-    method private unit_ : 'b. 'b Sink.t -> 'b
+    type 'a t = {
-    method private bool_ : 'b. 'b Sink.t -> bool -> 'b
+      visit : 'b. 'b Sink.t -> 'a -> 'b;
-    method private float_ : 'b. 'b Sink.t -> float -> 'b
+    }
-    method private int_ : 'b. 'b Sink.t -> int -> 'b
+
-    method private string_ : 'b. 'b Sink.t -> string -> 'b
+    val unit_ : 'b Sink.t -> 'b
-    method private list_ : 'b. 'b Sink.t -> 'a list -> 'b
+    val bool_ : 'b Sink.t -> bool -> 'b
-    method private record : 'b. 'b Sink.t -> (string*'a) list -> 'b
+    val float_ : 'b Sink.t -> float -> 'b
-    method private tuple : 'b. 'b Sink.t -> 'a list -> 'b
+    val int_ : 'b Sink.t -> int -> 'b
-    method private sum : 'b. 'b Sink.t -> string -> 'a list -> 'b
+    val string_ : 'b Sink.t -> string -> 'b
-    method virtual visit : 'b. 'b Sink.t -> 'a -> 'b
+    val list_ : src:'a t -> 'b Sink.t -> 'a list -> 'b
+    val record : src:'a t -> 'b Sink.t -> (string*'a) list -> 'b
+    val tuple : src:'a t -> 'b Sink.t -> 'a list -> 'b
+    val sum : src:'a t -> 'b Sink.t -> string -> 'a list -> 'b
   end
 end
 
 (** {6 Conversion Functions} *)
 
-val into : 'a Source.t -> 'b Sink.universal -> 'a -> 'b
+val into : 'a Source.t -> 'b Sink.Universal.t -> 'a -> 'b
   (** Conversion to universal sink *)
 
-val from : 'a Source.universal -> 'b Sink.t -> 'a -> 'b
+val from : 'a Source.Universal.t -> 'b Sink.t -> 'a -> 'b
   (** Conversion from universal source *)
 
 (* TODO for format conversion
@@ -191,8 +196,8 @@ module Json : sig
     | `Assoc of (string * t) list
   ]
 
-  val source : t Source.universal
+  val source : t Source.Universal.t
-  val sink : t Sink.universal
+  val sink : t Sink.Universal.t
 end
 
 module Sexp : sig
@@ -200,8 +205,8 @@ module Sexp : sig
     | Atom of string
     | List of t list
 
-  val source : t Source.universal
+  val source : t Source.Universal.t
-  val sink : t Sink.universal
+  val sink : t Sink.Universal.t
   val fmt : Format.formatter -> t -> unit (* for debug *)
 end
 
@@ -212,8 +217,8 @@ module Bencode : sig
     | List of t list
     | Assoc of (string * t) list
 
-  val source : t Source.universal
+  val source : t Source.Universal.t
-  val sink : t Sink.universal
+  val sink : t Sink.Universal.t
 end
 
 (** Tests *)