package core_kernel

  1. Overview
  2. Docs
package core_kernel
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file byte_units.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
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
(* Conversions between units of measure based on bytes. *)

open! Import
open Std_internal
module Repr = Int63

module T : sig
  type t [@@deriving compare, hash, sexp_of]

  val to_string : t -> string
  val of_repr : Repr.t -> t
  val to_repr : t -> Repr.t
end = struct
  type t = Repr.t [@@deriving compare, hash]

  let of_repr = Fn.id
  let to_repr = Fn.id

  let to_string n =
    let open Repr in
    let kib = of_int 1024 in
    let mib = kib * kib in
    let gib = kib * mib in
    let n_abs = abs n in
    if n_abs < kib
    then sprintf "%dB" (to_int_exn n)
    else if n_abs < mib
    then sprintf "%gK" (to_float n /. to_float kib)
    else if n_abs < gib
    then sprintf "%gM" (to_float n /. to_float mib)
    else sprintf "%gG" (to_float n /. to_float gib)
  ;;

  let sexp_of_t n = Sexp.Atom (to_string n)
end

include T
include Comparable.Make_plain (T)
include Hashable.Make_plain (T)

module Infix = struct
  let ( - ) a b = of_repr (Repr.( - ) (to_repr a) (to_repr b))
  let ( + ) a b = of_repr (Repr.( + ) (to_repr a) (to_repr b))
  let ( // ) a b = Repr.( // ) (to_repr a) (to_repr b)

  let ( / ) t s = of_repr (Repr.of_float (Repr.to_float (to_repr t) /. s))
  let ( * ) t s = of_repr (Repr.of_float (Repr.to_float (to_repr t) *. s))
end

let zero = of_repr Repr.zero
let scale = Infix.( * )
let iscale t s = of_repr (Repr.( * ) (to_repr t) (Repr.of_int s))
let bytes_int_exn t = Repr.to_int_exn (to_repr t)
let bytes_int63 = to_repr
let bytes_int64 t = Repr.to_int64 (to_repr t)
let bytes_float t = Repr.to_float (to_repr t)
let of_bytes_int b = of_repr (Repr.of_int b)
let of_bytes_int63 = of_repr
let of_bytes_int64_exn b = of_repr (Repr.of_int64_exn b)
let of_bytes_float_exn b = of_repr (Repr.of_float b)

let[@deprecated
  "[since 2019-01] Use [bytes_int_exn], [bytes_int63], [bytes_int64] or \
   [bytes_float] as appropriate."] bytes
  =
  bytes_float
;;

let[@deprecated
  "[since 2019-01] Use [of_bytes_int], [of_bytes_int63], [of_bytes_int64_exn] or \
   [of_bytes_float_exn] as appropriate."] of_bytes
  =
  of_bytes_float_exn
;;

let kilobyte : t = of_bytes_int 1024
let megabyte = iscale kilobyte 1024
let gigabyte = iscale megabyte 1024
let terabyte = iscale gigabyte 1024
let petabyte = iscale terabyte 1024
let exabyte = iscale petabyte 1024

let word =
  let module W = Word_size in
  match W.word_size with
  | W.W32 -> of_bytes_int 4
  | W.W64 -> of_bytes_int 8
;;

let kilobytes t : float = Infix.( // ) t kilobyte
let megabytes t = Infix.( // ) t megabyte
let gigabytes t = Infix.( // ) t gigabyte
let terabytes t = Infix.( // ) t terabyte
let petabytes t = Infix.( // ) t petabyte
let exabytes t = Infix.( // ) t exabyte
let words_int_exn t = Repr.to_int_exn (Repr.( / ) (to_repr t) (to_repr word))
let words_float t = Infix.( // ) t word
let of_kilobytes t : t = Infix.( * ) kilobyte t
let of_megabytes t = Infix.( * ) megabyte t
let of_gigabytes t = Infix.( * ) gigabyte t
let of_terabytes t = Infix.( * ) terabyte t
let of_petabytes t = Infix.( * ) petabyte t
let of_exabytes t = Infix.( * ) exabyte t
let of_words_int t = iscale word t
let of_words_float_exn t = Infix.( * ) word t

let[@deprecated "[since 2019-01] Use [words_int_exn] or [words_float]"] words =
  words_float
;;

let[@deprecated "[since 2019-01] Use [of_words_int] or [of_words_float_exn]"] of_words =
  of_words_float_exn
;;

let of_string s =
  let length = String.length s in
  if Int.( < ) length 2
  then invalid_argf "'%s' passed to Byte_units.of_string - too short" s ();
  let base_str = String.sub s ~pos:0 ~len:(length - 1) in
  let ext_char = Char.lowercase s.[length - 1] in
  let base =
    try Float.of_string base_str with
    | _ ->
      invalid_argf
        "'%s' passed to Byte_units.of_string - %s cannot be converted to float "
        s
        base_str
        ()
  in
  match ext_char with
  | 'b' -> of_bytes_float_exn base
  | 'k' -> of_kilobytes base
  | 'm' -> of_megabytes base
  | 'g' -> of_gigabytes base
  | 't' -> of_terabytes base
  | 'p' -> of_petabytes base
  | 'e' -> of_exabytes base
  | 'w' -> of_words base
  | ext ->
    invalid_argf "'%s' passed to Byte_units.of_string - illegal extension %c" s ext ()
;;

let largest_measure t =
  let t_abs = of_repr (Repr.abs (to_repr t)) in
  if t_abs >= exabyte
  then `Exabytes
  else if t_abs >= petabyte
  then `Petabytes
  else if t_abs >= terabyte
  then `Terabytes
  else if t_abs >= gigabyte
  then `Gigabytes
  else if t_abs >= megabyte
  then `Megabytes
  else if t_abs >= kilobyte
  then `Kilobytes
  else `Bytes
;;

module Stable = struct
  (* Share the common [of_sexp] code for [V1] and [V2]. *)
  module Of_sexp_v1_v2 : sig
    val t_of_sexp : Sexp.t -> t
  end = struct
    let no_match () = failwith "Not a recognized [Byte_units.t] representation"

    let of_value_sexp_and_unit_name val_sexp = function
      | "Bytes" ->
        (try of_bytes_int63 (Int63.t_of_sexp val_sexp) with
         | _ -> of_bytes_float_exn (Float.t_of_sexp val_sexp))
      | "Kilobytes" -> of_kilobytes (float_of_sexp val_sexp)
      | "Megabytes" -> of_megabytes (float_of_sexp val_sexp)
      | "Gigabytes" -> of_gigabytes (float_of_sexp val_sexp)
      | "Terabytes" -> of_terabytes (float_of_sexp val_sexp)
      | "Petabytes" -> of_petabytes (float_of_sexp val_sexp)
      | "Exabytes" -> of_exabytes (float_of_sexp val_sexp)
      | "Words" -> of_words_float_exn (float_of_sexp val_sexp)
      | _ -> no_match ()
    ;;

    let t_of_sexp = function
      | Sexp.Atom str -> of_string str
      | Sexp.List [ Sexp.Atom unit_name; value ] ->
        of_value_sexp_and_unit_name value unit_name
      | _ -> no_match ()
    ;;

    let t_of_sexp sexp =
      try t_of_sexp sexp with
      | exn -> raise (Sexp.Of_sexp_error (exn, sexp))
    ;;
  end

  module V1 = struct
    type nonrec t = t [@@deriving compare, hash]

    include Binable0.Of_binable
        (Float)
        (struct
          type nonrec t = t

          let to_binable = bytes_float
          let of_binable = of_bytes_float_exn
        end)

    include Of_sexp_v1_v2

    let sexp_of_t t =
      (* V1 only goes up to gigabytes *)
      match largest_measure t with
      | `Bytes -> [%sexp `Bytes (bytes_float t : float)]
      | `Kilobytes -> [%sexp `Kilobytes (kilobytes t : float)]
      | `Megabytes -> [%sexp `Megabytes (megabytes t : float)]
      | `Gigabytes | `Terabytes | `Petabytes | `Exabytes ->
        [%sexp `Gigabytes (gigabytes t : float)]
    ;;

    let to_string t = String.lowercase (to_string t)
    let of_string = of_string

    (* This test documents the original to-string representation and fails under javascript
       due to differences in the rounding. *)
    let%expect_test (_[@tags "no-js"]) =
      printf !"%{}" (of_bytes_int 1000);
      [%expect {| 1000b |}];
      printf !"%{}" (of_bytes_int 1023);
      [%expect {| 1023b |}];
      printf !"%{}" (of_bytes_int 1024);
      [%expect {| 1k |}];
      printf !"%{}" (of_bytes_int 1025);
      [%expect {| 1.00098k |}];
      printf !"%{}" (of_bytes_int 1500);
      [%expect {| 1.46484k |}];
      printf !"%{}" (of_bytes_int 10000);
      [%expect {| 9.76562k |}];
      printf !"%{}" (of_bytes_int 100000);
      [%expect {| 97.6562k |}];
      printf !"%{}" (of_bytes_int 1000000);
      [%expect {| 976.562k |}];
      printf !"%{}" (of_bytes_int 10000000);
      [%expect {| 9.53674m |}]
    ;;

    let t_of_sexp sexp =
      match sexp with
      | Sexp.Atom s ->
        (try of_string s with
         | Invalid_argument msg -> of_sexp_error msg sexp)
      | Sexp.List _ -> t_of_sexp sexp
    ;;
  end

  module V2 = struct
    type nonrec t = t [@@deriving compare, hash]

    include Binable0.Of_binable
        (Int63)
        (struct
          type nonrec t = t

          let to_binable = bytes_int63
          let of_binable = of_bytes_int63
        end)

    include Of_sexp_v1_v2

    let sexp_of_t t = [%sexp `Bytes (bytes_int63 t : Int63.t)]
  end
end

let to_string_hum = T.to_string

let to_string_short t =
  let to_units_str to_unit ext =
    let f = to_unit t in
    let f_abs = Float.abs f in
    if Float.Robustly_comparable.( >=. ) f_abs 100.
    then sprintf "%.0f%c" f ext
    else if Float.Robustly_comparable.( >=. ) f_abs 10.
    then sprintf "%.1f%c" f ext
    else sprintf "%.2f%c" f ext
  in
  match largest_measure t with
  | `Bytes -> sprintf "%dB" (bytes_int_exn t)
  | `Kilobytes -> to_units_str kilobytes 'K'
  | `Megabytes -> to_units_str megabytes 'M'
  | `Gigabytes -> to_units_str gigabytes 'G'
  | `Terabytes -> to_units_str terabytes 'T'
  | `Petabytes -> to_units_str petabytes 'P'
  | `Exabytes -> to_units_str exabytes 'E'
;;

let%expect_test _ =
  printf !"%{#short}" (of_bytes_int 1000);
  [%expect {| 1000B |}];
  printf !"%{#short}" (of_bytes_int 1023);
  [%expect {| 1023B |}];
  printf !"%{#short}" (of_bytes_int 1024);
  [%expect {| 1.00K |}];
  printf !"%{#short}" (of_bytes_int 1025);
  [%expect {| 1.00K |}];
  printf !"%{#short}" (of_bytes_int 10000);
  [%expect {| 9.77K |}];
  printf !"%{#short}" (of_bytes_int 100000);
  [%expect {| 97.7K |}];
  printf !"%{#short}" (of_bytes_int 1000000);
  [%expect {| 977K |}];
  printf !"%{#short}" (of_bytes_int 10000000);
  [%expect {| 9.54M |}];
  printf !"%{#short}" (of_bytes 10000000000.);
  [%expect {| 9.31G |}];
  printf !"%{#short}" (of_bytes 1000000000000.);
  [%expect {| 931G |}];
  printf !"%{#short}" (of_bytes 100000000000000.);
  [%expect {| 90.9T |}];
  printf !"%{#short}" (of_bytes 100000000000000000.);
  [%expect {| 88.8P |}];
  printf !"%{#short}" (of_bytes 3000000000000000000.);
  [%expect {| 2.60E |}];
  ()
;;

let[@deprecated
  "[since 2019-01] Use [of_bytes], [of_kilobytes], [of_megabytes], etc as appropriate."] create
                                                                                           units
                                                                                           value
  =
  match units with
  | `Bytes -> of_bytes_float_exn value
  | `Kilobytes -> of_kilobytes value
  | `Megabytes -> of_megabytes value
  | `Gigabytes -> of_gigabytes value
  | `Words -> of_words_float_exn value
;;
OCaml

Innovation. Community. Security.

GitHub Discord Twitter Peertube RSS
About
Changelog Releases Industrial Users Academic Users Why OCaml
Ecosystem
Packages Community Events OCaml Planet Jobs
Resources
Install OCaml Get Started Platform Tools Language Manual Standard Library API Books Exercises Papers OCaml Playground Logo
Policies
Carbon Footprint Governance Privacy Code of Conduct