crdt library in ocaml implementing json-joy
gdiazlo.tngl.sh
1(** Logical timestamps and clock vectors.
2
3 This module implements the clock types from json-joy:
4 - Timestamp: (session_id, logical_time) pair
5 - Timespan: Timestamp with a span/length
6 - ClockVector: Vector clock for multiple sessions *)
7
8type timestamp = {
9 sid : int; (** Session ID (53-bit safe integer) *)
10 time : int; (** Logical time (53-bit safe integer) *)
11}
12(** A logical timestamp identifying a unique operation *)
13
14type timespan = { sid : int; time : int; span : int (** Length of the span *) }
15(** A timespan representing a range of timestamps *)
16
17(** Compare two timestamps *)
18let compare_ts (a : timestamp) (b : timestamp) =
19 let c = Int.compare a.time b.time in
20 if c <> 0 then c else Int.compare a.sid b.sid
21
22(** Check if two timestamps are equal *)
23let equal_ts (a : timestamp) (b : timestamp) = a.sid = b.sid && a.time = b.time
24
25(** Create a timestamp *)
26let timestamp sid time : timestamp = { sid; time }
27
28(** Create a timespan *)
29let timespan sid time span = { sid; time; span }
30
31(** Check if a timestamp is contained within a timespan *)
32let contains ts span =
33 ts.sid = span.sid && ts.time >= span.time && ts.time < span.time + span.span
34
35(** Get the end timestamp of a timespan (exclusive) *)
36let timespan_end span = { sid = span.sid; time = span.time + span.span }
37
38type logical_clock = { mutable clock_sid : int; mutable clock_time : int }
39(** A logical clock for a single session *)
40
41(** Create a new logical clock *)
42let create_clock sid = { clock_sid = sid; clock_time = 0 }
43
44(** Tick the clock and return the new timestamp *)
45let tick clock : timestamp =
46 let ts : timestamp = { sid = clock.clock_sid; time = clock.clock_time } in
47 clock.clock_time <- clock.clock_time + 1;
48 ts
49
50type clock_vector = {
51 local : logical_clock;
52 mutable peers : (int * int) list; (** (sid, observed_time) pairs *)
53}
54(** A clock vector tracking multiple sessions *)
55
56(** Create a new clock vector *)
57let create_vector sid = { local = create_clock sid; peers = [] }
58
59(** Observe a timestamp and update peer knowledge *)
60let observe vector (ts : timestamp) =
61 let dominated = List.filter (fun (s, _) -> s <> ts.sid) vector.peers in
62 let existing = List.assoc_opt ts.sid vector.peers in
63 match existing with
64 | Some t when t >= ts.time -> () (* Already observed *)
65 | _ -> vector.peers <- (ts.sid, ts.time) :: dominated
66
67(** Fork the clock vector with a new session ID *)
68let fork vector new_sid =
69 let new_local = create_clock new_sid in
70 new_local.clock_time <- vector.local.clock_time;
71 {
72 local = new_local;
73 peers =
74 (vector.local.clock_sid, vector.local.clock_time - 1) :: vector.peers;
75 }
76
77(** Clone the clock vector *)
78let clone vector =
79 {
80 local =
81 {
82 clock_sid = vector.local.clock_sid;
83 clock_time = vector.local.clock_time;
84 };
85 peers = List.map (fun (s, t) -> (s, t)) vector.peers;
86 }