Source file integer_to_string.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
open! Import


module Constants =
  struct
    let pow10 : string =
      "\000\000\000\000\000\000\000\000\t\000\000\000\000\000\000\000c\000\000\000\000\000\000\000\231\003\000\000\000\000\000\000\015'\000\000\000\000\000\000\159\134\001\000\000\000\000\000?B\015\000\000\000\000\000\127\150\152\000\000\000\000\000\255\224\245\005\000\000\000\000\255\201\154;\000\000\000\000\255\227\011T\002\000\000\000\255\231vH\023\000\000\000\255\015\165\212\232\000\000\000\255\159rN\024\t\000\000\255?z\016\243Z\000\000\255\127\198\164~\141\003\000\255\255\192o\242\134#\000\255\255\137]xEc\001\255\255c\167\179\182\224\r\255\255\255\255\255\255\255\127"
    let digit_pairs =
      "00010203040506070809101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899"
  end
[@@@warning "-incompatible-with-upstream"]
module Char = struct let unsafe_of_int = Stdlib.Char.unsafe_chr end
module String =
  struct
    external unsafe_get :
      ((string)[@local_opt ]) -> ((int)[@local_opt ]) -> char @@ stateless =
        "%string_unsafe_get"
  end
module Bytes =
  struct
    external unsafe_set :
      ((bytes)[@local_opt ]) ->
        ((int)[@local_opt ]) -> ((char)[@local_opt ]) -> unit @@ stateless =
        "%bytes_unsafe_set"
    external unsafe_create_local :
      int -> bytes @ local @@ portable = "Base_unsafe_create_local_bytes"
    [@@noalloc ]
    [%%template
      let unsafe_create x = exclave_ unsafe_create_local x[@@alloc stack]
        [@@zero_alloc ]]
    let unsafe_create = Stdlib.Bytes.create
    external unsafe_to_string :
      no_mutation_while_string_reachable:((bytes)[@local_opt ]) ->
        ((string)[@local_opt ]) @@ stateless = "%bytes_to_string"
  end
module Bool =
  struct external to_int : bool -> int @@ stateless = "%identity" end
module I8 = struct type t : bits8 end
module I16 = struct type t : bits16 end
module I64 =
  struct
    type t = int64
    external (+) :
      t @ local -> t @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_add"
    external (-) :
      t @ local -> t @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_sub"
    external ( * ) :
      t @ local -> t @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_mul"
    external (/) :
      t @ local -> t @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_div"
    external (~-) :
      t @ local -> ((t)[@local_opt ]) @@ stateless = "%int64_neg"
    external \#land :
      t @ local -> t @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_and"
    include Int64_replace_polymorphic_compare
    let clz = Ocaml_intrinsics_kernel.Int64.count_leading_zeros
    external \#lsr :
      t @ local -> int @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_lsr"
    external of_int :
      int -> ((t)[@local_opt ]) @@ stateless = "%int64_of_int"
    external to_int_trunc : t @ local -> int @@ stateless = "%int64_to_int"
    external of_int32 :
      int32 @ local -> ((t)[@local_opt ]) @@ stateless = "%int64_of_int32"
    external of_nativeint :
      nativeint @ local -> ((t)[@local_opt ]) @@ stateless =
        "%int64_of_nativeint"
  end
module I64u =
  struct
    type t = int64#
    external of_int64 :
      ((int64)[@local_opt ]) -> ((t)[@unboxed ]) @@ stateless =
        "%unbox_int64"
    external to_int64 :
      ((t)[@unboxed ]) -> ((int64)[@local_opt ]) @@ stateless = "%box_int64"
    let of_int32 x = of_int64 (I64.of_int32 x)[@@inline ]
    let of_nativeint x = of_int64 (I64.of_nativeint x)[@@inline ]
    let select b t1 t2 =
      of_int64
        (Ocaml_intrinsics_kernel.Conditional.select_int64 b (to_int64 t1)
           (to_int64 t2))[@@inline ]
    let (+) t1 t2 = of_int64 (I64.(+) (to_int64 t1) (to_int64 t2))[@@inline ]
    let (-) t1 t2 = of_int64 (I64.(-) (to_int64 t1) (to_int64 t2))[@@inline ]
    let ( * ) t1 t2 = of_int64 (I64.( * ) (to_int64 t1) (to_int64 t2))
      [@@inline ]
    let (/) t1 t2 = of_int64 (I64.(/) (to_int64 t1) (to_int64 t2))[@@inline ]
    let (~-) t = of_int64 (I64.(~-) (to_int64 t))[@@inline ]
    let clz t = (((I64.clz)[@inlined hint]) (to_int64 t)) |> of_int64
      [@@inline ]
    let \#lsr t x =
      of_int64 (((let open I64 in \#lsr)[@inlined hint]) (to_int64 t) x)
      [@@inline ]
    let \#land t1 t2 = of_int64 (I64.(land) (to_int64 t1) (to_int64 t2))
      [@@inline ]
    let of_int x = of_int64 (I64.of_int x)[@@inline ]
    let to_int_trunc t = I64.to_int_trunc (to_int64 t)[@@inline ]
    let of_bool x = of_int (Bool.to_int x)[@@inline ]
    let (=) t1 t2 = I64.(=) (to_int64 t1) (to_int64 t2)[@@inline ]
    let (>) t1 t2 = I64.(>) (to_int64 t1) (to_int64 t2)[@@inline ]
    let (<) t1 t2 = I64.(<) (to_int64 t1) (to_int64 t2)[@@inline ]
    let (<>) t1 t2 = I64.(<>) (to_int64 t1) (to_int64 t2)[@@inline ]
    external unsafe_get_int64 :
      ((string)[@local_opt ]) -> int64# -> int64# @@ stateless =
        "%caml_string_get64u#_indexed_by_int64#"
    external swap64 : int64 -> int64 @@ stateless = "%bswap_int64"
    let swap64 v = of_int64 (swap64 (to_int64 v))
    let get_pow10 i =
      let v = unsafe_get_int64 Constants.pow10 (i * #8L) in
      if Stdlib.Sys.big_endian then swap64 v else v
    external bytes_unsafe_set_i8 :
      bytes @ local -> ((t)[@unboxed ]) -> ((I8.t)[@unboxed ]) -> unit @@
        stateless = "%set_idx"
    external string_unsafe_get_i16 :
      string @ local -> t -> ((I16.t)[@unboxed ]) @@ stateless = "%get_idx"
    external bytes_unsafe_set_i16 :
      bytes @ local -> ((t)[@unboxed ]) -> ((I16.t)[@unboxed ]) -> unit @@
        stateless = "%set_idx"
    external i8_of_i64 :
      ((t)[@unboxed ]) -> ((I8.t)[@unboxed ]) @@ stateless =
        "%int8#_of_int64#"
    let num_digits_neg (x : t) =
      let v = - x in
      let bits = select (x = #0L) x ((#64L - (clz v)) - #1L) in
      let est = #1L + ((bits * #1233L) lsr 12) in
      let need_extra = of_bool (v > (get_pow10 est)) in est + need_extra
    let num_digits_nonneg x = num_digits_neg (- x)
    let bytes_unsafe_set_i8 buf pos x =
      match Sys.backend_type with
      | Native -> bytes_unsafe_set_i8 buf pos (i8_of_i64 x)
      | Bytecode | Other _ ->
          Bytes.unsafe_set buf (to_int_trunc pos)
            (Char.unsafe_of_int (to_int_trunc x))
    let write_one_digit buf ~pos d =
      let a = d + #48L in bytes_unsafe_set_i8 buf pos a
    let write_2_digits buf ~pos d =
      let digit_idx = d * #2L in
      match Sys.backend_type with
      | Native ->
          let digits = string_unsafe_get_i16 Constants.digit_pairs digit_idx in
          bytes_unsafe_set_i16 buf (pos - #1L) digits
      | Bytecode | Other _ ->
          (Bytes.unsafe_set buf (to_int_trunc (pos - #1L))
             (String.unsafe_get Constants.digit_pairs
                (to_int_trunc digit_idx));
           Bytes.unsafe_set buf (to_int_trunc pos)
             (String.unsafe_get Constants.digit_pairs
                (to_int_trunc (digit_idx + #1L))))
    let write_negative_decimal_without_sign (buf @ local) ~pos ~num_digits n
      =
      let rec loop ~n ~pos ~remaining_digit_pairs =
        match remaining_digit_pairs > #0L with
        | true ->
            let q = n / #100L in
            let r = (q * #100L) - n in
            (write_2_digits buf ~pos r;
             loop ~n:q ~pos:(pos - #2L)
               ~remaining_digit_pairs:(remaining_digit_pairs - #1L))
        | false ->
            if (num_digits land #1L) <> #0L
            then let d = - n in write_one_digit buf ~pos d in
      let remaining_digit_pairs = num_digits / #2L in
      ((loop ~n ~pos ~remaining_digit_pairs)[@nontail ])
    let unsafe_write_nonnegative_decimal (buf @ local) ~pos ~num_digits n =
      let pos = (pos + num_digits) - #1L in
      write_negative_decimal_without_sign buf ~pos ~num_digits (- n)
    [%%template
      let to_string n =
        ((let is_neg = n < #0L in
          let always_negative_n = select is_neg n (- n) in
          let num_digits = num_digits_neg always_negative_n in
          let len = (of_bool is_neg) + num_digits in
          let buf = ((Bytes.unsafe_create)[@alloc a]) (to_int_trunc len) in
          bytes_unsafe_set_i8 buf #0L (select is_neg #45L #48L);
          write_negative_decimal_without_sign buf ~pos:(len - #1L)
            ~num_digits always_negative_n;
          Bytes.unsafe_to_string ~no_mutation_while_string_reachable:buf)
        [@exclave_if_stack a])[@@alloc a = (heap, stack)][@@inline never]]
  end
[%%template
  let int64_u_to_string i = ((((I64u.to_string)[@alloc a]) i)
    [@exclave_if_stack a])[@@alloc a = (heap, stack)][@@inline ]]
[%%template
  let int_to_string i = ((((I64u.to_string)[@alloc a]) (I64u.of_int i))
    [@exclave_if_stack a])[@@alloc a = (heap, stack)][@@inline ]]
[%%template
  let int64_to_string i = ((((I64u.to_string)[@alloc a]) (I64u.of_int64 i))
    [@exclave_if_stack a])[@@alloc a = (heap, stack)][@@inline ]]
[%%template
  let int32_to_string i = ((((I64u.to_string)[@alloc a]) (I64u.of_int32 i))
    [@exclave_if_stack a])[@@alloc a = (heap, stack)][@@inline ]]
[%%template
  let nativeint_to_string i =
    ((((I64u.to_string)[@alloc a]) (I64u.of_nativeint i))
    [@exclave_if_stack a])[@@alloc a = (heap, stack)][@@inline ]]
module Private = struct module Constants = Constants end