This file is indexed.

/usr/lib/ocaml/res/weak_impl.ml is in libres-ocaml-dev 4.0.3-4build1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
335
(*
   RES - Automatically Resizing Contiguous Memory for OCaml

   Copyright (C) 1999-  Markus Mottl
   email: markus.mottl@gmail.com
   WWW:   http://www.ocaml.info

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.

   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

(* TODO: make safe and improve *)

module Make (S : Strat.T) = struct
  module Strategy = S

  type strategy = Strategy.t

  type 'a t = {
    mutable ar : 'a Weak.t;
    mutable vlix : int;
    mutable strategy : strategy
  }

  let name = "Res.Weak"

  let invalid_arg str = invalid_arg (name ^ "." ^ str)
  let failwith str = failwith (name ^ "." ^ str)

  let length ra = ra.vlix + 1
  let lix ra = ra.vlix

  let real_length ra = Weak.length ra.ar
  let real_lix ra = real_length ra - 1

  let unsafe_get ra ix = Weak.get ra.ar ix
  let unsafe_set ra ix el = Weak.set ra.ar ix el

  let check ra ix = Weak.check ra.ar ix

  let get ra n =
    if n > ra.vlix || n < 0 then invalid_arg "get" else unsafe_get ra n

  let get_copy ra n =
    if n > ra.vlix || n < 0 then invalid_arg "get_copy"
    else Weak.get_copy ra.ar n

  let set ra n =
    if n > ra.vlix || n < 0 then invalid_arg "set" else unsafe_set ra n

  let creator = Weak.create

  let screate_fresh strategy n =
    let res = {ar = creator 0; vlix = n - 1; strategy = strategy} in
    res.ar <- creator (Strategy.grow strategy n);
    res

  let create_fresh n = screate_fresh Strategy.default n

  let create_from ra =
    {ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy}

  let sempty strategy =
    let res = {ar = creator 0; vlix = -1; strategy = strategy} in
    res.ar <- creator (Strategy.grow strategy 0);
    res

  let empty () = sempty Strategy.default

  let smake strategy n x =
    let res = screate_fresh strategy n in
    for i = 0 to n - 1 do unsafe_set res i x done; res

  let make n = smake Strategy.default n

  let create n = make n None
  let screate strategy n = smake strategy n None

  let sinit strategy n f =
    let res = screate_fresh strategy n in
    for i = 0 to n - 1 do unsafe_set res i (f i) done; res

  let init n f = sinit Strategy.default n f

  let get_strategy ra = ra.strategy

  let resizer some_lix ra len =
    let ar = creator len in
    for i = 0 to some_lix do Weak.set ar i (unsafe_get ra i) done;
    ra.ar <- ar

  let enforce_strategy ra =
    let real_len = real_length ra in
    let new_len = length ra in
    let new_real_len = Strategy.shrink ra.strategy ~real_len ~new_len in
    if new_real_len <> -1 then resizer ra.vlix ra new_real_len

  let set_strategy ra strategy = ra.strategy <- strategy; enforce_strategy ra
  let put_strategy ra strategy = ra.strategy <- strategy

  let copy ra =
    let ar = Weak.create (real_length ra) in
    for i = 0 to real_lix ra do Weak.set ar i (unsafe_get ra i) done;
    {ra with ar = ar}

  let unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len =
    let ofs_diff = ofs2 - ofs1 in
    for i = ofs1 to ofs1 + len - 1 do
      unsafe_set ra2 (i + ofs_diff) (unsafe_get ra1 i) done

  let append ra1 ra2 = match ra1.vlix, ra2.vlix with
    | -1, -1 -> empty ()
    | _, -1 -> copy ra1
    | -1, _ -> copy ra2
    | _ ->
        let len1 = length ra1 in
        let len2 = length ra2 in
        let res = create_fresh (len1 + len2) in
        unsafe_blit_on_other ra1 0 res 0 len1;
        unsafe_blit_on_other ra2 0 res len1 len2;
        res

  let rec concat_aux res offset = function
    | [] -> res
    | h::t -> if h.vlix < 0 then concat_aux res offset t
              else let len = length h in
                   unsafe_blit_on_other h 0 res offset len;
                   concat_aux res (offset + len) t

  let concat l =
    let len = List.fold_left (fun a el -> a + length el) 0 l in
    if len = 0 then empty ()
    else concat_aux (create_fresh len) 0 l

  let unsafe_sub ra ofs len =
    let res = create_fresh len in unsafe_blit_on_other ra ofs res 0 len; res

  let sub ra ofs len =
    if ofs < 0 || len < 0 || ofs + len > length ra then invalid_arg "sub"
    else unsafe_sub ra ofs len

  let guarantee_ix ra ix =
    if real_lix ra < ix then
      resizer ra.vlix ra (Strategy.grow ra.strategy (ix + 1))

  let maybe_grow_ix ra new_lix = guarantee_ix ra new_lix; ra.vlix <- new_lix

  let add_one ra x = let n = length ra in maybe_grow_ix ra n; unsafe_set ra n x

  let unsafe_remove_one ra =
    unsafe_set ra ra.vlix None; ra.vlix <- ra.vlix - 1;
    enforce_strategy ra

  let remove_one ra =
    if ra.vlix < 0 then failwith "remove_one" else unsafe_remove_one ra

  let unsafe_remove_n ra n =
    let old_vlix = ra.vlix in
    let old_ar = ra.ar in
    ra.vlix <- old_vlix - n; enforce_strategy ra;
    if old_ar == ra.ar then
      for i = ra.vlix + 1 to old_vlix do unsafe_set ra i None done

  let remove_n ra n =
    if n > length ra || n < 0 then invalid_arg "remove_n"
    else unsafe_remove_n ra n

  let unsafe_remove_range ra ofs len =
    unsafe_blit_on_other ra (ofs + len) ra ofs (length ra - len);
    unsafe_remove_n ra len

  let remove_range ra ofs len =
    if ofs < 0 || len < 0 || ofs + len > length ra then
      invalid_arg "remove_range"
    else unsafe_remove_range ra ofs len

  let clear ra = unsafe_remove_n ra (length ra)

  let unsafe_swap ra n m =
    let tmp = unsafe_get ra n in
    unsafe_set ra n (unsafe_get ra m);
    unsafe_set ra m tmp

  let swap ra n m =
    if n > ra.vlix || m > ra.vlix || n < 0 || m < 0 then invalid_arg "swap"
    else unsafe_swap ra n m

  let unsafe_swap_in_last ra n =
    unsafe_set ra n (unsafe_get ra ra.vlix);
    unsafe_remove_one ra

  let swap_in_last ra n =
    if n > ra.vlix || n < 0 then invalid_arg "swap_in_last"
    else unsafe_swap_in_last ra n

  let unsafe_fill ra ofs len x =
    let last = ofs + len - 1 in
    maybe_grow_ix ra (max last ra.vlix);
    for i = ofs to last do unsafe_set ra i x done

  let fill ra ofs len x =
    if ofs < 0 || len < 0 || ofs > length ra then invalid_arg "fill"
    else unsafe_fill ra ofs len x

  let unsafe_blit ra1 ofs1 ra2 ofs2 len =
    guarantee_ix ra2 (ofs2 + len - 1);
    if ofs1 < ofs2 then
      for i = len - 1 downto 0 do
        unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) done
    else
      for i = 0 to len - 1 do
        unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) done

  let blit ra1 ofs1 ra2 ofs2 len =
    if
      len < 0 || ofs1 < 0 || ofs2 < 0
      || ofs1 + len > length ra1 || ofs2 > length ra2
    then invalid_arg "blit"
    else unsafe_blit ra1 ofs1 ra2 ofs2 len

  let to_std ra =
    let wa = Weak.create (length ra) in
    for i = 0 to ra.vlix do Weak.set wa i (unsafe_get ra i) done; wa

  let sof_std strategy ar = sinit strategy (Weak.length ar) (Weak.get ar)

  let of_std ar = sof_std Strategy.default ar

  let rec to_list_aux ra i accu =
    if i < 0 then accu else to_list_aux ra (i - 1) (unsafe_get ra i :: accu)

  let to_list ra = to_list_aux ra ra.vlix []

  let rec of_list_aux res i = function
    | [] -> res
    | h::t -> unsafe_set res i h; of_list_aux res (i + 1) t

  let of_list l = of_list_aux (create_fresh (List.length l)) 0 l

  let iter f ra = for i = 0 to ra.vlix do f (unsafe_get ra i) done

  let iteri f ra = for i = 0 to ra.vlix do f i (unsafe_get ra i) done

  let fold_left f accu ra =
    let res = ref accu in
    for i = 0 to ra.vlix do res := f !res (unsafe_get ra i) done; !res

  let fold_right f ra accu =
    let res = ref accu in
    for i = ra.vlix downto 0 do res := f (unsafe_get ra i) !res done; !res

  let rec for_all_aux i p ra =
    if i > ra.vlix then true
    else if p (unsafe_get ra i) then for_all_aux (i + 1) p ra else false

  let for_all p ra = for_all_aux 0 p ra

  let rec exists_aux i p ra =
    if i > ra.vlix then false
    else if p (unsafe_get ra i) then true else exists_aux (i + 1) p ra

  let exists p ra = exists_aux 0 p ra

  let rec mem_aux i x ra =
    if i > ra.vlix then false
    else if unsafe_get ra i = x then true else mem_aux (i + 1) x ra

  let mem x ra = mem_aux 0 x ra

  let rec memq_aux i x ra =
    if i > ra.vlix then false
    else if unsafe_get ra i == x then true else memq_aux (i + 1) x ra

  let memq x ra = memq_aux 0 x ra

  let rec pos_aux i x ra =
    if i > ra.vlix then None
    else if unsafe_get ra i = x then Some i else pos_aux (i + 1) x ra

  let pos x ra = pos_aux 0 x ra

  let rec posq_aux i x ra =
    if i > ra.vlix then None
    else if unsafe_get ra i == x then Some i else posq_aux (i + 1) x ra

  let posq x ra = posq_aux 0 x ra

  let rec find_aux i p ra =
    if i > ra.vlix then raise Not_found
    else let el = unsafe_get ra i in if p el then el else find_aux (i + 1) p ra

  let find p ra = find_aux 0 p ra

  let rec find_index_aux p ra i =
    if i > ra.vlix then raise Not_found
    else if p (unsafe_get ra i) then i else find_index_aux p ra (i + 1)

  let find_index p ra i =
    if i < 0 then invalid_arg "find_index" else find_index_aux p ra i

  let filter p ra =
    let res = sempty ra.strategy in
    for i = 0 to ra.vlix do
      let el = unsafe_get ra i in if p el then add_one res el done;
    res

  let find_all = filter

  let filter_in_place p ra =
    let dest = ref 0 in
    let pos = ref 0 in
    while !pos <= ra.vlix do
      let el = unsafe_get ra !pos in
      if p el then begin unsafe_set ra !dest el; incr dest end;
      incr pos done;
    unsafe_remove_n ra (!pos - !dest)

  let partition p ra =
    let res1, res2 as res = sempty ra.strategy, sempty ra.strategy in
    for i = 0 to ra.vlix do
      let el = unsafe_get ra i in
      if p el then add_one res1 el else add_one res2 el done;
    res
end