Merge pull request #441 from c-cube/wip-rely-on-trmc

rely on TRMC more

.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 }}

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

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

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

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)
+combine (1 -- 10_000) (1 -- 10_000) = List.combine (1 -- 10_000) (1 -- 10_000)
-= List.combine (1 -- 100_000) (1 -- 100_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)

tests/data/t_misc.ml

@@ -37,7 +37,6 @@ module Mixset = struct
 end
 
 module Mixtbl = struct
-  open CCFun
   open CCMixtbl;;
 
   t @@ fun () ->