source: Deliverables/D2.2/8051/src/utilities/extArray.ml @ 1569

type 'a t = {
        mutable t_cont : 'a array;
        mutable t_length : int;
        t_def : 'a
}

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}
        
let default v = v.t_def

let get v n =
        (if n < 0 || n >= v.t_length then invalid_arg "out of bounds");
        v.t_cont.(n)

let length v = v.t_length

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 ensure v n =
        let m = Array.length v.t_cont in
        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;
        else ();
  v.t_length <- max (n + 1) v.t_length

        
        
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");
    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