diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index b40b35bf..f17d6f99 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -19,7 +19,7 @@ jobs: ocaml-compiler: - '4.08' - '4.14' - - '5.0' + - '5.1' - 'ocaml-variants.5.0.0+options,ocaml-option-bytecode-only' runs-on: ${{ matrix.os }} diff --git a/src/core/CCList.ml b/src/core/CCList.ml index 79a57708..3a15e151 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -1,27 +1,7 @@ -(* This file is free software, part of containers. See file "license" for more details. *) - -(** {1 Complements to list} *) - (* backport new functions from stdlib here *) [@@@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 = - match l with - | [] -> None - | x :: _ when p x -> Some x - | _ :: tl -> find_opt p tl - let rec compare_lengths l1 l2 = match l1, l2 with | [], [] -> 0 @@ -64,9 +44,12 @@ let mguard c = else [] -(* max depth for direct recursion *) +(** max depth for direct recursion *) let direct_depth_default_ = 1000 +(* TRMC on >= 5.1, no need to bring our own *) +[@@@iflt 5.1] + let tail_map f l = (* 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 @@ -136,6 +119,8 @@ let append l1 l2 = | [ x; y ] -> x :: y :: l2 | _ -> direct direct_depth_append_ l1 l2 +[@@@endif] + let ( @ ) = append let[@inline] cons' l x = x :: l @@ -144,6 +129,9 @@ let cons_maybe o l = | Some x -> x :: l | None -> l +(* TRMC after 5.1 *) +[@@@iflt 5.1] + let direct_depth_filter_ = 10_000 let filter p l = @@ -178,6 +166,8 @@ let fold_right f l acc = in direct direct_depth_default_ f l acc +[@@@endif] + let rec fold_while f acc = function | [] -> acc | e :: l -> @@ -286,6 +276,9 @@ let fold_flat_map_i f acc l = in aux f acc 0 [] l +[@@@iflt 5.1] + +(* keep this because it's tailrec for < 5.1 *) let init len f = let rec indirect_ i acc = if i = len then @@ -311,6 +304,8 @@ let init len f = else direct_ 0 +[@@@endif] + let rec compare f l1 l2 = match l1, l2 with | [], [] -> 0 @@ -425,6 +420,8 @@ let partition_filter_map f l = let partition_map = partition_filter_map +[@@@iflt 5.1] + let combine l1 l2 = let rec direct i l1 l2 = match l1, l2 with @@ -440,6 +437,16 @@ let combine l1 l2 = in 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 l1 = ref l1 in let l2 = ref l2 in @@ -451,6 +458,8 @@ let combine_gen l1 l2 = l2 := tail2; Some (x1, x2) +[@@@iflt 5.1] + let combine_shortest l1 l2 = let rec direct i l1 l2 = match l1, l2 with @@ -466,6 +475,15 @@ let combine_shortest l1 l2 = in 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 rec direct i l = match l with @@ -666,6 +684,8 @@ let sorted_diff_uniq ~cmp l1 l2 = in recurse ~cmp [] l1 l2 +[@@@iflt 5.1] + let take n l = let rec direct i n l = match l with @@ -684,6 +704,19 @@ let take n l = in 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 = match l with | [] -> [] @@ -748,6 +781,8 @@ let interleave l1 l2 : _ list = in aux [] l1 l2 +[@@@iflt 5.1] + let take_while p l = let rec direct i p l = match l with @@ -769,6 +804,19 @@ let take_while p l = in 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 = match l with | [] -> [] @@ -1416,6 +1464,8 @@ let of_seq_rev l = in loop [] l +[@@@iflt 5.1] + let of_seq l = let rec direct i seq = if i <= 0 then @@ -1428,6 +1478,8 @@ let of_seq l = in direct direct_depth_default_ l +[@@@endif] + let to_gen l = let l = ref l in fun () -> @@ -1437,6 +1489,8 @@ let to_gen l = l := l'; Some x +[@@@iflt 5.1] + let of_gen g = let rec direct i g = if i = 0 then @@ -1453,6 +1507,15 @@ let of_gen g = in 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 let[@inline] ( >|= ) l f = map f l let[@inline] ( >>= ) l f = flat_map f l diff --git a/src/core/CCList.mli b/src/core/CCList.mli index b4f5078f..0e159cb6 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -1,5 +1,3 @@ -(* This file is free software, part of containers. See file "license" for more details. *) - (** Complements to List *) type 'a iter = ('a -> unit) -> unit diff --git a/src/core/cpp/cpp.ml b/src/core/cpp/cpp.ml index 8ce5e529..5535049e 100644 --- a/src/core/cpp/cpp.ml +++ b/src/core/cpp/cpp.ml @@ -1,6 +1,6 @@ module C = Configurator.V1 -type op = Le | Ge +type op = Le | Ge | Gt | Lt type line = | If of op * int * int @@ -29,7 +29,9 @@ let prefix ~pre s = let eval ~major ~minor op i j = match op with | Le -> (major, minor) <= (i, j) + | Lt -> (major, minor) < (i, j) | Ge -> (major, minor) >= (i, j) + | Gt -> (major, minor) > (i, j) let preproc_lines ~file ~major ~minor (ic : in_channel) : unit = let pos = ref 0 in @@ -47,8 +49,12 @@ let preproc_lines ~file ~major ~minor (ic : in_channel) : unit = if line' <> "" && line'.[0] = '[' then if prefix line' ~pre:"[@@@ifle" then Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If (Le, x, y)) + else if prefix line' ~pre:"[@@@iflt" then + Scanf.sscanf line' "[@@@iflt %d.%d]" (fun x y -> If (Lt, x, y)) else if prefix line' ~pre:"[@@@ifge" then Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If (Ge, x, y)) + else if prefix line' ~pre:"[@@@ifgt" then + Scanf.sscanf line' "[@@@ifgt %d.%d]" (fun x y -> If (Gt, x, y)) else if prefix line' ~pre:"[@@@elifle" then Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif (Le, x, y)) else if prefix line' ~pre:"[@@@elifge" then diff --git a/tests/core/t_list.ml b/tests/core/t_list.ml index 1de591f8..4bc6ffb1 100644 --- a/tests/core/t_list.ml +++ b/tests/core/t_list.ml @@ -233,8 +233,13 @@ combine [ 1; 2; 3 ] [ 3; 2; 1 ] = List.combine [ 1; 2; 3 ] [ 3; 2; 1 ] ;; t @@ fun () -> -combine (1 -- 100_000) (1 -- 100_000) -= List.combine (1 -- 100_000) (1 -- 100_000) +combine (1 -- 10_000) (1 -- 10_000) = List.combine (1 -- 10_000) (1 -- 10_000) +;; + +t @@ fun () -> +combine (1 -- 300_000) (map string_of_int @@ (1 -- 300_000)) += map (fun (x, y) -> y, x) + @@ combine (map string_of_int @@ (1 -- 300_000)) (1 -- 300_000) ;; q @@ -741,6 +746,7 @@ t @@ fun () -> take_while (fun x -> x < 10) (1 -- 20) = 1 -- 9;; t @@ fun () -> take_while (fun x -> x <> 0) [ 0; 1; 2; 3 ] = [];; t @@ fun () -> take_while (fun _ -> true) [] = [];; t @@ fun () -> take_while (fun _ -> true) (1 -- 10) = 1 -- 10;; +t @@ fun () -> take_while (fun _ -> true) (1 -- 300_000) = 1 -- 300_000;; q Q.(pair (fun1 Observable.int bool) (list small_int)) @@ -761,6 +767,13 @@ q l1 = take_while (Q.Fn.apply f) l && l2 = drop_while (Q.Fn.apply f) l) ;; +t @@ fun () -> take_drop_while (fun _ -> true) [] = ([], []);; +t @@ fun () -> take_drop_while (fun _ -> true) (1 -- 10) = (1 -- 10, []);; + +t @@ fun () -> +take_drop_while (fun _ -> true) (1 -- 300_000) = (1 -- 300_000, []) +;; + eq ~printer:Q.Print.(option (list int)) (Some [ 2; 3 ]) (tail_opt [ 1; 2; 3 ]);; eq ~printer:Q.Print.(option (list int)) (Some []) (tail_opt [ 1 ]);; eq ~printer:Q.Print.(option (list int)) None (tail_opt []);; @@ -1046,6 +1059,8 @@ random_len 10 CCInt.random_small (Random.State.make [||]) |> List.length = 10 eq ~printer:(fun s -> s) (to_string string_of_int []) "";; eq ~printer:(fun s -> s) (to_string ~start:"[" ~stop:"]" string_of_int []) "[]" ;; +eq (1 -- 100) (of_seq (to_seq (1 -- 100)));; +eq (1 -- 100_000) (of_seq (to_seq (1 -- 100_000)));; eq ~printer:(fun s -> s) @@ -1067,6 +1082,8 @@ eq q Q.(list int) (fun l -> of_iter (to_iter l) = l);; q Q.(list int) (fun l -> of_gen (to_gen l) = l);; +eq (1 -- 100) (of_gen (to_gen (1 -- 100)));; +eq (1 -- 100_000) (of_gen (to_gen (1 -- 100_000)));; eq ~printer:(fun s -> s) diff --git a/tests/data/t_misc.ml b/tests/data/t_misc.ml index 5f7baa7c..af2811ac 100644 --- a/tests/data/t_misc.ml +++ b/tests/data/t_misc.ml @@ -37,7 +37,6 @@ module Mixset = struct end module Mixtbl = struct - open CCFun open CCMixtbl;; t @@ fun () ->