source: Deliverables/D2.2/8051-indexed-labels-branch/src/utilities/extArray.ml @ 1357

Last change on this file since 1357 was 1357, checked in by tranquil, 9 years ago
  • changed implementation of constant indexings with extensible arrays
  • work on ASM completed
  • next: optimizations!
File size: 1.6 KB
Line 
1type 'a t = {
2        mutable t_cont : 'a array;
3        mutable t_length : int;
4        t_def : 'a
5}
6
7let 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       
11let default v = v.t_def
12
13let get v n =
14        (if n < 0 || n >= v.t_length then invalid_arg "out of bounds");
15        v.t_cont.(n)
16
17
18let length v = v.t_length
19
20let chop v n =
21        let n = min n v.t_length in
22        Array.fill v.t_cont (v.t_length - n) v.t_length v.t_def; 
23        v.t_length <- v.t_length - n
24
25let ensure v n =
26        let m = Array.length v.t_cont in
27        if n >= m then
28                let d = n / m + 1 in
29                let new_arr = Array.make (d * m) v.t_def in
30                Array.blit v.t_cont 0 new_arr 0 m;
31                v.t_cont <- new_arr;
32        else ();
33  v.t_length <- max (n + 1) v.t_length
34
35       
36       
37let extend v n = ensure v (v.t_length + n - 1)
38
39let set v n a =
40          (if n < 0 then invalid_arg "out of bounds");
41    ensure v n;
42                v.t_cont.(n) <- a
43
44let append v a = set v (v.t_length) a
45
46let reclaim ?(packet = 16) v =
47  let new_l = v.t_length - (v.t_length - 1) mod packet + packet - 1 in
48        let new_l = max 1 new_l in
49        if new_l <> Array.length v.t_cont then
50                let new_cont = Array.make new_l v.t_def in
51                Array.blit v.t_cont 0 new_cont 0 v.t_length;
52                v.t_cont <- new_cont
53
54exception Finish_iter
55
56let iteri f v = 
57        let f' i a = if i < v.t_length then f i a else raise Finish_iter in
58        try Array.iteri f' v.t_cont with Finish_iter -> ()
59       
60let iter f = iteri (fun _ -> f)
61
62let fold_left f a v =
63        let res = ref a in
64        let f' b = res := f !res b in
65        iter f' v; !res
66
67let fold_right f v a =
68        let funct = ref (fun x -> x) in
69        let f' b = let funct' = !funct in funct := fun x -> funct' (f b x) in
70        iter f' v; !funct a
71
72       
73       
74
Note: See TracBrowser for help on using the repository browser.