added some typeclasses in a submodule

This commit is contained in:
Simon Cruanes 2013-02-27 17:52:29 +01:00
parent 213def7aab
commit 2ba0cfe2f4
2 changed files with 79 additions and 0 deletions

View file

@ -471,6 +471,53 @@ let random_array a =
let random_list l = random_array (Array.of_list l)
(** {2 Type-classes} *)
module TypeClass = struct
(** {3 Classes} *)
type ('a,'b) sequenceable = {
to_seq : 'b -> 'a t;
of_seq : 'a t -> 'b;
}
type ('a,'b) addable = {
empty : 'b;
add : 'b -> 'a -> 'b;
}
type 'a monoid = ('a,'a) addable
type ('a,'b) iterable = {
iter : ('a -> unit) -> 'b -> unit;
}
(** {3 Instances} *)
let (sequenceable : ('a,'a t) sequenceable) = {
to_seq = (fun seq -> seq);
of_seq = (fun seq -> seq);
}
let (iterable : ('a, 'a t) iterable) = {
iter = (fun f seq -> iter f seq);
}
let (monoid : 'a t monoid) = {
empty = empty;
add = (fun s1 s2 -> append s1 s2);
}
(** {3 Conversions} *)
let of_iterable iterable x =
from_iter (fun k -> iterable.iter k x)
let to_addable addable seq =
fold addable.add addable.empty seq
end
(** {2 Pretty printing of sequences} *)
(** Pretty print a sequence of ['a], using the given pretty printer

View file

@ -254,6 +254,38 @@ val random_array : 'a array -> 'a t
val random_list : 'a list -> 'a t
(** {2 Type-classes} *)
module TypeClass : sig
(** {3 Classes} *)
type ('a,'b) sequenceable = {
to_seq : 'b -> 'a t;
of_seq : 'a t -> 'b;
}
type ('a,'b) addable = {
empty : 'b;
add : 'b -> 'a -> 'b;
}
type 'a monoid = ('a,'a) addable
type ('a,'b) iterable = {
iter : ('a -> unit) -> 'b -> unit;
}
(** {3 Instances} *)
val sequenceable : ('a,'a t) sequenceable
val iterable : ('a,'a t) iterable
val monoid : 'a t monoid
(** {3 Conversions} *)
val of_iterable : ('a,'b) iterable -> 'b -> 'a t
val to_addable : ('a,'b) addable -> 'a t -> 'b
end
(** {2 Pretty printing of sequences} *)
val pp_seq : ?sep:string -> (Format.formatter -> 'a -> unit) ->