Source file `ml_bindings.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
open Endianness
open Error

open Printf
open Unix

let string_of_unix_time (tm : Nat_big_num.num) =
  let num  = Nat_big_num.to_int64 tm in
  let tm   = Unix.gmtime (Int64.to_float num) in
  let day  = tm.tm_mday in
  let mon  = 1 + tm.tm_mon in
  let year = 1900 + tm.tm_year in
  let hour = tm.tm_hour in
  let min  = tm.tm_min in
  let sec  = tm.tm_sec in
    Printf.sprintf "%i-%i-%iT%02i:%02i:%02i" year mon day hour min sec

let hex_string_of_nat_pad2 i : string =
  Printf.sprintf "%02i" i
;;

let hex_string_of_big_int_pad6 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%06Lx" i0
;;

let hex_string_of_big_int_pad7 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%07Lx" i0
;;

let hex_string_of_big_int_pad2 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%02Lx" i0
;;

let hex_string_of_big_int_pad4 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%04Lx" i0
;;

let hex_string_of_big_int_pad5 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%05Lx" i0
;;

let hex_string_of_big_int_pad8 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%08Lx" i0
;;

let hex_string_of_big_int_pad16 i : string =
  let i0 = Nat_big_num.to_int64 i in
    Printf.sprintf "%016Lx" i0
;;

let hex_string_of_big_int_no_padding i : string =
  let i0 = Nat_big_num.to_int64 i in
    if Int64.compare i0 Int64.zero < 0 then
      let i0 = Int64.neg i0 in
        Printf.sprintf "-%Lx" i0
    else
      Printf.sprintf "%Lx" i0
;;

let bytes_of_int32 (i : Int32.t) = assert false
;;

let bytes_of_int64 (i : Int64.t) = assert false
;;

let int32_of_quad c1 c2 c3 c4 =
  let b1 = Int32.of_int (Char.code c1) in
  let b2 = Int32.shift_left (Int32.of_int (Char.code c2)) 8 in
  let b3 = Int32.shift_left (Int32.of_int (Char.code c3)) 16 in
  let b4 = Int32.shift_left (Int32.of_int (Char.code c4)) 24 in
    Int32.add b1 (Int32.add b2 (Int32.add b3 b4))
;;

let int64_of_oct c1 c2 c3 c4 c5 c6 c7 c8 =
  let b1 = Int64.of_int (Char.code c1) in
  let b2 = Int64.shift_left (Int64.of_int (Char.code c2)) 8 in
  let b3 = Int64.shift_left (Int64.of_int (Char.code c3)) 16 in
  let b4 = Int64.shift_left (Int64.of_int (Char.code c4)) 24 in
  let b5 = Int64.shift_left (Int64.of_int (Char.code c5)) 32 in
  let b6 = Int64.shift_left (Int64.of_int (Char.code c6)) 40 in
  let b7 = Int64.shift_left (Int64.of_int (Char.code c7)) 48 in
  let b8 = Int64.shift_left (Int64.of_int (Char.code c8)) 56 in
    Int64.add b1 (Int64.add b2 (Int64.add b3 (Int64.add b4
        (Int64.add b5 (Int64.add b6 (Int64.add b7 b8))))))
;;

let decimal_string_of_int64 e =
  let i = Int64.to_int e in
    string_of_int i
;;

let hex_string_of_int64 (e : Int64.t) : string =
  let i = Int64.to_int e in
    Printf.sprintf "0x%x" i
;;

let string_suffix index str =
  if (* index < 0 *) Nat_big_num.less index (Nat_big_num.of_int 0) ||
     (* index > length str *) (Nat_big_num.greater index (Nat_big_num.of_int (String.length str))) then
    None
  else
  	let idx = Nat_big_num.to_int index in
  		Some (String.sub str idx (String.length str - idx))
;;

let string_prefix index str =
  if (* index < 0 *) Nat_big_num.less index (Nat_big_num.of_int 0) ||
     (* index > length str *) (Nat_big_num.greater index (Nat_big_num.of_int (String.length str))) then
    None
  else
  	let idx = Nat_big_num.to_int index in
  		Some (String.sub str 0 idx)
;;

let string_index_of (c: char) (s : string) = try Some(Nat_big_num.of_int (String.index s c))
    with Not_found -> None
;;

let find_substring (sub: string) (s : string) =
    try Some(Nat_big_num.of_int (Str.search_forward (Str.regexp_string sub) s 0))
    with Not_found -> None
;;

let rec list_index_big_int index xs =
  match xs with
    | []    -> None
    | x::xs ->
      if Nat_big_num.equal index (Nat_big_num.of_int 0) then
        Some x
      else
        list_index_big_int (Nat_big_num.sub index (Nat_big_num.of_int 1)) xs
;;

let argv_list = Array.to_list Sys.argv
;;

let nat_big_num_of_uint64 x = x
(*
    (* Nat_big_num can only be made from signed integers at present.
     * Workaround: make an int64, and if negative, add the high bit
     * in the big-num domain. *)
    let via_int64 = Uint64.to_int64 x
    in
    if Int64.compare via_int64 Int64.zero >= 0 then Nat_big_num.of_int64 via_int64
    else
        let two_to_63 = Uint64.shift_left (Uint64.of_int 1) 63 in
        let lower_by_2_to_63 = Uint64.sub x two_to_63 in
        (Nat_big_num.add
            (Nat_big_num.of_int64 (Uint64.to_int64 lower_by_2_to_63))
            (Nat_big_num.shift_left (Nat_big_num.of_int 1) 63)
        )
*)

(* TODO: String.split_on_char is not available on old OCaml versions *)
(* let split_string_on_char s c = String.split_on_char c s *)
let split_string_on_char str c =
  if str = "" then []
  else
    let rec loop acc offset =
      try (
        let index = String.rindex_from str offset c in
        if index = offset then
          loop (""::acc) (index - 1)
        else
          let token = String.sub str (index + 1) (offset - index) in
          loop (token::acc) (index - 1)
      ) with Not_found -> (String.sub str 0 (offset + 1))::acc
    in
    loop [] (String.length str - 1)

let string_replace s substr repl =
  (* Why the hell do we need to use the whole regexp machinery for simple string
     replacements? *)
  let r = Str.regexp_string substr in
  Str.global_replace r repl s