Skip to content

Commit 21649eb

Browse files
v0.18~preview.130.31+242
1 parent e81593a commit 21649eb

File tree

113 files changed

+6339
-3882
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

113 files changed

+6339
-3882
lines changed

src/array.ml

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ include Array0
55
type 'a t = 'a array
66
[@@deriving compare ~localize, globalize, sexp ~localize, sexp_grammar]
77

8+
[@@@warning "-incompatible-with-upstream"]
9+
810
(* This module implements a new in-place, constant heap sorting algorithm to replace the
911
one used by the standard libraries. Its only purpose is to be faster (hopefully
1012
strictly faster) than the base sort and stable_sort.
@@ -34,8 +36,8 @@ type 'a t = 'a array
3436
- http://www.sorting-algorithms.com/quick-sort-3-way *)
3537

3638
module%template.portable
37-
[@modality p] Sorter (S : sig
38-
type 'a t
39+
[@kind k = (value, immediate, immediate64)] [@modality p] Sorter (S : sig
40+
type ('a : k) t
3941

4042
val get : local_ 'a t -> int -> 'a
4143
val set : local_ 'a t -> int -> 'a -> unit
@@ -279,8 +281,9 @@ struct
279281
end
280282
[@@inline]
281283

282-
module%template Sort = Sorter [@modality portable] (struct
283-
type nonrec 'a t = 'a t
284+
module%template [@kind k = (value, immediate, immediate64)] Sort =
285+
Sorter [@kind k] [@modality portable] (struct
286+
type nonrec ('a : k) t = 'a t
284287

285288
let get = unsafe_get
286289
let set = unsafe_set
@@ -922,6 +925,11 @@ let sub t ~pos ~len = sub t ~pos ~len
922925
let invariant invariant_a t = iter t ~f:invariant_a
923926

924927
module Private = struct
925-
module Sort = Sort
926-
module%template.portable [@modality p] Sorter = Sorter [@modality p]
928+
module%template [@kind k = (value, immediate, immediate64)] Sort = Sort [@kind k]
929+
930+
module%template.portable
931+
[@kind k = (value, immediate, immediate64)] [@modality p] Sorter =
932+
Sorter
933+
[@kind k]
934+
[@modality p]
927935
end

src/array_intf.ml

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,8 @@
22

33
open! Import
44

5+
[@@@warning "-incompatible-with-upstream"]
6+
57
module Definitions = struct
68
module type Public = sig
79
type 'a t
@@ -343,8 +345,9 @@ module type Array = sig @@ portable
343345
end
344346
end
345347

346-
module%template.portable Sorter (S : sig
347-
type 'a t
348+
module%template.portable
349+
[@kind k = (value, immediate, immediate64)] Sorter (S : sig
350+
type ('a : k) t
348351

349352
val get : local_ 'a t -> int -> 'a
350353
val set : local_ 'a t -> int -> 'a -> unit

src/atomic.ml

Lines changed: 17 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,19 @@ module Compare_failed_or_set_here = struct
77
[@@deriving sexp_of ~localize]
88
end
99

10-
type 'a t = 'a Stdlib.Atomic.t
10+
type 'a t = 'a Basement.Portable_atomic.t
1111

12-
let make = Stdlib.Atomic.make
13-
let make_alone = Stdlib.Atomic.make_contended
12+
let make = Basement.Portable_atomic.make
13+
14+
let make_alone =
15+
if Basement.Stdlib_shim.runtime5 ()
16+
then Basement.Portable_atomic.make_contended
17+
else
18+
(* [caml_atomic_make_contended] is not supported on runtime4; we can just fall back to
19+
regular make, which is semantically correct and we shouldn't be as worried about
20+
false sharing on single-core applications anyway. *)
21+
make
22+
;;
1423

1524
external get : ('a t[@local_opt]) -> 'a @ contended portable @@ portable = "%atomic_load"
1625

@@ -44,13 +53,17 @@ external compare_exchange
4453
@@ portable
4554
= "%atomic_compare_exchange"
4655

56+
external is_runtime5 : unit -> bool @@ portable = "%runtime5"
57+
58+
let cpu_relax = if is_runtime5 () then Stdlib.Domain.cpu_relax else Fn.id
59+
4760
let rec update_and_return t ~(pure_f @ local) =
4861
let old = get t in
4962
let new_ = pure_f old in
5063
match compare_and_set t ~if_phys_equal_to:old ~replace_with:new_ with
5164
| Set_here -> old
5265
| Compare_failed ->
53-
Stdlib.Domain.cpu_relax ();
66+
cpu_relax ();
5467
update_and_return t ~pure_f
5568
;;
5669

src/atomic.mli

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,7 @@ module Compare_failed_or_set_here : sig
3737
[@@deriving sexp_of ~localize]
3838
end
3939

40-
type !'a t : value mod contended portable = 'a Stdlib.Atomic.t
40+
type !'a t : value mod contended portable = 'a Basement.Portable_atomic.t
4141

4242
[%%rederive: type nonrec (!'a : value mod contended) t = 'a t [@@deriving sexp_of]]
4343
[%%rederive: type nonrec (!'a : value mod portable) t = 'a t [@@deriving of_sexp]]

0 commit comments

Comments
 (0)