8000 Add support for atomic locs in the stdlib by glittershark · Pull Request #4232 · oxcaml/oxcaml · GitHub
[go: up one dir, main page]
More Web Proxy on the site http://driver.im/
Skip to content
8000

Add support for atomic locs in the stdlib #4232

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.

Sign up for GitHub

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

Draft
wants to merge 2 commits into
base: aspsmith/forbid-atomic-fields-in-patterns
Choose a base branch
from
Draft

Add support for atomic locs in the stdlib #4232

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
7b72146
Add support fo atomic locs in the stdlib
glittershark Jun 29, 2025
02cecc2
Merge branch 'aspsmith/forbid-atomic-fields-in-patterns' into aspsmit…
glittershark Jun 29, 2025
File filter 8000

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
52 changes: 52 additions & 0 deletions stdlib/atomic.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -58,3 +58,55 @@
'a t @ contended local -> 'a -> 'a -> 'a @@ portable =
"%atomic_compare_exchange"
end

module Loc = struct
type ('a : value_or_null) t : mutable_data with 'a = 'a atomic_loc
external get : ('a : value_or_null).
'a t @ local -> 'a @@ portable = "%atomic_load_loc"
external set : ('a : value_or_null).
'a t @ local -> 'a -> unit @@ portable = "%atomic_set_loc"
external exchange : ('a : value_or_null).
'a t @ local -> 'a -> 'a @@ portable = "%atomic_exchange_loc"
external compare_and_set : ('a : value_or_null).
'a t @ local -> 'a -> 'a -> bool @@ portable = "%atomic_cas_loc"
external compare_exchange : ('a : value_or_null).
'a t @ local -> 'a -> 'a -> 'a @@ portable = "%atomic_compare_exchange_loc"

external fetch_and_add
: int t @ contended local -> int -> int @@ portable = "%atomic_fetch_add_loc"

Check failure on line 76 in stdlib/atomic.ml

View workflow job for this annotation

GitHub Actions / build (ubuntu-latest, 4.14.0)

Line is longer than 80 characters 

Line 76 is too long in stdlib/atomic.ml

external add
: int t @ contended local -> int -> unit @@ portable = "%atomic_add_loc"

external sub
: int t @ contended local -> int -> unit @@ portable = "%atomic_sub_loc"

external logand
: int t @ contended local -> int -> unit @@ portable = "%atomic_land_loc"

external logor
: int t @ contended local -> int -> unit @@ portable = "%atomic_lor_loc"

external logxor
: int t @ contended local -> int -> unit @@ portable = "%atomic_lxor_loc"

let incr t = add t 1
let decr t = sub t 1

module Contended = struct
external get : ('a : value_or_null mod contended).
'a t @ contended local -> 'a @@ portable = "%atomic_load_loc"

external set : ('a : value_or_null mod portable).
'a t @ contended local -> 'a -> unit @@ portable = "%atomic_set_loc"

external exchange : ('a : value_or_null mod contended portable).
'a t @ contended local -> 'a -> 'a @@ portable = "%atomic_exchange_loc"

external compare_and_set : ('a : value_or_null mod portable).
'a t @ contended local -> 'a -> 'a -> bool @@ portable = "%atomic_cas_loc"

external compare_exchange : ('a : value_or_null mod contended portable).
'a t @ contended local -> 'a -> 'a -> 'a @@ portable = "%atomic_compare_exchange_loc"

Check failure on line 110 in stdlib/atomic.ml

View workflow job for this annotation

GitHub Actions / build (ubuntu-latest, 4.14.0)

Line is longer than 80 characters 

Line 110 is too long in stdlib/atomic.ml
end
end
65 changes: 65 additions & 0 deletions stdlib/atomic.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -126,6 +126,71 @@ module Contended : sig
'a t @ contended local -> 'a -> 'a -> 'a = "%atomic_compare_exchange"
end

(** Atomic "locations", such as record fields. *)
module Loc : sig
(** This module exposes a dedicated type ['a Atomic.Loc.t] for
atomic locations (storing a value of type ['a]) inside objects
that may not be atomic references. It is used in particular for
atomic record fields: if a record [r] has an atomic field [f] of
type [foo], then [[%atomic.loc r.f]] has type [foo Atomic.Loc.t].

The API below mirrors the API to access {{!t}atomic references},
see the documentation above for more information. *)
type ('a : value_or_null) t : mutable_data with 'a = 'a atomic_loc

external get : ('a : value_or_null). 'a t @ local -> 'a = "%atomic_load_loc"

external set : ('a : value_or_null).
'a t @ local -> 'a -> unit = "%atomic_set_loc"

external exchange : ('a : value_or_null).
'a t @ local -> 'a -> 'a = "%atomic_exchange_loc"

external compare_and_set : ('a : value_or_null).
'a t @ local -> 'a -> 'a -> bool = "%atomic_cas_loc"

external compare_exchange : ('a : value_or_null).
'a t @ local -> 'a -> 'a -> 'a = "%atomic_compare_exchange_loc"

external fetch_and_add
: int t @ contended local -> int -> int = "%atomic_fetch_add_loc"

external add
: int t @ contended local -> int -> unit = "%atomic_add_loc"

external sub
: int t @ contended local -> int -> unit = "%atomic_sub_loc"

external logand
: int t @ contended local -> int -> unit = "%atomic_land_loc"

external logor
: int t @ contended local -> int -> unit = "%atomic_lor_loc"

external logxor
: int t @ contended local -> int -> unit = "%atomic_lxor_loc"

val incr : int t @ contended local -> unit
val decr : int t @ contended local -> unit

module Contended : sig
external get : ('a : value_or_null mod contended).
'a t @ contended local -> 'a = "%atomic_load_loc"

external set : ('a : value_or_null mod portable).
'a t @ contended local -> 'a -> unit = "%atomic_set_loc"

external exchange : ('a : value_or_null mod contended portable).
'a t @ contended local -> 'a -> 'a = "%atomic_exchange_loc"

external compare_and_set : ('a : value_or_null mod portable).
'a t @ contended local -> 'a -> 'a -> bool = "%atomic_cas_loc"

external compare_exchange : ('a : value_or_null mod contended portable).
'a t @ contended local -> 'a -> 'a -> 'a = "%atomic_compare_exchange_loc"
end
end

(** {1:examples Examples}

{2 Basic Thread Coordination}
Expand Down
Loading
0