swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

wip debug

Browse source
This commit is contained in:
swrup 2026-02-07 00:11:25 +01:00
parent 08699487f1
commit f1936f150d
166 changed files with 17619 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

151
src/time.ml
View file

@ -1,151 +0,0 @@
let uint64_max = Int64.minus_one
module Relative = struct
type t = Int64.t
let forever = uint64_max
let zero = 0L
let compare = Int64.unsigned_compare
let min a b = if compare a b < 0 then a else b
let max a b = if compare a b > 0 then a else b
(* forever if either argument is forever or on overflow; otherwise a + b *)
let add a b =
if a = forever || b = forever then forever
else
let v = Int64.add a b in
if compare v a < 0 then forever else v
(* zero if a <= b, or forever if a is forever; otherwise a - b *)
let sub a b =
if compare a b <= 0 then zero
else if a = forever then forever
else Int64.sub a b
let of_s s =
let v = Int64.mul s 1_000_000L in
if Int64.unsigned_div v 1_000_000L <> s then forever else v
let bin = Bin.neint64
let bin_nbo = Bin.beint64
(* TODO should be in NBO here? *)
let caqti =
let encode v = Ok v in
let decode v = Ok v in
Caqti_type.custom ~encode ~decode Caqti_type.int64
(* TODO
reject negative / non-integer values
cap value at 2^53 - 1 inclusive *)
let jsont =
let jsont =
let forever_jsont =
let dec s =
match s with
| "forever" -> forever
| _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
in
let enc _t = "forever" in
Jsont.map ~dec ~enc Jsont.string
in
let num_jsont = Jsont.int64 in
let enc t = if t = forever then forever_jsont else num_jsont in
Jsont.any ~dec_string:forever_jsont ~dec_number:num_jsont ~enc ()
in
Jsont.Object.map ~kind:"RelativeTime" Fun.id
|> Jsont.Object.mem "d_us" jsont ~enc:Fun.id
|> Jsont.Object.finish
end
module Absolute = struct
type t = Int64.t
let never = uint64_max
let zero = 0L
let compare = Int64.unsigned_compare
let min a b = if compare a b < 0 then a else b
let max a b = if compare a b > 0 then a else b
(* zero if a >= b; never if b=never; otherwise b - a *)
let diff a b =
if compare a b >= 0 then zero
else if b = never then never
else Int64.sub b a
(* never if either argument is never/forever or on overflow; otherwise t + d *)
let add t d =
if t = never || d = never then never
else
let v = Int64.add t d in
if compare v t < 0 then never else v
(* zero if t <= d, or never if t is never; otherwise t - d *)
let sub t d =
if compare t d <= 0 then zero
else if t = never then never
else Int64.sub t d
let of_s s =
let v = Int64.mul s 1_000_000L in
if Int64.unsigned_div v 1_000_000L <> s then never else v
let of_ptime v = v |> Ptime.to_float_s |> Int64.of_float |> of_s
end
module Timestamp = struct
type t = Int64.t
let never = uint64_max
let zero = 0L
let compare = Int64.unsigned_compare
(* zero if a >= b; never if b=never; otherwise b - a *)
let diff a b =
if compare a b >= 0 then zero
else if b = never then never
else Int64.sub b a
let of_s s =
let v = Int64.mul s 1_000_000L in
if Int64.unsigned_div v 1_000_000L <> s then never else v
let to_s t =
if t = never then None else Some (Int64.unsigned_div t 1_000_000L)
let of_absolute a =
if a = never then never else Int64.sub a (Int64.unsigned_rem a 1_000_000L)
let of_ptime v = v |> Absolute.of_ptime |> of_absolute
let bin = Bin.neint64
let bin_nbo = Bin.beint64
let caqti =
let encode v = Ok v in
let decode v = Ok v in
Caqti_type.custom ~encode ~decode Caqti_type.int64
let jsont =
let jsont =
let never_jsont =
let dec s =
match s with
| "never" -> never
| _ -> Jsont.Error.msg Jsont.Meta.none "unexpected string value"
in
let enc _t = "never" in
Jsont.map ~dec ~enc Jsont.string
in
let num_jsont =
Jsont.map
~dec:(fun n -> of_s n)
~enc:(fun t -> match to_s t with None -> assert false | Some s -> s)
Jsont.int64
in
let enc t = if t = never then never_jsont else num_jsont in
Jsont.any ~dec_string:never_jsont ~dec_number:num_jsont ~enc ()
in
Jsont.Object.map ~kind:"Timestamp" Fun.id
|> Jsont.Object.mem "t_s" jsont ~enc:Fun.id
|> Jsont.Object.finish
end