simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-07 03:35:30 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

wip: remove tests from src/

Browse source
This commit is contained in:
Simon Cruanes 2022-06-30 22:28:07 -04:00
parent 215c5c7d5b
commit 0bee9bdd55
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
12 changed files with 0 additions and 1386 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

232
src/core/CCArray.ml
View file

@ -9,11 +9,6 @@ type 'a ord = 'a -> 'a -> int
type 'a random_gen = Random.State.t -> 'a type 'a random_gen = Random.State.t -> 'a
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
(*$T
let st = Random.State.make [||] in let a = 0--10000 in \
let b = Array.copy a in shuffle_with st a; a <> b
*)
(** {2 Arrays} *) (** {2 Arrays} *)
open CCShims_ open CCShims_
@ -42,26 +37,9 @@ let get_safe a i =
then Some (Array.unsafe_get a i) then Some (Array.unsafe_get a i)
else None else None
(*$=
(Some 1) (get_safe [|1;2;3|] 0)
(Some 2) (get_safe [|1;2;3|] 1)
(Some 3) (get_safe [|1;2;3|] 2)
None (get_safe [|1;2;3|] 4)
None (get_safe [|1;2;3|] max_int)
None (get_safe [|1;2;3|] ~-1)
None (get_safe [|1;2;3|] ~-42)
*)
let map_inplace f a = let map_inplace f a =
Array.iteri (fun i e -> Array.unsafe_set a i (f e)) a Array.iteri (fun i e -> Array.unsafe_set a i (f e)) a
(*$Q
Q.(array int) (fun a -> \
let b = map ((+) 1) a in \
map_inplace ((+) 1) a; \
b = a)
*)
let fold = Array.fold_left let fold = Array.fold_left
let foldi f acc a = let foldi f acc a =
@ -80,10 +58,6 @@ let fold_while f acc a =
else acc else acc
in fold_while_i f acc 0 in fold_while_i f acc 0
(*$T
fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 (Array.of_list [true;true;false;true]) = 2
*)
let fold_map f acc a = let fold_map f acc a =
let n = length a in let n = length a in
(* need special case for initializing the result *) (* need special case for initializing the result *)
@ -100,16 +74,6 @@ let fold_map f acc a =
!acc, res !acc, res
) )
(*$=
(6, [|"1"; "2"; "3"|]) \
(fold_map (fun acc x->acc+x, string_of_int x) 0 [|1;2;3|])
*)
(*$Q
Q.(array int) (fun a -> \
fold_map (fun acc x -> x::acc, x) [] a = (List.rev @@ Array.to_list a, a))
*)
let scan_left f acc a = let scan_left f acc a =
let n = length a in let n = length a in
let res = Array.make (n+1) acc in let res = Array.make (n+1) acc in
@ -120,12 +84,6 @@ let scan_left f acc a =
a; a;
res res
(*$= & ~printer:Q.Print.(array int)
[|0;1;3;6|] (scan_left (+) 0 [|1;2;3|])
[|0|] (scan_left (+) 0 [||])
*)
let reverse_in_place a = let reverse_in_place a =
let len = Array.length a in let len = Array.length a in
if len>0 then ( if len>0 then (
@ -136,80 +94,25 @@ let reverse_in_place a =
done done
) )
(*$T
reverse_in_place [| |]; true
reverse_in_place [| 1 |]; true
let a = [| 1; 2; 3; 4; 5 |] in \
reverse_in_place a; \
a = [| 5;4;3;2;1 |]
let a = [| 1; 2; 3; 4; 5; 6 |] in \
reverse_in_place a; \
a = [| 6;5;4;3;2;1 |]
*)
let sorted cmp a = let sorted cmp a =
let b = Array.copy a in let b = Array.copy a in
Array.sort cmp b; Array.sort cmp b;
b b
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] (sorted Stdlib.compare [||])
[|0;1;2;3;4|] (sorted Stdlib.compare [|3;2;1;4;0|])
*)
(*$Q
Q.(array int) (fun a -> \
let b = Array.copy a in \
Array.sort Stdlib.compare b; b = sorted Stdlib.compare a)
*)
let sort_indices cmp a = let sort_indices cmp a =
let len = Array.length a in let len = Array.length a in
let b = Array.init len (fun k->k) in let b = Array.init len (fun k->k) in
Array.sort (fun k1 k2 -> cmp a.(k1) a.(k2)) b; Array.sort (fun k1 k2 -> cmp a.(k1) a.(k2)) b;
b b
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] (sort_indices Stdlib.compare [||])
[|4;2;1;0;3|] (sort_indices Stdlib.compare [|"d";"c";"b";"e";"a"|])
*)
(*$Q
Q.(array_of_size Gen.(0 -- 30) printable_string) (fun a -> \
let b = sort_indices String.compare a in \
sorted String.compare a = Array.map (Array.get a) b)
*)
let sort_ranking cmp a = let sort_ranking cmp a =
sort_indices compare (sort_indices cmp a) sort_indices compare (sort_indices cmp a)
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[||] (sort_ranking Stdlib.compare [||])
[|3;2;1;4;0|] (sort_ranking Stdlib.compare [|"d";"c";"b";"e";"a"|])
*)
(*$Q
Q.(array_of_size Gen.(0--50) printable_string) (fun a -> \
let b = sort_ranking String.compare a in \
let a_sorted = sorted String.compare a in \
a = Array.map (Array.get a_sorted) b)
*)
let rev a = let rev a =
let b = Array.copy a in let b = Array.copy a in
reverse_in_place b; reverse_in_place b;
b b
(*$Q
Q.(array small_int) (fun a -> rev (rev a) = a)
*)
(*$T
rev [| 1; 2; 3 |] = [| 3; 2; 1 |]
rev [| 1; 2; |] = [| 2; 1 |]
rev [| |] = [| |]
*)
exception Found exception Found
let mem ?(eq = Stdlib.(=)) elt a = let mem ?(eq = Stdlib.(=)) elt a =
@ -218,11 +121,6 @@ let mem ?(eq = Stdlib.(=)) elt a =
false false
with Found -> true with Found -> true
(*$Q mem
Q.(array small_int) (fun a -> \
mem 1 a = (Array.mem 1 a))
*)
let rec find_aux f a i = let rec find_aux f a i =
if i >= Array.length a then None if i >= Array.length a then None
else match f i a.(i) with else match f i a.(i) with
@ -252,14 +150,6 @@ let filter_map f a =
| Some x -> aux (x::acc) (i+1) | Some x -> aux (x::acc) (i+1)
in aux [] 0 in aux [] 0
(*$T
filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \
[| 1; 2; 3; 4 |] = [| "2"; "4" |]
filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \
[| 1; 2; 3; 4; 5; 6 |] \
= [| "2"; "4"; "6" |]
*)
let filter p a = let filter p a =
filter_map (fun x -> if p x then Some x else None) a filter_map (fun x -> if p x then Some x else None) a
@ -283,12 +173,6 @@ let flat_map f a =
aux (__rev_append_list a' acc 0) (i+1) aux (__rev_append_list a' acc 0) (i+1)
in aux [] 0 in aux [] 0
(*$T
let a = [| 1; 3; 5 |] in \
let a' = flat_map (fun x -> [| x; x+1 |]) a in \
a' = [| 1; 2; 3; 4; 5; 6 |]
*)
let monoid_product f a1 a2 = let monoid_product f a1 a2 =
let na1 = length a1 in let na1 = length a1 in
init (na1 * length a2) init (na1 * length a2)
@ -297,11 +181,6 @@ let monoid_product f a1 a2 =
let j = i_prod / na1 in let j = i_prod / na1 in
f a1.(i) a2.(j)) f a1.(i) a2.(j))
(*$= & ~cmp:(=) ~printer:Q.Print.(array int)
[| 11; 12; 21; 22 |] (sorted CCInt.compare @@ monoid_product (+) [| 10; 20 |] [| 1; 2 |])
[| 11; 12; 13; 14 |] (sorted CCInt.compare @@ monoid_product (+) [| 10 |] [| 1; 2; 3; 4 |])
*)
let rec _lookup_rec ~cmp k a i j = let rec _lookup_rec ~cmp k a i j =
if i>j then raise Not_found if i>j then raise Not_found
else if i=j else if i=j
@ -334,16 +213,6 @@ let lookup ~cmp k a =
try Some (_lookup_exn ~cmp k a 0 (Array.length a-1)) try Some (_lookup_exn ~cmp k a 0 (Array.length a-1))
with Not_found -> None with Not_found -> None
(*$T
lookup ~cmp:CCInt.compare 2 [|0;1;2;3;4;5|] = Some 2
lookup ~cmp:CCInt.compare 4 [|0;1;2;3;4;5|] = Some 4
lookup ~cmp:CCInt.compare 0 [|1;2;3;4;5|] = None
lookup ~cmp:CCInt.compare 6 [|1;2;3;4;5|] = None
lookup ~cmp:CCInt.compare 3 [| |] = None
lookup ~cmp:CCInt.compare 1 [| 1 |] = Some 0
lookup ~cmp:CCInt.compare 2 [| 1 |] = None
*)
let bsearch ~cmp k a = let bsearch ~cmp k a =
let rec aux i j = let rec aux i j =
if i > j if i > j
@ -362,16 +231,6 @@ let bsearch ~cmp k a =
| _, c when c<0 -> `All_lower | _, c when c<0 -> `All_lower
| _ -> aux 0 (n-1) | _ -> aux 0 (n-1)
(*$T bsearch
bsearch ~cmp:CCInt.compare 3 [|1; 2; 2; 3; 4; 10|] = `At 3
bsearch ~cmp:CCInt.compare 5 [|1; 2; 2; 3; 4; 10|] = `Just_after 4
bsearch ~cmp:CCInt.compare 1 [|1; 2; 5; 5; 11; 12|] = `At 0
bsearch ~cmp:CCInt.compare 12 [|1; 2; 5; 5; 11; 12|] = `At 5
bsearch ~cmp:CCInt.compare 10 [|1; 2; 2; 3; 4; 9|] = `All_lower
bsearch ~cmp:CCInt.compare 0 [|1; 2; 2; 3; 4; 9|] = `All_bigger
bsearch ~cmp:CCInt.compare 3 [| |] = `Empty
*)
let rec _for_all2 p a1 a2 i1 i2 ~len = let rec _for_all2 p a1 a2 i1 i2 ~len =
len=0 || (p a1.(i1) a2.(i2) && _for_all2 p a1 a2 (i1+1) (i2+1) ~len:(len-1)) len=0 || (p a1.(i1) a2.(i2) && _for_all2 p a1 a2 (i1+1) (i2+1) ~len:(len-1))
@ -406,28 +265,12 @@ let (--) i j =
else else
Array.init (i-j+1) (fun k -> i-k) Array.init (i-j+1) (fun k -> i-k)
(*$T
(1 -- 4) |> Array.to_list = [1;2;3;4]
(4 -- 1) |> Array.to_list = [4;3;2;1]
(0 -- 0) |> Array.to_list = [0]
*)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a -- b) |> Array.to_list = CCList.(a -- b))
*)
let (--^) i j = let (--^) i j =
if i=j then [| |] if i=j then [| |]
else if i>j else if i>j
then Array.init (i-j) (fun k -> i-k) then Array.init (i-j) (fun k -> i-k)
else Array.init (j-i) (fun k -> i+k) else Array.init (j-i) (fun k -> i+k)
(*$Q
Q.(pair small_int small_int) (fun (a,b) -> \
(a --^ b) |> Array.to_list = CCList.(a --^ b))
*)
(** all the elements of a, but the i-th, into a list *) (** all the elements of a, but the i-th, into a list *)
let except_idx a i = let except_idx a i =
foldi foldi
@ -443,15 +286,6 @@ let equal eq a b =
&& &&
aux 0 aux 0
(*$Q
Q.(pair (array small_int)(array small_int)) (fun (a,b) -> \
equal (=) a b = equal (=) b a)
*)
(*$T
equal (=) [|1|] [|1|]
*)
let compare cmp a b = let compare cmp a b =
let rec aux i = let rec aux i =
if i = Array.length a if i = Array.length a
@ -464,13 +298,6 @@ let compare cmp a b =
in in
aux 0 aux 0
(*$T
compare CCOrd.compare [| 1; 2; 3 |] [| 1; 2; 3 |] = 0
compare CCOrd.compare [| 1; 2; 3 |] [| 2; 2; 3 |] < 0
compare CCOrd.compare [| 1; 2; |] [| 1; 2; 3 |] < 0
compare CCOrd.compare [| 1; 2; 3 |] [| 1; 2; |] > 0
*)
(* swap elements of array *) (* swap elements of array *)
let swap a i j = let swap a i j =
if i<>j then ( if i<>j then (
@ -479,27 +306,6 @@ let swap a i j =
a.(j) <- tmp; a.(j) <- tmp;
) )
(*$T
let a = [| 1;2;3 |] in \
swap a 0 1; \
a = [| 2;1;3 |]
let a = [| 1;2;3 |] in \
swap a 0 2; \
a = [| 3;2;1 |]
*)
(*$QR
Q.(array_of_size Gen.(0 -- 100) small_int) (fun a ->
let b = Array.copy a in
for i = 0 to Array.length a-1 do
for j = i+1 to Array.length a-1 do
swap a i j; done; done;
for i = 0 to Array.length a-1 do
for j = i+1 to Array.length a-1 do
swap a i j; done; done;
a=b)
*)
(* shuffle a[i … j] using the given int random generator (* shuffle a[i … j] using the given int random generator
See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *) See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *)
let _shuffle _rand_int a i j = let _shuffle _rand_int a i j =
@ -555,13 +361,6 @@ let to_string ?(sep=", ") item_to_string a =
|> List.map item_to_string |> List.map item_to_string
|> String.concat sep |> String.concat sep
(*$= to_string & ~printer:(fun s -> s)
(to_string string_of_int [|1;2;3;4;5;6|]) "1, 2, 3, 4, 5, 6"
(to_string string_of_int [||]) ""
(to_string ~sep:" " string_of_int [|1;2;3;4;5;6|]) "1 2 3 4 5 6"
(to_string string_of_int [|1|]) "1"
*)
let to_seq a = let to_seq a =
let rec aux i () = let rec aux i () =
if i>= length a then Seq.Nil if i>= length a then Seq.Nil
@ -569,12 +368,6 @@ let to_seq a =
in in
aux 0 aux 0
(*$=
[] (to_seq [||] |> CCList.of_seq)
[1;2;3] (to_seq [|1;2;3|] |> CCList.of_seq)
CCList.(1 -- 1000) (to_seq (1--1000) |> CCList.of_seq)
*)
let to_iter a k = iter k a let to_iter a k = iter k a
let to_gen a = let to_gen a =
@ -698,31 +491,6 @@ let sort_generic (type arr)(type elt)
let module S = SortGeneric(A) in let module S = SortGeneric(A) in
S.sort ~cmp a S.sort ~cmp a
(*$inject
module IA = struct
let get = Array.get
let set = Array.set
let length = Array.length
type elt = int
type t = int array
end
let gen_arr = Q.Gen.(array_size (1--100) small_int)
let arr_arbitrary = Q.make
~print:Q.Print.(array int)
~small:Array.length
~shrink:Q.Shrink.(array ?shrink:None)
gen_arr
*)
(*$Q & ~count:300
arr_arbitrary (fun a -> \
let a1 = Array.copy a and a2 = Array.copy a in \
Array.sort CCInt.compare a1; sort_generic (module IA) ~cmp:CCInt.compare a2; \
a1 = a2 )
*)
module Infix = struct module Infix = struct
let (>>=) a f = flat_map f a let (>>=) a f = flat_map f a
let (>>|) a f = map f a let (>>|) a f = map f a

13
src/core/CCBool.ml
View file

@ -10,21 +10,8 @@ let compare (a:bool) b = Stdlib.compare a b
let to_int (x:bool) : int = if x then 1 else 0 let to_int (x:bool) : int = if x then 1 else 0
(*$=
1 (to_int true)
0 (to_int false)
*)
let of_int x : t = x<>0 let of_int x : t = x<>0
(*$=
true (of_int 1)
false (of_int 0)
true (of_int 42)
true (of_int max_int)
true (of_int min_int)
*)
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
let pp = Format.pp_print_bool let pp = Format.pp_print_bool

125
src/core/CCByte_buffer.ml
View file

@ -17,13 +17,6 @@ let[@inline] length self = self.sz
let[@inline] is_empty self = self.sz = 0 let[@inline] is_empty self = self.sz = 0
let[@inline] clear self = self.sz <- 0 let[@inline] clear self = self.sz <- 0
(*$T
(let b = create() in is_empty b)
(let b = create ~cap:32 () in is_empty b)
(let b = create() in length b = 0)
(let b = create ~cap:32 () in length b = 0)
*)
let grow_cap_ self = let grow_cap_ self =
min Sys.max_string_length min Sys.max_string_length
(let n = capacity self in n + n lsl 1 + 5) (let n = capacity self in n + n lsl 1 + 5)
@ -124,121 +117,3 @@ let to_seq self =
s 0 s 0
(* TODO: unicode operators.*) (* TODO: unicode operators.*)
(*$inject
let test_count = 2_500
open QCheck
type op =
| Add_char of char
| Add_string of string
| Get_contents
| Get of int
| Clear
| Shrink_to of int
| Set of int * char
let spf = Printf.sprintf
let str_op = function
| Add_char c -> spf "add_char %C" c
| Add_string s -> spf "add_string %S" s
| Get_contents -> "contents"
| Get i -> spf "get %d" i
| Clear -> "clear"
| Shrink_to n -> spf "shrink %d" n
| Set (i,c) -> spf "set %d %C" i c
let gen_op size : (_*_) Gen.t =
let open Gen in
let base = if size>0 then
[1, ((0--size) >|= fun x -> Get x, size);
1, ((0--size) >>= fun x -> printable >|= fun c -> Set (x,c), size);
1, ((0--size) >|= fun x -> Shrink_to x, x);
]
else []
in
frequency (base @ [
1, return (Get_contents, size);
1, return (Clear, 0);
3, (printable >|= fun c -> Add_char c, size+1);
1, (string_size (0 -- 100) ~gen:printable >|= fun s ->
Add_string s, size+String.length s);
])
let rec gen_l acc sz n =
let open Gen in
if n=0 then return (List.rev acc)
else (
gen_op sz >>= fun (op, sz) ->
gen_l (op::acc) sz (n-1)
)
let gen : op list Gen.t = Gen.sized (gen_l [] 0)
let is_valid ops =
let rec loop sz = function
| [] -> true
| Add_char _ :: tl -> loop (sz+1) tl
| Clear :: tl -> loop 0 tl
| Add_string s :: tl -> loop (sz+String.length s) tl
| (Get n | Set (n,_)) :: tl -> n < sz && loop sz tl
| Get_contents :: tl -> loop sz tl
| Shrink_to x :: tl -> x <= sz && loop x tl
in loop 0 ops
let shrink_op = Iter.(function
| Get_contents | Clear -> empty
| Get n -> Shrink.int n >|= fun n->Get n
| Add_char c -> Shrink.char c >|= fun c -> Add_char c
| Add_string s -> Shrink.string s >|= fun s -> Add_string s
| Shrink_to n -> Shrink.int n >|= fun n -> Shrink_to n
| Set (n,c) ->
(Shrink.int n >|= fun n-> Set(n,c)) <+>
(Shrink.char c >|= fun c-> Set(n,c))
)
let arb = make gen ~print:(Print.list str_op)
~shrink:Shrink.(filter is_valid @@ list ~shrink:shrink_op)
exception Nope of string
let prop_consistent ops =
let buf = ref "" in
let b = create ~cap:32 () in
let run_op op =
match op with
| Get i ->
assert (String.length !buf = length b);
let c1 = (!buf).[i] in
let c2 = get b i in
if c1<>c2 then raise (Nope (spf "c1=%C, c2=%C" c1 c2))
| Get_contents ->
let s1 = !buf in
let s2 = contents b in
if s1<>s2 then raise (Nope (spf "s1=%S, s2=%S" s1 s2))
| Add_char c -> buf := !buf ^ String.make 1 c; add_char b c
| Add_string s -> buf := !buf ^ s; append_string b s
| Clear -> buf := ""; clear b
| Shrink_to n -> buf := String.sub !buf 0 n; shrink_to b n
| Set (n,c) ->
(
let b' = Bytes.of_string !buf in
Bytes.set b' n c;
buf := Bytes.unsafe_to_string b';
);
set b n c
in
assume (is_valid ops);
try List.iter run_op ops; true
with Nope str ->
Test.fail_reportf "consistent ops failed:\n%s" str
*)
(*$Q
arb (fun ops -> prop_consistent ops)
*)

55
src/core/CCCanonical_sexp.ml
View file

@ -273,58 +273,3 @@ module Basic_ = struct
end end
include (Make(Basic_) : S with type t := t) include (Make(Basic_) : S with type t := t)
(*$inject
let csexp_bijective s = to_string s |> parse_string = Ok s
*)
(*$= & ~printer:CCFormat.(to_string (Dump.result pp))
(Ok (`List [`Atom ""])) (parse_string {|(0:)|})
(Ok (`List [`Atom "a"; `Atom "b "])) (parse_string {|(1:a2:b )|})
*)
(*$T
csexp_bijective (`List [`Atom ""])
*)
(*$inject
let sexp_gen =
let mkatom a = `Atom a and mklist l = `List l in
let atom = Q.Gen.(map mkatom (string_size ~gen:char (1 -- 30))) in
let gen = Q.Gen.(
sized (fix
(fun self n st -> match n with
| 0 -> atom st
| _ ->
frequency
[ 1, atom
; 2, map mklist (list_size (0 -- 10) (self (n/10)))
] st
)
)) in
let rec small = function
| `Atom s -> String.length s
| `List l -> List.fold_left (fun n x->n+small x) 0 l
and print = function
| `Atom s -> Printf.sprintf "`Atom \"%s\"" s
| `List l -> "`List " ^ Q.Print.list print l
and shrink = function
| `Atom s -> Q.Iter.map mkatom (Q.Shrink.string s)
| `List l -> Q.Iter.map mklist (Q.Shrink.list ~shrink l)
in
Q.make ~print ~small ~shrink gen
*)
(*$Q & ~count:100
sexp_gen csexp_bijective
*)
(*$R
let s1 =
`List (CCList.init 100_000
(fun i -> `List [`Atom "-"; `Atom (string_of_int i); `Atom ")(\n]"])) in
let str = to_string s1 in
match parse_string str with
| Ok s2 -> assert_equal s1 s2
| Error e -> assert_failure e
*)

9
src/core/CCChar.ml
View file

@ -13,17 +13,8 @@ let of_int_exn = Char.chr
let of_int c = try Some (of_int_exn c) with Invalid_argument _ -> None let of_int c = try Some (of_int_exn c) with Invalid_argument _ -> None
let to_int = Char.code let to_int = Char.code
(*$=
(Some 'a') (of_int (to_int 'a'))
None (of_int 257)
*)
let to_string c = String.make 1 c let to_string c = String.make 1 c
(*$Q to_string
(Q.string_of_size (Q.Gen.return 1)) (fun s -> CCShims_.Stdlib.(=) (to_string s.[0]) s)
*)
module Infix = struct module Infix = struct
let (=) : t -> t -> bool = CCShims_.Stdlib.(=) let (=) : t -> t -> bool = CCShims_.Stdlib.(=)
let (<>) : t -> t -> bool = CCShims_.Stdlib.(<>) let (<>) : t -> t -> bool = CCShims_.Stdlib.(<>)

20
src/core/CCEither.ml
View file

@ -15,32 +15,12 @@ let right r = Right r
let is_left = function Left _ -> true | Right _ -> false let is_left = function Left _ -> true | Right _ -> false
(*$=
(is_left (Left 1)) (true)
(is_left (Right 1)) (false)
*)
let is_right = function Left _ -> false | Right _ -> true let is_right = function Left _ -> false | Right _ -> true
(*$=
(is_right (Left 1)) (false)
(is_right (Right 1)) (true)
*)
let find_left = function Left l -> Some l | Right _ -> None let find_left = function Left l -> Some l | Right _ -> None
(*$=
(find_left (Left 1)) (Some 1)
(find_left (Right 1)) (None)
*)
let find_right = function Left _ -> None | Right r -> Some r let find_right = function Left _ -> None | Right r -> Some r
(*$=
(find_right (Left 1)) (None)
(find_right (Right 1)) (Some 1)
*)
let map_left f = function Left l -> Left (f l) | Right r -> Right r let map_left f = function Left l -> Left (f l) | Right r -> Right r
let map_right f = function Left l -> Left l | Right r -> Right (f r) let map_right f = function Left l -> Left l | Right r -> Right (f r)

5
src/core/CCEqual.ml
View file

@ -41,11 +41,6 @@ let triple f g h (x1,y1,z1)(x2,y2,z2) = f x1 x2 && g y1 y2 && h z1 z2
let map f eq x y = eq (f x) (f y) let map f eq x y = eq (f x) (f y)
(*$Q
Q.(let p = small_list (pair small_int bool) in pair p p) (fun (l1,l2) -> \
CCEqual.(list (pair int bool)) l1 l2 = (l1=l2))
*)
let always_eq _ _ = true let always_eq _ _ = true
let never_eq _ _ = false let never_eq _ _ = false

20
src/core/CCFloat.ml
View file

@ -62,20 +62,6 @@ let max (x : t) y =
| _, FP_nan -> x | _, FP_nan -> x
| _ -> if x > y then x else y | _ -> if x > y then x else y
(*$T
max nan 1. = 1.
min nan 1. = 1.
max 1. nan = 1.
min 1. nan = 1.
*)
(*$Q
Q.(pair float float) (fun (x,y) -> \
is_nan x || is_nan y || (min x y <= x && min x y <= y))
Q.(pair float float) (fun (x,y) -> \
is_nan x || is_nan y || (max x y >= x && max x y >= y))
*)
let equal (a:float) b = a=b let equal (a:float) b = a=b
let hash : t -> int = Hashtbl.hash let hash : t -> int = Hashtbl.hash
@ -102,12 +88,6 @@ let round x =
let high = ceil x in let high = ceil x in
if x-.low > high-.x then high else low if x-.low > high-.x then high else low
(*$=
2. (round 1.6)
1. (round 1.4)
0. (round 0.)
*)
let to_int (a:float) = Stdlib.int_of_float a let to_int (a:float) = Stdlib.int_of_float a
let of_int (a:int) = Stdlib.float_of_int a let of_int (a:int) = Stdlib.float_of_int a

95
src/core/CCFormat.ml
View file

@ -16,17 +16,6 @@ let silent _fmt _ = ()
let return fmt_str out () = Format.fprintf out "%(%)" fmt_str let return fmt_str out () = Format.fprintf out "%(%)" fmt_str
(*$inject
let to_string_test s = CCFormat.sprintf_no_color "@[<h>%a@]%!" s ()
*)
(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
"a b" (to_string_test (return "a@ b"))
", " (to_string_test (return ",@ "))
"and then" (to_string_test (return "@{<Red>and then@}@,"))
"a b" (to_string_test (return "@[<h>a@ b@]"))
*)
let unit fmt () = Format.pp_print_string fmt "()" let unit fmt () = Format.pp_print_string fmt "()"
let int fmt i = Format.pp_print_string fmt (string_of_int i) let int fmt i = Format.pp_print_string fmt (string_of_int i)
let string = Format.pp_print_string let string = Format.pp_print_string
@ -51,11 +40,6 @@ let substring out (s,i,len): unit =
let text = Format.pp_print_text let text = Format.pp_print_text
(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
"a\nb\nc" (sprintf_no_color "@[<v>%a@]%!" text "a b c")
"a b\nc" (sprintf_no_color "@[<h>%a@]%!" text "a b\nc")
*)
let string_lines out (s:string) : unit = let string_lines out (s:string) : unit =
fprintf out "@[<v>"; fprintf out "@[<v>";
let i = ref 0 in let i = ref 0 in
@ -69,10 +53,6 @@ let string_lines out (s:string) : unit =
done; done;
fprintf out "@]" fprintf out "@]"
(*$= & ~printer:(fun s->CCFormat.sprintf "%S" s)
"(a\n b\n c)" (sprintf_no_color "(@[<v>%a@])" string_lines "a\nb\nc")
*)
let list ?(sep=return ",@ ") pp fmt l = let list ?(sep=return ",@ ") pp fmt l =
let rec pp_list l = match l with let rec pp_list l = match l with
| x::((_::_) as l) -> | x::((_::_) as l) ->
@ -128,21 +108,9 @@ let append ppa ppb fmt () =
ppa fmt (); ppa fmt ();
ppb fmt () ppb fmt ()
(*$= append & ~printer:(fun s -> CCFormat.sprintf "%S" s)
"foobar" (to_string_test (append (return "foo") (return "bar")))
"bar" (to_string_test (append (return "") (return "bar")))
"foo" (to_string_test (append (return "foo") (return "")))
*)
let append_l ppl fmt () = let append_l ppl fmt () =
List.iter (fun pp -> pp fmt ()) ppl List.iter (fun pp -> pp fmt ()) ppl
(*$= append_l & ~printer:(fun s -> CCFormat.sprintf "%S" s)
"" (to_string_test @@ append_l [])
"foobarbaz" (to_string_test @@ append_l (List.map return ["foo"; "bar"; "baz"]))
"3141" (to_string_test @@ append_l (List.map (const int) [3; 14; 1]))
*)
let within a b p out x = let within a b p out x =
string out a; string out a;
p out x; p out x;
@ -227,17 +195,6 @@ let tee a b =
fb.Format.out_string str i len) fb.Format.out_string str i len)
(fun () -> fa.Format.out_flush (); fb.Format.out_flush ()) (fun () -> fa.Format.out_flush (); fb.Format.out_flush ())
(*$R
let buf1 = Buffer.create 42 in
let buf2 = Buffer.create 42 in
let f1 = Format.formatter_of_buffer buf1 in
let f2 = Format.formatter_of_buffer buf2 in
let fmt = tee f1 f2 in
Format.fprintf fmt "coucou@.";
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf1);
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
*)
let to_file filename format = let to_file filename format =
let oc = open_out filename in let oc = open_out filename in
let fmt = Format.formatter_of_out_channel oc in let fmt = Format.formatter_of_out_channel oc in
@ -287,10 +244,6 @@ module ANSI_codes = struct
let reset = string_of_style `Reset let reset = string_of_style `Reset
(*$=
ANSI_codes.reset "\x1b[0m"
*)
let string_of_style_list = function let string_of_style_list = function
| [] -> reset | [] -> reset
| [a] -> string_of_style a | [a] -> string_of_style a
@ -407,19 +360,6 @@ let set_color_tag_handling ppf =
in in
pp_set_formatter_stag_functions ppf funs' pp_set_formatter_stag_functions ppf funs'
(*$R
set_color_default true;
let s = sprintf
"what is your %a? %a! No, %a! Ahhhhhhh@."
(styling [`FG `White; `Bold] string) "favorite color"
(styling [`FG `Blue] string) "blue"
(styling [`FG `Red] string) "red"
in
assert_equal ~printer:CCFun.id
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \027[31mred\027[0m! Ahhhhhhh\n"
s
*)
[@@@else_] [@@@else_]
(* either prints the tag of [s] or delegate to [or_else] *) (* either prints the tag of [s] or delegate to [or_else] *)
@ -466,16 +406,6 @@ let set_color_default =
); );
) else if not b && !color_enabled then color_enabled := false ) else if not b && !color_enabled then color_enabled := false
(*$R
set_color_default true;
let s = sprintf
"what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>red@}! Ahhhhhhh@."
in
assert_equal ~printer:CCFun.id
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \027[31mred\027[0m! Ahhhhhhh\n"
s
*)
let with_color s pp out x = let with_color s pp out x =
pp_open_tag out s; pp_open_tag out s;
pp out x; pp out x;
@ -522,18 +452,6 @@ let fprintf_dyn_color ~colors out fmt =
(fun out -> Format.pp_set_mark_tags out old_tags) (fun out -> Format.pp_set_mark_tags out old_tags)
out fmt out fmt
(*$T
sprintf "yolo %s %d" "a b" 42 = "yolo a b 42"
sprintf "%d " 0 = "0 "
sprintf_no_color "%d " 0 = "0 "
*)
(*$R
set_color_default true;
assert_equal "\027[31myolo\027[0m" (sprintf "@{<red>yolo@}");
assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}");
*)
let ksprintf ?margin ~f fmt = let ksprintf ?margin ~f fmt =
let buf = Buffer.create 32 in let buf = Buffer.create 32 in
let out = Format.formatter_of_buffer buf in let out = Format.formatter_of_buffer buf in
@ -543,11 +461,6 @@ let ksprintf ?margin ~f fmt =
(fun _ -> Format.pp_print_flush out (); f (Buffer.contents buf)) (fun _ -> Format.pp_print_flush out (); f (Buffer.contents buf))
out fmt out fmt
(*$= & ~printer:CCFormat.(to_string (opt string))
(Some "hello world") \
(ksprintf ~f:(fun s -> Some s) "hello %a" CCFormat.string "world")
*)
module Dump = struct module Dump = struct
type 'a t = 'a printer type 'a t = 'a printer
let unit = unit let unit = unit
@ -574,14 +487,6 @@ module Dump = struct
let to_string = to_string let to_string = to_string
end end
(*$= & ~printer:(fun s->s)
"[1;2;3]" (to_string Dump.(list int) [1;2;3])
"Some 1" (to_string Dump.(option int) (Some 1))
"[None;Some \"a b\"]" (to_string Dump.(list (option string)) [None; Some "a b"])
"[(Ok \"a b c\");(Error \"nope\")]" \
(to_string Dump.(list (result string)) [Ok "a b c"; Error "nope"])
*)
module Infix = struct module Infix = struct
let (++) = append let (++) = append
end end

19
src/core/CCFun.ml
View file

@ -80,18 +80,6 @@ let rec iterate n f x =
else else
iterate (n - 1) f (f x) iterate (n - 1) f (f x)
(*$= iterate & ~printer:Q.Print.int
10 (iterate 0 succ 10)
11 (iterate 1 succ 10)
12 (iterate 2 succ 10)
15 (iterate 5 succ 10)
*)
(*$R
assert_raises
(Invalid_argument "CCFun.iterate")
(fun () -> iterate (-1) succ 10)
*)
module Infix = struct module Infix = struct
(* default implem for some operators *) (* default implem for some operators *)
let (|>) x f = f x let (|>) x f = f x
@ -101,13 +89,6 @@ module Infix = struct
let (%) f g x = f (g x) let (%) f g x = f (g x)
end end
(*$T
CCFun.((succ %> string_of_int) 2 = "3")
CCFun.((( * ) 3 % succ) 5 = 18)
CCFun.(succ @@ ( * ) 2 @@ pred @@ 3 = 5)
CCFun.(3 |> succ |> ( * ) 5 |> pred = 19)
*)
include Infix include Infix
module Monad(X : sig type t end) = struct module Monad(X : sig type t end) = struct

15
src/core/CCHash.ml
View file

@ -100,16 +100,6 @@ let bytes (x:bytes) =
let string (x:string) = bytes (Bytes.unsafe_of_string x) let string (x:string) = bytes (Bytes.unsafe_of_string x)
(*$T
int 42 >= 0
int max_int >= 0
int max_int = int max_int
int min_int >= 0
int 0 >= 0
char 'c' >= 0
int 152352 = int 152352
*)
let slice x i len = let slice x i len =
let j=i+len in let j=i+len in
let rec aux i s = let rec aux i s =
@ -147,11 +137,6 @@ let list_comm f l =
List.iteri (fun i x -> arr.(i) <- f x) l; List.iteri (fun i x -> arr.(i) <- f x) l;
array_of_hashes_ arr array_of_hashes_ arr
(*$T
list_comm int [1;2] = list_comm int [2;1]
list_comm int [1;2] <> list_comm int [2;3]
*)
let iter f seq = let iter f seq =
let h = ref 0x43 in let h = ref 0x43 in
seq (fun x -> h := combine f !h x); seq (fun x -> h := combine f !h x);

778
src/core/CCList.ml
View file

File diff suppressed because it is too large Load diff