Source file `duration_private.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
156
157
158
159
160
161
162
163
164
165
166
167
module P = Stdlib

module O : sig
  type t

  val ( * ) : t -> t -> t

  val ( + ) : t -> t -> t

  val ( - ) : t -> t -> t

  val ( / ) : t -> t -> t

  val abs : t -> t

  val of_int : int -> t

  val of_float : float -> t

  val compare : t -> t -> int

  val lt : t -> t -> bool

  val le : t -> t -> bool

  val gt : t -> t -> bool

  val ge : t -> t -> bool

  val to_string : t -> string

  val zero : t

  val one : t

  val to_float : t -> float

  val to_int : t -> int

  val div : t -> t -> int * t
end = struct
  type t = float

  let ( * ) = ( *. )

  let ( + ) = ( +. )

  let ( - ) = ( -. )

  let ( / ) = ( /. )

  let abs = abs_float

  let of_int = float_of_int

  let of_float x = x

  let compare (a : float) (b : float) = compare a b

  let lt a b = compare a b < 0

  let le a b = compare a b <= 0

  let gt a b = compare a b > 0

  let ge a b = compare a b >= 0

  let to_string x = string_of_int (int_of_float x)

  let zero = 0.0

  let one = 1.0

  let to_float x = x

  let to_int x = int_of_float x

  let div duration diviseur =
    let d = duration / diviseur in
    if lt (abs d) one then (0, duration)
    else (int_of_float d, mod_float duration diviseur)
end

open O

let ms_in_ms = of_int 1

let ms_in_s = of_int 1000

let s_in_s = of_int 1

let s_in_min = of_int 60

let ms_in_min = ms_in_s * s_in_min

let min_in_hour = of_int 60

let ms_in_hour = ms_in_min * min_in_hour

let hour_in_day = of_int 24

let ms_in_day = ms_in_hour * hour_in_day

let day_in_week = of_int 7

let ms_in_week = ms_in_day * day_in_week

let day_in_year = of_float 365.24219879

let month_in_year = of_int 12

let day_in_month = day_in_year / month_in_year

let ms_in_month = ms_in_day * day_in_month

let ms_in_year = ms_in_day * day_in_year

let fact_of_directive = function
  | 'x' -> ms_in_ms
  | 's' -> ms_in_s
  | 'm' -> ms_in_min
  | 'h' -> ms_in_hour
  | 'D' -> ms_in_day
  | 'W' -> ms_in_week
  | 'M' -> ms_in_month
  | 'Y' -> ms_in_year
  | _ -> assert false

let apply_directive dir d =
  let units = fact_of_directive dir in
  let dv = d in
  let fwd = ge dv (of_int 0) in
  let update = if fwd then ( - ) else ( + ) in
  let v' = abs dv / units in
  if lt v' one then (d, zero)
  else
    let new_d = update d (v' * units) in
    (new_d, v')

let static_printer s : O.t -> O.t -> string = fun _ _ -> s

let empty_printer = static_printer ""

let show_value (w : int) (_d : O.t) v =
  let str = to_string v in
  let i = P.( - ) w (String.length str) in
  if i > 0 then String.make i '0' ^ str else str

let check_condition cmp int true' false' =
  let false' = match false' with None -> empty_printer | Some y -> y in
  let cmp =
    match cmp with `EQ -> ( = ) | `NEQ -> ( <> ) | `LT -> ( < ) | `GT -> ( > )
  in
  fun d v -> if cmp (to_int v) int then true' d v else false' d v

let check_condition_simple cmp true' =
  let cmp : int -> bool =
    match cmp with
    | `EQ i -> ( = ) i
    | `LT -> fun i -> i < 0
    | `GT -> fun i -> i > 0
  in
  fun (d : O.t) (v : O.t) -> if cmp (O.to_int d) then true' d v else ""

let directive_block (dir : char) expr (d : O.t) _v =
  let nd, nv = apply_directive dir d in
  expr nd nv