mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-07 11:45:31 -05:00
more operations on collections;
optimization level as a parameter in CCBatch
This commit is contained in:
Simon Cruanes
parent
80522a4959
commit
ee72934864
6 changed files with 83 additions and 20 deletions
|
|
@ -125,6 +125,13 @@ let exists p a =
|
|||
i < Array.length a && (p a.(i) || check (i+1))
|
||||
in check 0
|
||||
|
||||
let (--) i j =
|
||||
if i<=j
|
||||
then
|
||||
Array.init (j-i+1) (fun k -> i+k)
|
||||
else
|
||||
Array.init (i-j+1) (fun k -> i-k)
|
||||
|
||||
(** all the elements of a, but the i-th, into a list *)
|
||||
let except_idx a i =
|
||||
foldi
|
||||
|
|
|
|||
|
|
@ -58,6 +58,9 @@ val for_all2 : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
|
|||
|
||||
val exists : ('a -> bool) -> 'a t -> bool
|
||||
|
||||
val (--) : int -> int -> int t
|
||||
(** Range array *)
|
||||
|
||||
val except_idx : 'a t -> int -> 'a list
|
||||
(** Remove given index *)
|
||||
|
||||
|
|
|
|||
|
|
@ -42,15 +42,24 @@ module type S = sig
|
|||
type ('a,'b) op
|
||||
(** Operation that converts an ['a t] into a ['b t] *)
|
||||
|
||||
val apply : ('a,'b) op -> 'a t -> 'b t
|
||||
val apply' : 'a t -> ('a,'b) op -> 'b t
|
||||
|
||||
val length : (_,_) op -> int
|
||||
(** Number of intermediate structures needed to compute this operation *)
|
||||
|
||||
val optimize : ('a,'b) op -> ('a,'b) op
|
||||
type optimization_level =
|
||||
| OptimNone
|
||||
| OptimBase
|
||||
| OptimMergeFlatMap
|
||||
|
||||
val optimize : ?level:optimization_level -> ('a,'b) op -> ('a,'b) op
|
||||
(** Try to minimize the length of the operation *)
|
||||
|
||||
val apply : ?level:optimization_level -> ('a,'b) op -> 'a t -> 'b t
|
||||
(** Apply the operation to the collection.
|
||||
@param level the optimization level, default is [OptimBase] *)
|
||||
|
||||
val apply' : 'a t -> ('a,'b) op -> 'b t
|
||||
(** Flip of {!apply} *)
|
||||
|
||||
(** {6 Combinators} *)
|
||||
|
||||
val id : ('a, 'a) op
|
||||
|
|
@ -92,22 +101,29 @@ module Make(C : COLLECTION) = struct
|
|||
| Same of 'a
|
||||
| New of 'a
|
||||
|
||||
type optimization_level =
|
||||
| OptimNone
|
||||
| OptimBase
|
||||
| OptimMergeFlatMap
|
||||
|
||||
let _new_compose a b = New (Compose (a,b))
|
||||
|
||||
(* optimize a batch operation by fusion *)
|
||||
let rec _optimize : type a b. (a,b) op -> (a,b) op
|
||||
= fun op -> match op with
|
||||
let rec _optimize : type a b. level:optimization_level -> (a,b) op -> (a,b) op
|
||||
= fun ~level op -> match op with
|
||||
| _ when level = OptimNone -> op
|
||||
| Compose (a, b) ->
|
||||
let b' = _optimize b in
|
||||
_optimize_rec (Compose (a, b'))
|
||||
let b' = _optimize ~level b in
|
||||
_optimize_rec ~level (Compose (a, b'))
|
||||
| Id -> Id
|
||||
(* repeat optimization until a fixpoint is reached *)
|
||||
and _optimize_rec : type a b. (a,b) op -> (a,b) op
|
||||
= fun op -> match _optimize_head op with
|
||||
and _optimize_rec : type a b. level:optimization_level -> (a,b) op -> (a,b) op
|
||||
= fun ~level op -> match _optimize_head ~level op with
|
||||
| Same _ -> op
|
||||
| New op' -> _optimize_rec op'
|
||||
and _optimize_head : type a b. (a,b) op -> (a,b) op optim_result
|
||||
= function
|
||||
| New op' -> _optimize_rec ~level op'
|
||||
and _optimize_head
|
||||
: type a b. level:optimization_level -> (a,b) op -> (a,b) op optim_result
|
||||
= fun ~level op -> match op with
|
||||
| Id -> Same Id
|
||||
| Compose (Map f, Compose (Map g, cont)) ->
|
||||
_new_compose (Map (fun x -> g (f x))) cont
|
||||
|
|
@ -157,6 +173,13 @@ module Make(C : COLLECTION) = struct
|
|||
| None -> C.empty
|
||||
| Some y -> f' y))
|
||||
cont
|
||||
| Compose (FlatMap f, Compose (FlatMap f', cont)) ->
|
||||
_new_compose
|
||||
(FlatMap
|
||||
(fun x ->
|
||||
let a = f x in
|
||||
C.flat_map f' a))
|
||||
cont
|
||||
| (Compose _) as op ->
|
||||
Same op (* cannot optimize *)
|
||||
|
||||
|
|
@ -165,9 +188,9 @@ module Make(C : COLLECTION) = struct
|
|||
| Compose (_, Id) -> 0
|
||||
| Compose (_, cont) -> 1 + length cont
|
||||
|
||||
let optimize = _optimize
|
||||
let optimize ?(level=OptimBase) = _optimize ~level
|
||||
|
||||
let apply op a =
|
||||
let apply ?level op a =
|
||||
let rec _apply : type a b. (a,b) op -> a t -> b t
|
||||
= fun op a -> match op with
|
||||
| Compose (op1, op2) ->
|
||||
|
|
@ -182,7 +205,7 @@ module Make(C : COLLECTION) = struct
|
|||
| FilterMap f -> C.filter_map f a
|
||||
in
|
||||
(* optimize and run *)
|
||||
let op' = _optimize op in
|
||||
let op' = optimize ?level op in
|
||||
_apply op' a
|
||||
|
||||
let apply' a op = apply op a
|
||||
|
|
|
|||
|
|
@ -48,15 +48,24 @@ module type S = sig
|
|||
type ('a,'b) op
|
||||
(** Operation that converts an ['a t] into a ['b t] *)
|
||||
|
||||
val apply : ('a,'b) op -> 'a t -> 'b t
|
||||
val apply' : 'a t -> ('a,'b) op -> 'b t
|
||||
|
||||
val length : (_,_) op -> int
|
||||
(** Number of intermediate structures needed to compute this operation *)
|
||||
|
||||
val optimize : ('a,'b) op -> ('a,'b) op
|
||||
type optimization_level =
|
||||
| OptimNone
|
||||
| OptimBase
|
||||
| OptimMergeFlatMap
|
||||
|
||||
val optimize : ?level:optimization_level -> ('a,'b) op -> ('a,'b) op
|
||||
(** Try to minimize the length of the operation *)
|
||||
|
||||
val apply : ?level:optimization_level -> ('a,'b) op -> 'a t -> 'b t
|
||||
(** Apply the operation to the collection.
|
||||
@param level the optimization level, default is [OptimBase] *)
|
||||
|
||||
val apply' : 'a t -> ('a,'b) op -> 'b t
|
||||
(** Flip of {!apply} *)
|
||||
|
||||
(** {6 Combinators} *)
|
||||
|
||||
val id : ('a, 'a) op
|
||||
|
|
|
|||
|
|
@ -57,6 +57,15 @@ let of_list l =
|
|||
| x::l' -> `Cons (x, aux l')
|
||||
in aux l
|
||||
|
||||
let equal ?(eq=(=)) l1 l2 =
|
||||
let rec aux l1 l2 = match l1(), l2() with
|
||||
| `Nil, `Nil -> true
|
||||
| `Nil, _
|
||||
| _, `Nil -> false
|
||||
| `Cons (x1,l1'), `Cons (x2,l2') ->
|
||||
eq x1 x2 && aux l1' l2'
|
||||
in aux l1 l2
|
||||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
|
||||
|
|
@ -140,6 +149,14 @@ and _flat_map_app f l l' () = match l () with
|
|||
| `Cons (x, tl) ->
|
||||
`Cons (x, _flat_map_app f tl l')
|
||||
|
||||
let rec filter_map f l () = match l() with
|
||||
| `Nil -> `Nil
|
||||
| `Cons (x, l') ->
|
||||
begin match f x with
|
||||
| None -> filter_map f l' ()
|
||||
| Some y -> `Cons (y, filter_map f l')
|
||||
end
|
||||
|
||||
let flatten l = flat_map (fun x->x) l
|
||||
|
||||
let range i j =
|
||||
|
|
|
|||
|
|
@ -45,6 +45,8 @@ val of_list : 'a list -> 'a t
|
|||
val to_list : 'a t -> 'a list
|
||||
(** Gather all values into a list *)
|
||||
|
||||
val equal : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool
|
||||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
|
||||
|
|
@ -72,6 +74,8 @@ val append : 'a t -> 'a t -> 'a t
|
|||
|
||||
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
|
||||
|
||||
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
|
||||
|
||||
val flatten : 'a t t -> 'a t
|
||||
|
||||
val range : int -> int -> int t
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue