Source file time_float0.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
open! Import
open Std_internal
open! Int.Replace_polymorphic_compare
module Span = Span_float
module Ofday = Ofday_float

module Absolute = struct
  type underlying = Float.t

  include (
    Float :
      sig
        type t = float [@@deriving bin_io, hash, typerep]

        include Comparable.S_common with type t := t

        include module type of struct
          include Float.O
        end
      end)

  (* due to precision limitations in float we can't expect better than microsecond
     precision *)
  include Float.Robust_compare.Make (struct
    let robust_comparison_tolerance = 1E-6
  end)

  let diff t1 t2 = Span.of_sec (t1 - t2)
  let add t span = t +. Span.to_sec span
  let sub t span = t -. Span.to_sec span
  let prev t = Float.one_ulp `Down t
  let next t = Float.one_ulp `Up t
  let to_span_since_epoch = Span.of_sec
  let of_span_since_epoch = Span.to_sec
end

include Absolute

module Date_and_ofday = struct
  type t = float

  let of_synthetic_span_since_epoch span = Span.to_sec span
  let to_synthetic_span_since_epoch t = Span.of_sec t

  let of_date_ofday date ofday =
    let days =
      Float.of_int (Date0.Days.diff (Date0.Days.of_date date) Date0.Days.unix_epoch)
    in
    (days *. 86400.) +. Span.to_sec (Ofday.to_span_since_start_of_day ofday)
  ;;

  let to_absolute relative ~offset_from_utc = sub relative offset_from_utc
  let of_absolute absolute ~offset_from_utc = add absolute offset_from_utc

  (* Years out of range for [Date.create_exn]. *)
  let[@cold] assert_in_bounds ~sec_since_epoch =
    (* $ TZ=UTC date --date=@-62167219200
       Sat Jan  1 00:00:00 UTC 0000 *)
    let gmtime_lower_bound = -62_167_219_200. in
    (* $ TZ=UTC date --date=@253402300799
       Fri Dec 31 23:59:59 UTC 9999 *)
    let gmtime_upper_bound = 253_402_300_799. in
    if Float.( >= ) sec_since_epoch (gmtime_upper_bound +. 1.)
       || Float.( < ) sec_since_epoch gmtime_lower_bound
    then failwithf "Time.gmtime: out of range (%f)" sec_since_epoch ()
  ;;

  let sec_per_day = Int63.of_int 86_400

  let to_days_from_epoch t =
    assert_in_bounds ~sec_since_epoch:t;
    let open Int63.O in
    let days_from_epoch_approx = Int63.of_float t / sec_per_day in
    (* when [t] is negative the integer division that calculated days_from_epoch_approx
       will leave us one day short because it truncates (e.g. -100 / 86_400 = 0 and we
       want -1) -- adjust for that here. *)
    if Float.( < ) t (Int63.to_float (days_from_epoch_approx * sec_per_day))
    then Int63.pred days_from_epoch_approx
    else days_from_epoch_approx
  ;;

  let ofday_of_days_from_epoch t ~days_from_epoch =
    let open Int63.O in
    let days_from_epoch_in_sec = Int63.to_float (days_from_epoch * sec_per_day) in
    let remainder = t -. days_from_epoch_in_sec in
    Span.of_sec remainder |> Ofday.of_span_since_start_of_day_exn
  ;;

  let date_of_days_from_epoch ~days_from_epoch =
    Int63.to_int_exn days_from_epoch
    |> Date0.Days.add_days Date0.Days.unix_epoch
    |> Date0.Days.to_date
  ;;

  let to_date t =
    let days_from_epoch = to_days_from_epoch t in
    date_of_days_from_epoch ~days_from_epoch
  ;;

  let to_ofday t =
    let days_from_epoch = to_days_from_epoch t in
    ofday_of_days_from_epoch t ~days_from_epoch
  ;;

  let to_date_ofday t =
    let days_from_epoch = to_days_from_epoch t in
    let date = date_of_days_from_epoch ~days_from_epoch in
    let ofday = ofday_of_days_from_epoch t ~days_from_epoch in
    date, ofday
  ;;
end

let next_multiple_internal ~can_equal_after ~base ~after ~interval =
  if Span.( <= ) interval Span.zero
  then
    failwiths
      ~here:[%here]
      "Time.next_multiple got nonpositive interval"
      interval
      [%sexp_of: Span.t];
  let base_to_after = diff after base in
  if Span.( < ) base_to_after Span.zero
  then base (* [after < base], choose [k = 0]. *)
  else (
    let next =
      add
        base
        (Span.scale
           interval
           (Float.round ~dir:`Down (Span.( // ) base_to_after interval)))
    in
    if next > after || (can_equal_after && next = after) then next else add next interval)
;;

let next_multiple ?(can_equal_after = false) ~base ~after ~interval () =
  next_multiple_internal ~can_equal_after ~base ~after ~interval
;;

let prev_multiple ?(can_equal_before = false) ~base ~before ~interval () =
  next_multiple_internal
    ~can_equal_after:(not can_equal_before)
    ~base
    ~after:(sub before interval)
    ~interval
;;

let now () =
  let float_ns = Time_now.nanoseconds_since_unix_epoch () |> Int63.to_float in
  of_span_since_epoch (Span.of_sec (float_ns *. 1E-9))
;;

module Stable = struct
  module Span = Span.Stable
  module Ofday = Ofday.Stable
end