mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-08 04:05:30 -05:00
big update of Conv, with universal sources and sinks
and GADTs for describing other sources and sinks
This commit is contained in:
Simon Cruanes
parent
57bb863f78
commit
016a557a37
2 changed files with 351 additions and 68 deletions
315
conv.ml
315
conv.ml
|
|
@ -28,94 +28,289 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
|
|
||||||
exception ConversionFailure of string
|
exception ConversionFailure of string
|
||||||
|
|
||||||
|
(* error-raising function *)
|
||||||
|
let __error msg =
|
||||||
|
let b = Buffer.create 15 in
|
||||||
|
Printf.bprintf b "conversion error: ";
|
||||||
|
Printf.kbprintf
|
||||||
|
(fun b -> raise (ConversionFailure (Buffer.contents b)))
|
||||||
|
b msg
|
||||||
|
|
||||||
module Sink = struct
|
module Sink = struct
|
||||||
|
(** A specific sink that requires a given shape to produce
|
||||||
|
* a value of type 'a *)
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Int : (int -> 'a) -> 'a t
|
| Int : (int -> 'a) -> 'a t
|
||||||
| String : (string -> 'a) -> 'a t
|
| String : (string -> 'a) -> 'a t
|
||||||
| List : (('b t -> 'b list) -> 'a) -> 'a t
|
| List : (('b t -> 'b list) -> 'a) -> 'a t
|
||||||
| RecordField : string * 'b t * ('b -> 'a t) -> 'a t
|
| Record : 'a record_sink -> 'a t
|
||||||
| Return : 'a -> 'a t
|
| Tuple : 'a tuple_sink -> 'a t
|
||||||
|
| Sum : (string -> ('b t -> 'b) -> 'a) -> 'a t
|
||||||
|
| Map : 'a t * ('a -> 'b) -> 'b t
|
||||||
|
|
||||||
let return x = Return x
|
and 'r record_sink =
|
||||||
|
| RecordField : string * 'a t * ('a -> 'r record_sink) -> 'r record_sink
|
||||||
|
| RecordStop : 'r -> 'r record_sink
|
||||||
|
|
||||||
|
and 't tuple_sink =
|
||||||
|
| TupleField : 'a t * ('a -> 't tuple_sink) -> 't tuple_sink
|
||||||
|
| TupleStop : 't -> 't tuple_sink
|
||||||
|
|
||||||
|
and 's sum_sink =
|
||||||
|
| SumSink : (string -> ('b t -> 'b) -> 's) -> 's sum_sink
|
||||||
|
|
||||||
|
let rec __expected : type a. a t -> string = function
|
||||||
|
| Int _ -> "int"
|
||||||
|
| String _ -> "string"
|
||||||
|
| List _ -> "list"
|
||||||
|
| Record _ -> "record"
|
||||||
|
| Tuple _ -> "tuple"
|
||||||
|
| Sum _ -> "sum"
|
||||||
|
| Map (sink', _) -> __expected sink'
|
||||||
|
|
||||||
let int_ = Int (fun i -> i)
|
let int_ = Int (fun i -> i)
|
||||||
let string_ = String (fun s -> s)
|
let string_ = String (fun s -> s)
|
||||||
|
|
||||||
let list_ e =
|
let list_ e =
|
||||||
List (fun k -> let l = k e in l)
|
List (fun k -> let l = k e in l)
|
||||||
|
|
||||||
|
let map f sink = Map (sink, f)
|
||||||
|
let array_ sink =
|
||||||
|
map Array.of_list (list_ sink)
|
||||||
|
|
||||||
|
let (-->) a b = a, b
|
||||||
|
let (|:|) (name,sink) cont = RecordField (name,sink,cont)
|
||||||
|
let yield_record r = RecordStop r
|
||||||
|
let record r = Record r
|
||||||
|
|
||||||
|
let (|+|) sink cont = TupleField (sink, cont)
|
||||||
|
let yield_tuple t = TupleStop t
|
||||||
|
let tuple t = Tuple t
|
||||||
|
|
||||||
|
let pair a b =
|
||||||
|
tuple (
|
||||||
|
a |+| fun x ->
|
||||||
|
b |+| fun y ->
|
||||||
|
yield_tuple (x,y)
|
||||||
|
)
|
||||||
|
|
||||||
|
let triple a b c =
|
||||||
|
tuple (
|
||||||
|
a |+| fun x ->
|
||||||
|
b |+| fun y ->
|
||||||
|
c |+| fun z ->
|
||||||
|
yield_tuple (x,y,z)
|
||||||
|
)
|
||||||
|
|
||||||
|
let quad a b c d =
|
||||||
|
tuple (
|
||||||
|
a |+| fun x ->
|
||||||
|
b |+| fun y ->
|
||||||
|
c |+| fun z ->
|
||||||
|
d |+| fun w ->
|
||||||
|
yield_tuple (x,y,z,w)
|
||||||
|
)
|
||||||
|
|
||||||
|
let sum f = Sum f
|
||||||
|
|
||||||
|
(** Universal sink, such as a serialization format *)
|
||||||
|
class type ['a] universal = object
|
||||||
|
method int_ : int -> 'a
|
||||||
|
method string_ : string -> 'a
|
||||||
|
method list_ : 'a list -> 'a
|
||||||
|
method record : (string*'a) list -> 'a
|
||||||
|
method tuple : 'a list -> 'a
|
||||||
|
method sum : string -> 'a -> 'a
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
module Source = struct
|
module Source = struct
|
||||||
type 'a t = {
|
(** A specific source that follows the shape of the type 'a *)
|
||||||
convert : 'b. 'b Sink.t -> 'a -> 'b;
|
type 'a 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 * 'b t * 'b) -> 'a t
|
||||||
|
| Map : 'a t * ('b -> 'a) -> 'b t
|
||||||
|
|
||||||
let int_ =
|
and 'r record_src =
|
||||||
let convert sink x = match sink with
|
| RecordField : string * ('r -> 'a) * 'a t * 'r record_src -> 'r record_src
|
||||||
| Sink.Int f -> f x
|
| RecordStop : 'r record_src
|
||||||
| _ -> raise (ConversionFailure "expected int")
|
|
||||||
in { convert; }
|
|
||||||
|
|
||||||
let string_ =
|
and 't tuple_src =
|
||||||
let convert sink x = match sink with
|
| TupleField : 'a t * ('t -> 'a) * 't tuple_src -> 't tuple_src
|
||||||
| Sink.String f -> f x
|
| TupleStop : 't tuple_src
|
||||||
| _ -> raise (ConversionFailure "expected string")
|
|
||||||
in { convert; }
|
|
||||||
|
|
||||||
let list_ e =
|
let int_ = Int
|
||||||
let convert sink l = match sink with
|
let string_ = String
|
||||||
| Sink.List f -> f (fun sink' -> List.map (e.convert sink') l)
|
let list_ e = List e
|
||||||
| _ -> raise (ConversionFailure "expected list")
|
|
||||||
in
|
let map f src = Map (src, f)
|
||||||
{ convert; }
|
let array_ src = map Array.to_list (list_ src)
|
||||||
|
|
||||||
|
let record_field name get src' cont =
|
||||||
|
RecordField (name,get,src',cont)
|
||||||
|
let record_stop = RecordStop
|
||||||
|
let record r = Record r
|
||||||
|
let (@@@) a b = a b
|
||||||
|
|
||||||
|
let tuple_field src get cont = TupleField (src,get,cont)
|
||||||
|
let tuple_stop = TupleStop
|
||||||
|
let tuple t = Tuple t
|
||||||
|
|
||||||
|
let pair a b =
|
||||||
|
tuple (tuple_field a fst (tuple_field b snd tuple_stop))
|
||||||
|
|
||||||
|
let triple a b c =
|
||||||
|
tuple
|
||||||
|
(tuple_field a (fun (a,b,c) -> a)
|
||||||
|
(tuple_field b (fun (a,b,c) -> b)
|
||||||
|
(tuple_field c (fun (a,b,c) -> c)
|
||||||
|
tuple_stop)))
|
||||||
|
|
||||||
|
let quad a b c d =
|
||||||
|
tuple
|
||||||
|
(tuple_field a (fun (a,b,c,d) -> a)
|
||||||
|
(tuple_field b (fun (a,b,c,d) -> b)
|
||||||
|
(tuple_field c (fun (a,b,c,d) -> c)
|
||||||
|
(tuple_field d (fun (a,b,c,d) -> d)
|
||||||
|
tuple_stop))))
|
||||||
|
|
||||||
|
let sum f = Sum f
|
||||||
|
|
||||||
|
(* function to look up the given name in an association list *)
|
||||||
|
let _get_field l name =
|
||||||
|
try List.assoc name l
|
||||||
|
with Not_found ->
|
||||||
|
__error "record field %s not found in source" name
|
||||||
|
|
||||||
|
class virtual ['a] universal = object(self)
|
||||||
|
|
||||||
|
method private int_ : 'b. 'b Sink.t -> int -> 'b
|
||||||
|
= fun sink i -> match sink with
|
||||||
|
| Sink.Int f -> f i
|
||||||
|
| Sink.String f -> f (string_of_int i)
|
||||||
|
| Sink.Map (sink', f) -> f (self#int_ sink' i)
|
||||||
|
| _ -> __error "get Int, but expected %s" (Sink.__expected sink)
|
||||||
|
|
||||||
|
method private string_ : 'b. 'b Sink.t -> string -> 'b
|
||||||
|
= fun sink s -> match sink with
|
||||||
|
| Sink.String f -> f s
|
||||||
|
| Sink.Int f ->
|
||||||
|
begin try f (int_of_string s)
|
||||||
|
with Invalid_argument _ -> __error "get String, but expected Int"
|
||||||
|
end
|
||||||
|
| Sink.Map (sink', f) -> f (self#string_ sink' s)
|
||||||
|
| _ -> __error "get String, but expected %s" (Sink.__expected sink)
|
||||||
|
|
||||||
|
method private list_ : 'b. 'b Sink.t -> 'a list -> 'b
|
||||||
|
= fun sink l -> match sink with
|
||||||
|
| Sink.List f ->
|
||||||
|
f (fun sink' -> List.map (self#visit sink') l)
|
||||||
|
| Sink.Map (sink', f) -> f (self#list_ sink' l)
|
||||||
|
| _ -> __error "get List, but expected %s" (Sink.__expected sink)
|
||||||
|
|
||||||
|
method private record : 'b. 'b Sink.t -> (string*'a) list -> 'b
|
||||||
|
= fun sink l -> match sink with
|
||||||
|
| Sink.Record r ->
|
||||||
|
(* fold over the expected record fields *)
|
||||||
|
let rec build_record : 'r. 'r Sink.record_sink -> 'r
|
||||||
|
= 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
|
||||||
|
build_record (cont sink_field)
|
||||||
|
in build_record r
|
||||||
|
| Sink.Map (sink', f) -> f (self#record sink' l)
|
||||||
|
| _ -> __error "get Record, but expected %s" (Sink.__expected sink)
|
||||||
|
|
||||||
|
method private tuple : 'b. 'b Sink.t -> 'a list -> 'b
|
||||||
|
= fun sink l -> match sink with
|
||||||
|
| Sink.Tuple t_sink ->
|
||||||
|
(* fold over the expected tuple component *)
|
||||||
|
let rec build_tuple : 't. 'a list -> 't Sink.tuple_sink -> 't
|
||||||
|
= fun l t_sink -> match l, t_sink with
|
||||||
|
| [], Sink.TupleStop t -> t
|
||||||
|
| [], _ ->
|
||||||
|
__error "not enough tuple components"
|
||||||
|
| _::_, Sink.TupleStop _ ->
|
||||||
|
__error "too many tuple components (%d too many)" (List.length l)
|
||||||
|
| x::l', Sink.TupleField (sink', cont) ->
|
||||||
|
let y = self#visit sink' x in
|
||||||
|
build_tuple l' (cont y)
|
||||||
|
in build_tuple l t_sink
|
||||||
|
| Sink.Map (sink', f) -> f (self#tuple sink' l)
|
||||||
|
| _ -> __error "get Tuple, but expected %s" (Sink.__expected sink)
|
||||||
|
|
||||||
|
method private sum : 'b. 'b Sink.t -> string -> 'a -> 'b
|
||||||
|
= fun sink name s -> match sink with
|
||||||
|
| Sink.Sum f ->
|
||||||
|
f name (fun sink' -> self#visit sink' s)
|
||||||
|
| Sink.Map (sink', f) -> f (self#sum 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
|
end
|
||||||
|
|
||||||
let conv ~src ~sink x = src.Source.convert sink x
|
let rec into : type a b. a Source.t -> b Sink.universal -> a -> b =
|
||||||
|
fun src sink x -> match src with
|
||||||
|
| Source.Int -> sink#int_ x
|
||||||
|
| Source.String -> sink#string_ x
|
||||||
|
| Source.List src' ->
|
||||||
|
let l = List.map (into src' sink) x in
|
||||||
|
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 acc
|
||||||
|
| Source.RecordField (name,get,src',r') ->
|
||||||
|
let acc = (name, into src' sink (get x)) :: acc in
|
||||||
|
conv_fields acc r'
|
||||||
|
in conv_fields [] r
|
||||||
|
| Source.Tuple t ->
|
||||||
|
let rec conv_tuple : b list -> a Source.tuple_src -> b
|
||||||
|
= fun acc t -> match t with
|
||||||
|
| Source.TupleStop -> sink#tuple acc
|
||||||
|
| Source.TupleField (src',get,t') ->
|
||||||
|
let acc = into src' sink (get x) :: acc in
|
||||||
|
conv_tuple acc t'
|
||||||
|
in conv_tuple [] t
|
||||||
|
| Source.Sum f ->
|
||||||
|
let name, src', y = f x in
|
||||||
|
let z = into src' sink y in
|
||||||
|
sink#sum name z
|
||||||
|
| Source.Map (src', f) -> into src' sink (f x)
|
||||||
|
|
||||||
(* test for records
|
let from (src:'a Source.universal) (sink:'b Sink.t) (x:'a) : 'b = src#visit sink x
|
||||||
* TODO: continue, and provide a good API for records,
|
|
||||||
* recursive types and tuples. *)
|
(* test for records *)
|
||||||
|
|
||||||
type point = {
|
type point = {
|
||||||
x:int;
|
x:int;
|
||||||
|
y:int;
|
||||||
color:string;
|
color:string;
|
||||||
}
|
}
|
||||||
|
|
||||||
let point_sink : point Sink.t =
|
let point_sink =
|
||||||
Sink.RecordField ("x", Sink.int_,
|
Sink.(record (
|
||||||
(fun x -> Sink.RecordField ("color", Sink.string_,
|
"x" --> int_ |:| fun x ->
|
||||||
(fun color -> Sink.return {x;color;}))))
|
"y" --> int_ |:| fun y ->
|
||||||
|
"color" --> string_ |:| fun color ->
|
||||||
|
yield_record {x;y;color}
|
||||||
|
))
|
||||||
|
|
||||||
type 'r record_source =
|
|
||||||
| RSStop : 'r record_source
|
|
||||||
| RSField : string * ('r -> 'a) * 'a Source.t * 'r record_source -> 'r record_source
|
|
||||||
|
|
||||||
let mk_record_src rs =
|
|
||||||
let rec convert : 'b. 'b Sink.t -> 'a -> 'b
|
|
||||||
= fun sink x -> match sink with
|
|
||||||
| Sink.Return y -> y
|
|
||||||
| Sink.RecordField (name, sink', kont) ->
|
|
||||||
search rs name sink' x kont
|
|
||||||
| _ -> raise (ConversionFailure "expected record")
|
|
||||||
and search
|
|
||||||
: 'b 'c. 'a record_source -> string -> 'b Sink.t -> 'a -> ('b -> 'c Sink.t) -> 'c
|
|
||||||
= fun rs name sink' x kont -> match rs with
|
|
||||||
| RSStop -> raise (ConversionFailure ("could not find field "^name))
|
|
||||||
| RSField (name', get, src, _) when name = name' ->
|
|
||||||
(* use source to encode x *)
|
|
||||||
let new_sink = kont (conv ~src ~sink:sink' (get x)) in
|
|
||||||
convert new_sink x
|
|
||||||
| RSField (_, _, _, rs') ->
|
|
||||||
(* search further *)
|
|
||||||
search rs' name sink' x kont
|
|
||||||
in Source.({ convert; })
|
|
||||||
|
|
||||||
let point_source : point Source.t =
|
let point_source : point Source.t =
|
||||||
mk_record_src (
|
Source.(record (
|
||||||
RSField ("x", (fun p -> p.x), Source.int_,
|
record_field "x" (fun p -> p.x) int_ @@@
|
||||||
RSField ("color", (fun p -> p.color), Source.string_,
|
record_field "y" (fun p -> p.y) int_ @@@
|
||||||
RSStop ))
|
record_field "color" (fun p -> p.color) string_ @@@
|
||||||
)
|
record_stop
|
||||||
|
))
|
||||||
|
|
||||||
let p = {x=1; color="yellow"; }
|
let p = {x=1; y=42; color="yellow"; }
|
||||||
|
|
||||||
|
(* TODO tests *)
|
||||||
|
|
|
||||||
104
conv.mli
104
conv.mli
|
|
@ -29,29 +29,117 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
exception ConversionFailure of string
|
exception ConversionFailure of string
|
||||||
|
|
||||||
module Sink : sig
|
module Sink : sig
|
||||||
|
(** A specific sink that requires a given shape to produce
|
||||||
|
* a value of type 'a *)
|
||||||
type 'a t =
|
type 'a t =
|
||||||
| Int : (int -> 'a) -> 'a t
|
| Int : (int -> 'a) -> 'a t
|
||||||
| String : (string -> 'a) -> 'a t
|
| String : (string -> 'a) -> 'a t
|
||||||
| List : (('b t -> 'b list) -> 'a) -> 'a t
|
| List : (('b t -> 'b list) -> 'a) -> 'a t
|
||||||
| RecordField : string * 'b t * ('b -> 'a t) -> 'a t
|
| Record : 'a record_sink -> 'a t
|
||||||
| Return : 'a -> 'a t
|
| Tuple : 'a tuple_sink -> 'a t
|
||||||
|
| Sum : (string -> ('b t -> 'b) -> 'a) -> 'a t
|
||||||
|
| Map : 'a t * ('a -> 'b) -> 'b t
|
||||||
|
|
||||||
val return : 'a -> 'a t
|
and 'r record_sink =
|
||||||
|
| RecordField : string * 'a t * ('a -> 'r record_sink) -> 'r record_sink
|
||||||
|
| RecordStop : 'r -> 'r record_sink
|
||||||
|
|
||||||
|
and 't tuple_sink =
|
||||||
|
| TupleField : 'a t * ('a -> 't tuple_sink) -> 't tuple_sink
|
||||||
|
| TupleStop : 't -> 't tuple_sink
|
||||||
|
|
||||||
|
and 's sum_sink =
|
||||||
|
| SumSink : (string -> ('b t -> 'b) -> 's) -> 's sum_sink
|
||||||
|
|
||||||
val int_ : int t
|
val int_ : int t
|
||||||
val string_ : string t
|
val string_ : string t
|
||||||
val list_ : 'a t -> 'a list t
|
val list_ : 'a t -> 'a list t
|
||||||
|
|
||||||
|
val map : ('a -> 'b) -> 'a t -> 'b t
|
||||||
|
val array_ : 'a t -> 'a array t
|
||||||
|
|
||||||
|
val (-->) : 'a -> 'b -> 'a * 'b
|
||||||
|
val (|:|) : (string * 'a t) -> ('a -> 'r record_sink) -> 'r record_sink
|
||||||
|
val yield_record : 'r -> 'r record_sink
|
||||||
|
val record : 'r record_sink -> 'r t
|
||||||
|
|
||||||
|
val (|+|) : 'a t -> ('a -> 't tuple_sink) -> 't tuple_sink
|
||||||
|
val yield_tuple : 't -> 't tuple_sink
|
||||||
|
val tuple : 't tuple_sink -> 't t
|
||||||
|
|
||||||
|
val pair : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
|
||||||
|
val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
|
||||||
|
|
||||||
|
val sum : (string -> ('b t -> 'b) -> 'a) -> 'a t
|
||||||
|
|
||||||
|
(** Universal sink, such as a serialization format *)
|
||||||
|
class type ['a] universal = object
|
||||||
|
method int_ : int -> 'a
|
||||||
|
method string_ : string -> 'a
|
||||||
|
method list_ : 'a list -> 'a
|
||||||
|
method record : (string*'a) list -> 'a
|
||||||
|
method tuple : 'a list -> 'a
|
||||||
|
method sum : string -> 'a -> 'a
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
module Source : sig
|
module Source : sig
|
||||||
type 'a t = {
|
(** A specific source that follows the shape of the type 'a *)
|
||||||
convert : 'b. 'b Sink.t -> 'a -> 'b;
|
type 'a 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 * 'b t * 'b) -> 'a t
|
||||||
|
| Map : 'a t * ('b -> 'a) -> 'b t
|
||||||
|
|
||||||
|
and 'r record_src =
|
||||||
|
| RecordField : string * ('r -> 'a) * 'a t * 'r record_src -> 'r record_src
|
||||||
|
| RecordStop : 'r record_src
|
||||||
|
|
||||||
|
and 't tuple_src =
|
||||||
|
| TupleField : 'a t * ('t -> 'a) * 't tuple_src -> 't tuple_src
|
||||||
|
| TupleStop : 't tuple_src
|
||||||
|
|
||||||
val int_ : int t
|
val int_ : int t
|
||||||
val string_ : string t
|
val string_ : string t
|
||||||
val list_ : 'a t -> 'a list t
|
val list_ : 'a t -> 'a list t
|
||||||
|
|
||||||
|
val map : ('b -> 'a) -> 'a t -> 'b t
|
||||||
|
val array_ : 'a t -> 'a array t
|
||||||
|
|
||||||
|
val record_field : string -> ('r -> 'a) -> 'a t -> 'r record_src -> 'r record_src
|
||||||
|
val record_stop : 'r record_src
|
||||||
|
val record : 'r record_src -> 'r t
|
||||||
|
|
||||||
|
val tuple_field : 'a t -> ('t -> 'a) -> 't tuple_src -> 't tuple_src
|
||||||
|
val tuple_stop : 't tuple_src
|
||||||
|
val tuple : 't tuple_src -> 't t
|
||||||
|
val (@@@) : ('a -> 'b) -> 'a -> 'b
|
||||||
|
|
||||||
|
val pair : 'a t -> 'b t -> ('a * 'b) t
|
||||||
|
val triple : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t
|
||||||
|
val quad : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t
|
||||||
|
|
||||||
|
val sum : ('a -> string * 'b t * 'b) -> 'a t
|
||||||
|
|
||||||
|
(** Universal source from type 'a. A universal type should inherit from it
|
||||||
|
and implement the visit method by calling self-methods. *)
|
||||||
|
class virtual ['a] universal : object
|
||||||
|
method private int_ : 'b. 'b Sink.t -> int -> 'b
|
||||||
|
method private string_ : 'b. 'b Sink.t -> string -> 'b
|
||||||
|
method private list_ : 'b. 'b Sink.t -> 'a list -> 'b
|
||||||
|
method private record : 'b. 'b Sink.t -> (string*'a) list -> 'b
|
||||||
|
method private tuple : 'b. 'b Sink.t -> 'a list -> 'b
|
||||||
|
method private sum : 'b. 'b Sink.t -> string -> 'a -> 'b
|
||||||
|
method virtual visit : 'b. 'b Sink.t -> 'a -> 'b
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
val conv : src:'a Source.t -> sink:'b Sink.t -> 'a -> 'b
|
val into : 'a Source.t -> 'b Sink.universal -> 'a -> 'b
|
||||||
(** Main conversion function *)
|
(** Conversion to universal sink *)
|
||||||
|
|
||||||
|
val from : 'a Source.universal -> 'b Sink.t -> 'a -> 'b
|
||||||
|
(** Conversion from universal source *)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue