1 | type 'a t = { |
---|
2 | mutable t_cont : 'a array; |
---|
3 | mutable t_length : int; |
---|
4 | t_def : 'a |
---|
5 | } |
---|
6 | |
---|
7 | let make ?(buff = 16) n a = |
---|
8 | let m = max 1 (max buff n) in |
---|
9 | {t_cont = Array.make m a; t_length = n; t_def = a} |
---|
10 | |
---|
11 | let default v = v.t_def |
---|
12 | |
---|
13 | let get v n = |
---|
14 | (if n < 0 || n >= v.t_length then invalid_arg "out of bounds"); |
---|
15 | v.t_cont.(n) |
---|
16 | |
---|
17 | let length v = v.t_length |
---|
18 | |
---|
19 | let chop v n = |
---|
20 | let n = min n v.t_length in |
---|
21 | Array.fill v.t_cont (v.t_length - n) v.t_length v.t_def; |
---|
22 | v.t_length <- v.t_length - n |
---|
23 | |
---|
24 | let ensure v n = |
---|
25 | let m = Array.length v.t_cont in |
---|
26 | if n >= m then |
---|
27 | let d = n / m + 1 in |
---|
28 | let new_arr = Array.make (d * m) v.t_def in |
---|
29 | Array.blit v.t_cont 0 new_arr 0 m; |
---|
30 | v.t_cont <- new_arr; |
---|
31 | else (); |
---|
32 | v.t_length <- max (n + 1) v.t_length |
---|
33 | |
---|
34 | |
---|
35 | |
---|
36 | let extend v n = ensure v (v.t_length + n - 1) |
---|
37 | |
---|
38 | let set v n a = |
---|
39 | (if n < 0 then invalid_arg "out of bounds"); |
---|
40 | ensure v n; |
---|
41 | v.t_cont.(n) <- a |
---|
42 | |
---|
43 | let append v a = set v (v.t_length) a |
---|
44 | |
---|
45 | let reclaim ?(packet = 16) v = |
---|
46 | let new_l = v.t_length - (v.t_length - 1) mod packet + packet - 1 in |
---|
47 | let new_l = max 1 new_l in |
---|
48 | if new_l <> Array.length v.t_cont then |
---|
49 | let new_cont = Array.make new_l v.t_def in |
---|
50 | Array.blit v.t_cont 0 new_cont 0 v.t_length; |
---|
51 | v.t_cont <- new_cont |
---|
52 | |
---|
53 | exception Finish_iter |
---|
54 | |
---|
55 | let iteri f v = |
---|
56 | let f' i a = if i < v.t_length then f i a else raise Finish_iter in |
---|
57 | try Array.iteri f' v.t_cont with Finish_iter -> () |
---|
58 | |
---|
59 | let iter f = iteri (fun _ -> f) |
---|
60 | |
---|
61 | let fold_left f a v = |
---|
62 | let res = ref a in |
---|
63 | let f' b = res := f !res b in |
---|
64 | iter f' v; !res |
---|
65 | |
---|
66 | let fold_right f v a = |
---|
67 | let funct = ref (fun x -> x) in |
---|
68 | let f' b = let funct' = !funct in funct := fun x -> funct' (f b x) in |
---|
69 | iter f' v; !funct a |
---|
70 | |
---|
71 | |
---|
72 | |
---|
73 | |
---|