Skip to content

Commit

Permalink
Update ocamlformat version. (#181)
Browse files Browse the repository at this point in the history
Update ocamlformat version.
  • Loading branch information
lyrm authored Jan 8, 2025
1 parent 306bea6 commit f343045
Show file tree
Hide file tree
Showing 36 changed files with 1,036 additions and 1,074 deletions.
2 changes: 1 addition & 1 deletion .ocamlformat
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
profile = default
version = 0.26.2
version = 0.27.0

exp-grouping=preserve
18 changes: 9 additions & 9 deletions src/ArrayExtra.ml
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
(* The following code is taken from the library [sek] by Arthur Charguéraud
and François Pottier. *)

(** [blit_circularly_dst a1 i1 a2 i2 k] copies [k] elements from the array
[a1], starting at index [i1], to the array [a2], starting at index [i2].
The destination array is regarded as circular, so it is permitted for the
(** [blit_circularly_dst a1 i1 a2 i2 k] copies [k] elements from the array [a1],
starting at index [i1], to the array [a2], starting at index [i2]. The
destination array is regarded as circular, so it is permitted for the
destination range to wrap around. *)
let blit_circularly_dst a1 i1 a2 i2 k =
(* The source range must be well-formed. *)
Expand All @@ -22,12 +22,12 @@ let blit_circularly_dst a1 i1 a2 i2 k =
Array.blit a1 (i1 + k1) a2 0 (k - k1)

(** [blit_circularly a1 i1 a2 i2 k] copies [k] elements from the array [a1],
starting at index [i1], to the array [a2], starting at index [i2]. Both
the source array and the destination array are regarded as circular, so
it is permitted for the source range or destination range to wrap around.
[i1] must be comprised between 0 included and [Array.length a1] excluded.
[i2] must be comprised between 0 included and [Array.length a2] excluded.
[k] must be comprised between 0 included and [Array.length a2] included. *)
starting at index [i1], to the array [a2], starting at index [i2]. Both the
source array and the destination array are regarded as circular, so it is
permitted for the source range or destination range to wrap around. [i1]
must be comprised between 0 included and [Array.length a1] excluded. [i2]
must be comprised between 0 included and [Array.length a2] excluded. [k]
must be comprised between 0 included and [Array.length a2] included. *)
let blit_circularly a1 i1 a2 i2 k =
let n1 = Array.length a1 in
(* The source range must be well-formed. *)
Expand Down
78 changes: 38 additions & 40 deletions src/bag.mli
Original file line number Diff line number Diff line change
Expand Up @@ -20,43 +20,41 @@ val pop_exn : 'v t -> 'v
@raise Empty if the [bag] is empty. *)

val pop_opt : 'v t -> 'v option
(** [pop_opt bag] removes and returns [Some] of a random element of the [bag]
and [None] if the [bag] is empty. *)

(** {1 Example}
{[
# Random.init 0
- : unit = ()
# module Bag = Saturn.Bag
module Bag = Saturn.Bag
# let t : string Bag.t = Bag.create ()
val t : string Bag.t = <abstr>
# let planets = ["Mercury"; "Venus"; "Earth"; "Mars"; "Jupiter"; "Saturn"; "Uranus"; "Neptune"]
val planets : string list =
["Mercury"; "Venus"; "Earth"; "Mars"; "Jupiter"; "Saturn"; "Uranus";
"Neptune"]
# List.iter (Bag.push t) planets
- : unit = ()
# Bag.pop_exn t
- : string = "Neptune"
# Bag.pop_opt t
- : string option = Some "Saturn"
# Bag.pop_exn t
- : string = "Mercury"
# Bag.pop_exn t
- : string = "Mars"
# Bag.pop_exn t
- : string = "Earth"
# Bag.pop_exn t
- : string = "Venus"
# Bag.pop_exn t
- : string = "Uranus"
# Bag.pop_exn t
- : string = "Jupiter"
# Bag.pop_exn t
Exception: Saturn__Bag.Empty.
]}
*)
(** [pop_opt bag] removes and returns [Some] of a random element of the [bag]
and [None] if the [bag] is empty. *)

(** {1 Example}
{[
# Random.init 0
- : unit = ()
# module Bag = Saturn.Bag
module Bag = Saturn.Bag
# let t : string Bag.t = Bag.create ()
val t : string Bag.t = <abstr>
# let planets = ["Mercury"; "Venus"; "Earth"; "Mars"; "Jupiter"; "Saturn"; "Uranus"; "Neptune"]
val planets : string list =
["Mercury"; "Venus"; "Earth"; "Mars"; "Jupiter"; "Saturn"; "Uranus";
"Neptune"]
# List.iter (Bag.push t) planets
- : unit = ()
# Bag.pop_exn t
- : string = "Neptune"
# Bag.pop_opt t
- : string option = Some "Saturn"
# Bag.pop_exn t
- : string = "Mercury"
# Bag.pop_exn t
- : string = "Mars"
# Bag.pop_exn t
- : string = "Earth"
# Bag.pop_exn t
- : string = "Venus"
# Bag.pop_exn t
- : string = "Uranus"
# Bag.pop_exn t
- : string = "Jupiter"
# Bag.pop_exn t
Exception: Saturn__Bag.Empty.
]} *)
5 changes: 2 additions & 3 deletions src/bounded_queue/bounded_queue.body.ml
Original file line number Diff line number Diff line change
Expand Up @@ -146,9 +146,8 @@ let rec fix_tail tail new_tail =

type _ mono = Bool : bool mono | Unit : unit mono

let rec push_as :
type r. 'a t -> ('a, [ `Node ]) node -> ('a, [ `Node ]) node -> r mono -> r
=
let rec push_as : type r.
'a t -> ('a, [ `Node ]) node -> ('a, [ `Node ]) node -> r mono -> r =
fun t new_node old_tail mono ->
let capacity = get_capacity old_tail in
if capacity = 0 then begin
Expand Down
11 changes: 5 additions & 6 deletions src/bounded_queue/bounded_queue.mli
Original file line number Diff line number Diff line change
@@ -1,9 +1,8 @@
(** Lock-free bounded Queue.
(** Lock-free bounded Queue.
This module implements a lock-free bounded queue based on Michael-Scott's queue
algorithm. Adding a capacity to this algorithm adds a general overhead to the
operations, and thus, it is recommended to use the unbounded queue
{!Saturn.Queue} if you don't need it.
*)
This module implements a lock-free bounded queue based on Michael-Scott's
queue algorithm. Adding a capacity to this algorithm adds a general overhead
to the operations, and thus, it is recommended to use the unbounded queue
{!Saturn.Queue} if you don't need it. *)

include Bounded_queue_intf.BOUNDED_QUEUE
103 changes: 52 additions & 51 deletions src/bounded_queue/bounded_queue_intf.mli
Original file line number Diff line number Diff line change
Expand Up @@ -20,70 +20,72 @@ module type BOUNDED_QUEUE = sig
(** Represents a lock-free bounded queue holding elements of type ['a]. *)

val create : ?capacity:int -> unit -> 'a t
(** [create ~capacity ()] creates a new empty bounded queue with a maximum
capacity of [capacity]. The default [capacity] value is [Int.max_int].*)
(** [create ~capacity ()] creates a new empty bounded queue with a maximum
capacity of [capacity]. The default [capacity] value is [Int.max_int].*)

val of_list_exn : ?capacity:int -> 'a list -> 'a t
(** [of_list_exn ~capacity list] creates a new queue from a list.
@raises Full if the length of [list] is greater than [capacity].
🐌 This is a linear-time operation.
{[
# open Saturn.Bounded_queue
# let t : int t = of_list_exn [1;2;3;4]
val t : int t = <abstr>
# pop_opt t
- : int option = Some 1
# pop_opt t
- : int option = Some 2
# length t
- : int = 2
]}
*)
@raise Full if the length of [list] is greater than [capacity].
🐌 This is a linear-time operation.
{[
# open Saturn.Bounded_queue
# let t : int t = of_list_exn [1;2;3;4]
val t : int t = <abstr>
# pop_opt t
- : int option = Some 1
# pop_opt t
- : int option = Some 2
# length t
- : int = 2
]} *)

val length : 'a t -> int
(** [length queue] returns the number of elements currently in the [queue]. *)

val capacity_of : 'a t -> int
(** [capacity_of queue] returns the maximum number of elements that the [queue]
can hold. *)
(** [capacity_of queue] returns the maximum number of elements that the
[queue] can hold. *)

val is_empty : 'a t -> bool
(** [is_empty queue] returns [true] if the [queue] is empty, otherwise [false]. *)
(** [is_empty queue] returns [true] if the [queue] is empty, otherwise
[false]. *)

val is_full : 'a t -> bool
(** [is_full queue] returns [true] if the [queue] is full, otherwise [false]. *)
(** [is_full queue] returns [true] if the [queue] is full, otherwise [false].
*)

(** {2 Consumer functions} *)

exception Empty
(** Raised when {!pop_exn}, {!peek_exn}, or {!drop_exn} is applied to an empty
stack. *)
stack. *)

val peek_exn : 'a t -> 'a
(** [peek_exn queue] returns the first element of the [queue] without removing it.
@raises Empty if the [queue] is empty. *)
(** [peek_exn queue] returns the first element of the [queue] without removing
it.
@raise Empty if the [queue] is empty. *)

val peek_opt : 'a t -> 'a option
(** [peek_opt queue] returns [Some] of the first element of the [queue] without
removing it, or [None] if the [queue] is empty. *)
(** [peek_opt queue] returns [Some] of the first element of the [queue]
without removing it, or [None] if the [queue] is empty. *)

val pop_exn : 'a t -> 'a
(** [pop_exn queue] removes and returns the first element of the [queue].
@raises Empty if the [queue] is empty. *)
@raise Empty if the [queue] is empty. *)

val pop_opt : 'a t -> 'a option
(** [pop_opt queue] removes and returns [Some] of the first element of the [queue],
or [None] if the [queue] is empty. *)
(** [pop_opt queue] removes and returns [Some] of the first element of the
[queue], or [None] if the [queue] is empty. *)

val drop_exn : 'a t -> unit
(** [drop_exn queue] removes the top element of the [queue].
@raises Empty if the [queue] is empty. *)
(** [drop_exn queue] removes the top element of the [queue].
@raise Empty if the [queue] is empty. *)

(** {2 Producer functions} *)

Expand All @@ -92,8 +94,8 @@ module type BOUNDED_QUEUE = sig

val push_exn : 'a t -> 'a -> unit
(** [push_exn queue element] adds [element] at the end of the [queue].
@raises Full if the [queue] is full. *)
@raise Full if the [queue] is full. *)

val try_push : 'a t -> 'a -> bool
(** [try_push queue element] tries to add [element] at the end of the [queue].
Expand All @@ -117,7 +119,7 @@ end
- : unit = ()
# push_exn t 4
Exception: Saturn__Bounded_queue.Full.
# try_push t 4
# try_push t 4
- : bool = false
# pop_exn t
- : int = 1
Expand All @@ -130,15 +132,16 @@ end
# pop_opt t
- : int option = None
# pop_exn t
Exception: Saturn__Bounded_queue.Empty.]}
*)
Exception: Saturn__Bounded_queue.Empty.
]} *)

(** {2 Multicore example}
Note: The barrier is used in this example solely to make the results more
interesting by increasing the likelihood of parallelism. Spawning a domain is
a costly operation, especially compared to the relatively small amount of work
being performed here. In practice, using a barrier in this manner is unnecessary.
Note: The barrier is used in this example solely to make the results more
interesting by increasing the likelihood of parallelism. Spawning a domain
is a costly operation, especially compared to the relatively small amount of
work being performed here. In practice, using a barrier in this manner is
unnecessary.
{@ocaml non-deterministic=command[
# open Saturn.Bounded_queue
Expand All @@ -148,16 +151,16 @@ end
# let barrier = Atomic.make 2
val barrier : int Atomic.t = <abstr>
# let pusher () =
# let pusher () =
Atomic.decr barrier;
while Atomic.get barrier != 0 do Domain.cpu_relax () done;
List.init 8 (fun i -> i)
|> List.map (fun i -> Domain.cpu_relax (); try_push t i)
val pusher : unit -> bool list = <fun>
# let popper () =
# let popper () =
Atomic.decr barrier;
while Atomic.get barrier != 0 do Domain.cpu_relax () done;
while Atomic.get barrier != 0 do Domain.cpu_relax () done;
List.init 8 (fun i -> Domain.cpu_relax (); pop_opt t)
val popper : unit -> int option list = <fun>
Expand All @@ -171,6 +174,4 @@ end
- : bool list = [true; true; true; true; true; false; true; true]
# Domain.join domain_popper
- : int option list = [None; None; Some 0; None; Some 1; Some 2; Some 3; Some 4]
]}
*)
]} *)
11 changes: 5 additions & 6 deletions src/bounded_queue/bounded_queue_unsafe.mli
Original file line number Diff line number Diff line change
@@ -1,9 +1,8 @@
(** Optimized lock-free bounded Queue.
(** Optimized lock-free bounded Queue.
This module implements a lock-free bounded queue based on Michael-Scott's queue
algorithm. Adding a capacity to this algorithm adds a general overhead to the
operations, and thus, it is recommended to use the unbounded queue
{!Saturn.Queue} if you don't need it.
*)
This module implements a lock-free bounded queue based on Michael-Scott's
queue algorithm. Adding a capacity to this algorithm adds a general overhead
to the operations, and thus, it is recommended to use the unbounded queue
{!Saturn.Queue} if you don't need it. *)

include Bounded_queue_intf.BOUNDED_QUEUE
Loading

0 comments on commit f343045

Please sign in to comment.