ligo/vendors/ligo-utils/simple-utils/x_option.ml

100 lines
2.0 KiB
OCaml
Raw Normal View History

2019-05-28 14:46:22 +04:00
(* Constructors *)
let none = None
let some x = Some x
let return = some
2019-05-13 00:46:25 +04:00
2019-05-28 14:46:22 +04:00
(* Destructors *)
2019-05-13 00:46:25 +04:00
let unopt ~default x = match x with
| None -> default
| Some x -> x
let unopt_exn x = match x with
| None -> raise Not_found
| Some x -> x
2019-05-28 14:46:22 +04:00
(* Base Tranformers *)
let bind f = function
2019-05-13 00:46:25 +04:00
| None -> None
2019-05-28 14:46:22 +04:00
| Some x -> f x
let map f x =
let f' y = return @@ f y in
bind f' x
2019-05-13 00:46:25 +04:00
2019-05-28 14:46:22 +04:00
(* Syntax *)
let (>>=) x f = bind f x
(* Interaction with List *)
let to_list = function
| None -> []
| Some x -> [ x ]
let collapse_list = fun l ->
List.concat @@ List.map to_list l
2019-05-28 14:46:22 +04:00
(* Combinators *)
let bind_eager_or = fun a b -> match (a , b) with
| Some a , _ -> Some a
| _ , Some b -> Some b
| _ -> None
let map_pair_or = fun (fa, fb) p ->
bind_eager_or (fa p) (fb p)
2019-05-28 14:46:22 +04:00
let bind_union (a , b) = match (a , b) with
2019-05-13 00:46:25 +04:00
| Some x , _ -> Some (`Left x)
| None , Some x -> Some (`Right x)
| _ -> None
let rec bind_list = fun lst ->
2019-05-28 14:46:22 +04:00
(* TODO: recursive terminal *)
2019-05-13 00:46:25 +04:00
match lst with
| [] -> Some []
| hd :: tl -> (
match hd with
| None -> None
| Some hd' -> (
match bind_list tl with
| None -> None
| Some tl' -> Some (hd' :: tl')
)
)
let bind_pair = fun (a , b) ->
a >>= fun a' ->
b >>= fun b' ->
Some (a' , b')
let bind_map_list = fun f lst -> bind_list (X_list.map f lst)
let bind_map_pair = fun f (a , b) -> bind_pair (f a , f b)
let bind_smap (s:_ X_map.String.t) =
let open X_map.String in
let aux k v prev =
prev >>= fun prev' ->
v >>= fun v' ->
Some (add k v' prev') in
fold aux s (Some empty)
let bind_map_smap f smap = bind_smap (X_map.String.map f smap)
2019-11-26 03:15:25 +04:00
let equal eq x y =
match (x, y) with
| (None, None) -> true
| (Some x, Some y) -> eq x y
| _ -> false
let compare compare x y =
match (x, y) with
| (None, None) -> 0
| (None, Some _) -> -1
| (Some _, None) -> 1
| (Some x, Some y) -> compare x y
let is_some x =
match x with
| Some _ -> true
| None -> false
let is_none x =
match x with
| Some _ -> false
| None -> true