Source file `Hex.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
(* https://github.com/mirage/ocaml-hex/blob/85fe242997b61dc2f07ca1b62600b4d01ac0da94/lib/hex.ml
 *
 * Copyright (c) 2015 Trevor Summers Smith <trevorsummerssmith@gmail.com>
 * Copyright (c) 2014 Thomas Gazagnaire <thomas@gazagnaire.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *
 *)

let invalid_arg fmt =
  Printf.ksprintf (fun str -> raise (Invalid_argument str)) fmt

let hexa = "0123456789abcdef"

and hexa1 =
  "0000000000000000111111111111111122222222222222223333333333333333444444444444444455555555555555556666666666666666777777777777777788888888888888889999999999999999aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbccccccccccccccccddddddddddddddddeeeeeeeeeeeeeeeeffffffffffffffff"

and hexa2 =
  "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"

let of_char c =
  let x = Char.code c in
  (hexa.[x lsr 4], hexa.[x land 0xf])

let to_char x y =
  let code c =
    match c with
    | '0' .. '9' -> Char.code c - 48 (* Char.code '0' *)
    | 'A' .. 'F' -> Char.code c - 55 (* Char.code 'A' + 10 *)
    | 'a' .. 'f' -> Char.code c - 87 (* Char.code 'a' + 10 *)
    | _ -> invalid_arg "Hex.to_char: %d is an invalid char" (Char.code c)
  in
  Char.chr ((code x lsl 4) + code y)

let of_string_fast s =
  let len = String.length s in
  let buf = Bytes.create (len * 2) in
  for i = 0 to len - 1 do
    Bytes.unsafe_set buf (i * 2)
      (String.unsafe_get hexa1 (Char.code (String.unsafe_get s i)));
    Bytes.unsafe_set buf
      (succ (i * 2))
      (String.unsafe_get hexa2 (Char.code (String.unsafe_get s i)))
  done;
  `Hex (Bytes.to_string buf)

let of_helper ~ignore (next : int -> char) len =
  let buf = Buffer.create len in
  for i = 0 to len - 1 do
    let c = next i in
    if List.mem c ignore then ()
    else
      let x, y = of_char c in
      Buffer.add_char buf x;
      Buffer.add_char buf y
  done;
  `Hex (Buffer.contents buf)

let of_string ?(ignore = []) s =
  match ignore with
  | [] -> of_string_fast s
  | ignore -> of_helper ~ignore (fun i -> s.[i]) (String.length s)

let of_bytes ?ignore b = of_string ?ignore (Bytes.to_string b)

let to_helper ~empty_return ~create ~set (`Hex s) =
  if s = "" then empty_return
  else
    let n = String.length s in
    let buf = create (n / 2) in
    let rec aux i j =
      if i >= n then ()
      else if j >= n then
        invalid_arg
          "Hex conversion: Hex string cannot have an odd number of characters."
      else (
        set buf (i / 2) (to_char s.[i] s.[j]);
        aux (j + 1) (j + 2))
    in
    aux 0 1;
    buf

let to_bytes hex =
  to_helper ~empty_return:Bytes.empty ~create:Bytes.create ~set:Bytes.set hex

let to_string hex = Bytes.to_string @@ to_bytes hex
let show (`Hex hex) = hex