mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
Internally shadow polymorphic operators and functions from Pervasives
This commit is contained in:
parent
01a3b94ff9
commit
6d2063ded4
32 changed files with 146 additions and 104 deletions
1
.merlin
1
.merlin
|
|
@ -20,3 +20,4 @@ PKG threads.posix
|
||||||
PKG lwt
|
PKG lwt
|
||||||
PKG qcheck
|
PKG qcheck
|
||||||
FLG -w +a-4-44-48-60@8
|
FLG -w +a-4-44-48-60@8
|
||||||
|
FLG -open CCMonomorphic
|
||||||
|
|
|
||||||
9
_oasis
9
_oasis
|
|
@ -44,7 +44,7 @@ Library "containers"
|
||||||
CCInt64, CCChar, CCResult, CCParse, CCArray_slice,
|
CCInt64, CCChar, CCResult, CCParse, CCArray_slice,
|
||||||
CCListLabels, CCArrayLabels, CCEqual,
|
CCListLabels, CCArrayLabels, CCEqual,
|
||||||
Containers
|
Containers
|
||||||
BuildDepends: bytes, result
|
BuildDepends: bytes, result, containers.monomorphic
|
||||||
# BuildDepends: bytes, bisect_ppx
|
# BuildDepends: bytes, bisect_ppx
|
||||||
|
|
||||||
Library "containers_monomorphic"
|
Library "containers_monomorphic"
|
||||||
|
|
@ -56,14 +56,14 @@ Library "containers_monomorphic"
|
||||||
Library "containers_unix"
|
Library "containers_unix"
|
||||||
Path: src/unix
|
Path: src/unix
|
||||||
Modules: CCUnix
|
Modules: CCUnix
|
||||||
BuildDepends: bytes, result, unix
|
BuildDepends: bytes, result, unix, containers.monomorphic
|
||||||
FindlibParent: containers
|
FindlibParent: containers
|
||||||
FindlibName: unix
|
FindlibName: unix
|
||||||
|
|
||||||
Library "containers_sexp"
|
Library "containers_sexp"
|
||||||
Path: src/sexp
|
Path: src/sexp
|
||||||
Modules: CCSexp, CCSexp_lex
|
Modules: CCSexp, CCSexp_lex
|
||||||
BuildDepends: bytes, result
|
BuildDepends: bytes, result, containers.monomorphic
|
||||||
FindlibParent: containers
|
FindlibParent: containers
|
||||||
FindlibName: sexp
|
FindlibName: sexp
|
||||||
|
|
||||||
|
|
@ -75,7 +75,7 @@ Library "containers_data"
|
||||||
CCMixset, CCGraph, CCHashSet, CCBitField,
|
CCMixset, CCGraph, CCHashSet, CCBitField,
|
||||||
CCHashTrie, CCWBTree, CCRAL, CCSimple_queue,
|
CCHashTrie, CCWBTree, CCRAL, CCSimple_queue,
|
||||||
CCImmutArray, CCHet, CCZipper
|
CCImmutArray, CCHet, CCZipper
|
||||||
BuildDepends: bytes
|
BuildDepends: bytes, containers.monomorphic
|
||||||
# BuildDepends: bytes, bisect_ppx
|
# BuildDepends: bytes, bisect_ppx
|
||||||
FindlibParent: containers
|
FindlibParent: containers
|
||||||
FindlibName: data
|
FindlibName: data
|
||||||
|
|
@ -83,6 +83,7 @@ Library "containers_data"
|
||||||
Library "containers_iter"
|
Library "containers_iter"
|
||||||
Path: src/iter
|
Path: src/iter
|
||||||
Modules: CCKTree, CCKList, CCLazy_list
|
Modules: CCKTree, CCKList, CCLazy_list
|
||||||
|
BuildDepends: containers.monomorphic
|
||||||
FindlibParent: containers
|
FindlibParent: containers
|
||||||
FindlibName: iter
|
FindlibName: iter
|
||||||
|
|
||||||
|
|
|
||||||
1
_tags
1
_tags
|
|
@ -161,3 +161,4 @@ true: annot, bin_annot
|
||||||
<src/**/*.ml> and not <src/misc/*.ml>: warn(+a-4-44-58-60@8)
|
<src/**/*.ml> and not <src/misc/*.ml>: warn(+a-4-44-58-60@8)
|
||||||
true: no_alias_deps, safe_string, short_paths, color(always)
|
true: no_alias_deps, safe_string, short_paths, color(always)
|
||||||
<src/**/*Labels.cm*>: nolabels
|
<src/**/*Labels.cm*>: nolabels
|
||||||
|
not (<src/monomorphic/CCMonomorphic.*> or <qtest/*>): open(CCMonomorphic)
|
||||||
|
|
|
||||||
|
|
@ -280,7 +280,7 @@ module Arr = struct
|
||||||
let a2 = Array.copy a1 in
|
let a2 = Array.copy a1 in
|
||||||
sort_std a1;
|
sort_std a1;
|
||||||
quicksort ~limit:10 a2;
|
quicksort ~limit:10 a2;
|
||||||
assert (a1 = a2))
|
assert (CCArray.equal CCInt.equal a1 a2))
|
||||||
[ 10; 100; 1000]
|
[ 10; 100; 1000]
|
||||||
|
|
||||||
let bench_sort ?(time=2) n =
|
let bench_sort ?(time=2) n =
|
||||||
|
|
@ -1154,7 +1154,7 @@ module Str = struct
|
||||||
and mk_current () = CCString.find_all_l ~sub:needle haystack
|
and mk_current () = CCString.find_all_l ~sub:needle haystack
|
||||||
and mk_current_compiled =
|
and mk_current_compiled =
|
||||||
let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in
|
let f = CCString.find_all_l ~start:0 ~sub:needle in fun () -> f haystack in
|
||||||
assert (mk_naive () = mk_current ());
|
assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ()));
|
||||||
B.throughputN 3 ~repeat
|
B.throughputN 3 ~repeat
|
||||||
[ "naive", mk_naive, ()
|
[ "naive", mk_naive, ()
|
||||||
; "current", mk_current, ()
|
; "current", mk_current, ()
|
||||||
|
|
@ -1168,7 +1168,7 @@ module Str = struct
|
||||||
pp_pb needle haystack;
|
pp_pb needle haystack;
|
||||||
let mk_naive () = find_all_l ~sub:needle haystack
|
let mk_naive () = find_all_l ~sub:needle haystack
|
||||||
and mk_current () = CCString.find_all_l ~sub:needle haystack in
|
and mk_current () = CCString.find_all_l ~sub:needle haystack in
|
||||||
assert (mk_naive () = mk_current ());
|
assert (CCList.equal CCInt.equal (mk_naive ()) (mk_current ()));
|
||||||
B.throughputN 3 ~repeat
|
B.throughputN 3 ~repeat
|
||||||
[ "naive", mk_naive, ()
|
[ "naive", mk_naive, ()
|
||||||
; "current", mk_current, ()
|
; "current", mk_current, ()
|
||||||
|
|
@ -1182,7 +1182,7 @@ module Str = struct
|
||||||
let rec same s1 s2 i =
|
let rec same s1 s2 i =
|
||||||
if i = String.length s1 then true
|
if i = String.length s1 then true
|
||||||
else (
|
else (
|
||||||
String.unsafe_get s1 i = String.unsafe_get s2 i && same s1 s2 (i+1)
|
CCChar.equal (String.unsafe_get s1 i) (String.unsafe_get s2 i) && same s1 s2 (i+1)
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
String.length pre <= String.length s &&
|
String.length pre <= String.length s &&
|
||||||
|
|
@ -1193,7 +1193,7 @@ module Str = struct
|
||||||
begin
|
begin
|
||||||
let i = ref 0 in
|
let i = ref 0 in
|
||||||
while !i < String.length pre &&
|
while !i < String.length pre &&
|
||||||
String.unsafe_get s !i = String.unsafe_get pre !i
|
CCChar.equal (String.unsafe_get s !i) (String.unsafe_get pre !i)
|
||||||
do incr i done;
|
do incr i done;
|
||||||
!i = String.length pre
|
!i = String.length pre
|
||||||
end
|
end
|
||||||
|
|
@ -1225,7 +1225,7 @@ module Str = struct
|
||||||
else
|
else
|
||||||
let rec loop str p i =
|
let rec loop str p i =
|
||||||
if i = len then true
|
if i = len then true
|
||||||
else if String.unsafe_get str i <> String.unsafe_get p i then false
|
else if not (CCChar.equal (String.unsafe_get str i) (String.unsafe_get p i)) then false
|
||||||
else loop str p (i + 1)
|
else loop str p (i + 1)
|
||||||
in loop str p 0
|
in loop str p 0
|
||||||
|
|
||||||
|
|
@ -1256,7 +1256,7 @@ module Str = struct
|
||||||
Array.iteri
|
Array.iteri
|
||||||
(fun i (pre, y) ->
|
(fun i (pre, y) ->
|
||||||
let res = f ~pre y in
|
let res = f ~pre y in
|
||||||
assert (res = output.(i)))
|
assert (CCBool.equal res output.(i)))
|
||||||
input
|
input
|
||||||
in
|
in
|
||||||
Benchmark.throughputN 3
|
Benchmark.throughputN 3
|
||||||
|
|
|
||||||
2
opam
2
opam
|
|
@ -39,6 +39,6 @@ conflicts: [
|
||||||
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
|
tags: [ "stdlib" "containers" "iterators" "list" "heap" "queue" ]
|
||||||
homepage: "https://github.com/c-cube/ocaml-containers/"
|
homepage: "https://github.com/c-cube/ocaml-containers/"
|
||||||
doc: "http://cedeela.fr/~simon/software/containers/"
|
doc: "http://cedeela.fr/~simon/software/containers/"
|
||||||
available: [ocaml-version >= "4.01.0"]
|
available: [ocaml-version >= "4.02.0"]
|
||||||
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
|
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
|
||||||
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
|
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,7 @@
|
||||||
|
|
||||||
type t = bool
|
type t = bool
|
||||||
|
|
||||||
let equal (a:bool) b = a=b
|
let equal (a:bool) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let compare (a:bool) b = Pervasives.compare a b
|
let compare (a:bool) b = Pervasives.compare a b
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,7 @@
|
||||||
|
|
||||||
include Char
|
include Char
|
||||||
|
|
||||||
let equal (a:char) b = a=b
|
let equal (a:char) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let pp = Buffer.add_char
|
let pp = Buffer.add_char
|
||||||
let print = Format.pp_print_char
|
let print = Format.pp_print_char
|
||||||
|
|
@ -15,12 +15,10 @@ let of_int_exn = Char.chr
|
||||||
let of_int c = try Some (of_int_exn c) with _ -> None
|
let of_int c = try Some (of_int_exn c) with _ -> None
|
||||||
let to_int = Char.code
|
let to_int = Char.code
|
||||||
|
|
||||||
let lowercase_ascii c =
|
let lowercase_ascii = function
|
||||||
if c >= 'A' && c <= 'Z'
|
| 'A'..'Z' as c -> Char.unsafe_chr (Char.code c + 32)
|
||||||
then Char.unsafe_chr (Char. code c + 32)
|
| c -> c
|
||||||
else c
|
|
||||||
|
|
||||||
let uppercase_ascii c =
|
let uppercase_ascii = function
|
||||||
if c >= 'a' && c <= 'z'
|
| 'a'..'z' as c -> Char.unsafe_chr (Char.code c - 32)
|
||||||
then Char.unsafe_chr (Char.code c - 32)
|
| c -> c
|
||||||
else c
|
|
||||||
|
|
|
||||||
|
|
@ -5,12 +5,12 @@
|
||||||
|
|
||||||
type 'a t = 'a -> 'a -> bool
|
type 'a t = 'a -> 'a -> bool
|
||||||
|
|
||||||
let poly = (=)
|
let poly = Pervasives.(=)
|
||||||
|
|
||||||
let int : int t = (=)
|
let int : int t = (=)
|
||||||
let string : string t = (=)
|
let string : string t = Pervasives.(=)
|
||||||
let bool : bool t = (=)
|
let bool : bool t = Pervasives.(=)
|
||||||
let float : float t = (=)
|
let float : float t = Pervasives.(=)
|
||||||
let unit () () = true
|
let unit () () = true
|
||||||
|
|
||||||
let rec list f l1 l2 = match l1, l2 with
|
let rec list f l1 l2 = match l1, l2 with
|
||||||
|
|
|
||||||
|
|
@ -9,6 +9,16 @@ type fpclass = Pervasives.fpclass =
|
||||||
| FP_infinite
|
| FP_infinite
|
||||||
| FP_nan
|
| FP_nan
|
||||||
|
|
||||||
|
module Infix = struct
|
||||||
|
let (=) = Pervasives.(=)
|
||||||
|
let (<>) = Pervasives.(<>)
|
||||||
|
let (<) = Pervasives.(<)
|
||||||
|
let (>) = Pervasives.(>)
|
||||||
|
let (<=) = Pervasives.(<=)
|
||||||
|
let (>=) = Pervasives.(>=)
|
||||||
|
end
|
||||||
|
include Infix
|
||||||
|
|
||||||
let nan = Pervasives.nan
|
let nan = Pervasives.nan
|
||||||
|
|
||||||
let infinity = Pervasives.infinity
|
let infinity = Pervasives.infinity
|
||||||
|
|
@ -84,13 +94,3 @@ let random_range i j st = i +. random (j-.i) st
|
||||||
let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
|
let equal_precision ~epsilon a b = abs_float (a-.b) < epsilon
|
||||||
|
|
||||||
let classify = Pervasives.classify_float
|
let classify = Pervasives.classify_float
|
||||||
|
|
||||||
module Infix = struct
|
|
||||||
let (=) = Pervasives.(=)
|
|
||||||
let (<>) = Pervasives.(<>)
|
|
||||||
let (<) = Pervasives.(<)
|
|
||||||
let (>) = Pervasives.(>)
|
|
||||||
let (<=) = Pervasives.(<=)
|
|
||||||
let (>=) = Pervasives.(>=)
|
|
||||||
end
|
|
||||||
include Infix
|
|
||||||
|
|
|
||||||
|
|
@ -75,9 +75,11 @@ let floor_div a n =
|
||||||
(fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m)))
|
(fun (n, m) -> floor_div n (-m) = int_of_float @@ floor (float n /. float (-m)))
|
||||||
*)
|
*)
|
||||||
|
|
||||||
|
let bool_neq (a : bool) b = Pervasives.(<>) a b
|
||||||
|
|
||||||
let rem a n =
|
let rem a n =
|
||||||
let y = a mod n in
|
let y = a mod n in
|
||||||
if (y < 0) <> (n < 0) && y <> 0 then
|
if bool_neq (y < 0) (n < 0) && y <> 0 then
|
||||||
y + n
|
y + n
|
||||||
else
|
else
|
||||||
y
|
y
|
||||||
|
|
|
||||||
|
|
@ -28,7 +28,7 @@ let (lsr) = shift_right_logical
|
||||||
|
|
||||||
let (asr) = shift_right
|
let (asr) = shift_right
|
||||||
|
|
||||||
let equal (x:t) y = x=y
|
let equal (x:t) y = Pervasives.(=) x y
|
||||||
|
|
||||||
let hash x = Pervasives.abs (to_int x)
|
let hash x = Pervasives.abs (to_int x)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -635,7 +635,7 @@ let sorted_insert ?(cmp=Pervasives.compare) ?(uniq=false) x l =
|
||||||
List.mem x (sorted_insert x l))
|
List.mem x (sorted_insert x l))
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let uniq_succ ?(eq=(=)) l =
|
let uniq_succ ?(eq=Pervasives.(=)) l =
|
||||||
let rec f acc l = match l with
|
let rec f acc l = match l with
|
||||||
| [] -> List.rev acc
|
| [] -> List.rev acc
|
||||||
| [x] -> List.rev (x::acc)
|
| [x] -> List.rev (x::acc)
|
||||||
|
|
@ -648,7 +648,7 @@ let uniq_succ ?(eq=(=)) l =
|
||||||
uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1]
|
uniq_succ [1;1;2;3;1;6;6;4;6;1] = [1;2;3;1;6;4;6;1]
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let group_succ ?(eq=(=)) l =
|
let group_succ ?(eq=Pervasives.(=)) l =
|
||||||
let rec f ~eq acc cur l = match cur, l with
|
let rec f ~eq acc cur l = match cur, l with
|
||||||
| [], [] -> List.rev acc
|
| [], [] -> List.rev acc
|
||||||
| _::_, [] -> List.rev (List.rev cur :: acc)
|
| _::_, [] -> List.rev (List.rev cur :: acc)
|
||||||
|
|
@ -766,7 +766,7 @@ let sublists_of_len ?(last=fun _ -> None) ?offset n l =
|
||||||
(* add sub-lists of [l] to [acc] *)
|
(* add sub-lists of [l] to [acc] *)
|
||||||
let rec aux acc l =
|
let rec aux acc l =
|
||||||
let group = take n l in
|
let group = take n l in
|
||||||
if group=[] then acc (* this was the last group, we are done *)
|
if is_empty group then acc (* this was the last group, we are done *)
|
||||||
else if List.length group < n (* last group, with missing elements *)
|
else if List.length group < n (* last group, with missing elements *)
|
||||||
then match last group with
|
then match last group with
|
||||||
| None -> acc
|
| None -> acc
|
||||||
|
|
@ -900,7 +900,7 @@ let find_idx p l = find_mapi (fun i x -> if p x then Some (i, x) else None) l
|
||||||
find_map (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None
|
find_map (fun x -> if x=3 then Some "a" else None) [1;2;4;5] = None
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let remove ?(eq=(=)) ~x l =
|
let remove ?(eq=Pervasives.(=)) ~x l =
|
||||||
let rec remove' eq x acc l = match l with
|
let rec remove' eq x acc l = match l with
|
||||||
| [] -> List.rev acc
|
| [] -> List.rev acc
|
||||||
| y :: tail when eq x y -> remove' eq x acc tail
|
| y :: tail when eq x y -> remove' eq x acc tail
|
||||||
|
|
@ -972,16 +972,16 @@ let all_ok l =
|
||||||
(Error "e2") (all_ok [Ok 1; Error "e2"; Error "e3"; Ok 4])
|
(Error "e2") (all_ok [Ok 1; Error "e2"; Error "e3"; Ok 4])
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let mem ?(eq=(=)) x l =
|
let mem ?(eq=Pervasives.(=)) x l =
|
||||||
let rec search eq x l = match l with
|
let rec search eq x l = match l with
|
||||||
| [] -> false
|
| [] -> false
|
||||||
| y::l' -> eq x y || search eq x l'
|
| y::l' -> eq x y || search eq x l'
|
||||||
in search eq x l
|
in search eq x l
|
||||||
|
|
||||||
let add_nodup ?(eq=(=)) x l =
|
let add_nodup ?(eq=Pervasives.(=)) x l =
|
||||||
if mem ~eq x l then l else x::l
|
if mem ~eq x l then l else x::l
|
||||||
|
|
||||||
let remove_one ?(eq=(=)) x l =
|
let remove_one ?(eq=Pervasives.(=)) x l =
|
||||||
let rec remove_one ~eq x acc l = match l with
|
let rec remove_one ~eq x acc l = match l with
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| y :: tl when eq x y -> List.rev_append acc tl
|
| y :: tl when eq x y -> List.rev_append acc tl
|
||||||
|
|
@ -998,12 +998,12 @@ let remove_one ?(eq=(=)) x l =
|
||||||
not (mem x l) || List.length (remove_one x l) = List.length l - 1)
|
not (mem x l) || List.length (remove_one x l) = List.length l - 1)
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let subset ?(eq=(=)) l1 l2 =
|
let subset ?(eq=Pervasives.(=)) l1 l2 =
|
||||||
List.for_all
|
List.for_all
|
||||||
(fun t -> mem ~eq t l2)
|
(fun t -> mem ~eq t l2)
|
||||||
l1
|
l1
|
||||||
|
|
||||||
let uniq ?(eq=(=)) l =
|
let uniq ?(eq=Pervasives.(=)) l =
|
||||||
let rec uniq eq acc l = match l with
|
let rec uniq eq acc l = match l with
|
||||||
| [] -> List.rev acc
|
| [] -> List.rev acc
|
||||||
| x::xs when List.exists (eq x) xs -> uniq eq acc xs
|
| x::xs when List.exists (eq x) xs -> uniq eq acc xs
|
||||||
|
|
@ -1019,7 +1019,7 @@ let uniq ?(eq=(=)) l =
|
||||||
sort_uniq l = (uniq l |> sort Pervasives.compare))
|
sort_uniq l = (uniq l |> sort Pervasives.compare))
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let union ?(eq=(=)) l1 l2 =
|
let union ?(eq=Pervasives.(=)) l1 l2 =
|
||||||
let rec union eq acc l1 l2 = match l1 with
|
let rec union eq acc l1 l2 = match l1 with
|
||||||
| [] -> List.rev_append acc l2
|
| [] -> List.rev_append acc l2
|
||||||
| x::xs when mem ~eq x l2 -> union eq acc xs l2
|
| x::xs when mem ~eq x l2 -> union eq acc xs l2
|
||||||
|
|
@ -1030,7 +1030,7 @@ let union ?(eq=(=)) l1 l2 =
|
||||||
union [1;2;4] [2;3;4;5] = [1;2;3;4;5]
|
union [1;2;4] [2;3;4;5] = [1;2;3;4;5]
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let inter ?(eq=(=)) l1 l2 =
|
let inter ?(eq=Pervasives.(=)) l1 l2 =
|
||||||
let rec inter eq acc l1 l2 = match l1 with
|
let rec inter eq acc l1 l2 = match l1 with
|
||||||
| [] -> List.rev acc
|
| [] -> List.rev acc
|
||||||
| x::xs when mem ~eq x l2 -> inter eq (x::acc) xs l2
|
| x::xs when mem ~eq x l2 -> inter eq (x::acc) xs l2
|
||||||
|
|
@ -1236,9 +1236,9 @@ module Assoc = struct
|
||||||
| (y,z)::l' ->
|
| (y,z)::l' ->
|
||||||
if eq x y then z else search_exn eq l' x
|
if eq x y then z else search_exn eq l' x
|
||||||
|
|
||||||
let get_exn ?(eq=(=)) x l = search_exn eq l x
|
let get_exn ?(eq=Pervasives.(=)) x l = search_exn eq l x
|
||||||
|
|
||||||
let get ?(eq=(=)) x l =
|
let get ?(eq=Pervasives.(=)) x l =
|
||||||
try Some (search_exn eq l x)
|
try Some (search_exn eq l x)
|
||||||
with Not_found -> None
|
with Not_found -> None
|
||||||
|
|
||||||
|
|
@ -1259,7 +1259,7 @@ module Assoc = struct
|
||||||
then f x (Some y') (List.rev_append acc l')
|
then f x (Some y') (List.rev_append acc l')
|
||||||
else search_set eq ((x',y')::acc) l' x ~f
|
else search_set eq ((x',y')::acc) l' x ~f
|
||||||
|
|
||||||
let set ?(eq=(=)) x y l =
|
let set ?(eq=Pervasives.(=)) x y l =
|
||||||
search_set eq [] l x
|
search_set eq [] l x
|
||||||
~f:(fun x _ l -> (x,y)::l)
|
~f:(fun x _ l -> (x,y)::l)
|
||||||
|
|
||||||
|
|
@ -1270,7 +1270,7 @@ module Assoc = struct
|
||||||
= [1, "1"; 2, "2"; 3, "3"]
|
= [1, "1"; 2, "2"; 3, "3"]
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let mem ?(eq=(=)) x l =
|
let mem ?(eq=Pervasives.(=)) x l =
|
||||||
try ignore (search_exn eq l x); true
|
try ignore (search_exn eq l x); true
|
||||||
with Not_found -> false
|
with Not_found -> false
|
||||||
|
|
||||||
|
|
@ -1279,7 +1279,7 @@ module Assoc = struct
|
||||||
not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"])
|
not (Assoc.mem 4 [1,"1"; 2,"2"; 3, "3"])
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let update ?(eq=(=)) ~f x l =
|
let update ?(eq=Pervasives.(=)) ~f x l =
|
||||||
search_set eq [] l x
|
search_set eq [] l x
|
||||||
~f:(fun x opt_y rest ->
|
~f:(fun x opt_y rest ->
|
||||||
match f opt_y with
|
match f opt_y with
|
||||||
|
|
@ -1297,7 +1297,7 @@ module Assoc = struct
|
||||||
~f:(function None -> Some "3" | _ -> assert false) |> lsort)
|
~f:(function None -> Some "3" | _ -> assert false) |> lsort)
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let remove ?(eq=(=)) x l =
|
let remove ?(eq=Pervasives.(=)) x l =
|
||||||
search_set eq [] l x
|
search_set eq [] l x
|
||||||
~f:(fun _ opt_y rest -> match opt_y with
|
~f:(fun _ opt_y rest -> match opt_y with
|
||||||
| None -> l (* keep as is *)
|
| None -> l (* keep as is *)
|
||||||
|
|
|
||||||
|
|
@ -43,6 +43,9 @@ type state = {
|
||||||
|
|
||||||
exception ParseError of parse_branch * (unit -> string)
|
exception ParseError of parse_branch * (unit -> string)
|
||||||
|
|
||||||
|
let char_equal (a : char) b = Pervasives.(=) a b
|
||||||
|
let string_equal (a : string) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let rec string_of_branch l =
|
let rec string_of_branch l =
|
||||||
let pp_s () = function
|
let pp_s () = function
|
||||||
| None -> ""
|
| None -> ""
|
||||||
|
|
@ -87,7 +90,7 @@ let next st ~ok ~err =
|
||||||
else (
|
else (
|
||||||
let c = st.str.[st.i] in
|
let c = st.str.[st.i] in
|
||||||
st.i <- st.i + 1;
|
st.i <- st.i + 1;
|
||||||
if c='\n'
|
if char_equal c '\n'
|
||||||
then (st.lnum <- st.lnum + 1; st.cnum <- 1)
|
then (st.lnum <- st.lnum + 1; st.cnum <- 1)
|
||||||
else st.cnum <- st.cnum + 1;
|
else st.cnum <- st.cnum + 1;
|
||||||
ok c
|
ok c
|
||||||
|
|
@ -146,7 +149,7 @@ let char c =
|
||||||
let msg = Printf.sprintf "expected '%c'" c in
|
let msg = Printf.sprintf "expected '%c'" c in
|
||||||
fun st ~ok ~err ->
|
fun st ~ok ~err ->
|
||||||
next st ~err
|
next st ~err
|
||||||
~ok:(fun c' -> if c=c' then ok c else fail_ ~err st (const_ msg))
|
~ok:(fun c' -> if char_equal c c' then ok c else fail_ ~err st (const_ msg))
|
||||||
|
|
||||||
let char_if p st ~ok ~err =
|
let char_if p st ~ok ~err =
|
||||||
next st ~err
|
next st ~err
|
||||||
|
|
@ -164,7 +167,7 @@ let chars_if p st ~ok ~err:_ =
|
||||||
let chars1_if p st ~ok ~err =
|
let chars1_if p st ~ok ~err =
|
||||||
chars_if p st ~err
|
chars_if p st ~err
|
||||||
~ok:(fun s ->
|
~ok:(fun s ->
|
||||||
if s = ""
|
if string_equal s ""
|
||||||
then fail_ ~err st (const_ "unexpected sequence of chars")
|
then fail_ ~err st (const_ "unexpected sequence of chars")
|
||||||
else ok s)
|
else ok s)
|
||||||
|
|
||||||
|
|
@ -231,7 +234,7 @@ let string s st ~ok ~err =
|
||||||
else
|
else
|
||||||
next st ~err
|
next st ~err
|
||||||
~ok:(fun c ->
|
~ok:(fun c ->
|
||||||
if c = s.[i]
|
if char_equal c s.[i]
|
||||||
then check (i+1)
|
then check (i+1)
|
||||||
else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s))
|
else fail_ ~err st (fun () -> Printf.sprintf "expected \"%s\"" s))
|
||||||
in
|
in
|
||||||
|
|
@ -386,7 +389,7 @@ module U = struct
|
||||||
skip_white <* string stop
|
skip_white <* string stop
|
||||||
|
|
||||||
let int =
|
let int =
|
||||||
chars1_if (fun c -> is_num c || c='-')
|
chars1_if (fun c -> is_num c || char_equal c '-')
|
||||||
>>= fun s ->
|
>>= fun s ->
|
||||||
try return (int_of_string s)
|
try return (int_of_string s)
|
||||||
with Failure _ -> fail "expected an int"
|
with Failure _ -> fail "expected an int"
|
||||||
|
|
|
||||||
|
|
@ -77,7 +77,7 @@ let replicate n g st =
|
||||||
in aux [] n
|
in aux [] n
|
||||||
|
|
||||||
(* Sample without replacement using rejection sampling. *)
|
(* Sample without replacement using rejection sampling. *)
|
||||||
let sample_without_replacement (type elt) ?(compare=compare) k (rng:elt t) st=
|
let sample_without_replacement (type elt) ?(compare=Pervasives.compare) k (rng:elt t) st=
|
||||||
let module S = Set.Make(struct type t=elt let compare = compare end) in
|
let module S = Set.Make(struct type t=elt let compare = compare end) in
|
||||||
let rec aux s k =
|
let rec aux s k =
|
||||||
if k <= 0 then
|
if k <= 0 then
|
||||||
|
|
@ -221,6 +221,7 @@ let uniformity_test ?(size_hint=10) k rng st =
|
||||||
let confidence = 4. in
|
let confidence = 4. in
|
||||||
let std = confidence *. (sqrt (kf *. variance)) in
|
let std = confidence *. (sqrt (kf *. variance)) in
|
||||||
let predicate _key n acc =
|
let predicate _key n acc =
|
||||||
|
let (<) (a : float) b = Pervasives.(<) a b in
|
||||||
acc && abs_float (average -. float_of_int n) < std in
|
acc && abs_float (average -. float_of_int n) < std in
|
||||||
Hashtbl.fold predicate histogram true
|
Hashtbl.fold predicate histogram true
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -56,7 +56,7 @@ module type S = sig
|
||||||
val print : Format.formatter -> t -> unit
|
val print : Format.formatter -> t -> unit
|
||||||
end
|
end
|
||||||
|
|
||||||
let equal (a:string) b = a=b
|
let equal (a:string) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let compare = String.compare
|
let compare = String.compare
|
||||||
|
|
||||||
|
|
@ -78,7 +78,7 @@ let _is_sub ~sub i s j ~len =
|
||||||
let rec check k =
|
let rec check k =
|
||||||
if k = len
|
if k = len
|
||||||
then true
|
then true
|
||||||
else sub.[i+k] = s.[j+k] && check (k+1)
|
else CCChar.equal sub.[i+k] s.[j+k] && check (k+1)
|
||||||
in
|
in
|
||||||
j+len <= String.length s && check 0
|
j+len <= String.length s && check 0
|
||||||
|
|
||||||
|
|
@ -126,7 +126,7 @@ module Find = struct
|
||||||
let j = ref 0 in
|
let j = ref 0 in
|
||||||
while !i < len do
|
while !i < len do
|
||||||
match !j with
|
match !j with
|
||||||
| _ when get str (!i-1) = get str !j ->
|
| _ when CCChar.equal (get str (!i-1)) (get str !j) ->
|
||||||
(* substring starting at !j continues matching current char *)
|
(* substring starting at !j continues matching current char *)
|
||||||
incr j;
|
incr j;
|
||||||
failure.(!i) <- !j;
|
failure.(!i) <- !j;
|
||||||
|
|
@ -158,7 +158,7 @@ module Find = struct
|
||||||
while !j < pat_len && !i + !j < len do
|
while !j < pat_len && !i + !j < len do
|
||||||
let c = String.get s (!i + !j) in
|
let c = String.get s (!i + !j) in
|
||||||
let expected = String.get pattern.str !j in
|
let expected = String.get pattern.str !j in
|
||||||
if c = expected
|
if CCChar.equal c expected
|
||||||
then (
|
then (
|
||||||
(* char matches *)
|
(* char matches *)
|
||||||
incr j;
|
incr j;
|
||||||
|
|
@ -193,7 +193,7 @@ module Find = struct
|
||||||
while !j < pat_len && !i + !j < len do
|
while !j < pat_len && !i + !j < len do
|
||||||
let c = String.get s (len - !i - !j - 1) in
|
let c = String.get s (len - !i - !j - 1) in
|
||||||
let expected = String.get pattern.str (String.length pattern.str - !j - 1) in
|
let expected = String.get pattern.str (String.length pattern.str - !j - 1) in
|
||||||
if c = expected
|
if CCChar.equal c expected
|
||||||
then (
|
then (
|
||||||
(* char matches *)
|
(* char matches *)
|
||||||
incr j;
|
incr j;
|
||||||
|
|
@ -292,7 +292,7 @@ let replace_at_ ~pos ~len ~by s =
|
||||||
Buffer.contents b
|
Buffer.contents b
|
||||||
|
|
||||||
let replace ?(which=`All) ~sub ~by s =
|
let replace ?(which=`All) ~sub ~by s =
|
||||||
if sub="" then invalid_arg "CCString.replace";
|
if is_empty sub then invalid_arg "CCString.replace";
|
||||||
match which with
|
match which with
|
||||||
| `Left ->
|
| `Left ->
|
||||||
let i = find ~sub s ~start:0 in
|
let i = find ~sub s ~start:0 in
|
||||||
|
|
@ -490,7 +490,7 @@ let edit_distance s1 s2 =
|
||||||
then length s2
|
then length s2
|
||||||
else if length s2 = 0
|
else if length s2 = 0
|
||||||
then length s1
|
then length s1
|
||||||
else if s1 = s2
|
else if equal s1 s2
|
||||||
then 0
|
then 0
|
||||||
else begin
|
else begin
|
||||||
(* distance vectors (v0=previous, v1=current) *)
|
(* distance vectors (v0=previous, v1=current) *)
|
||||||
|
|
@ -777,14 +777,9 @@ let exists2 p s1 s2 =
|
||||||
(** {2 Ascii functions} *)
|
(** {2 Ascii functions} *)
|
||||||
|
|
||||||
let equal_caseless s1 s2: bool =
|
let equal_caseless s1 s2: bool =
|
||||||
let char_lower c =
|
|
||||||
if c >= 'A' && c <= 'Z'
|
|
||||||
then Char.unsafe_chr (Char. code c + 32)
|
|
||||||
else c
|
|
||||||
in
|
|
||||||
String.length s1 = String.length s2 &&
|
String.length s1 = String.length s2 &&
|
||||||
for_all2
|
for_all2
|
||||||
(fun c1 c2 -> char_lower c1 = char_lower c2)
|
(fun c1 c2 -> CCChar.equal (CCChar.lowercase_ascii c1) (CCChar.lowercase_ascii c2))
|
||||||
s1 s2
|
s1 s2
|
||||||
|
|
||||||
let pp buf s =
|
let pp buf s =
|
||||||
|
|
|
||||||
|
|
@ -513,7 +513,7 @@ let for_all p v =
|
||||||
else p v.vec.(i) && check (i+1)
|
else p v.vec.(i) && check (i+1)
|
||||||
in check 0
|
in check 0
|
||||||
|
|
||||||
let member ?(eq=(=)) x v =
|
let member ?(eq=Pervasives.(=)) x v =
|
||||||
exists (eq x) v
|
exists (eq x) v
|
||||||
|
|
||||||
let find_exn p v =
|
let find_exn p v =
|
||||||
|
|
|
||||||
|
|
@ -161,9 +161,13 @@ module Replacing = struct
|
||||||
| Pair _
|
| Pair _
|
||||||
| Empty -> raise Not_found
|
| Empty -> raise Not_found
|
||||||
|
|
||||||
|
let is_empty = function
|
||||||
|
| Empty -> true
|
||||||
|
| Pair _ -> false
|
||||||
|
|
||||||
let set c x y =
|
let set c x y =
|
||||||
let i = c.hash x mod Array.length c.arr in
|
let i = c.hash x mod Array.length c.arr in
|
||||||
if c.arr.(i) = Empty then c.c_size <- c.c_size + 1;
|
if is_empty c.arr.(i) then c.c_size <- c.c_size + 1;
|
||||||
c.arr.(i) <- Pair (x,y)
|
c.arr.(i) <- Pair (x,y)
|
||||||
|
|
||||||
let iter c f =
|
let iter c f =
|
||||||
|
|
|
||||||
|
|
@ -74,9 +74,11 @@ let is_zero_ n = match n.cell with
|
||||||
| Two _
|
| Two _
|
||||||
| Three _ -> false
|
| Three _ -> false
|
||||||
|
|
||||||
|
let bool_eq (a : bool) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let is_empty d =
|
let is_empty d =
|
||||||
let res = d.size = 0 in
|
let res = d.size = 0 in
|
||||||
assert (res = is_zero_ d.cur);
|
assert (bool_eq res (is_zero_ d.cur));
|
||||||
res
|
res
|
||||||
|
|
||||||
let push_front d x =
|
let push_front d x =
|
||||||
|
|
@ -377,7 +379,7 @@ let copy d =
|
||||||
assert_equal ~cmp q q'
|
assert_equal ~cmp q q'
|
||||||
*)
|
*)
|
||||||
|
|
||||||
let equal ?(eq=(=)) a b =
|
let equal ?(eq=Pervasives.(=)) a b =
|
||||||
let rec aux eq a b = match a() , b() with
|
let rec aux eq a b = match a() , b() with
|
||||||
| None, None -> true
|
| None, None -> true
|
||||||
| None, Some _
|
| None, Some _
|
||||||
|
|
@ -412,4 +414,3 @@ let print pp_x out d =
|
||||||
pp_x out x
|
pp_x out x
|
||||||
) d;
|
) d;
|
||||||
Format.fprintf out "}@]"
|
Format.fprintf out "}@]"
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -34,10 +34,14 @@ let empty = Shallow Zero
|
||||||
|
|
||||||
exception Empty
|
exception Empty
|
||||||
|
|
||||||
|
let is_not_zero = function
|
||||||
|
| Zero -> false
|
||||||
|
| One _ | Two _ | Three _ -> true
|
||||||
|
|
||||||
let _single x = Shallow (One x)
|
let _single x = Shallow (One x)
|
||||||
let _double x y = Shallow (Two (x,y))
|
let _double x y = Shallow (Two (x,y))
|
||||||
let _deep n hd middle tl =
|
let _deep n hd middle tl =
|
||||||
assert (hd<>Zero && tl<>Zero);
|
assert (is_not_zero hd && is_not_zero tl);
|
||||||
Deep (n, hd, middle, tl)
|
Deep (n, hd, middle, tl)
|
||||||
|
|
||||||
let is_empty = function
|
let is_empty = function
|
||||||
|
|
|
||||||
|
|
@ -56,7 +56,7 @@ type ('k, 'a) table = {
|
||||||
(** Mutable set *)
|
(** Mutable set *)
|
||||||
type 'a set = ('a, unit) table
|
type 'a set = ('a, unit) table
|
||||||
|
|
||||||
let mk_table (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size =
|
let mk_table (type k) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) size =
|
||||||
let module H = Hashtbl.Make(struct
|
let module H = Hashtbl.Make(struct
|
||||||
type t = k
|
type t = k
|
||||||
let equal = eq
|
let equal = eq
|
||||||
|
|
@ -240,7 +240,7 @@ module Traverse = struct
|
||||||
| (v1,_,_) :: path' ->
|
| (v1,_,_) :: path' ->
|
||||||
eq v v1 || list_mem_ ~eq ~graph v path'
|
eq v v1 || list_mem_ ~eq ~graph v path'
|
||||||
|
|
||||||
let dfs_tag ?(eq=(=)) ~tags ~graph seq =
|
let dfs_tag ?(eq=Pervasives.(=)) ~tags ~graph seq =
|
||||||
let first = ref true in
|
let first = ref true in
|
||||||
fun k ->
|
fun k ->
|
||||||
if !first then first := false else raise Sequence_once;
|
if !first then first := false else raise Sequence_once;
|
||||||
|
|
@ -316,7 +316,7 @@ let is_dag ?(tbl=mk_table 128) ~graph vs =
|
||||||
|
|
||||||
exception Has_cycle
|
exception Has_cycle
|
||||||
|
|
||||||
let topo_sort_tag ?(eq=(=)) ?(rev=false) ~tags ~graph seq =
|
let topo_sort_tag ?(eq=Pervasives.(=)) ?(rev=false) ~tags ~graph seq =
|
||||||
(* use DFS *)
|
(* use DFS *)
|
||||||
let l =
|
let l =
|
||||||
Traverse.Event.dfs_tag ~eq ~tags ~graph seq
|
Traverse.Event.dfs_tag ~eq ~tags ~graph seq
|
||||||
|
|
@ -542,7 +542,7 @@ module Dot = struct
|
||||||
(** Print an enum of Full.traverse_event *)
|
(** Print an enum of Full.traverse_event *)
|
||||||
let pp_seq
|
let pp_seq
|
||||||
?(tbl=mk_table 128)
|
?(tbl=mk_table 128)
|
||||||
?(eq=(=))
|
?(eq=Pervasives.(=))
|
||||||
?(attrs_v=fun _ -> [])
|
?(attrs_v=fun _ -> [])
|
||||||
?(attrs_e=fun _ -> [])
|
?(attrs_e=fun _ -> [])
|
||||||
?(name="graph")
|
?(name="graph")
|
||||||
|
|
@ -622,7 +622,7 @@ type ('v, 'e) mut_graph = {
|
||||||
remove : 'v -> unit;
|
remove : 'v -> unit;
|
||||||
}
|
}
|
||||||
|
|
||||||
let mk_mut_tbl (type k) ?(eq=(=)) ?(hash=Hashtbl.hash) size =
|
let mk_mut_tbl (type k) ?(eq=Pervasives.(=)) ?(hash=Hashtbl.hash) size =
|
||||||
let module Tbl = Hashtbl.Make(struct
|
let module Tbl = Hashtbl.Make(struct
|
||||||
type t = k
|
type t = k
|
||||||
let hash = hash
|
let hash = hash
|
||||||
|
|
@ -757,7 +757,7 @@ end
|
||||||
|
|
||||||
(** {2 Misc} *)
|
(** {2 Misc} *)
|
||||||
|
|
||||||
let of_list ?(eq=(=)) l =
|
let of_list ?(eq=Pervasives.(=)) l =
|
||||||
(fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l)
|
(fun v yield -> List.iter (fun (a,b) -> if eq a v then yield ((),b)) l)
|
||||||
|
|
||||||
let of_fun f =
|
let of_fun f =
|
||||||
|
|
|
||||||
|
|
@ -292,6 +292,7 @@ module Make(Key : KEY)
|
||||||
val make : Key.t -> t
|
val make : Key.t -> t
|
||||||
val zero : t (* special "hash" *)
|
val zero : t (* special "hash" *)
|
||||||
val is_0 : t -> bool
|
val is_0 : t -> bool
|
||||||
|
val equal : t -> t -> bool
|
||||||
val rem : t -> int (* [A.length_log] last bits *)
|
val rem : t -> int (* [A.length_log] last bits *)
|
||||||
val quotient : t -> t (* remove [A.length_log] last bits *)
|
val quotient : t -> t (* remove [A.length_log] last bits *)
|
||||||
end = struct
|
end = struct
|
||||||
|
|
@ -299,6 +300,7 @@ module Make(Key : KEY)
|
||||||
let make = Key.hash
|
let make = Key.hash
|
||||||
let zero = 0
|
let zero = 0
|
||||||
let is_0 h = h==0
|
let is_0 h = h==0
|
||||||
|
let equal (a : int) b = Pervasives.(=) a b
|
||||||
let rem h = h land (A.length - 1)
|
let rem h = h land (A.length - 1)
|
||||||
let quotient h = h lsr A.length_log
|
let quotient h = h lsr A.length_log
|
||||||
end
|
end
|
||||||
|
|
@ -407,14 +409,14 @@ module Make(Key : KEY)
|
||||||
let rec add_ ~id k v ~h m = match m with
|
let rec add_ ~id k v ~h m = match m with
|
||||||
| E -> S (h, k, v)
|
| E -> S (h, k, v)
|
||||||
| S (h', k', v') ->
|
| S (h', k', v') ->
|
||||||
if h=h'
|
if Hash.equal h h'
|
||||||
then if Key.equal k k'
|
then if Key.equal k k'
|
||||||
then S (h, k, v) (* replace *)
|
then S (h, k, v) (* replace *)
|
||||||
else L (h, Cons (k, v, Cons (k', v', Nil)))
|
else L (h, Cons (k, v, Cons (k', v', Nil)))
|
||||||
else
|
else
|
||||||
make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h
|
make_array_ ~id ~leaf:(Cons (k', v', Nil)) ~h_leaf:h' k v ~h
|
||||||
| L (h', l) ->
|
| L (h', l) ->
|
||||||
if h=h'
|
if Hash.equal h h'
|
||||||
then L (h, add_list_ k v l)
|
then L (h, add_list_ k v l)
|
||||||
else (* split into N *)
|
else (* split into N *)
|
||||||
make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h
|
make_array_ ~id ~leaf:l ~h_leaf:h' k v ~h
|
||||||
|
|
|
||||||
|
|
@ -11,6 +11,7 @@ module Bit : sig
|
||||||
type t = private int
|
type t = private int
|
||||||
val highest : int -> t
|
val highest : int -> t
|
||||||
val min_int : t
|
val min_int : t
|
||||||
|
val equal : t -> t -> bool
|
||||||
val is_0 : bit:t -> int -> bool
|
val is_0 : bit:t -> int -> bool
|
||||||
val is_1 : bit:t -> int -> bool
|
val is_1 : bit:t -> int -> bool
|
||||||
val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *)
|
val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *)
|
||||||
|
|
@ -21,6 +22,8 @@ end = struct
|
||||||
|
|
||||||
let min_int = min_int
|
let min_int = min_int
|
||||||
|
|
||||||
|
let equal (a : int) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let rec highest_bit_naive x m =
|
let rec highest_bit_naive x m =
|
||||||
if x=m then m
|
if x=m then m
|
||||||
else highest_bit_naive (x land (lnot m)) (2*m)
|
else highest_bit_naive (x land (lnot m)) (2*m)
|
||||||
|
|
@ -241,7 +244,7 @@ let rec equal ~eq a b = a==b || match a, b with
|
||||||
| E, E -> true
|
| E, E -> true
|
||||||
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb
|
| L (ka, va), L (kb, vb) -> ka = kb && eq va vb
|
||||||
| N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
|
| N (pa, sa, la, ra), N (pb, sb, lb, rb) ->
|
||||||
pa=pb && sa=sb && equal ~eq la lb && equal ~eq ra rb
|
pa=pb && Bit.equal sa sb && equal ~eq la lb && equal ~eq ra rb
|
||||||
| E, _
|
| E, _
|
||||||
| N _, _
|
| N _, _
|
||||||
| L _, _ -> false
|
| L _, _ -> false
|
||||||
|
|
@ -295,7 +298,7 @@ let rec union f t1 t2 =
|
||||||
(* insert k, v into o *)
|
(* insert k, v into o *)
|
||||||
insert_ (fun ~old v -> f k old v) k v o
|
insert_ (fun ~old v -> f k old v) k v o
|
||||||
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
|
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
|
||||||
if p1 = p2 && m1 = m2
|
if p1 = p2 && Bit.equal m1 m2
|
||||||
then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
|
then mk_node_ p1 m1 (union f l1 l2) (union f r1 r2)
|
||||||
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
|
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
|
||||||
then if Bit.is_0 p2 ~bit:m1
|
then if Bit.is_0 p2 ~bit:m1
|
||||||
|
|
@ -353,7 +356,7 @@ let rec inter f a b =
|
||||||
with Not_found -> E
|
with Not_found -> E
|
||||||
end
|
end
|
||||||
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
|
| N (p1, m1, l1, r1), N (p2, m2, l2, r2) ->
|
||||||
if p1 = p2 && m1 = m2
|
if p1 = p2 && Bit.equal m1 m2
|
||||||
then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
|
then mk_node_ p1 m1 (inter f l1 l2) (inter f r1 r2)
|
||||||
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
|
else if Bit.gt m1 m2 && is_prefix_ ~prefix:p1 p2 ~bit:m1
|
||||||
then if Bit.is_0 p2 ~bit:m1
|
then if Bit.is_0 p2 ~bit:m1
|
||||||
|
|
|
||||||
|
|
@ -123,9 +123,13 @@ module Make(X : ORD) : S with type key = X.t = struct
|
||||||
|
|
||||||
let remove = M.remove
|
let remove = M.remove
|
||||||
|
|
||||||
|
let is_some = function
|
||||||
|
| None -> false
|
||||||
|
| Some _ -> true
|
||||||
|
|
||||||
let mem ~inj x map =
|
let mem ~inj x map =
|
||||||
try
|
try
|
||||||
inj.get (M.find x map) <> None
|
is_some (inj.get (M.find x map))
|
||||||
with Not_found -> false
|
with Not_found -> false
|
||||||
|
|
||||||
let iter_keys ~f map =
|
let iter_keys ~f map =
|
||||||
|
|
|
||||||
|
|
@ -84,9 +84,13 @@ let remove tbl x = Hashtbl.remove tbl x
|
||||||
|
|
||||||
let copy tbl = Hashtbl.copy tbl
|
let copy tbl = Hashtbl.copy tbl
|
||||||
|
|
||||||
|
let is_some = function
|
||||||
|
| None -> false
|
||||||
|
| Some _ -> true
|
||||||
|
|
||||||
let mem ~inj tbl x =
|
let mem ~inj tbl x =
|
||||||
try
|
try
|
||||||
inj.get (Hashtbl.find tbl x) <> None
|
is_some (inj.get (Hashtbl.find tbl x))
|
||||||
with Not_found -> false
|
with Not_found -> false
|
||||||
|
|
||||||
(*$R
|
(*$R
|
||||||
|
|
|
||||||
|
|
@ -371,7 +371,7 @@ let drop_while ~f l =
|
||||||
|
|
||||||
let take_drop n l = take n l, drop n l
|
let take_drop n l = take n l, drop n l
|
||||||
|
|
||||||
let equal ?(eq=(=)) l1 l2 =
|
let equal ?(eq=Pervasives.(=)) l1 l2 =
|
||||||
let rec aux ~eq l1 l2 = match l1, l2 with
|
let rec aux ~eq l1 l2 = match l1, l2 with
|
||||||
| Nil, Nil -> true
|
| Nil, Nil -> true
|
||||||
| Cons (size1, t1, l1'), Cons (size2, t2, l2') ->
|
| Cons (size1, t1, l1'), Cons (size2, t2, l2') ->
|
||||||
|
|
|
||||||
|
|
@ -23,7 +23,11 @@ let make_ hd tl = match hd with
|
||||||
| [] -> {hd=List.rev tl; tl=[] }
|
| [] -> {hd=List.rev tl; tl=[] }
|
||||||
| _::_ -> {hd; tl; }
|
| _::_ -> {hd; tl; }
|
||||||
|
|
||||||
let is_empty q = q.hd = []
|
let list_is_empty = function
|
||||||
|
| [] -> true
|
||||||
|
| _::_ -> false
|
||||||
|
|
||||||
|
let is_empty q = list_is_empty q.hd
|
||||||
|
|
||||||
let push x q = make_ q.hd (x :: q.tl)
|
let push x q = make_ q.hd (x :: q.tl)
|
||||||
|
|
||||||
|
|
@ -31,7 +35,7 @@ let snoc q x = push x q
|
||||||
|
|
||||||
let peek_exn q =
|
let peek_exn q =
|
||||||
match q.hd with
|
match q.hd with
|
||||||
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
|
| [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
|
||||||
| x::_ -> x
|
| x::_ -> x
|
||||||
|
|
||||||
let peek q = match q.hd with
|
let peek q = match q.hd with
|
||||||
|
|
@ -40,7 +44,7 @@ let peek q = match q.hd with
|
||||||
|
|
||||||
let pop_exn q =
|
let pop_exn q =
|
||||||
match q.hd with
|
match q.hd with
|
||||||
| [] -> assert (q.tl = []); invalid_arg "Queue.peek"
|
| [] -> assert (list_is_empty q.tl); invalid_arg "Queue.peek"
|
||||||
| x::hd' ->
|
| x::hd' ->
|
||||||
let q' = make_ hd' q.tl in
|
let q' = make_ hd' q.tl in
|
||||||
x, q'
|
x, q'
|
||||||
|
|
|
||||||
|
|
@ -527,7 +527,7 @@ module Make(W : WORD)
|
||||||
| Empty -> 0
|
| Empty -> 0
|
||||||
| Cons (_, t') -> size t'
|
| Cons (_, t') -> size t'
|
||||||
| Node (v, map) ->
|
| Node (v, map) ->
|
||||||
let s = if v=None then 0 else 1 in
|
let s = match v with None -> 0 | Some _ -> 1 in
|
||||||
M.fold
|
M.fold
|
||||||
(fun _ t' acc -> size t' + acc)
|
(fun _ t' acc -> size t' + acc)
|
||||||
map s
|
map s
|
||||||
|
|
|
||||||
|
|
@ -141,13 +141,17 @@ module FQ = struct
|
||||||
|
|
||||||
let empty = _make [] []
|
let empty = _make [] []
|
||||||
|
|
||||||
let is_empty q = q.hd = []
|
let list_is_empty = function
|
||||||
|
| [] -> true
|
||||||
|
| _::_ -> false
|
||||||
|
|
||||||
|
let is_empty q = list_is_empty q.hd
|
||||||
|
|
||||||
let push q x = _make q.hd (x::q.tl)
|
let push q x = _make q.hd (x::q.tl)
|
||||||
|
|
||||||
let pop_exn q =
|
let pop_exn q =
|
||||||
match q.hd with
|
match q.hd with
|
||||||
| [] -> assert (q.tl = []); raise Empty
|
| [] -> assert (list_is_empty q.tl); raise Empty
|
||||||
| x::hd' ->
|
| x::hd' ->
|
||||||
let q' = _make hd' q.tl in
|
let q' = _make hd' q.tl in
|
||||||
x, q'
|
x, q'
|
||||||
|
|
|
||||||
|
|
@ -13,7 +13,7 @@ type t = [
|
||||||
]
|
]
|
||||||
type sexp = t
|
type sexp = t
|
||||||
|
|
||||||
let equal a b = a = b
|
let equal (a : sexp) b = Pervasives.(=) a b
|
||||||
|
|
||||||
let compare a b = Pervasives.compare a b
|
let compare a b = Pervasives.compare a b
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -20,9 +20,11 @@
|
||||||
| Escaped_int_1 of int
|
| Escaped_int_1 of int
|
||||||
| Escaped_int_2 of int
|
| Escaped_int_2 of int
|
||||||
|
|
||||||
|
let char_equal (a : char) b = Pervasives.(=) a b
|
||||||
|
|
||||||
(* remove quotes + unescape *)
|
(* remove quotes + unescape *)
|
||||||
let remove_quotes lexbuf s =
|
let remove_quotes lexbuf s =
|
||||||
assert (s.[0] = '"' && s.[String.length s - 1] = '"');
|
assert (char_equal s.[0] '"' && char_equal s.[String.length s - 1] '"');
|
||||||
let buf = Buffer.create (String.length s) in
|
let buf = Buffer.create (String.length s) in
|
||||||
let st = ref Not_escaped in
|
let st = ref Not_escaped in
|
||||||
for i = 1 to String.length s-2 do
|
for i = 1 to String.length s-2 do
|
||||||
|
|
@ -72,4 +74,3 @@ rule token = parse
|
||||||
| string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) }
|
| string { ATOM (remove_quotes lexbuf (Lexing.lexeme lexbuf)) }
|
||||||
| _ as c
|
| _ as c
|
||||||
{ error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) }
|
{ error lexbuf (Printf.sprintf "lexing failed on char `%c`" c) }
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -314,11 +314,15 @@ module Make(P : PARAM) = struct
|
||||||
| Run cell ->
|
| Run cell ->
|
||||||
with_lock_ cell (fun cell -> cell.state)
|
with_lock_ cell (fun cell -> cell.state)
|
||||||
|
|
||||||
|
let is_not_waiting = function
|
||||||
|
| Waiting -> false
|
||||||
|
| Failed _ | Done _ -> true
|
||||||
|
|
||||||
let is_done = function
|
let is_done = function
|
||||||
| Return _
|
| Return _
|
||||||
| FailNow _ -> true
|
| FailNow _ -> true
|
||||||
| Run cell ->
|
| Run cell ->
|
||||||
with_lock_ cell (fun c -> c.state <> Waiting)
|
with_lock_ cell (fun c -> is_not_waiting c.state)
|
||||||
|
|
||||||
(** {2 Combinators *)
|
(** {2 Combinators *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,11 @@
|
||||||
type job =
|
type job =
|
||||||
| Job : float * (unit -> 'a) -> job
|
| Job : float * (unit -> 'a) -> job
|
||||||
|
|
||||||
|
let (<=) (a : float) b = Pervasives.(<=) a b
|
||||||
|
let (>=) (a : float) b = Pervasives.(>=) a b
|
||||||
|
let (<) (a : float) b = Pervasives.(<) a b
|
||||||
|
let (>) (a : float) b = Pervasives.(>) a b
|
||||||
|
|
||||||
module TaskHeap = CCHeap.Make(struct
|
module TaskHeap = CCHeap.Make(struct
|
||||||
type t = job
|
type t = job
|
||||||
let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2
|
let leq (Job(f1,_)) (Job (f2,_)) = f1 <= f2
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue