aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Utilities.ml
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Utilities.ml28
-rw-r--r--lib/Utilities.mli17
2 files changed, 45 insertions, 0 deletions
diff --git a/lib/Utilities.ml b/lib/Utilities.ml
index a6b36c7..e4ee9c3 100644
--- a/lib/Utilities.ml
+++ b/lib/Utilities.ml
@@ -1,3 +1,9 @@
+module Ordering = struct
+ type t = Equal | Smaller | Greater
+
+ let of_int x = if x < 0 then Smaller else if x > 0 then Greater else Equal
+end
+
module Result = struct
let ( let* ) = Result.bind
let fmap f m = Result.bind m f
@@ -69,3 +75,25 @@ module FingerTree = struct
BatFingerTree.print ~first:"" ~last:"" ~sep:sep BatIO.nwrite
|> Fun.flip BatIO.to_string ss
end
+
+module Option = struct
+ let ( let* ) = Option.bind
+ let fmap f m = Option.bind m f
+end
+
+module Atomic = struct
+ let rec swap atom f =
+ let v = Atomic.get atom in
+ let v' = f v in
+ if Atomic.compare_and_set atom v v'
+ then atom
+ else swap atom f
+
+ let rec mswap atom f =
+ let open Result in
+ let v = Atomic.get atom in
+ let* v' = f v in
+ if Atomic.compare_and_set atom v v'
+ then Ok atom
+ else mswap atom f
+end
diff --git a/lib/Utilities.mli b/lib/Utilities.mli
index 2735009..f149889 100644
--- a/lib/Utilities.mli
+++ b/lib/Utilities.mli
@@ -1,3 +1,9 @@
+module Ordering : sig
+ type t = Equal | Smaller | Greater
+
+ val of_int : int -> t
+end
+
module Result : sig
val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result
val fmap : ('a -> ('b, 'e) result) -> ('a, 'e) result -> ('b, 'e) result
@@ -7,6 +13,17 @@ module List : sig
val sequence : ('a, 'b) result list -> ('a list, 'b) result
end
+module Option : sig
+ val ( let* ) : 'a option -> ('a -> 'b option) -> 'b option
+ val fmap : ('a -> 'b option) -> 'a option -> 'b option
+end
+
+module Atomic : sig
+ val swap : 'a Atomic.t -> ('a -> 'a) -> 'a Atomic.t
+ (* This is silly *)
+ val mswap : 'a Atomic.t -> ('a -> ('a, 'b) result) -> ('a Atomic.t, 'b) result
+end
+
module FingerTree : sig
val map2 : ('a -> 'b -> 'c) -> 'a BatFingerTree.t -> 'b BatFingerTree.t -> 'c BatFingerTree.t
val zip : 'a BatFingerTree.t -> 'b BatFingerTree.t -> ('a * 'b) BatFingerTree.t