Merge pull request #323 from yallop/extra-carray-functions

Add some extra CArray functions

src/ctypes/ctypes.mli

@@ -277,6 +277,30 @@ sig
       element of the list is the result of reading the corresponding element of
       [a]. *)
 
+  val iter : ('a -> unit) -> 'a t -> unit
+  (** [iter f a] is analogous to [Array.iter f a]: it applies [f] in turn to
+      all the elements of [a]. *)
+
+  val map : 'b typ -> ('a -> 'b) -> 'a t -> 'b t
+  (** [map t f a] is analogous to [Array.map f a]: it creates a new array with
+      element type [t] whose elements are obtained by applying [f] to the
+      elements of [a]]. *)
+
+  val mapi : 'b typ -> (int -> 'a -> 'b) -> 'a t -> 'b t
+  (** [mapi] behaves like {!Array.mapi}, except that it also passes the
+      index of each element as the first argument to [f] and the element
+      itself as the second argument. *)
+
+  val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+  (** [CArray.fold_left (@) x a] computes 
+         [(((x @ a.(0)) @ a.(1)) ...) @ a.(n-1)]
+       where [n] is the length of the array [a]. *)
+
+  val fold_right : ('b -> 'a -> 'a) -> 'b t -> 'a -> 'a
+  (** [CArray.fold_right f a x] computes
+         [a.(0) @ (a.(1) @ ( ... (a.(n-1) @ x) ...))]
+       where [n] is the length of the array [a]. *)
+
   val length : 'a t -> int
   (** Return the number of elements of the given array. *)
 
@@ -293,8 +317,18 @@ sig
       used to initialise every element of the array.  The argument [?finalise],
       if present, will be called just before the memory is freed. *)
 
+  val copy : 'a t -> 'a t
+  (** [copy a] creates a fresh array with the same elements as [a]. *)
+
+  val sub : 'a t -> pos:int -> length:int -> 'a t
+  (** [sub a ~pos ~length] creates a fresh array of length [length] containing
+      the elements [a.(pos)] to [a.(pos + length - 1)] of [a].
+
+      Raise [Invalid_argument "CArray.sub"] if [pos] and [length] do not
+      designate a valid subarray of [a]. *)
+
   val element_type : 'a t -> 'a typ
-(** Retrieve the element type of an array. *)
+  (** Retrieve the element type of an array. *)
 end
 (** Operations on C arrays. *)
 

src/ctypes/ctypes_memory.ml

@@ -199,6 +199,19 @@ struct
         | None -> arr
         | Some v -> fill arr v; arr
 
+  let copy {astart = CPointer src; alength} =
+    begin
+      let reftyp = Fat.reftype src in
+      let CPointer dst as r = allocate_n reftyp alength in
+      let () = Stubs.memcpy ~dst ~src ~size:(alength * sizeof reftyp) in
+      from_ptr r alength
+    end
+
+  let sub arr ~pos ~length:len =
+  if pos < 0 || len < 0 || pos > length arr - len
+  then invalid_arg "CArray.sub"
+  else copy { astart = arr.astart +@ pos; alength = len }
+
   let element_type { astart } = reference_type astart
 
   let of_list typ list =
@@ -212,6 +225,41 @@ struct
       l := get a i :: !l
     done;
     !l
+
+  let iter f a =
+    for i = 0 to length a - 1 do
+      f (unsafe_get a i)
+    done
+
+  let map typ f a =
+    let l = length a in
+    let r = make typ l in
+    for i = 0 to l - 1 do
+      unsafe_set r i (f (unsafe_get a i))
+    done;
+    r
+
+  let mapi typ f a =
+    let l = length a in
+    let r = make typ l in
+    for i = 0 to l - 1 do
+      unsafe_set r i (f i (unsafe_get a i))
+    done;
+    r
+
+  let fold_left f x a =
+    let r = ref x in
+    for i = 0 to length a - 1 do
+      r := f !r (unsafe_get a i)
+    done;
+    !r
+
+  let fold_right f a x =
+    let r = ref x in
+    for i = length a - 1 downto 0 do
+      r := f (unsafe_get a i) !r
+    done;
+    !r
 end
 
 let make ?finalise s =

tests/test-arrays/test_array.ml

@@ -93,6 +93,124 @@ let test_multidimensional_arrays _ =
   done
 
 
+(*
+  Test the CArray.iter function
+ *)
+let test_iter _ =
+  let r = ref 0 in
+  let a = CArray.of_list int [1; 2; 3] in
+  let () = CArray.iter (fun v -> r := !r + v) a in
+  assert_equal !r 6;
+
+  let r = ref 0 in
+  let a = CArray.of_list int [] in
+  let () = CArray.iter (fun _ -> assert false) a in
+  assert_equal !r 0
+
+
+(*
+  Test the CArray.map function
+ *)
+let test_map _ =
+  let a = CArray.of_list int [1; 2; 3] in
+  let r = CArray.map float float_of_int a in
+  assert_equal [1.0; 2.0; 3.0] (CArray.to_list r);
+
+  let a = CArray.of_list int [] in
+  let r = CArray.map string (fun _ -> assert false) a in
+  assert_equal (CArray.length r) 0
+
+
+(*
+  Test the CArray.mapi function
+ *)
+let test_mapi _ =
+  let a = CArray.of_list int [1; 2; 3] in
+  let r = CArray.mapi int (+) a in
+  assert_equal [1; 3; 5] (CArray.to_list r);
+
+  let a = CArray.of_list int [] in
+  let r = CArray.mapi string (fun _ _ -> assert false) a in
+  assert_equal (CArray.length r) 0
+
+
+(*
+  Test the CArray.fold_left function
+ *)
+let test_fold_left _ =
+  let a = CArray.of_list int [1; 2; 3] in
+  let r = CArray.fold_left (Printf.sprintf "%s%d") "." a in
+  assert_equal ".123" r;
+
+  let a = CArray.of_list int [] in
+  let r = CArray.fold_left (fun _ -> assert false) [] a in
+  assert_equal r []
+
+
+(*
+  Test the CArray.fold_right function
+ *)
+let test_fold_right _ =
+  let a = CArray.of_list int [1; 2; 3] in
+  let r = CArray.fold_right (Printf.sprintf "%d%s") a "." in
+  assert_equal "123." r;
+
+  let a = CArray.of_list int [] in
+  let r = CArray.fold_right (fun _ -> assert false) a [] in
+  assert_equal r []
+
+(*
+  Test the CArray.copy function
+ *)
+let test_copy _ =
+  let a = CArray.of_list int [1; 2; 3] in
+  let r = CArray.copy a in
+
+  begin
+    assert_equal [1; 2; 3] (CArray.to_list a);
+    assert_equal [1; 2; 3] (CArray.to_list r);
+    CArray.set r 0 10;
+    assert_equal [1; 2; 3] (CArray.to_list a);
+    assert_equal [10; 2; 3] (CArray.to_list r);
+    CArray.set a 1 20;
+    assert_equal [1; 20; 3] (CArray.to_list a);
+    assert_equal [10; 2; 3] (CArray.to_list r);
+  end
+
+
+(*
+  Test the CArray.sub function
+ *)
+let test_sub _ =
+  let a = CArray.of_list int [1; 2; 3] in
+
+  assert_raises (Invalid_argument "CArray.sub") begin fun () ->
+    CArray.sub a ~pos:(-1) ~length:1
+  end;
+
+  assert_raises (Invalid_argument "CArray.sub") begin fun () ->
+    CArray.sub a ~pos:1 ~length:4
+  end;
+
+  assert_raises (Invalid_argument "CArray.sub") begin fun () ->
+    CArray.sub a ~pos:1 ~length:(-1)
+  end;
+
+  let r = CArray.sub a ~pos:1 ~length:2 in 
+  assert_equal [2; 3] (CArray.to_list r);
+
+  let r = CArray.sub a ~pos:1 ~length:0 in
+  assert_equal [] (CArray.to_list r);
+
+  let a = CArray.of_list int [1; 2; 3] in
+  let r = CArray.sub a ~pos:1 ~length:2 in
+  begin
+    CArray.set r 0 10;
+    assert_equal [1; 2; 3] (CArray.to_list a);
+    assert_equal [10; 3] (CArray.to_list r);
+  end
+
+
 (*
   Test that creating an array initializes all elements appropriately.
 *)
@@ -204,6 +322,27 @@ let suite = "Array tests" >:::
   ["multidimensional arrays"
     >:: test_multidimensional_arrays;
 
+   "CArray.iter "
+    >:: test_iter;
+
+   "CArray.map "
+    >:: test_map;
+
+   "CArray.mapi "
+    >:: test_mapi;
+
+   "CArray.fold_left"
+    >:: test_fold_left;
+
+   "CArray.fold_right"
+    >:: test_fold_right;
+
+   "CArray.copy"
+    >:: test_copy;
+
+   "CArray.sub"
+    >:: test_sub;
+
    "array initialization"
     >:: test_array_initialiation;