Changeset 1357 for Deliverables/D2.2/8051-indexed-labels-branch/src/utilities/extArray.ml

Timestamp:

Oct 11, 2011, 5:42:20 PM (9 years ago)

Author:

tranquil

Message:

• changed implementation of constant indexings with extensible arrays
• work on ASM completed
• next: optimizations!

File:

• Deliverables/D2.2/8051-indexed-labels-branch/src/utilities/extArray.ml (modified) (3 diffs)

Deliverables/D2.2/8051-indexed-labels-branch/src/utilities/extArray.ml

@@ -1 @@
-type +'a t = {
+type 'a t = {
         mutable t_cont : 'a array;
         mutable t_length : int;
@@ -5 +5 @@
 }
 
-let default_buffer_size = 4
-
-let make n a =
-        let m = min default_buffer_size n in
+let make ?(buff = 16) n a =
+        let m = max 1 (max buff n) in
         {t_cont = Array.make m a; t_length = n; t_def = a}
         
@@ -20 +18 @@
 let length v = v.t_length
 
-let chop v n = v.t_length <- max 0 (v.t_length - n)
+let chop v n =
+        let n = min n v.t_length in
+        Array.fill v.t_cont (v.t_length - n) v.t_length v.t_def;  
+        v.t_length <- v.t_length - n
 
-let assure v n =
+let ensure v n =
         let m = Array.length v.t_cont in
-        (if n >= m then
+        if n >= m then
                 let d = n / m + 1 in
                 let new_arr = Array.make (d * m) v.t_def in
                 Array.blit v.t_cont 0 new_arr 0 m;
-                v.t_cont <- new_arr);
-   v.t_length <- max v.t_length (m + 1)
+                v.t_cont <- new_arr;
+        else ();
+  v.t_length <- max (n + 1) v.t_length
 
         
         
-let extend v n = assure v (v.t_length + n)
+let extend v n = ensure v (v.t_length + n - 1)
 
 let set v n a =
           (if n < 0 then invalid_arg "out of bounds");
-    assure v n;
-                v.t_cont.(n) <- a;
+    ensure v n;
+                v.t_cont.(n) <- a
 
 let append v a = set v (v.t_length) a
-        
+
+let reclaim ?(packet = 16) v =
+  let new_l = v.t_length - (v.t_length - 1) mod packet + packet - 1 in
+        let new_l = max 1 new_l in
+        if new_l <> Array.length v.t_cont then
+                let new_cont = Array.make new_l v.t_def in
+                Array.blit v.t_cont 0 new_cont 0 v.t_length;
+                v.t_cont <- new_cont
+
+exception Finish_iter
+
+let iteri f v = 
+        let f' i a = if i < v.t_length then f i a else raise Finish_iter in
+        try Array.iteri f' v.t_cont with Finish_iter -> ()
+        
+let iter f = iteri (fun _ -> f)
+
+let fold_left f a v =
+        let res = ref a in
+        let f' b = res := f !res b in
+        iter f' v; !res
+
+let fold_right f v a =
+        let funct = ref (fun x -> x) in
+        let f' b = let funct' = !funct in funct := fun x -> funct' (f b x) in
+        iter f' v; !funct a
+
+