Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add some extra CArray functions #323

Merged
merged 7 commits into from
Sep 19, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
36 changes: 35 additions & 1 deletion src/ctypes/ctypes.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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. *)

Expand All @@ -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. *)

Expand Down
48 changes: 48 additions & 0 deletions src/ctypes/ctypes_memory.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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 =
Expand Down
139 changes: 139 additions & 0 deletions tests/test-arrays/test_array.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.
*)
Expand Down Expand Up @@ -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;

Expand Down