mirror of
https://github.com/c-cube/sidekick.git
synced 2025-12-08 04:05:43 -05:00
feat: add Event in util
This commit is contained in:
parent
a35f5719b7
commit
6f1fcee828
2 changed files with 53 additions and 0 deletions
38
src/util/Event.ml
Normal file
38
src/util/Event.ml
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
|
||||
type 'a small_set =
|
||||
| S0
|
||||
| S1 of 'a
|
||||
| S2 of 'a * 'a
|
||||
| S3 of 'a * 'a * 'a * 'a small_set
|
||||
|
||||
type 'a t = {
|
||||
mutable set: ('a -> unit) small_set;
|
||||
}
|
||||
|
||||
let[@unroll 1] rec cons_ f set = match set with
|
||||
| S0 -> S1 f
|
||||
| S1 f2 -> S2(f,f2)
|
||||
| S2(f2,f3) -> S3 (f,f2,f3, S0)
|
||||
| S3(f1,f2,f3,tl) -> S3 (f,f1,f2,cons_ f3 tl)
|
||||
|
||||
let on (e:_ t) f : unit =
|
||||
let set' = cons_ f e.set in
|
||||
e.set <- set'
|
||||
|
||||
module Emitter = struct
|
||||
type nonrec 'a t = 'a t
|
||||
|
||||
let rec fire_set_ set x =
|
||||
match set with
|
||||
| S0 -> ()
|
||||
| S1 f -> f x
|
||||
| S2 (f1,f2) -> f1 x; f2 x
|
||||
| S3 (f1,f2,f3,tl) -> f1 x; f2 x; f3 x; fire_set_ tl x
|
||||
|
||||
let[@inline] fire e x = fire_set_ e.set x
|
||||
end
|
||||
|
||||
let make () =
|
||||
let e = {set=S0} in
|
||||
e, e
|
||||
|
||||
15
src/util/Event.mli
Normal file
15
src/util/Event.mli
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
|
||||
(** {1 Observer pattern} *)
|
||||
|
||||
type 'a t
|
||||
|
||||
val on : 'a t -> ('a -> unit) -> unit
|
||||
|
||||
module Emitter : sig
|
||||
type 'a t
|
||||
|
||||
val fire : 'a t -> 'a -> unit
|
||||
end
|
||||
|
||||
val make : unit -> 'a t * 'a Emitter.t
|
||||
|
||||
Loading…
Add table
Reference in a new issue