-
Notifications
You must be signed in to change notification settings - Fork 1.1k
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
new ephemeron API, implemented on top of old ephemerons #10737
Merged
Merged
Changes from 6 commits
Commits
Show all changes
7 commits
Select commit
Hold shift + click to select a range
348004d
new ephemeron API, implemented on top of old ephemerons
damiendoligez d535cc9
fix tests that use the old ephemeron API
damiendoligez 1c2952c
add Changes entry
damiendoligez cd592f8
update .depend
damiendoligez d099279
ephemerons: port tests to the new API
damiendoligez c1f281d
ephemerons : fix test for flambda
damiendoligez 5de50bd
fix "set_key/set_data" virtual bug; update Changes
damiendoligez File filter
Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -13,15 +13,77 @@ | |
(* *) | ||
(**************************************************************************) | ||
|
||
[@@@ocaml.warning "-32"] | ||
|
||
module type SeededS = sig | ||
include Hashtbl.SeededS | ||
|
||
type key | ||
type !'a t | ||
val create : ?random (*thwart tools/sync_stdlib_docs*) : bool -> int -> 'a t | ||
val clear : 'a t -> unit | ||
val reset : 'a t -> unit | ||
val copy : 'a t -> 'a t | ||
val add : 'a t -> key -> 'a -> unit | ||
val remove : 'a t -> key -> unit | ||
val find : 'a t -> key -> 'a | ||
val find_opt : 'a t -> key -> 'a option | ||
val find_all : 'a t -> key -> 'a list | ||
val replace : 'a t -> key -> 'a -> unit | ||
val mem : 'a t -> key -> bool | ||
val iter : (key -> 'a -> unit) -> 'a t -> unit | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val length : 'a t -> int | ||
val stats : 'a t -> Hashtbl.statistics | ||
val to_seq : 'a t -> (key * 'a) Seq.t | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val to_seq_keys : _ t -> key Seq.t | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val to_seq_values : 'a t -> 'a Seq.t | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val add_seq : 'a t -> (key * 'a) Seq.t -> unit | ||
val replace_seq : 'a t -> (key * 'a) Seq.t -> unit | ||
val of_seq : (key * 'a) Seq.t -> 'a t | ||
val clean: 'a t -> unit | ||
val stats_alive: 'a t -> Hashtbl.statistics | ||
(** same as {!stats} but only count the alive bindings *) | ||
end | ||
|
||
module type S = sig | ||
include Hashtbl.S | ||
|
||
type key | ||
type !'a t | ||
val create : int -> 'a t | ||
val clear : 'a t -> unit | ||
val reset : 'a t -> unit | ||
val copy : 'a t -> 'a t | ||
val add : 'a t -> key -> 'a -> unit | ||
val remove : 'a t -> key -> unit | ||
val find : 'a t -> key -> 'a | ||
val find_opt : 'a t -> key -> 'a option | ||
val find_all : 'a t -> key -> 'a list | ||
val replace : 'a t -> key -> 'a -> unit | ||
val mem : 'a t -> key -> bool | ||
val iter : (key -> 'a -> unit) -> 'a t -> unit | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val filter_map_inplace : (key -> 'a -> 'a option) -> 'a t -> unit | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val length : 'a t -> int | ||
val stats : 'a t -> Hashtbl.statistics | ||
val to_seq : 'a t -> (key * 'a) Seq.t | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val to_seq_keys : _ t -> key Seq.t | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val to_seq_values : 'a t -> 'a Seq.t | ||
[@@alert old_ephemeron_api "This function won't be available in 5.0"] | ||
val add_seq : 'a t -> (key * 'a) Seq.t -> unit | ||
val replace_seq : 'a t -> (key * 'a) Seq.t -> unit | ||
val of_seq : (key * 'a) Seq.t -> 'a t | ||
val clean: 'a t -> unit | ||
val stats_alive: 'a t -> Hashtbl.statistics | ||
(** same as {!stats} but only count the alive bindings *) | ||
|
@@ -450,6 +512,18 @@ module K1 = struct | |
let check_data (t:('k,'d) t) : bool = ObjEph.check_data t | ||
let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2 | ||
|
||
let make key data = | ||
let eph = create () in | ||
set_key eph key; | ||
set_data eph data; | ||
eph | ||
|
||
let query eph key = | ||
match get_key eph with | ||
| None -> None | ||
| Some k when k == key -> get_data eph | ||
| Some _ -> None | ||
|
||
module MakeSeeded (H:Hashtbl.SeededHashedType) = | ||
GenHashTable.MakeSeeded(struct | ||
type 'a container = (H.t,'a) t | ||
|
@@ -490,6 +564,37 @@ module K1 = struct | |
tbl | ||
end | ||
|
||
module Bucket = struct | ||
|
||
type nonrec ('k, 'd) t = ('k, 'd) t list ref | ||
let k1_make = make | ||
let make () = ref [] | ||
let add b k d = b := k1_make k d :: !b | ||
|
||
let test_key k e = | ||
match get_key e with | ||
| Some x when x == k -> true | ||
| _ -> false | ||
|
||
let remove b k = | ||
let rec loop l acc = | ||
match l with | ||
| [] -> () | ||
| h :: t when test_key k h -> b := List.rev_append acc t | ||
| h :: t -> loop t (h :: acc) | ||
in | ||
loop !b [] | ||
|
||
let find b k = | ||
match List.find_opt (test_key k) !b with | ||
| Some e -> get_data e | ||
| None -> None | ||
|
||
let length b = List.length !b | ||
let clear b = b := [] | ||
|
||
end | ||
|
||
end | ||
|
||
module K2 = struct | ||
|
@@ -530,6 +635,24 @@ module K2 = struct | |
let check_data (t:('k1,'k2,'d) t) : bool = ObjEph.check_data t | ||
let blit_data (t1:(_,_,'d) t) (t2:(_,_,'d) t) : unit = ObjEph.blit_data t1 t2 | ||
|
||
let make key1 key2 data = | ||
let eph = create () in | ||
set_key1 eph key1; | ||
set_key2 eph key2; | ||
set_data eph data; | ||
eph | ||
|
||
let query eph key1 key2 = | ||
match get_key1 eph with | ||
| None -> None | ||
| Some k when k == key1 -> | ||
begin match get_key2 eph with | ||
| None -> None | ||
| Some k when k == key2 -> get_data eph | ||
| Some _ -> None | ||
end | ||
| Some _ -> None | ||
|
||
module MakeSeeded | ||
(H1:Hashtbl.SeededHashedType) | ||
(H2:Hashtbl.SeededHashedType) = | ||
|
@@ -582,6 +705,37 @@ module K2 = struct | |
tbl | ||
end | ||
|
||
module Bucket = struct | ||
|
||
type nonrec ('k1, 'k2, 'd) t = ('k1, 'k2, 'd) t list ref | ||
let k2_make = make | ||
let make () = ref [] | ||
let add b k1 k2 d = b := k2_make k1 k2 d :: !b | ||
|
||
let test_keys k1 k2 e = | ||
match get_key1 e, get_key2 e with | ||
| Some x1, Some x2 when x1 == k1 && x2 == k2 -> true | ||
| _ -> false | ||
|
||
let remove b k1 k2 = | ||
let rec loop l acc = | ||
match l with | ||
| [] -> () | ||
| h :: t when test_keys k1 k2 h -> b := List.rev_append acc t | ||
| h :: t -> loop t (h :: acc) | ||
in | ||
loop !b [] | ||
|
||
let find b k1 k2 = | ||
match List.find_opt (test_keys k1 k2) !b with | ||
| Some e -> get_data e | ||
| None -> None | ||
|
||
let length b = List.length !b | ||
let clear b = b := [] | ||
|
||
end | ||
|
||
end | ||
|
||
module Kn = struct | ||
|
@@ -608,6 +762,26 @@ module Kn = struct | |
let check_data (t:('k,'d) t) : bool = ObjEph.check_data t | ||
let blit_data (t1:(_,'d) t) (t2:(_,'d) t) : unit = ObjEph.blit_data t1 t2 | ||
|
||
let make keys data = | ||
let l = Array.length keys in | ||
let eph = create l in | ||
for i = 0 to l - 1 do set_key eph i keys.(i) done; | ||
set_data eph data; | ||
eph | ||
|
||
let query eph keys = | ||
let l = length eph in | ||
try | ||
if l <> Array.length keys then raise Exit; | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Would |
||
for i = 0 to l - 1 do | ||
match get_key eph i with | ||
| None -> raise Exit | ||
| Some k when k == keys.(i) -> () | ||
| Some _ -> raise Exit | ||
done; | ||
get_data eph | ||
with Exit -> None | ||
|
||
module MakeSeeded (H:Hashtbl.SeededHashedType) = | ||
GenHashTable.MakeSeeded(struct | ||
type 'a container = (H.t,'a) t | ||
|
@@ -685,4 +859,42 @@ module Kn = struct | |
replace_seq tbl i; | ||
tbl | ||
end | ||
|
||
module Bucket = struct | ||
|
||
type nonrec ('k, 'd) t = ('k, 'd) t list ref | ||
let kn_make = make | ||
let make () = ref [] | ||
let add b k d = b := kn_make k d :: !b | ||
|
||
let test_keys k e = | ||
try | ||
if length e <> Array.length k then raise Exit; | ||
for i = 0 to Array.length k - 1 do | ||
match get_key e i with | ||
| Some x when x == k.(i) -> () | ||
| _ -> raise Exit | ||
done; | ||
true | ||
with Exit -> false | ||
|
||
let remove b k = | ||
let rec loop l acc = | ||
match l with | ||
| [] -> () | ||
| h :: t when test_keys k h -> b := List.rev_append acc t | ||
| h :: t -> loop t (h :: acc) | ||
in | ||
loop !b [] | ||
|
||
let find b k = | ||
match List.find_opt (test_keys k) !b with | ||
| Some e -> get_data e | ||
| None -> None | ||
|
||
let length b = List.length !b | ||
let clear b = b := [] | ||
|
||
end | ||
|
||
end |
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
It is safer in theory to write this as
set_data eph data; set_key eph key
, because if this is the last use ofkey
and the GC runs betweenset_key
andset_data
then it can clear the ephemeron before the data is set, resulting in an ephemeron with a dead, clearedkey
and a strong reference todata
. This strong reference will never be cleared.I think in practice this situation will not occur, because there is no allocation between those two calls, the safepoints patch does not insert allocations at that point, and if this is inlined into a function that does contain allocations it seems relatively unlikely that the optimiser will choose to move an allocation between these calls. So it's probably fine as-is, but it would at least be more obviously fine the other way around.
(See here for further discussion on this issue. I think the new API proposed here is a big improvement, because it avoids this sort of trickiness)
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Doesn't cost much to fix, so I fixed it.