mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
CCList: use TRMC for many functions on 5.1
This commit is contained in:
parent
1b026f267c
commit
3bd95d257c
1 changed files with 90 additions and 11 deletions
|
|
@ -6,16 +6,6 @@
|
||||||
|
|
||||||
[@@@ocaml.warning "-32"]
|
[@@@ocaml.warning "-32"]
|
||||||
|
|
||||||
let nth_opt l n =
|
|
||||||
if n < 0 then invalid_arg "nth_opt";
|
|
||||||
let rec aux l n =
|
|
||||||
match l, n with
|
|
||||||
| [], _ -> None
|
|
||||||
| x :: _, 0 -> Some x
|
|
||||||
| _ :: l, _ -> aux l (n - 1)
|
|
||||||
in
|
|
||||||
aux l n
|
|
||||||
|
|
||||||
let rec find_opt p l =
|
let rec find_opt p l =
|
||||||
match l with
|
match l with
|
||||||
| [] -> None
|
| [] -> None
|
||||||
|
|
@ -64,9 +54,11 @@ let mguard c =
|
||||||
else
|
else
|
||||||
[]
|
[]
|
||||||
|
|
||||||
(* max depth for direct recursion *)
|
(** max depth for direct recursion *)
|
||||||
let direct_depth_default_ = 1000
|
let direct_depth_default_ = 1000
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let tail_map f l =
|
let tail_map f l =
|
||||||
(* Unwind the list of tuples, reconstructing the full list front-to-back.
|
(* Unwind the list of tuples, reconstructing the full list front-to-back.
|
||||||
@param tail_acc a suffix of the final list; we append tuples' content
|
@param tail_acc a suffix of the final list; we append tuples' content
|
||||||
|
|
@ -136,6 +128,8 @@ let append l1 l2 =
|
||||||
| [ x; y ] -> x :: y :: l2
|
| [ x; y ] -> x :: y :: l2
|
||||||
| _ -> direct direct_depth_append_ l1 l2
|
| _ -> direct direct_depth_append_ l1 l2
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let ( @ ) = append
|
let ( @ ) = append
|
||||||
let[@inline] cons' l x = x :: l
|
let[@inline] cons' l x = x :: l
|
||||||
|
|
||||||
|
|
@ -144,6 +138,9 @@ let cons_maybe o l =
|
||||||
| Some x -> x :: l
|
| Some x -> x :: l
|
||||||
| None -> l
|
| None -> l
|
||||||
|
|
||||||
|
(* TRMC after 5.1 *)
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let direct_depth_filter_ = 10_000
|
let direct_depth_filter_ = 10_000
|
||||||
|
|
||||||
let filter p l =
|
let filter p l =
|
||||||
|
|
@ -178,6 +175,8 @@ let fold_right f l acc =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ f l acc
|
direct direct_depth_default_ f l acc
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec fold_while f acc = function
|
let rec fold_while f acc = function
|
||||||
| [] -> acc
|
| [] -> acc
|
||||||
| e :: l ->
|
| e :: l ->
|
||||||
|
|
@ -286,6 +285,9 @@ let fold_flat_map_i f acc l =
|
||||||
in
|
in
|
||||||
aux f acc 0 [] l
|
aux f acc 0 [] l
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
|
(* keep this because it's tailrec for < 5.1 *)
|
||||||
let init len f =
|
let init len f =
|
||||||
let rec indirect_ i acc =
|
let rec indirect_ i acc =
|
||||||
if i = len then
|
if i = len then
|
||||||
|
|
@ -311,6 +313,8 @@ let init len f =
|
||||||
else
|
else
|
||||||
direct_ 0
|
direct_ 0
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec compare f l1 l2 =
|
let rec compare f l1 l2 =
|
||||||
match l1, l2 with
|
match l1, l2 with
|
||||||
| [], [] -> 0
|
| [], [] -> 0
|
||||||
|
|
@ -425,6 +429,8 @@ let partition_filter_map f l =
|
||||||
|
|
||||||
let partition_map = partition_filter_map
|
let partition_map = partition_filter_map
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let combine l1 l2 =
|
let combine l1 l2 =
|
||||||
let rec direct i l1 l2 =
|
let rec direct i l1 l2 =
|
||||||
match l1, l2 with
|
match l1, l2 with
|
||||||
|
|
@ -440,6 +446,16 @@ let combine l1 l2 =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ l1 l2
|
direct direct_depth_default_ l1 l2
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
let[@tail_mod_cons] rec combine l1 l2 =
|
||||||
|
match l1, l2 with
|
||||||
|
| [], [] -> []
|
||||||
|
| x1 :: l1', x2 :: l2' -> (x1, x2) :: combine l1' l2'
|
||||||
|
| _, _ -> invalid_arg "CCList.combine"
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let combine_gen l1 l2 =
|
let combine_gen l1 l2 =
|
||||||
let l1 = ref l1 in
|
let l1 = ref l1 in
|
||||||
let l2 = ref l2 in
|
let l2 = ref l2 in
|
||||||
|
|
@ -451,6 +467,8 @@ let combine_gen l1 l2 =
|
||||||
l2 := tail2;
|
l2 := tail2;
|
||||||
Some (x1, x2)
|
Some (x1, x2)
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let combine_shortest l1 l2 =
|
let combine_shortest l1 l2 =
|
||||||
let rec direct i l1 l2 =
|
let rec direct i l1 l2 =
|
||||||
match l1, l2 with
|
match l1, l2 with
|
||||||
|
|
@ -466,6 +484,15 @@ let combine_shortest l1 l2 =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ l1 l2
|
direct direct_depth_default_ l1 l2
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
let[@tail_mod_cons] rec combine_shortest l1 l2 =
|
||||||
|
match l1, l2 with
|
||||||
|
| _, [] | [], _ -> []
|
||||||
|
| x1 :: l1', x2 :: l2' -> (x1, x2) :: combine_shortest l1' l2'
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let split l =
|
let split l =
|
||||||
let rec direct i l =
|
let rec direct i l =
|
||||||
match l with
|
match l with
|
||||||
|
|
@ -666,6 +693,8 @@ let sorted_diff_uniq ~cmp l1 l2 =
|
||||||
in
|
in
|
||||||
recurse ~cmp [] l1 l2
|
recurse ~cmp [] l1 l2
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let take n l =
|
let take n l =
|
||||||
let rec direct i n l =
|
let rec direct i n l =
|
||||||
match l with
|
match l with
|
||||||
|
|
@ -684,6 +713,19 @@ let take n l =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ n l
|
direct direct_depth_default_ n l
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
let[@tail_mod_cons] rec take n l =
|
||||||
|
match l with
|
||||||
|
| [] -> []
|
||||||
|
| x :: l' ->
|
||||||
|
if n > 0 then
|
||||||
|
x :: take (n - 1) l'
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec drop n l =
|
let rec drop n l =
|
||||||
match l with
|
match l with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
|
|
@ -748,6 +790,8 @@ let interleave l1 l2 : _ list =
|
||||||
in
|
in
|
||||||
aux [] l1 l2
|
aux [] l1 l2
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let take_while p l =
|
let take_while p l =
|
||||||
let rec direct i p l =
|
let rec direct i p l =
|
||||||
match l with
|
match l with
|
||||||
|
|
@ -769,6 +813,19 @@ let take_while p l =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ p l
|
direct direct_depth_default_ p l
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
let rec take_while p l =
|
||||||
|
match l with
|
||||||
|
| [] -> []
|
||||||
|
| x :: l' ->
|
||||||
|
if p x then
|
||||||
|
x :: take_while p l'
|
||||||
|
else
|
||||||
|
[]
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let rec drop_while p l =
|
let rec drop_while p l =
|
||||||
match l with
|
match l with
|
||||||
| [] -> []
|
| [] -> []
|
||||||
|
|
@ -1416,6 +1473,8 @@ let of_seq_rev l =
|
||||||
in
|
in
|
||||||
loop [] l
|
loop [] l
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let of_seq l =
|
let of_seq l =
|
||||||
let rec direct i seq =
|
let rec direct i seq =
|
||||||
if i <= 0 then
|
if i <= 0 then
|
||||||
|
|
@ -1428,6 +1487,15 @@ let of_seq l =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ l
|
direct direct_depth_default_ l
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
let[@tail_mod_cons] rec of_seq seq =
|
||||||
|
match seq () with
|
||||||
|
| Seq.Nil -> []
|
||||||
|
| Seq.Cons (x, tl) -> x :: of_seq tl
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
let to_gen l =
|
let to_gen l =
|
||||||
let l = ref l in
|
let l = ref l in
|
||||||
fun () ->
|
fun () ->
|
||||||
|
|
@ -1437,6 +1505,8 @@ let to_gen l =
|
||||||
l := l';
|
l := l';
|
||||||
Some x
|
Some x
|
||||||
|
|
||||||
|
[@@@iflt 5.1]
|
||||||
|
|
||||||
let of_gen g =
|
let of_gen g =
|
||||||
let rec direct i g =
|
let rec direct i g =
|
||||||
if i = 0 then
|
if i = 0 then
|
||||||
|
|
@ -1453,6 +1523,15 @@ let of_gen g =
|
||||||
in
|
in
|
||||||
direct direct_depth_default_ g
|
direct direct_depth_default_ g
|
||||||
|
|
||||||
|
[@@@else_]
|
||||||
|
|
||||||
|
let[@tail_mod_cons] rec of_gen g =
|
||||||
|
match g () with
|
||||||
|
| None -> []
|
||||||
|
| Some x -> x :: of_gen g
|
||||||
|
|
||||||
|
[@@@endif]
|
||||||
|
|
||||||
module Infix = struct
|
module Infix = struct
|
||||||
let[@inline] ( >|= ) l f = map f l
|
let[@inline] ( >|= ) l f = map f l
|
||||||
let[@inline] ( >>= ) l f = flat_map f l
|
let[@inline] ( >>= ) l f = flat_map f l
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue