mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-09 04:35:29 -05:00
Merge branch 'master' into stable for 0.19
This commit is contained in:
commit
47978e4bba
22 changed files with 362 additions and 194 deletions
|
|
@ -30,6 +30,5 @@
|
|||
#load "containers_top.cma";;
|
||||
#thread;;
|
||||
#load "containers_thread.cma";;
|
||||
#install_printer CCSexp.print;;
|
||||
(* vim:syntax=ocaml:
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,17 @@
|
|||
= Changelog
|
||||
|
||||
== 0.19
|
||||
|
||||
- add regression test for #75
|
||||
- Fix `CCString.Split.{left,right}` (#75)
|
||||
- additional functions in `CCMultiSet`
|
||||
- show ocaml array type concretely in `CCRingBuffer.Make` sig
|
||||
- cleanup and more tests in `CCHeap`
|
||||
- fix bugs in `CCFlatHashtbl`, add some tests
|
||||
- add more generic printers for `CCError` and `CCResult` (close #73)
|
||||
- add `CCstring.of_char`
|
||||
- update headers
|
||||
|
||||
== 0.18
|
||||
|
||||
- update implem of `CCVector.equal`
|
||||
|
|
@ -9,7 +21,7 @@
|
|||
- add aliases to deprecated functions from `String`, add `Fun.opaque_identity`
|
||||
- add `CCLazy_list.take`
|
||||
- add `Lazy_list.filter`
|
||||
- add CCList.range_by
|
||||
- add `CCList.range_by`
|
||||
|
||||
== 0.17
|
||||
|
||||
|
|
|
|||
26
HOWTO.adoc
26
HOWTO.adoc
|
|
@ -5,19 +5,21 @@
|
|||
Beforehand, check `grep deprecated -r src` to see whether some functions
|
||||
can be removed.
|
||||
|
||||
1. `make test`
|
||||
2. update version in `_oasis`
|
||||
3. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
|
||||
4. check status of modules (`{b status: foo}`) and update if required;
|
||||
. `make test`
|
||||
. update version in `_oasis`
|
||||
. `make update_next_tag` (to update `@since` comments; be careful not to change symlinks)
|
||||
. check status of modules (`{b status: foo}`) and update if required;
|
||||
removed deprecated functions, etc.
|
||||
5. update `CHANGELOG.md` (see its end to find the right git command)
|
||||
6. commit the changes
|
||||
7. `git checkout stable`
|
||||
8. `git merge master`
|
||||
9. `oasis setup; make test doc`
|
||||
10. tag, and push both to github
|
||||
11. `opam pin https://github.com/c-cube/ocaml-containers#<release>`
|
||||
12. new opam package: `opam publish prepare; opam publish submit`
|
||||
. update `CHANGELOG.md` (see its end to find the right git command)
|
||||
. commit the changes
|
||||
. `git checkout stable`
|
||||
. `git merge master`
|
||||
. `oasis setup; make test doc`
|
||||
. update `opam` (the version field; remove `oasis` in deps)
|
||||
. tag, and push both to github
|
||||
. `opam pin add containers https://github.com/c-cube/ocaml-containers.git#<release>`
|
||||
. new opam package: `opam publish prepare; opam publish submit`
|
||||
. re-generate doc: `make doc push_doc`
|
||||
|
||||
== List Authors
|
||||
|
||||
|
|
|
|||
2
_oasis
2
_oasis
|
|
@ -1,6 +1,6 @@
|
|||
OASISFormat: 0.4
|
||||
Name: containers
|
||||
Version: 0.18
|
||||
Version: 0.19
|
||||
Homepage: https://github.com/c-cube/ocaml-containers
|
||||
Authors: Simon Cruanes
|
||||
License: BSD-2-clause
|
||||
|
|
|
|||
21
opam
21
opam
|
|
@ -1,6 +1,6 @@
|
|||
opam-version: "1.2"
|
||||
name: "containers"
|
||||
version: "0.17"
|
||||
version: "0.19"
|
||||
author: "Simon Cruanes"
|
||||
maintainer: "simon.cruanes@inria.fr"
|
||||
build: [
|
||||
|
|
@ -26,13 +26,18 @@ remove: [
|
|||
]
|
||||
depends: [
|
||||
"ocamlfind" {build}
|
||||
"oasis" {build}
|
||||
"base-bytes"
|
||||
"result"
|
||||
"cppo" {build}
|
||||
"ocamlbuild" {build}
|
||||
]
|
||||
depopts: [ "sequence" "base-bigarray" "base-unix" "base-threads" "qtest" { test } ]
|
||||
depopts: [
|
||||
"sequence"
|
||||
"base-bigarray"
|
||||
"base-unix"
|
||||
"base-threads"
|
||||
"qtest" { test }
|
||||
]
|
||||
conflicts: [
|
||||
"sequence" { < "0.5" }
|
||||
"qtest" { < "2.2" }
|
||||
|
|
@ -45,12 +50,8 @@ available: [ocaml-version >= "4.00.0"]
|
|||
dev-repo: "https://github.com/c-cube/ocaml-containers.git"
|
||||
bug-reports: "https://github.com/c-cube/ocaml-containers/issues/"
|
||||
post-messages: [
|
||||
"Another large release, with many new features:
|
||||
"Small release with mostly bugfixes, and a few improvements of some
|
||||
already existing modules.
|
||||
|
||||
- performance improvements, in particular for string search (using KMP)
|
||||
- `CCHet`, a heterogeneous map with unique keys
|
||||
- `CCImmutArray`, immutable arrays
|
||||
- `CCString.pad`, for webscale string padding!
|
||||
|
||||
as usual, see https://github.com/c-cube/ocaml-containers/blob/0.17/CHANGELOG.adoc"
|
||||
changelog: https://github.com/c-cube/ocaml-containers/blob/0.19/CHANGELOG.adoc"
|
||||
]
|
||||
|
|
|
|||
9
setup.ml
9
setup.ml
|
|
@ -1,7 +1,7 @@
|
|||
(* setup.ml generated for the first time by OASIS v0.4.4 *)
|
||||
|
||||
(* OASIS_START *)
|
||||
(* DO NOT EDIT (digest: 935c9eb827a9a1a9b4de988f1afb58dd) *)
|
||||
(* DO NOT EDIT (digest: cbbbbd12ca7bf75f770eaacaf3a54236) *)
|
||||
(*
|
||||
Regenerated by OASIS v0.4.6
|
||||
Visit http://oasis.forge.ocamlcore.org for more information and
|
||||
|
|
@ -6898,7 +6898,7 @@ let setup_t =
|
|||
alpha_features = ["ocamlbuild_more_args"];
|
||||
beta_features = [];
|
||||
name = "containers";
|
||||
version = "0.18";
|
||||
version = "0.19";
|
||||
license =
|
||||
OASISLicense.DEP5License
|
||||
(OASISLicense.DEP5Unit
|
||||
|
|
@ -7745,8 +7745,7 @@ let setup_t =
|
|||
};
|
||||
oasis_fn = Some "_oasis";
|
||||
oasis_version = "0.4.6";
|
||||
oasis_digest =
|
||||
Some "\006\139\194\135\189\021\197\018\208\031.\187\212'\016\192";
|
||||
oasis_digest = Some ",\224J\206\221\238\129V\182\136\172 \240v\168\211";
|
||||
oasis_exec = None;
|
||||
oasis_setup_args = [];
|
||||
setup_update = false
|
||||
|
|
@ -7754,6 +7753,6 @@ let setup_t =
|
|||
|
||||
let setup () = BaseSetup.setup setup_t;;
|
||||
|
||||
# 7758 "setup.ml"
|
||||
# 7757 "setup.ml"
|
||||
(* OASIS_STOP *)
|
||||
let () = setup ();;
|
||||
|
|
|
|||
|
|
@ -260,6 +260,14 @@ let pp pp_x buf e = match e with
|
|||
| `Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
|
||||
| `Error s -> Printf.bprintf buf "error(%s)" s
|
||||
|
||||
let pp' pp_x pp_e buf e = match e with
|
||||
| `Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
|
||||
| `Error s -> Printf.bprintf buf "error(%a)" pp_e s
|
||||
|
||||
let print pp_x fmt e = match e with
|
||||
| `Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
|
||||
| `Error s -> Format.fprintf fmt "@[error(@,%s)@]" s
|
||||
|
||||
let print' pp_x pp_e fmt e = match e with
|
||||
| `Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
|
||||
| `Error s -> Format.fprintf fmt "@[error(@,%a)@]" pp_e s
|
||||
|
|
|
|||
|
|
@ -190,8 +190,16 @@ val to_seq : ('a, _) t -> 'a sequence
|
|||
|
||||
val pp : 'a printer -> ('a, string) t printer
|
||||
|
||||
val pp': 'a printer -> 'e printer -> ('a, 'e) t printer
|
||||
(** Printer that is generic on the error type
|
||||
@since 0.19 *)
|
||||
|
||||
val print : 'a formatter -> ('a, string) t formatter
|
||||
|
||||
val print' : 'a formatter -> 'e formatter -> ('a, 'e) t formatter
|
||||
(** Printer that is generic on the error type
|
||||
@since 0.19 *)
|
||||
|
||||
(** {2 Global Exception Printers}
|
||||
|
||||
One can register exception printers here, so they will be used by {!guard},
|
||||
|
|
|
|||
|
|
@ -64,6 +64,19 @@ end
|
|||
)
|
||||
*)
|
||||
|
||||
(* test filter *)
|
||||
(*$QR & ~count:30
|
||||
Q.(list_of_size Gen.(return 1_000) int) (fun l ->
|
||||
(* put elements into a heap *)
|
||||
let h = H.of_seq (Sequence.of_list l) in
|
||||
let h = H.filter (fun x->x mod 2=0) h in
|
||||
OUnit.assert_bool "all odd"
|
||||
(H.to_seq h |> Sequence.for_all (fun x -> x mod 2 = 0));
|
||||
let l' = extract_list h in
|
||||
is_sorted l'
|
||||
)
|
||||
*)
|
||||
|
||||
module type S = sig
|
||||
type elt
|
||||
type t
|
||||
|
|
@ -114,7 +127,7 @@ module type S = sig
|
|||
(** Number of elements (linear complexity) *)
|
||||
|
||||
(** {2 Conversions}
|
||||
|
||||
|
||||
The interface of [of_gen], [of_seq], [of_klist]
|
||||
has changed @since 0.16 (the old signatures
|
||||
are now [add_seq], [add_gen], [add_klist]) *)
|
||||
|
|
|
|||
|
|
@ -65,7 +65,7 @@ module type S = sig
|
|||
(** Number of elements (linear complexity) *)
|
||||
|
||||
(** {2 Conversions}
|
||||
|
||||
|
||||
The interface of [of_gen], [of_seq], [of_klist]
|
||||
has changed @since 0.16 (the old signatures
|
||||
are now [add_seq], [add_gen], [add_klist]) *)
|
||||
|
|
|
|||
|
|
@ -261,6 +261,14 @@ let pp pp_x buf e = match e with
|
|||
| Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
|
||||
| Error s -> Printf.bprintf buf "error(%s)" s
|
||||
|
||||
let pp' pp_x pp_e buf e = match e with
|
||||
| Ok x -> Printf.bprintf buf "ok(%a)" pp_x x
|
||||
| Error s -> Printf.bprintf buf "error(%a)" pp_e s
|
||||
|
||||
let print pp_x fmt e = match e with
|
||||
| Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
|
||||
| Error s -> Format.fprintf fmt "@[error(@,%s)@]" s
|
||||
|
||||
let print' pp_x pp_e fmt e = match e with
|
||||
| Ok x -> Format.fprintf fmt "@[ok(@,%a)@]" pp_x x
|
||||
| Error s -> Format.fprintf fmt "@[error(@,%a)@]" pp_e s
|
||||
|
|
|
|||
|
|
@ -193,4 +193,13 @@ val to_err : ('a, 'b) t -> ('a, 'b) error
|
|||
|
||||
val pp : 'a printer -> ('a, string) t printer
|
||||
|
||||
val pp': 'a printer -> 'e printer -> ('a, 'e) t printer
|
||||
(** Printer that is generic on the error type
|
||||
@since 0.19 *)
|
||||
|
||||
val print : 'a formatter -> ('a, string) t formatter
|
||||
|
||||
val print' : 'a formatter -> 'e formatter -> ('a, 'e) t formatter
|
||||
(** Printer that is generic on the error type
|
||||
@since 0.19 *)
|
||||
|
||||
|
|
|
|||
|
|
@ -367,14 +367,18 @@ module Split = struct
|
|||
let left_exn ~by s =
|
||||
let i = find ~sub:by s in
|
||||
if i = ~-1 then raise Not_found
|
||||
else String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)
|
||||
else
|
||||
let right = i + String.length by in
|
||||
String.sub s 0 i, String.sub s right (String.length s - right)
|
||||
|
||||
let left ~by s = try Some (left_exn ~by s) with Not_found -> None
|
||||
|
||||
let right_exn ~by s =
|
||||
let i = rfind ~sub:by s in
|
||||
if i = ~-1 then raise Not_found
|
||||
else String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)
|
||||
else
|
||||
let right = i + String.length by in
|
||||
String.sub s 0 i, String.sub s right (String.length s - right)
|
||||
|
||||
let right ~by s = try Some (right_exn ~by s) with Not_found -> None
|
||||
end
|
||||
|
|
@ -398,11 +402,6 @@ let compare_versions a b =
|
|||
in
|
||||
cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
|
||||
|
||||
(*$Q
|
||||
Q.(pair printable_string printable_string) (fun (a,b) -> \
|
||||
CCOrd.equiv (compare_versions a b) (CCOrd.opp (compare_versions b a)))
|
||||
*)
|
||||
|
||||
let repeat s n =
|
||||
assert (n>=0);
|
||||
let len = String.length s in
|
||||
|
|
@ -475,6 +474,8 @@ let _to_gen s i0 len =
|
|||
|
||||
let to_gen s = _to_gen s 0 (String.length s)
|
||||
|
||||
let of_char c = String.make 1 c
|
||||
|
||||
let of_gen g =
|
||||
let b = Buffer.create 32 in
|
||||
let rec aux () = match g () with
|
||||
|
|
|
|||
|
|
@ -94,6 +94,10 @@ val pad : ?side:[`Left|`Right] -> ?c:char -> int -> string -> string
|
|||
"aaa" (pad ~side:`Right ~c:'a' 3 "")
|
||||
*)
|
||||
|
||||
val of_char : char -> string
|
||||
(** [of_char 'a' = "a"]
|
||||
@since 0.19 *)
|
||||
|
||||
val of_gen : char gen -> string
|
||||
val of_seq : char sequence -> string
|
||||
val of_klist : char klist -> string
|
||||
|
|
@ -445,7 +449,10 @@ module Split : sig
|
|||
|
||||
(*$T
|
||||
Split.left ~by:" " "ab cde f g " = Some ("ab", "cde f g ")
|
||||
Split.left ~by:"__" "a__c__e_f" = Some ("a", "c__e_f")
|
||||
Split.left ~by:"_" "abcde" = None
|
||||
Split.left ~by:"bb" "abbc" = Some ("a", "c")
|
||||
Split.left ~by:"a_" "abcde" = None
|
||||
*)
|
||||
|
||||
val right : by:string -> string -> (string * string) option
|
||||
|
|
@ -460,7 +467,9 @@ module Split : sig
|
|||
|
||||
(*$T
|
||||
Split.right ~by:" " "ab cde f g" = Some ("ab cde f", "g")
|
||||
Split.right ~by:"__" "a__c__e_f" = Some ("a__c", "e_f")
|
||||
Split.right ~by:"_" "abcde" = None
|
||||
Split.right ~by:"a_" "abcde" = None
|
||||
*)
|
||||
end
|
||||
|
||||
|
|
@ -480,6 +489,12 @@ val compare_versions : string -> string -> int
|
|||
compare_versions "1.2.3.4" "01.2.4.3" < 0
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
Q.(pair printable_string printable_string) (fun (a,b) -> \
|
||||
CCOrd.equiv (compare_versions a b) (CCOrd.opp compare_versions b a))
|
||||
*)
|
||||
|
||||
|
||||
(** {2 Slices} A contiguous part of a string *)
|
||||
|
||||
module Sub : sig
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
# OASIS_START
|
||||
# DO NOT EDIT (digest: 048ee564ec86589b85b55f903119ad20)
|
||||
version = "0.18"
|
||||
# DO NOT EDIT (digest: 56ec39bd73892c447789e2116b0f000e)
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "bytes result"
|
||||
archive(byte) = "containers.cma"
|
||||
|
|
@ -9,7 +9,7 @@ archive(native) = "containers.cmxa"
|
|||
archive(native, plugin) = "containers.cmxs"
|
||||
exists_if = "containers.cma"
|
||||
package "unix" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "bytes unix"
|
||||
archive(byte) = "containers_unix.cma"
|
||||
|
|
@ -20,7 +20,7 @@ package "unix" (
|
|||
)
|
||||
|
||||
package "top" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires =
|
||||
"compiler-libs.common containers containers.data containers.bigarray containers.string containers.unix containers.sexp containers.iter"
|
||||
|
|
@ -32,7 +32,7 @@ package "top" (
|
|||
)
|
||||
|
||||
package "thread" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "containers threads"
|
||||
archive(byte) = "containers_thread.cma"
|
||||
|
|
@ -43,7 +43,7 @@ package "thread" (
|
|||
)
|
||||
|
||||
package "string" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "bytes"
|
||||
archive(byte) = "containers_string.cma"
|
||||
|
|
@ -54,7 +54,7 @@ package "string" (
|
|||
)
|
||||
|
||||
package "sexp" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "bytes"
|
||||
archive(byte) = "containers_sexp.cma"
|
||||
|
|
@ -65,7 +65,7 @@ package "sexp" (
|
|||
)
|
||||
|
||||
package "iter" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
archive(byte) = "containers_iter.cma"
|
||||
archive(byte, plugin) = "containers_iter.cma"
|
||||
|
|
@ -75,7 +75,7 @@ package "iter" (
|
|||
)
|
||||
|
||||
package "io" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "bytes"
|
||||
archive(byte) = "containers_io.cma"
|
||||
|
|
@ -86,7 +86,7 @@ package "io" (
|
|||
)
|
||||
|
||||
package "data" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "bytes"
|
||||
archive(byte) = "containers_data.cma"
|
||||
|
|
@ -97,7 +97,7 @@ package "data" (
|
|||
)
|
||||
|
||||
package "bigarray" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "containers bigarray bytes"
|
||||
archive(byte) = "containers_bigarray.cma"
|
||||
|
|
@ -108,7 +108,7 @@ package "bigarray" (
|
|||
)
|
||||
|
||||
package "advanced" (
|
||||
version = "0.18"
|
||||
version = "0.19"
|
||||
description = "A modular standard library focused on data structures."
|
||||
requires = "containers sequence"
|
||||
archive(byte) = "containers_advanced.cma"
|
||||
|
|
|
|||
|
|
@ -101,6 +101,9 @@ module Make(X : HASHABLE) = struct
|
|||
let i = min Sys.max_array_length (max i 8) in
|
||||
{ arr=Array.make i Empty; size=0; }
|
||||
|
||||
(* TODO: enforce that [tbl.arr] has a power of 2 as length, then
|
||||
initial_index is just a mask with (length-1)? *)
|
||||
|
||||
(* initial index for a value with hash [h] *)
|
||||
let _initial_idx tbl h =
|
||||
h mod Array.length tbl.arr
|
||||
|
|
@ -109,18 +112,15 @@ module Make(X : HASHABLE) = struct
|
|||
let i' = i+1 in
|
||||
if i' = Array.length tbl.arr then 0 else i'
|
||||
|
||||
let _pred tbl i =
|
||||
if i = 0 then Array.length tbl.arr - 1 else i-1
|
||||
|
||||
(* distance to initial bucket, at index [i] with hash [h] *)
|
||||
let _dib tbl h i =
|
||||
let _dib tbl h ~i =
|
||||
let i0 = _initial_idx tbl h in
|
||||
if i>=i0
|
||||
then i-i0
|
||||
else i+ (Array.length tbl.arr - i0 - 1)
|
||||
then i - i0
|
||||
else i + (Array.length tbl.arr - i0)
|
||||
|
||||
(* insert k->v in [tbl], currently at index [i] *)
|
||||
let rec _linear_probe tbl k v h_k i =
|
||||
(* insert k->v in [tbl], currently at index [i] and distance [dib] *)
|
||||
let rec _linear_probe tbl k v h_k i dib =
|
||||
match tbl.arr.(i) with
|
||||
| Empty ->
|
||||
(* add binding *)
|
||||
|
|
@ -131,14 +131,16 @@ module Make(X : HASHABLE) = struct
|
|||
assert (h_k = h_k');
|
||||
tbl.arr.(i) <- Key (k, v, h_k)
|
||||
| Key (k', v', h_k') ->
|
||||
if _dib tbl h_k i < _dib tbl h_k' i
|
||||
let dib' = _dib tbl h_k' ~i in
|
||||
if dib > dib'
|
||||
then (
|
||||
(* replace *)
|
||||
tbl.arr.(i) <- Key (k, v, h_k);
|
||||
_linear_probe tbl k' v' h_k' (_succ tbl i)
|
||||
) else
|
||||
_linear_probe tbl k' v' h_k' (_succ tbl i) (dib'+1)
|
||||
) else (
|
||||
(* go further *)
|
||||
_linear_probe tbl k v h_k (_succ tbl i)
|
||||
_linear_probe tbl k v h_k (_succ tbl i) (dib+1)
|
||||
)
|
||||
|
||||
(* resize table: put a bigger array in it, then insert values
|
||||
from the old array *)
|
||||
|
|
@ -152,65 +154,73 @@ module Make(X : HASHABLE) = struct
|
|||
Array.iter
|
||||
(function
|
||||
| Empty -> ()
|
||||
| Key (k, v, h_k) -> _linear_probe tbl k v h_k (_initial_idx tbl h_k)
|
||||
) old_arr
|
||||
| Key (k, v, h_k) ->
|
||||
_linear_probe tbl k v h_k (_initial_idx tbl h_k) 0)
|
||||
old_arr
|
||||
|
||||
let add tbl k v =
|
||||
if _reached_max_load tbl
|
||||
then _resize tbl;
|
||||
if _reached_max_load tbl then _resize tbl;
|
||||
(* insert value *)
|
||||
let h_k = X.hash k in
|
||||
_linear_probe tbl k v h_k (_initial_idx tbl h_k)
|
||||
_linear_probe tbl k v h_k (_initial_idx tbl h_k) 0
|
||||
|
||||
(* shift back elements that have a DIB > 0 until an empty bucket is
|
||||
met, or some element doesn't need shifting *)
|
||||
let rec _backward_shift tbl i =
|
||||
(* shift back elements that have a DIB > 0 until an empty bucket
|
||||
or a bucket that doesn't need shifting is met *)
|
||||
let rec _backward_shift tbl ~prev:prev_i i =
|
||||
match tbl.arr.(i) with
|
||||
| Empty -> ()
|
||||
| Key (_, _, h_k) when _dib tbl h_k i = 0 ->
|
||||
() (* stop *)
|
||||
| Key (_k, _v, h_k) as bucket ->
|
||||
assert (_dib tbl h_k i > 0);
|
||||
(* shift backward *)
|
||||
tbl.arr.(_pred tbl i) <- bucket;
|
||||
tbl.arr.(i) <- Empty;
|
||||
_backward_shift tbl (_succ tbl i)
|
||||
| Empty ->
|
||||
tbl.arr.(prev_i) <- Empty;
|
||||
| Key (_, _, h_k) as bucket ->
|
||||
let d = _dib tbl h_k ~i in
|
||||
assert (d >= 0);
|
||||
if d > 0 then (
|
||||
(* shift backward *)
|
||||
tbl.arr.(prev_i) <- bucket;
|
||||
_backward_shift tbl ~prev:i (_succ tbl i)
|
||||
) else (
|
||||
tbl.arr.(prev_i) <- Empty;
|
||||
)
|
||||
|
||||
(* linear probing for removal of [k] *)
|
||||
let rec _linear_probe_remove tbl k h_k i =
|
||||
(* linear probing for removal of [k]: find the bucket containing [k],
|
||||
if any, and perform backward shift from there *)
|
||||
let rec _linear_probe_remove tbl k h_k i dib =
|
||||
match tbl.arr.(i) with
|
||||
| Empty -> ()
|
||||
| Key (k', _, _) when X.equal k k' ->
|
||||
tbl.arr.(i) <- Empty;
|
||||
tbl.size <- tbl.size - 1;
|
||||
_backward_shift tbl (_succ tbl i)
|
||||
(* shift all elements that follow and have a DIB > 0;
|
||||
it will also erase the last shifted bucket, and erase [i] in
|
||||
any case *)
|
||||
_backward_shift tbl ~prev:i (_succ tbl i)
|
||||
| Key (_, _, h_k') ->
|
||||
if _dib tbl h_k' i < _dib tbl h_k i
|
||||
then () (* [k] not present, would be here otherwise *)
|
||||
else _linear_probe_remove tbl k h_k (_succ tbl i)
|
||||
if dib > _dib tbl h_k' ~i
|
||||
then () (* [k] not present, would be here otherwise *)
|
||||
else _linear_probe_remove tbl k h_k (_succ tbl i) (dib+1)
|
||||
|
||||
let remove tbl k =
|
||||
let h_k = X.hash k in
|
||||
_linear_probe_remove tbl k h_k (_initial_idx tbl h_k)
|
||||
_linear_probe_remove tbl k h_k (_initial_idx tbl h_k) 0
|
||||
|
||||
let rec _get_exn tbl k h_k i dib =
|
||||
let rec get_exn_rec tbl k h_k i dib =
|
||||
match tbl.arr.(i) with
|
||||
| Empty -> raise Not_found
|
||||
| Key (k', v', _) when X.equal k k' -> v'
|
||||
| Key (_, _, h_k') ->
|
||||
if _dib tbl h_k' i < dib
|
||||
then raise Not_found (* [k] would be here otherwise *)
|
||||
else _get_exn tbl k h_k (_succ tbl i) (dib+1)
|
||||
if dib > _dib tbl h_k' ~i
|
||||
then raise Not_found (* [k] would be here otherwise *)
|
||||
else get_exn_rec tbl k h_k (_succ tbl i) (dib+1)
|
||||
|
||||
let get_exn k tbl =
|
||||
let h_k = X.hash k in
|
||||
let i0 = _initial_idx tbl h_k in
|
||||
(* unroll a few steps *)
|
||||
match tbl.arr.(i0) with
|
||||
| Empty -> raise Not_found
|
||||
| Key (k', v, _) ->
|
||||
if X.equal k k' then v
|
||||
else let i1 = _succ tbl i0 in
|
||||
match tbl.arr.(i1) with
|
||||
else
|
||||
let i1 = _succ tbl i0 in
|
||||
match tbl.arr.(i1) with
|
||||
| Empty -> raise Not_found
|
||||
| Key (k', v, _) ->
|
||||
if X.equal k k' then v
|
||||
|
|
@ -220,7 +230,7 @@ module Make(X : HASHABLE) = struct
|
|||
| Empty -> raise Not_found
|
||||
| Key (k', v, _) ->
|
||||
if X.equal k k' then v
|
||||
else _get_exn tbl k h_k (_succ tbl i2) 3
|
||||
else get_exn_rec tbl k h_k (_succ tbl i2) 3
|
||||
|
||||
let get k tbl =
|
||||
try Some (get_exn k tbl)
|
||||
|
|
@ -245,8 +255,8 @@ module Make(X : HASHABLE) = struct
|
|||
Array.fold_left
|
||||
(fun acc bucket -> match bucket with
|
||||
| Empty -> acc
|
||||
| Key (k,v,_) -> (k,v)::acc
|
||||
) [] tbl.arr
|
||||
| Key (k,v,_) -> (k,v)::acc)
|
||||
[] tbl.arr
|
||||
|
||||
let of_seq seq =
|
||||
let tbl = create 16 in
|
||||
|
|
@ -267,4 +277,112 @@ module Make(X : HASHABLE) = struct
|
|||
Array.iter
|
||||
(function Empty -> () | Key (_, v, _) -> yield v)
|
||||
tbl.arr
|
||||
|
||||
(*
|
||||
let pp_debug_ out t =
|
||||
let open T in
|
||||
let pp_buck out (i,b) = match b with
|
||||
| Empty -> Format.fprintf out "_"
|
||||
| Key (k,v,h_k) ->
|
||||
let dib = _dib t h_k ~i in
|
||||
Format.fprintf out "[%d]{%d -> %d (dib=%d)}@," i (Obj.magic k) (Obj.magic v) dib
|
||||
in
|
||||
Format.fprintf out "@[";
|
||||
Array.iteri
|
||||
(fun i b -> pp_buck out (i,b))
|
||||
t.arr;
|
||||
Format.fprintf out "@]";
|
||||
()
|
||||
*)
|
||||
end
|
||||
|
||||
(*$inject
|
||||
module T = Make(CCInt)
|
||||
|
||||
let gen_l =
|
||||
let g = Q.(list (pair small_int small_int)) in
|
||||
Q.map_same_type
|
||||
(CCList.sort_uniq ~cmp:(fun x y -> compare (fst x) (fst y)))
|
||||
g
|
||||
|
||||
|
||||
type op =
|
||||
| Add of int*int
|
||||
| Remove of int
|
||||
|
||||
let op_add x y = Add (x,y)
|
||||
let op_remove x = Remove x
|
||||
|
||||
let op_exec t = function
|
||||
| Add (x,y) -> T.add t x y
|
||||
| Remove x -> T.remove t x
|
||||
|
||||
let op_pp = function
|
||||
| Add (x,y) -> Printf.sprintf "add(%d,%d)" x y
|
||||
| Remove x -> Printf.sprintf "remove(%d)" x
|
||||
|
||||
let gen_ops n =
|
||||
let open Q.Gen in
|
||||
let gen_op =
|
||||
frequency
|
||||
[ 2, return op_add <*> small_int <*> small_int
|
||||
; 1, return op_remove <*> small_int
|
||||
]
|
||||
in
|
||||
list_size (0--n) gen_op
|
||||
|
||||
let arb_ops n : op list Q.arbitrary =
|
||||
let shrink_op o =
|
||||
let open Q.Iter in
|
||||
match o with
|
||||
| Add (x,y) ->
|
||||
(return op_add <*> Q.Shrink.int x <*> return y)
|
||||
<+>
|
||||
(return op_add <*> return x <*> Q.Shrink.int y)
|
||||
| Remove x -> map op_remove (Q.Shrink.int x)
|
||||
in
|
||||
let shrink =
|
||||
Q.Shrink.list ~shrink:shrink_op in
|
||||
let print = Q.Print.list op_pp in
|
||||
Q.make ~shrink ~print (gen_ops n)
|
||||
|
||||
module TRef = CCHashtbl.Make(CCInt)
|
||||
|
||||
let op_exec_ref t = function
|
||||
| Add (x,y) -> TRef.replace t x y
|
||||
| Remove x -> TRef.remove t x
|
||||
*)
|
||||
|
||||
(*$T
|
||||
let t = T.create 32 in \
|
||||
T.add t 0 "0"; T.find t 0 = Some "0"
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
gen_l (fun l -> \
|
||||
(T.of_list l |> T.to_list |> List.sort CCOrd.compare) = l)
|
||||
*)
|
||||
|
||||
(* test that the table behaves the same as a normal hashtable *)
|
||||
|
||||
(*$inject
|
||||
let test_ops l =
|
||||
let t = T.create 16 in
|
||||
let t' = TRef.create 16 in
|
||||
List.iter (op_exec t) l;
|
||||
List.iter (op_exec_ref t') l;
|
||||
(T.to_list t |> List.sort CCOrd.compare) =
|
||||
(TRef.to_list t' |> List.sort CCOrd.compare)
|
||||
*)
|
||||
|
||||
(*$Q & ~count:500
|
||||
(arb_ops 300) test_ops
|
||||
*)
|
||||
|
||||
(*$Q & ~count:10
|
||||
(arb_ops 3000) test_ops
|
||||
*)
|
||||
|
||||
(*$Q & ~count:5
|
||||
(arb_ops 30000) test_ops
|
||||
*)
|
||||
|
|
|
|||
|
|
@ -1,27 +1,5 @@
|
|||
(*
|
||||
copyright (c) 2013, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
this software is provided by the copyright holders and contributors "as is" and
|
||||
any express or implied warranties, including, but not limited to, the implied
|
||||
warranties of merchantability and fitness for a particular purpose are
|
||||
disclaimed. in no event shall the copyright holder or contributors be liable
|
||||
for any direct, indirect, incidental, special, exemplary, or consequential
|
||||
damages (including, but not limited to, procurement of substitute goods or
|
||||
services; loss of use, data, or profits; or business interruption) however
|
||||
caused and on any theory of liability, whether in contract, strict liability,
|
||||
or tort (including negligence or otherwise) arising in any way out of the use
|
||||
of this software, even if advised of the possibility of such damage.
|
||||
*)
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(** {1 Multiset} *)
|
||||
|
||||
|
|
@ -46,31 +24,53 @@ module type S = sig
|
|||
val remove : t -> elt -> t
|
||||
|
||||
val add_mult : t -> elt -> int -> t
|
||||
(** [add_mult set x n] adds [n] occurrences of [x] to [set]
|
||||
@raise Invalid_argument if [n < 0]
|
||||
@since 0.6 *)
|
||||
|
||||
val remove_mult : t -> elt -> int -> t
|
||||
(** [remove_mult set x n] removes at most [n] occurrences of [x] from [set]
|
||||
@raise Invalid_argument if [n < 0]
|
||||
@since 0.6 *)
|
||||
|
||||
val update : t -> elt -> (int -> int) -> t
|
||||
(** [update set x f] calls [f n] where [n] is the current multiplicity
|
||||
of [x] in [set] ([0] to indicate its absence); the result of [f n]
|
||||
is the new multiplicity of [x].
|
||||
@raise Invalid_argument if [f n < 0]
|
||||
@since 0.6 *)
|
||||
|
||||
val min : t -> elt
|
||||
(** Minimal element w.r.t the total ordering on elements *)
|
||||
|
||||
val max : t -> elt
|
||||
(** Maximal element w.r.t the total ordering on elements *)
|
||||
|
||||
val union : t -> t -> t
|
||||
(** [union a b] contains as many occurrences of an element [x]
|
||||
as [count a x + count b x]. *)
|
||||
|
||||
val meet : t -> t -> t
|
||||
(** [meet a b] is a multiset such that
|
||||
[count (meet a b) x = max (count a x) (count b x)] *)
|
||||
|
||||
val intersection : t -> t -> t
|
||||
(** [intersection a b] is a multiset such that
|
||||
[count (intersection a b) x = min (count a x) (count b x)] *)
|
||||
|
||||
val diff : t -> t -> t
|
||||
(** MultiSet difference.
|
||||
[count (diff a b) x = max (count a x - count b x) 0] *)
|
||||
|
||||
val contains : t -> t -> bool
|
||||
(** [contains a x = (count m x > 0)] *)
|
||||
|
||||
val compare : t -> t -> int
|
||||
|
||||
val equal : t -> t -> bool
|
||||
|
||||
val cardinal : t -> int
|
||||
(** Number of distinct elements *)
|
||||
(** Number of distinct elements *)
|
||||
|
||||
val iter : t -> (int -> elt -> unit) -> unit
|
||||
|
||||
|
|
@ -83,6 +83,18 @@ module type S = sig
|
|||
val to_seq : t -> elt sequence
|
||||
|
||||
val of_seq : elt sequence -> t
|
||||
|
||||
val of_list_mult : (elt * int) list -> t
|
||||
(** @since 0.19 *)
|
||||
|
||||
val to_list_mult : t -> (elt * int) list
|
||||
(** @since 0.19 *)
|
||||
|
||||
val to_seq_mult : t -> (elt * int) sequence
|
||||
(** @since 0.19 *)
|
||||
|
||||
val of_seq_mult : (elt * int) sequence -> t
|
||||
(** @since 0.19 *)
|
||||
end
|
||||
|
||||
module Make(O : Set.OrderedType) = struct
|
||||
|
|
@ -221,6 +233,21 @@ module Make(O : Set.OrderedType) = struct
|
|||
let m = ref empty in
|
||||
seq (fun x -> m := add !m x);
|
||||
!m
|
||||
|
||||
let of_list_mult l =
|
||||
List.fold_left
|
||||
(fun s (x,i) -> add_mult s x i)
|
||||
empty l
|
||||
|
||||
let to_list_mult m =
|
||||
fold m [] (fun acc n x -> (x,n) :: acc)
|
||||
|
||||
let to_seq_mult m k = M.iter (fun x n -> k (x,n)) m
|
||||
|
||||
let of_seq_mult seq =
|
||||
let m = ref empty in
|
||||
seq (fun (x,n) -> m := add_mult !m x n);
|
||||
!m
|
||||
end
|
||||
|
||||
(*$T
|
||||
|
|
|
|||
|
|
@ -1,27 +1,5 @@
|
|||
(*
|
||||
copyright (c) 2013, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
this software is provided by the copyright holders and contributors "as is" and
|
||||
any express or implied warranties, including, but not limited to, the implied
|
||||
warranties of merchantability and fitness for a particular purpose are
|
||||
disclaimed. in no event shall the copyright holder or contributors be liable
|
||||
for any direct, indirect, incidental, special, exemplary, or consequential
|
||||
damages (including, but not limited to, procurement of substitute goods or
|
||||
services; loss of use, data, or profits; or business interruption) however
|
||||
caused and on any theory of liability, whether in contract, strict liability,
|
||||
or tort (including negligence or otherwise) arising in any way out of the use
|
||||
of this software, even if advised of the possibility of such damage.
|
||||
*)
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(** {1 Multiset} *)
|
||||
|
||||
|
|
@ -105,6 +83,18 @@ module type S = sig
|
|||
val to_seq : t -> elt sequence
|
||||
|
||||
val of_seq : elt sequence -> t
|
||||
|
||||
val of_list_mult : (elt * int) list -> t
|
||||
(** @since 0.19 *)
|
||||
|
||||
val to_list_mult : t -> (elt * int) list
|
||||
(** @since 0.19 *)
|
||||
|
||||
val to_seq_mult : t -> (elt * int) sequence
|
||||
(** @since 0.19 *)
|
||||
|
||||
val of_seq_mult : (elt * int) sequence -> t
|
||||
(** @since 0.19 *)
|
||||
end
|
||||
|
||||
module Make(O : Set.OrderedType) : S with type elt = O.t
|
||||
|
|
|
|||
|
|
@ -210,4 +210,4 @@ module Byte : S with module Array = Array.Byte
|
|||
module MakeFromArray(A : Array.S) : S with module Array = A
|
||||
|
||||
(** Buffer using regular arrays *)
|
||||
module Make(X : sig type t end) : S with type Array.elt = X.t
|
||||
module Make(X : sig type t end) : S with type Array.elt = X.t and type Array.t = X.t array
|
||||
|
|
|
|||
|
|
@ -1,27 +1,5 @@
|
|||
(*
|
||||
Copyright (c) 2013, Simon Cruanes
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. Redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*)
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(** {1 Simple S-expression parsing/printing} *)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,31 +1,9 @@
|
|||
(*
|
||||
Copyright (c) 2013, Simon Cruanes
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. Redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*)
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(** {1 Simple and efficient S-expression parsing/printing}
|
||||
|
||||
@since 0.7 *)
|
||||
@since 0.7 *)
|
||||
|
||||
type 'a or_error = [ `Ok of 'a | `Error of string ]
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
|
|
|
|||
|
|
@ -15,13 +15,15 @@ let install_printer s =
|
|||
()
|
||||
let install_printers = List.iter install_printer
|
||||
|
||||
let pp_vector pp_x out (v: _ CCVector.vector) = CCVector.print pp_x out v
|
||||
let pp_rw_vector pp_x out (v: _ CCVector.vector) = CCVector.print pp_x out v
|
||||
let pp_ro_vector pp_x out (v: _ CCVector.ro_vector) = CCVector.print pp_x out v
|
||||
let pp_klist (ppx:Format.formatter -> 'a -> unit) out l = CCKList.print ppx out l
|
||||
|
||||
let () =
|
||||
install_printers
|
||||
[ "CCHashtbl.print"
|
||||
; "Containers_top.pp_vector"
|
||||
; "Containers_top.pp_rw_vector"
|
||||
; "Containers_top.pp_ro_vector"
|
||||
; "CCBV.print"
|
||||
; "CCDeque.print"
|
||||
; "CCFQueue.print"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue