Markus Mottl avatar Markus Mottl committed e4dc9d5

Robustified implementation by avoiding internal use of Obj.magic

Comments (0)

Files changed (8)

+2009-06-01: Robustified implementation to avoid internal use of Obg.magic.
+
 2008-09-16: Changed strategy API to greatly improve performance of
             growing/shrinking.
 
 2002-05-04: Revised the whole installation procedure. See INSTALL for
             details.
 
-2002-04-30: Updated OcamlMakefile: it does not ask for confirmation
+2002-04-30: Updated OCamlMakefile: it does not ask for confirmation
             during installation anymore!
 
 2001-06-30: Removed "Printexc.catch" from stupid_ga-example: is going
             shorter. This change requires an OCaml-version higher
             than 3.00.
 
-2001-01-24: Updated OcamlMakefile
+2001-01-24: Updated OCamlMakefile
 
-2000-06-24: Updated OcamlMakefile
+2000-06-24: Updated OCamlMakefile
 
-2000-06-13: Updated OcamlMakefile
+2000-06-13: Updated OCamlMakefile
 
-2000-06-11: Updated OcamlMakefile
+2000-06-11: Updated OCamlMakefile
 
-2000-06-08: Added installation routine + updated OcamlMakefile again:
+2000-06-08: Added installation routine + updated OCamlMakefile again:
 
             This upgrade makes installation much easier! Read the
             updated INSTALL-file!
 
-2000-06-07: Upgraded to new OcamlMakefile.
+2000-06-07: Upgraded to new OCamlMakefile.
 
 2000-04-28: Fixed *critical* bug:
 
 name="res"
-version="3.0.0"
+version="3.1.0"
 description="RES - resizable contiguous memory"
 requires=""
 archive(byte)="res.cma"

lib/nopres_impl.ml

 (*
    RES - Automatically Resizing Contiguous Memory for OCaml
 
-   Copyright (C) 1999-2002  Markus Mottl
+   Copyright (C) 1999-  Markus Mottl
    email: markus.mottl@gmail.com
    WWW:   http://www.ocaml.info
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
-(* $Id: nopres_impl.ml,v 1.14 2005/11/07 20:25:28 mottl Exp $ *)
-
 module type Implementation = sig
   type el
   type t
 
   type el = Impl.el
 
-  type t = {mutable ar : Impl.t;
-            mutable vlix : int;
-            mutable strategy : strategy}
+  type t = {
+    mutable ar : Impl.t;
+    mutable vlix : int;
+    mutable strategy : strategy
+  }
 
   let name = Impl.name
 
   let invalid_arg str = invalid_arg (name ^ "." ^ str)
   let failwith str = failwith (name ^ "." ^ str)
 
-  let length ra = succ ra.vlix
+  let length ra = ra.vlix + 1
   let lix ra = ra.vlix
 
   let real_length ra = Impl.length ra.ar
-  let real_lix ra = pred (real_length ra)
+  let real_lix ra = real_length ra - 1
 
   let unsafe_get ra ix = Impl.unsafe_get ra.ar ix
   let unsafe_set ra ix el = Impl.unsafe_set ra.ar ix el
 
   let get ra n =
-    if n > ra.vlix or n < 0 then invalid_arg "get" else unsafe_get ra n
+    if n > ra.vlix || n < 0 then invalid_arg "get"
+    else unsafe_get ra n
 
   let set ra n el =
-    if n > ra.vlix or n < 0 then invalid_arg "set" else unsafe_set ra n el
+    if n > ra.vlix || n < 0 then invalid_arg "set"
+    else unsafe_set ra n el
 
   let creator = Impl.create
-
-  let dummy_loc = 0
-  let no_obj () = Obj.magic dummy_loc
+  let empty_ar = Impl.create 0
 
   let screate strategy n =
-    let res = {ar = no_obj (); vlix = pred n; strategy = strategy} in
+    let res = { ar = empty_ar; vlix = n - 1; strategy = strategy } in
     res.ar <- creator (Strategy.grow strategy n);
     res
 
   let smake strategy n x =
-    let res = {ar = no_obj (); vlix = pred n; strategy = strategy} in
+    let res = { ar = empty_ar; vlix = n - 1; strategy = strategy } in
     res.ar <- Impl.make (Strategy.grow strategy n) x;
     res
 
   let create_fresh n = screate Strategy.default n
 
   let create_from ra =
-    {ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy}
+    { ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy }
 
   let sempty strategy =
-    let res = {ar = no_obj (); vlix = -1; strategy = strategy} in
+    let res = { ar = empty_ar; vlix = -1; strategy = strategy } in
     res.ar <- creator (Strategy.grow strategy 0);
     res
 
   let empty () = sempty Strategy.default
-
   let create = screate Strategy.default
   let make = smake Strategy.default
 
   let sinit strategy n f =
     let res = smake strategy n (f 0) in
-    for i = 1 to pred n do unsafe_set res i (f i) done; res
+    let ar = res.ar in
+    for i = 1 to n - 1 do Impl.unsafe_set ar 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 Impl.unsafe_set ar i (unsafe_get ra i) done;
-    ra.ar <- ar
+  let resizer some_lix ({ ar = ar} as ra) len =
+    let new_ar = creator len in
+    for i = 0 to some_lix do
+      Impl.unsafe_set new_ar i (Impl.unsafe_get ar i)
+    done;
+    ra.ar <- new_ar
 
   let enforce_strategy ra =
-    let real_len = real_length ra and new_len = length ra in
+    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 unsafe_blit_on_other ra1 ofs1 ra2 = Impl.unsafe_blit ra1.ar ofs1 ra2.ar
 
   let copy ra =
-    let len = length ra in let ar = Impl.create len in
-    Impl.unsafe_blit ra.ar 0 ar 0 len; {ra with ar = ar}
+    let len = length ra in
+    let ar = Impl.create len in
+    Impl.unsafe_blit ra.ar 0 ar 0 len;
+    { ra with ar = ar }
 
   let append ra1 ra2 = match ra1.vlix, ra2.vlix with
     | -1, -1 -> empty ()
     | _, -1 -> copy ra1
     | -1, _ -> copy ra2
-    | _ -> let len1 = length ra1
-           and 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 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
+    | 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
     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 res = create_fresh len in
+    unsafe_blit_on_other ra ofs res 0 len;
+    res
 
   let sub ra ofs len =
-    if ofs < 0 or len < 0 or ofs + len > length ra then invalid_arg "sub"
+    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 (succ ix))
+      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 add_one ra x =
+    let n = length ra in
+    maybe_grow_ix ra n;
+    unsafe_set ra n x
 
-  let unsafe_remove_one ra = ra.vlix <- pred ra.vlix; enforce_strategy ra
+  let unsafe_remove_one ra = 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
+    if ra.vlix < 0 then failwith "remove_one"
+    else unsafe_remove_one ra
 
   let unsafe_remove_n ra n = ra.vlix <- ra.vlix - n; enforce_strategy ra
 
     unsafe_remove_n ra len
 
   let remove_range ra ofs len =
-    if ofs < 0 or len < 0 or ofs + len > length ra then
+    if ofs < 0 || len < 0 || ofs + len > length ra then
       invalid_arg "remove_range"
     else unsafe_remove_range ra ofs len
 
   let clear ra = ra.vlix <- -1; enforce_strategy 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 unsafe_swap { ar = ar } n m =
+    let tmp = Impl.unsafe_get ar n in
+    Impl.unsafe_set ar n (Impl.unsafe_get ar m);
+    Impl.unsafe_set ar m tmp
 
   let swap ra n m =
-    if n > ra.vlix or m > ra.vlix or n < 0 or m < 0 then invalid_arg "swap"
+    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);
+  let unsafe_swap_in_last ({ ar = ar } as ra) n =
+    Impl.unsafe_set ar n (Impl.unsafe_get ar ra.vlix);
     unsafe_remove_one ra
 
   let swap_in_last ra n =
-    if n > ra.vlix or n < 0 then invalid_arg "swap_in_last"
+    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 + pred len in
+  let unsafe_fill ({ ar = ar } as ra) ofs len x =
+    let last = ofs + len - 1 in
     guarantee_ix ra (max last ra.vlix);
-    for i = ofs to last do unsafe_set ra i x done
+    for i = ofs to last do Impl.unsafe_set ar i x done
 
   let fill ra ofs len x =
-    if ofs < 0 or len < 0 or ofs > length ra then invalid_arg "fill"
+    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 + pred len);
+    guarantee_ix ra2 (ofs2 + len - 1);
     unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len
 
   let blit ra1 ofs1 ra2 ofs2 len =
-    if len < 0 or ofs1 < 0 or ofs2 < 0 or ofs1 + len > length ra1 or
-       ofs2 > length ra2 then invalid_arg "blit"
+    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 rec to_list_aux ra i accu =
-    if i < 0 then accu else to_list_aux ra (pred i) (unsafe_get ra i :: accu)
+  let rec to_list_aux ar i accu =
+    if i < 0 then accu
+    else to_list_aux ar (i - 1) (Impl.unsafe_get ar i :: accu)
 
-  let to_list ra = to_list_aux ra ra.vlix []
+  let to_list ra = to_list_aux ra.ar ra.vlix []
 
-  let rec of_list_aux res i = function
-    | [] -> res
-    | h::t -> unsafe_set res i h; of_list_aux res (succ i) t
+  let rec of_list_aux ar i = function
+    | [] -> ()
+    | h::t -> Impl.unsafe_set ar i h; of_list_aux ar (i + 1) t
 
-  let of_list l = of_list_aux (create_fresh (List.length l)) 0 l
+  let of_list l =
+    let ra = create_fresh (List.length l) in
+    of_list_aux ra.ar 0 l;
+    ra
 
-  let sof_list strategy l = of_list_aux (screate strategy (List.length l)) 0 l
+  let sof_list strategy l =
+    let ra = screate strategy (List.length l) in
+    of_list_aux ra.ar 0 l;
+    ra
 
-  let to_array ra = Array.init (length ra) (fun i -> unsafe_get ra i)
+  let to_array ({ ar = ar } as ra) =
+    Array.init (length ra) (fun i -> Impl.unsafe_get ar i)
 
   let sof_array strategy ar =
     sinit strategy (Array.length ar) (fun i -> Array.unsafe_get ar i)
 
   let of_array ar = sof_array Strategy.default ar
 
-  let iter f ra = for i = 0 to ra.vlix do f (unsafe_get ra i) done
+  let iter f ({ ar = ar } as ra) =
+    for i = 0 to ra.vlix do f (Impl.unsafe_get ar i) done
 
-  let map f ra =
+  let map f ({ ar = ar } as ra) =
     let res = create_from ra in
-    for i = 0 to res.vlix do unsafe_set res i (f (unsafe_get ra i)) done; res
+    let res_ar = res.ar in
+    for i = 0 to res.vlix do
+      Impl.unsafe_set res_ar i (f (Impl.unsafe_get ar i))
+    done;
+    res
 
-  let iteri f ra = for i = 0 to ra.vlix do f i (unsafe_get ra i) done
+  let iteri f ({ ar = ar } as ra) =
+    for i = 0 to ra.vlix do f i (Impl.unsafe_get ar i) done
 
-  let mapi f ra =
-    let res = create_from ra in
-    for i = 0 to res.vlix do unsafe_set res i (f i (unsafe_get ra i)) done; res
+  let mapi f ({ ar = ar } as ra) =
+    let { ar = res_ar } as res = create_from ra in
+    for i = 0 to res.vlix do
+      Impl.unsafe_set res_ar i (f i (Impl.unsafe_get ar i))
+    done;
+    res
 
-  let fold_left f accu ra =
+  let fold_left f accu ({ ar = ar } as ra) =
     let res = ref accu in
-    for i = 0 to ra.vlix do res := f !res (unsafe_get ra i) done; !res
+    for i = 0 to ra.vlix do
+      res := f !res (Impl.unsafe_get ar i)
+    done;
+    !res
 
-  let fold_right f ra accu =
+  let fold_right f ({ ar = ar } as ra) accu =
     let res = ref accu in
-    for i = ra.vlix downto 0 do res := f (unsafe_get ra i) !res done; !res
+    for i = ra.vlix downto 0 do
+      res := f (Impl.unsafe_get ar 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 (succ i) p ra else false
+    i > ra.vlix || p (unsafe_get ra i) && for_all_aux (i + 1) p ra
 
   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 (succ i) p ra
+    i <= ra.vlix && (p (unsafe_get ra i) || 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 (succ i) x ra
+    i <= ra.vlix && (unsafe_get ra i = x || 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 (succ i) x ra
+    i <= ra.vlix && (unsafe_get ra i == x || 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 (succ i) x ra
+    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 (succ i) x ra
+    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 (succ i) p ra
+    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 (succ i)
+    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
+    if i < 0 then invalid_arg "find_index"
+    else find_index_aux p ra i
 
-  let filter p ra =
+  let filter p ({ ar = ar } as 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;
+      let el = Impl.unsafe_get ar 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
-    and pos = ref 0 in
+  let filter_in_place p ({ ar = ar } as 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;
+      let el = Impl.unsafe_get ar !pos in
+      if p el then begin
+        Impl.unsafe_set ar !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;
+      if p el then add_one res1 el
+      else add_one res2 el
+    done;
     res
 end
 (*
    RES - Automatically Resizing Contiguous Memory for OCaml
 
-   Copyright (C) 1999-2002  Markus Mottl
+   Copyright (C) 1999-  Markus Mottl
    email: markus.mottl@gmail.com
    WWW:   http://www.ocaml.info
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
-(* $Id: pres_impl.ml,v 1.16 2005/11/07 20:25:28 mottl Exp $ *)
-
 module type Implementation = sig
   type 'a t
   val name : string
 
   type strategy = Strategy.t
 
-  type 'a t = {mutable ar : 'a Impl.t;
-               mutable vlix : int;
-               mutable strategy : strategy}
+  type 'a t = {
+    mutable ar : 'a option Impl.t;
+    mutable vlix : int;
+    mutable strategy : strategy
+  }
 
   let name = Impl.name
 
   let invalid_arg str = invalid_arg (name ^ "." ^ str)
   let failwith str = failwith (name ^ "." ^ str)
 
-  let length ra = succ ra.vlix
-  let lix ra = ra.vlix 
+  let length ra = ra.vlix + 1
+  let lix ra = ra.vlix
 
   let real_length ra = Impl.length ra.ar
-  let real_lix ra = pred (real_length ra)
+  let real_lix ra = real_length ra - 1
 
-  let unsafe_get ra ix = Impl.unsafe_get ra.ar ix
-  let unsafe_set ra ix el = Impl.unsafe_set ra.ar ix el
+  let unsafe_get_ar ar ix =
+    match Impl.unsafe_get ar ix with
+    | None -> failwith "unsafe_get_ar: element undefined - concurrent access?"
+    | Some el -> el
 
-  let unsafe_expose_array ra = ra.ar
+  let unsafe_get ra ix = unsafe_get_ar ra.ar ix
+
+  let unsafe_set_ar ar ix el = Impl.unsafe_set ar ix (Some el)
+  let unsafe_set ra ix el = unsafe_set_ar ra.ar ix el
 
   let get ra n =
-    if n > ra.vlix or n < 0 then invalid_arg "get" else unsafe_get ra n
+    if n > ra.vlix || n < 0 then invalid_arg "get"
+    else unsafe_get ra n
 
   let set ra n el =
-    if n > ra.vlix or n < 0 then invalid_arg "set" else unsafe_set ra n el
+    if n > ra.vlix || n < 0 then invalid_arg "set"
+    else unsafe_set ra n el
 
-  let dummy_loc = 0
-  let no_obj () = Obj.magic dummy_loc
-
-  let creator n = let nothing = no_obj () in Impl.make n nothing
+  let creator n = Impl.make n None
 
   let screate_fresh strategy n =
-    let res = {ar = no_obj (); vlix = pred n; strategy = strategy} in
-    res.ar <- creator (Strategy.grow 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}
+    { ar = creator (length ra); vlix = ra.vlix; strategy = ra.strategy }
 
   let sempty strategy =
-    let res = {ar = no_obj (); vlix = -1; strategy = strategy} in
+    let res = { ar = creator 0; vlix = -1; strategy = strategy } in
     res.ar <- creator (Strategy.grow strategy 0);
     res
 
 
   let screate strategy n x =
     let res = screate_fresh strategy n in
-    for i = 0 to pred n do unsafe_set res i x done; res
+    let res_ar = res.ar in
+    let el = Some x in
+    for i = 0 to n - 1 do Impl.unsafe_set res_ar i el done;
+    res
 
   let smake = screate
 
 
   let sinit strategy n f =
     let res = screate_fresh strategy n in
-    for i = 0 to pred n do unsafe_set res i (f i) done; res
+    let res_ar = res.ar in
+    for i = 0 to n - 1 do unsafe_set_ar res_ar i (f i) done;
+    res
 
   let init n f = sinit Strategy.default n f
 
-  let to_array ra = Array.init (length ra) (fun i -> unsafe_get ra i)
+  let to_array ({ ar = ar } as ra) =
+    Array.init (length ra) (fun i -> unsafe_get_ar ar i)
 
   let sof_array strategy ar =
     sinit strategy (Array.length ar) (fun i -> Array.unsafe_get ar i)
 
   let resizer some_lix ra len =
     let ar = creator len in
-    for i = 0 to some_lix do Impl.unsafe_set ar i (unsafe_get ra i) done;
+    let old_ar = ra.ar in
+    for i = 0 to some_lix do
+      Impl.unsafe_set ar i (Impl.unsafe_get old_ar i)
+    done;
     ra.ar <- ar
 
   let enforce_strategy ra =
-    let real_len = real_length ra and new_len = length ra in
+    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 make_matrix sx sy init =
     let res = create_fresh sx in
-    for i = 0 to res.vlix do unsafe_set res i (make sy init) done; res
+    let res_ar = res.ar in
+    for i = 0 to res.vlix do
+      unsafe_set_ar res_ar i (make sy init)
+    done;
+    res
 
-  let copy ra =
-    let ar = Impl.make (real_length ra) (unsafe_get ra 0) in
-    for i = 1 to real_lix ra do Impl.unsafe_set ar i (unsafe_get ra i) done;
-    {ra with ar = ar}
+  let copy ({ ar = ar } as ra) =
+    let new_ar = Impl.make (real_length ra) (Impl.unsafe_get ar 0) in
+    for i = 1 to real_lix ra do
+      Impl.unsafe_set new_ar i (Impl.unsafe_get ar i)
+    done;
+    { ra with ar = new_ar }
 
-  let unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len =
+  let unsafe_blit_on_other { ar = ar1 } ofs1 { ar = ar2 } ofs2 len =
     let ofs_diff = ofs2 - ofs1 in
-    for i = ofs1 to ofs1 + pred len do
-      unsafe_set ra2 (i + ofs_diff) (unsafe_get ra1 i) done
+    for i = ofs1 to ofs1 + len - 1 do
+      Impl.unsafe_set ar2 (i + ofs_diff) (Impl.unsafe_get ar1 i)
+    done
 
-  let append ra1 ra2 = match ra1.vlix, ra2.vlix with
+  let append ra1 ra2 =
+    match ra1.vlix, ra2.vlix with
     | -1, -1 -> empty ()
     | _, -1 -> copy ra1
     | -1, _ -> copy ra2
-    | _ -> let len1 = length ra1
-           and 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 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
+    | 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
     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 res = create_fresh len in
+    unsafe_blit_on_other ra ofs res 0 len;
+    res
 
   let sub ra ofs len =
-    if ofs < 0 or len < 0 or ofs + len > length ra then invalid_arg "sub"
+    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 (succ ix))
+      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 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 (no_obj ()); ra.vlix <- pred ra.vlix;
+    Impl.unsafe_set ra.ar 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
+    if ra.vlix < 0 then failwith "remove_one"
+    else unsafe_remove_one ra
 
   let unsafe_remove_n ra n =
-    let old_vlix = ra.vlix and old_ar = ra.ar in
-    ra.vlix <- old_vlix - n; enforce_strategy ra;
+    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
-      let nothing = no_obj () in
-      for i = succ ra.vlix to old_vlix do unsafe_set ra i nothing done
+      for i = ra.vlix + 1 to old_vlix do
+        Impl.unsafe_set old_ar i None
+      done
 
   let remove_n ra n =
     if n > length ra || n < 0 then invalid_arg "remove_n"
     unsafe_remove_n ra len
 
   let remove_range ra ofs len =
-    if ofs < 0 or len < 0 or ofs + len > length ra then
+    if ofs < 0 || len < 0 || ofs + len > length ra then
       invalid_arg "remove_range"
     else unsafe_remove_range ra ofs len
 
     unsafe_set ra m tmp
 
   let swap ra n m =
-    if n > ra.vlix or m > ra.vlix or n < 0 or m < 0 then invalid_arg "swap"
+    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);
+  let unsafe_swap_in_last ({ ar = ar } as ra) n =
+    Impl.unsafe_set ar n (Impl.unsafe_get ar ra.vlix);
     unsafe_remove_one ra
 
   let swap_in_last ra n =
-    if n > ra.vlix or n < 0 then invalid_arg "swap_in_last"
+    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 + pred len in
+    let last = ofs + len - 1 in
     guarantee_ix ra (max last ra.vlix);
-    for i = ofs to last do unsafe_set ra i x done
+    let el = Some x in
+    let ar = ra.ar in
+    for i = ofs to last do Impl.unsafe_set ar i el done
 
   let fill ra ofs len x =
-    if ofs < 0 or len < 0 or ofs > length ra then invalid_arg "fill"
+    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 + pred len);
+  let unsafe_blit { ar = ar1 } ofs1 ({ ar = ar2 } as ra2) ofs2 len =
+    guarantee_ix ra2 (ofs2 + len - 1);
     if ofs1 < ofs2 then
-      for i = pred len downto 0 do
-        unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) done
+      for i = len - 1 downto 0 do
+        Impl.unsafe_set ar2 (ofs2 + i) (Impl.unsafe_get ar1 (ofs1 + i))
+      done
     else
-      for i = 0 to pred len do
-        unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) done
+      for i = 0 to len - 1 do
+        Impl.unsafe_set ar2 (ofs2 + i) (Impl.unsafe_get ar1 (ofs1 + i))
+      done
 
   let blit ra1 ofs1 ra2 ofs2 len =
-    if len < 0 or ofs1 < 0 or ofs2 < 0 or ofs1 + len > length ra1 or
-       ofs2 > length ra2 then invalid_arg "blit"
+    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 rec to_list_aux ra i accu =
-    if i < 0 then accu else to_list_aux ra (pred i) (unsafe_get ra i :: accu)
+  let rec to_list_aux ar i accu =
+    if i < 0 then accu
+    else to_list_aux ar (i - 1) (unsafe_get_ar ar i :: accu)
 
-  let to_list ra = to_list_aux ra ra.vlix []
+  let to_list ra = to_list_aux ra.ar ra.vlix []
 
-  let rec of_list_aux res i = function
-    | [] -> res 
-    | h::t -> unsafe_set res i h; of_list_aux res (succ i) t
+  let rec of_list_aux res_ar i = function
+    | [] -> ()
+    | h::t ->
+        unsafe_set_ar res_ar i h;
+        of_list_aux res_ar (i + 1) t
 
-  let of_list l = of_list_aux (create_fresh (List.length l)) 0 l
+  let of_list l =
+    let res = create_fresh (List.length l) in
+    of_list_aux res.ar 0 l;
+    res
 
-  let sof_list s l = of_list_aux (screate_fresh s (List.length l)) 0 l
+  let sof_list s l =
+    let res = screate_fresh s (List.length l) in
+    of_list_aux res.ar 0 l;
+    res
 
-  let iter f ra = for i = 0 to ra.vlix do f (unsafe_get ra i) done
+  let iter f ({ ar = ar } as ra) =
+    for i = 0 to ra.vlix do f (unsafe_get_ar ar i) done
 
-  let map f ra =
-    let res = create_from ra in
-    for i = 0 to res.vlix do unsafe_set res i (f (unsafe_get ra i)) done; res
+  let map f ({ ar = ar } as ra) =
+    let { ar = res_ar } as res = create_from ra in
+    for i = 0 to res.vlix do
+      unsafe_set_ar res_ar i (f (unsafe_get_ar ar i))
+    done;
+    res
 
-  let iteri f ra = for i = 0 to ra.vlix do f i (unsafe_get ra i) done
+  let iteri f ({ ar = ar } as ra) =
+    for i = 0 to ra.vlix do f i (unsafe_get_ar ar i) done
 
-  let mapi f ra =
-    let res = create_from ra in
-    for i = 0 to res.vlix do unsafe_set res i (f i (unsafe_get ra i)) done; res
+  let mapi f ({ ar = ar } as ra) =
+    let { ar = res_ar } as res = create_from ra in
+    for i = 0 to res.vlix do
+      unsafe_set_ar res_ar i (f i (unsafe_get_ar ar i))
+    done;
+    res
 
-  let fold_left f accu ra =
+  let fold_left f accu ({ ar = ar } as ra) =
     let res = ref accu in
-    for i = 0 to ra.vlix do res := f !res (unsafe_get ra i) done; !res
+    for i = 0 to ra.vlix do
+      res := f !res (unsafe_get_ar ar i)
+    done;
+    !res
 
-  let fold_right f ra accu =
+  let fold_right f ({ ar = ar } as ra) accu =
     let res = ref accu in
-    for i = ra.vlix downto 0 do res := f (unsafe_get ra i) !res done; !res
+    for i = ra.vlix downto 0 do
+      res := f (unsafe_get_ar ar 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 (succ i) p ra else false
+    i > ra.vlix || p (unsafe_get ra i) && for_all_aux (i + 1) p ra
 
   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 (succ i) p ra
+    i <= ra.vlix && (p (unsafe_get ra i) || 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 (succ i) x ra
+    i <= ra.vlix && (unsafe_get ra i = x || 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 (succ i) x ra
+    i <= ra.vlix && (unsafe_get ra i == x || 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 (succ i) x ra
+    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 (succ i) x ra
+    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 (succ i) p ra
+    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 (succ i)
+    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
+    if i < 0 then invalid_arg "find_index"
+    else find_index_aux p ra i
 
-  let filter p ra =
+  let filter p ({ ar = ar } as 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;
+      let el = unsafe_get_ar ar 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
-    and pos = ref 0 in
+  let filter_in_place p ({ ar = ar } as 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;
+      let el = unsafe_get_ar ar !pos in
+      if p el then begin
+        unsafe_set_ar ar !dest el;
+        incr dest
+      end;
+      incr pos
+    done;
     unsafe_remove_n ra (!pos - !dest)
 
-  let partition p ra =
+  let partition p ({ ar = ar } as 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;
+      let el = unsafe_get_ar ar i in
+      if p el then add_one res1 el
+      else add_one res2 el
+    done;
     res
 end

lib/pres_intf.mli

 
   val unsafe_swap : 'a t -> int -> int -> unit
   val unsafe_swap_in_last : 'a t -> int -> unit
-
-  val unsafe_expose_array : 'a t -> 'a array
 end
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
-(* $Id: res.ml,v 1.18 2005/11/07 20:25:28 mottl Exp $ *)
-
 module DefStrat = struct
   type t = float * float * int
 
   let default = 1.5, 0.5, 1024
 end
 
-module Array_Impl = struct
+module Unsafe_array_impl = struct
   type 'a t = 'a array
 
-  let name = "Res.Array"
+  let name = "Res.Unsafe_array"
   let length = Array.length
   let make = Array.make
   let unsafe_get = Array.unsafe_get
   let unsafe_set = Array.unsafe_set
 end
 
-module Int_Impl = struct
-  type el = int
-  type t = el array
-
-  let name = "Res.Ints"
-  let length = Array.length
-  let create n = Array.create n 0
-  let make = Array.make
-  let unsafe_get = Array.unsafe_get
-  let unsafe_set = Array.unsafe_set
-
-  let unsafe_blit ar1 ofs1 ar2 ofs2 len =
-    if ofs1 < ofs2 then
-      for i = pred len downto 0 do
-        unsafe_set ar2 (ofs2 + i) (unsafe_get ar1 (ofs1 + i)) done
-    else
-      for i = 0 to pred len do
-        unsafe_set ar2 (ofs2 + i) (unsafe_get ar1 (ofs1 + i)) done
+module Array_impl = struct
+  include Unsafe_array_impl
+  let name = "Res.Array"
+  let unsafe_get = Array.get
+  let unsafe_set = Array.set
 end
 
-module Float_Impl = struct
+module Unsafe_float_impl = struct
   type el = float
   type t = el array
 
-  let name = "Res.Floats"
+  let name = "Res.Unsafe_floats"
   let length = Array.length
   let create n = Array.create n 0.0
   let make = Array.make
   let unsafe_get = Array.unsafe_get
   let unsafe_set = Array.unsafe_set
 
-  let unsafe_blit ar1 ofs1 ar2 ofs2 len =
+  let unsafe_blit (ar1 : t) ofs1 ar2 ofs2 len =
     if ofs1 < ofs2 then
-      for i = pred len downto 0 do
+      for i = len - 1 downto 0 do
         unsafe_set ar2 (ofs2 + i) (unsafe_get ar1 (ofs1 + i)) done
     else
-      for i = 0 to pred len do
+      for i = 0 to len - 1 do
         unsafe_set ar2 (ofs2 + i) (unsafe_get ar1 (ofs1 + i)) done
 end
 
+module Float_impl = struct
+  include Unsafe_float_impl
+
+  let name = "Res.Floats"
+  let unsafe_get = Array.get
+  let unsafe_set = Array.set
+
+  let unsafe_blit ar1 ofs1 ar2 ofs2 len =
+    if
+      len < 0 || ofs1 < 0
+      || ofs1 > Array.length ar1 - len
+      || ofs2 < 0 || ofs2 > Array.length ar2 - len
+    then invalid_arg "Res.Floats.blit"
+    else unsafe_blit ar1 ofs1 ar2 ofs2 len
+end
+
+(* TODO: create safe version *)
 (* Code of the Bit-module due to Jean-Christophe Filliatre *)
-module Bit_Impl = struct
+module Bit_impl = struct
   type el = bool
   type t = { length : int; bits : int array }
 
   let bit_j = Array.init bpi (fun j -> 1 lsl j)
   let bit_not_j = Array.init bpi (fun j -> max_int - bit_j.(j))
 
-  let low_mask = Array.create (succ bpi) 0
-  let _ =
-    for i = 1 to bpi do low_mask.(i) <- low_mask.(i-1) lor bit_j.(pred i) done
+  let low_mask = Array.create (bpi + 1) 0
+
+  let () =
+    for i = 1 to bpi do
+      low_mask.(i) <- low_mask.(i-1) lor bit_j.(i - 1)
+    done
 
   let keep_lowest_bits a j = a land low_mask.(j)
 
-  let high_mask = Array.init (succ bpi) (fun j -> low_mask.(j) lsl (bpi-j))
+  let high_mask = Array.init (bpi + 1) (fun j -> low_mask.(j) lsl (bpi-j))
 
   let keep_highest_bits a j = a land high_mask.(j)
 
     if r = 0 then { length = n; bits = Array.create (n / bpi) initv }
     else begin
       let s = n / bpi in
-      let b = Array.create (succ s) initv in
+      let b = Array.create (s + 1) initv in
       b.(s) <- b.(s) land low_mask.(r);
       { length = n; bits = b }
     end
   let create n = make n false
 
   let pos n =
-    let i = n / bpi and j = n mod bpi in
+    let i = n / bpi in
+    let j = n mod bpi in
     if j < 0 then (i - 1, j + bpi) else (i,j)
 
   let unsafe_get v n =
         Array.unsafe_set v i'
           (((keep_lowest_bits (a lsr i) (bpi - j)) lsl j) lor
            (keep_lowest_bits (Array.unsafe_get v i') j));
-        Array.unsafe_set v (succ i')
+        Array.unsafe_set v (i' + 1)
           ((keep_lowest_bits (a lsr (i + bpi - j)) d) lor
-           (keep_highest_bits (Array.unsafe_get v (succ i')) (bpi - d)))
+           (keep_highest_bits (Array.unsafe_get v (i' + 1)) (bpi - d)))
       end else
         Array.unsafe_set v i'
           (((keep_lowest_bits (a lsr i) m) lsl j) lor
       Array.unsafe_set v i
         ( (keep_lowest_bits (Array.unsafe_get v i) j) lor
          ((keep_lowest_bits a (bpi - j)) lsl j));
-      Array.unsafe_set v (succ i)
-        ((keep_highest_bits (Array.unsafe_get v (succ i)) (bpi - j)) lor
+      Array.unsafe_set v (i + 1)
+        ((keep_highest_bits (Array.unsafe_get v (i + 1)) (bpi - j)) lor
          (a lsr (bpi - j)))
     end
 
     else begin
       blit_bits (Array.unsafe_get v1.bits bi) bj (bpi - bj) v2.bits ofs2;
       let n = ref (ofs2 + bpi - bj) in
-      for i = succ bi to pred ei do
+      for i = bi + 1 to ei - 1 do
         blit_int (Array.unsafe_get v1.bits i) v2.bits !n;
         n := !n + bpi
       done;
-      blit_bits (Array.unsafe_get v1.bits ei) 0 (succ ej) v2.bits !n
+      blit_bits (Array.unsafe_get v1.bits ei) 0 (ej + 1) v2.bits !n
     end
 end
 
-module Buffer_Impl = struct
+module Buffer_unsafe_impl = struct
   type el = char
   type t = string
 
-  let name = "Res.Buffer"
+  let name = "Res.Unsafe_buffer"
   let length = String.length
   let create = String.create
   let make = String.make
   let unsafe_blit = String.unsafe_blit
 end
 
-module MakeArray (S : Strat.T) = Pres_impl.Make (S) (Array_Impl)
-module MakeInts (S : Strat.T) = Nopres_impl.Make (S) (Int_Impl)
-module MakeFloats (S : Strat.T) = Nopres_impl.Make (S) (Float_Impl)
-module MakeBits (S : Strat.T) = Nopres_impl.Make (S) (Bit_Impl)
+module Buffer_impl = struct
+  include Buffer_unsafe_impl
+
+  let name = "Res.Buffer"
+  let unsafe_get = String.get
+  let unsafe_set = String.set
+  let unsafe_blit = String.blit
+end
+
+module MakeArray (S : Strat.T) = Pres_impl.Make (S) (Array_impl)
+module MakeFloats (S : Strat.T) = Nopres_impl.Make (S) (Float_impl)
+module MakeBits (S : Strat.T) = Nopres_impl.Make (S) (Bit_impl)
 module MakeWeak (S : Strat.T) = Weak_impl.Make (S)
 
 module MakeBuffer (S : Strat.T) = struct
-  module B = Nopres_impl.Make (S) (Buffer_Impl)
+  module B = Nopres_impl.Make (S) (Buffer_impl)
   include B
 
   let create _ = empty ()
   let add_char = add_one
 
   let add_string buf str =
-    let old_buf_len = length buf
-    and len = String.length str in
+    let old_buf_len = length buf in
+    let len = String.length str in
     maybe_grow_ix buf (buf.vlix + len);
     String.blit str 0 buf.ar old_buf_len len
 
     let old_buf_len = length buf in
     maybe_grow_ix buf (buf.vlix + len);
     try really_input ch buf.ar old_buf_len len with
-    | End_of_file -> buf.vlix <- pred old_buf_len; enforce_strategy buf
+    | End_of_file ->
+        buf.vlix <- old_buf_len - 1;
+        enforce_strategy buf
 
   let rec add_full_channel_f_aux buf ch len adjust =
     if len > 0 then begin
 end
 
 module Array = MakeArray (DefStrat)
-module Ints = MakeInts (DefStrat)
 module Floats = MakeFloats (DefStrat)
 module Bits = MakeBits (BitDefStrat)
 module Weak = MakeWeak (DefStrat)
 (*
    RES - Automatically Resizing Contiguous Memory for OCaml
 
-   Copyright (C) 1999-2002  Markus Mottl
+   Copyright (C) 1999-  Markus Mottl
    email: markus.mottl@gmail.com
    WWW:   http://www.ocaml.info
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
-(* $Id: res.mli,v 1.12 2005/11/07 20:25:28 mottl Exp $ *)
-
 (** Global module for resizable datastructures and default implementations *)
 
 (** {6 Default strategies} *)
 (** Resizable parameterized array using the default reallocation strategy. *)
 module Array : (Pres_intf.T with module Strategy = DefStrat)
 
-(** Resizable int array using the default reallocation strategy. *)
-module Ints
-  : (Nopres_intf.T with module Strategy = DefStrat and type el = int)
-
 (** Resizable float array using the default reallocation strategy. *)
 module Floats
   : (Nopres_intf.T with module Strategy = DefStrat and type el = float)
 module MakeArray : functor (S : Strat.T) ->
   (Pres_intf.T with module Strategy = S)
 
-(** Functor that creates resizable int arrays from reallocation
-    strategies. *)
-module MakeInts : functor (S : Strat.T) ->
-  (Nopres_intf.T with module Strategy = S and type el = int)
-
 (** Functor that creates resizable float arrays from reallocation
     strategies. *)
 module MakeFloats : functor (S : Strat.T) ->
 (*
    RES - Automatically Resizing Contiguous Memory for OCaml
 
-   Copyright (C) 1999-2002  Markus Mottl
+   Copyright (C) 1999-  Markus Mottl
    email: markus.mottl@gmail.com
    WWW:   http://www.ocaml.info
 
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
-(* $Id: weak_impl.ml,v 1.10 2005/11/07 20:25:28 mottl Exp $ *)
+(* 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}
+  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 = succ ra.vlix
-  let lix ra = ra.vlix 
+  let length ra = ra.vlix + 1
+  let lix ra = ra.vlix
 
   let real_length ra = Weak.length ra.ar
-  let real_lix ra = pred (real_length ra)
+  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 or n < 0 then invalid_arg "get" else unsafe_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 or n < 0 then invalid_arg "get_copy"
+    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 or n < 0 then invalid_arg "set" else unsafe_set ra n
+    if n > ra.vlix || n < 0 then invalid_arg "set" else unsafe_set ra n
 
   let dummy_loc = 0
   let no_obj () = Obj.magic dummy_loc
   let creator = Weak.create
 
   let screate_fresh strategy n =
-    let res = {ar = no_obj (); vlix = pred n; strategy = strategy} in
+    let res = {ar = no_obj (); vlix = n - 1; strategy = strategy} in
     res.ar <- creator (Strategy.grow strategy n);
     res
 
 
   let smake strategy n x =
     let res = screate_fresh strategy n in
-    for i = 0 to pred n do unsafe_set res i x done; res
+    for i = 0 to n - 1 do unsafe_set res i x done; res
 
   let make n = smake Strategy.default n
 
 
   let sinit strategy n f =
     let res = screate_fresh strategy n in
-    for i = 0 to pred n do unsafe_set res i (f i) done; res
+    for i = 0 to n - 1 do unsafe_set res i (f i) done; res
 
   let init n f = sinit Strategy.default n f
 
     ra.ar <- ar
 
   let enforce_strategy ra =
-    let real_len = real_length ra and new_len = length ra in
+    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 unsafe_blit_on_other ra1 ofs1 ra2 ofs2 len =
     let ofs_diff = ofs2 - ofs1 in
-    for i = ofs1 to ofs1 + pred len do
+    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
-           and 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 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
     let res = create_fresh len in unsafe_blit_on_other ra ofs res 0 len; res
 
   let sub ra ofs len =
-    if ofs < 0 or len < 0 or ofs + len > length ra then invalid_arg "sub"
+    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 (succ ix))
+      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 <- pred ra.vlix;
+    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 and old_ar = ra.ar in
+    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 = succ ra.vlix to old_vlix do unsafe_set ra i None done
+      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"
     unsafe_remove_n ra len
 
   let remove_range ra ofs len =
-    if ofs < 0 or len < 0 or ofs + len > length ra then
+    if ofs < 0 || len < 0 || ofs + len > length ra then
       invalid_arg "remove_range"
     else unsafe_remove_range ra ofs len
 
     unsafe_set ra m tmp
 
   let swap ra n m =
-    if n > ra.vlix or m > ra.vlix or n < 0 or m < 0 then invalid_arg "swap"
+    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_remove_one ra
 
   let swap_in_last ra n =
-    if n > ra.vlix or n < 0 then invalid_arg "swap_in_last"
+    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 + pred len in
+    let last = ofs + len - 1 in
     guarantee_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 or len < 0 or ofs > length ra then invalid_arg "fill"
+    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 + pred len);
+    guarantee_ix ra2 (ofs2 + len - 1);
     if ofs1 < ofs2 then
-      for i = pred len downto 0 do
+      for i = len - 1 downto 0 do
         unsafe_set ra2 (ofs2 + i) (unsafe_get ra1 (ofs1 + i)) done
     else
-      for i = 0 to pred len do
+      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 or ofs1 < 0 or ofs2 < 0 or ofs1 + len > length ra1 or
-       ofs2 > length ra2 then invalid_arg "blit"
+    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 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 (pred i) (unsafe_get 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 (succ i) t
+    | [] -> 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 rec for_all_aux i p ra =
     if i > ra.vlix then true
-    else if p (unsafe_get ra i) then for_all_aux (succ i) p ra else false
+    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 (succ i) p ra
+    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 (succ i) x ra
+    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 (succ i) x ra
+    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 (succ i) x ra
+    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 (succ i) x ra
+    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 (succ i) p ra
+    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 (succ i)
+    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 find_all = filter
 
   let filter_in_place p ra =
-    let dest = ref 0
-    and pos = ref 0 in
+    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;
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.