add Irc.Mode.Set datastructure, backed by simple bit operations
This commit is contained in:
parent
76b31627b2
commit
b46d808e1f
|
@ -48,6 +48,67 @@ let[@warning "+8"] _check_exhaustive (x : chan) =
|
||||||
| #chan_c -> ()
|
| #chan_c -> ()
|
||||||
| #chan_d -> ()
|
| #chan_d -> ()
|
||||||
|
|
||||||
|
|
||||||
|
module Set = struct
|
||||||
|
type t = int
|
||||||
|
type elt = [user | chan_d]
|
||||||
|
|
||||||
|
let[@inline] singleton = function
|
||||||
|
| `i -> 1
|
||||||
|
| `m -> 2
|
||||||
|
| `n -> 4
|
||||||
|
| `o -> 8
|
||||||
|
| `s -> 16
|
||||||
|
| `t -> 32
|
||||||
|
| `w -> 64
|
||||||
|
|
||||||
|
let empty = 0
|
||||||
|
let equal = Int.equal
|
||||||
|
let union = ( lor )
|
||||||
|
let inter = ( land )
|
||||||
|
let diff s t = s land Int.lognot t
|
||||||
|
let mem elt s = s land (singleton elt) <> 0
|
||||||
|
let add elt s = union s (singleton elt)
|
||||||
|
let remove elt s = diff s (singleton elt)
|
||||||
|
|
||||||
|
let to_string s =
|
||||||
|
let bs = Bytes.create 7 in
|
||||||
|
let bit ch elt i =
|
||||||
|
if mem elt s then (Bytes.set bs i ch; i + 1)
|
||||||
|
else i
|
||||||
|
in
|
||||||
|
let n =
|
||||||
|
0 |> bit 'i' `i |> bit 'm' `m |> bit 'n' `n |> bit 'o' `o |>
|
||||||
|
bit 's' `s |> bit 't' `t |> bit 'w' `w
|
||||||
|
in
|
||||||
|
Bytes.sub_string bs 0 n
|
||||||
|
|
||||||
|
let pp ppf s =
|
||||||
|
Format.pp_print_string ppf (to_string s)
|
||||||
|
|
||||||
|
let of_list l =
|
||||||
|
List.fold_left (fun s e -> add e s) empty l
|
||||||
|
|
||||||
|
(* TODO: i dont think the following two functions are useful outside of the expect tests *)
|
||||||
|
|
||||||
|
let of_string s =
|
||||||
|
let chr = function
|
||||||
|
| 'i' -> `i | 'm' -> `m | 'n' -> `n | 'o' -> `o
|
||||||
|
| 's' -> `s | 't' -> `t | 'w' -> `w
|
||||||
|
| _ -> invalid_arg "Irc.Mode.Set.of_string"
|
||||||
|
in
|
||||||
|
String.fold_left (fun s c -> add (chr c) s) empty s
|
||||||
|
|
||||||
|
let to_list s =
|
||||||
|
let cons x xs =
|
||||||
|
if mem x s then x :: xs
|
||||||
|
else xs
|
||||||
|
in
|
||||||
|
cons `i @@ cons `m @@ cons `n @@ cons `o @@
|
||||||
|
cons `s @@ cons `t @@ cons `w []
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
let%expect_test _ =
|
let%expect_test _ =
|
||||||
let roundtrip of_char_x m =
|
let roundtrip of_char_x m =
|
||||||
match of_char_x (to_char m) with
|
match of_char_x (to_char m) with
|
||||||
|
@ -68,3 +129,17 @@ let%expect_test _ =
|
||||||
roundtrip_chan `o;
|
roundtrip_chan `o;
|
||||||
roundtrip_chan `s;
|
roundtrip_chan `s;
|
||||||
roundtrip_chan `t;
|
roundtrip_chan `t;
|
||||||
|
|
||||||
|
let print_set_nl s = Printf.printf "[%s]\n" (Set.to_string s) in
|
||||||
|
let print_bool_nl b = print_endline (if b then "true" else "false") in
|
||||||
|
|
||||||
|
print_set_nl Set.empty; [%expect {| [] |}];
|
||||||
|
print_set_nl (Set.of_list [`i]); [%expect {| [i] |}];
|
||||||
|
print_set_nl (Set.of_list [`n; `o]); [%expect {| [no] |}];
|
||||||
|
print_set_nl (Set.of_list [`s; `m]); [%expect {| [ms] |}];
|
||||||
|
print_set_nl (Set.of_string "wi"); [%expect {| [iw] |}];
|
||||||
|
print_set_nl (Set.of_string "wi"); [%expect {| [iw] |}];
|
||||||
|
print_bool_nl (Set.(mem `i (of_string "ins"))); [%expect "true"];
|
||||||
|
print_bool_nl (Set.(mem `w (of_string "ins"))); [%expect "false"];
|
||||||
|
print_bool_nl (Set.(mem `w (of_string "wwww"))); [%expect "true"];
|
||||||
|
print_bool_nl (Set.(mem `t (of_string "imnosw"))); [%expect "false"];
|
||||||
|
|
|
@ -36,3 +36,24 @@ val pp : Format.formatter -> [< t] -> unit
|
||||||
val to_char : [< t] -> char
|
val to_char : [< t] -> char
|
||||||
val of_char_user : char -> [> user]
|
val of_char_user : char -> [> user]
|
||||||
val of_char_chan : char -> [> chan]
|
val of_char_chan : char -> [> chan]
|
||||||
|
|
||||||
|
module Set : sig
|
||||||
|
type t
|
||||||
|
type elt = [user | chan_d]
|
||||||
|
|
||||||
|
val empty : t
|
||||||
|
val singleton : [< elt] -> t
|
||||||
|
val mem : [< elt] -> t -> bool
|
||||||
|
val add : [< elt] -> t -> t
|
||||||
|
val remove : [< elt] -> t -> t
|
||||||
|
val union : t -> t -> t
|
||||||
|
val inter : t -> t -> t
|
||||||
|
val diff : t -> t -> t
|
||||||
|
val equal : t -> t -> bool
|
||||||
|
|
||||||
|
val pp : Format.formatter -> t -> unit
|
||||||
|
val to_string : t -> string
|
||||||
|
val of_string : string -> t
|
||||||
|
val to_list : t -> elt list
|
||||||
|
val of_list : [< elt] list -> t
|
||||||
|
end
|
||||||
|
|
Loading…
Reference in New Issue