mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
remove containers.bigarray
This commit is contained in:
Simon Cruanes
parent
af4c3fc195
commit
bfa5a20f07
8 changed files with 4 additions and 1483 deletions
|
|
@ -33,7 +33,6 @@ cross-module dependencies).
|
|||
a LINQ-like query module, batch operations using GADTs, and others).
|
||||
- Utilities around the `unix` library in `containers.unix` (mainly to spawn
|
||||
sub-processes)
|
||||
- A bigstring module using `bigarray` in `containers.bigarray` (*deprecated*)
|
||||
- A lightweight S-expression printer and streaming parser in `containers.sexp`
|
||||
|
||||
Some of the modules have been moved to their own repository (e.g. `sequence`,
|
||||
|
|
@ -262,7 +261,7 @@ branch `stable` it is not necessary.
|
|||
To build and run tests (requires `oUnit` and https://github.com/vincent-hugot/iTeML[qtest]):
|
||||
|
||||
$ opam install oUnit qtest
|
||||
$ ./configure --enable-tests --enable-unix --enable-bigarray
|
||||
$ ./configure --enable-tests --enable-unix
|
||||
$ make test
|
||||
|
||||
To build the small benchmarking suite (requires https://github.com/chris00/ocaml-benchmark[benchmark]):
|
||||
|
|
|
|||
17
_oasis
17
_oasis
|
|
@ -36,10 +36,6 @@ Flag "bench"
|
|||
Description: Build and run benchmarks
|
||||
Default: true
|
||||
|
||||
Flag "bigarray"
|
||||
Description: Build modules that depend on bigarrays
|
||||
Default: true
|
||||
|
||||
Flag "advanced"
|
||||
Description: Build advanced combinators (requires "sequence")
|
||||
Default: true
|
||||
|
|
@ -109,13 +105,6 @@ Library "containers_advanced"
|
|||
FindlibParent: containers
|
||||
BuildDepends: containers, sequence
|
||||
|
||||
Library "containers_bigarray"
|
||||
Path: src/bigarray
|
||||
Modules: CCBigstring, CCArray1
|
||||
FindlibName: bigarray
|
||||
FindlibParent: containers
|
||||
BuildDepends: containers, bigarray, bytes
|
||||
|
||||
Library "containers_thread"
|
||||
Path: src/threads/
|
||||
Modules: CCPool, CCLock, CCSemaphore, CCThread, CCBlockingQueue,
|
||||
|
|
@ -140,14 +129,14 @@ Document containers
|
|||
Title: Containers docs
|
||||
Type: ocamlbuild (0.3)
|
||||
BuildTools+: ocamldoc
|
||||
Build$: flag(docs) && flag(advanced) && flag(bigarray) && flag(unix)
|
||||
Build$: flag(docs) && flag(advanced) && flag(unix)
|
||||
Install: true
|
||||
XOCamlbuildPath: .
|
||||
XOCamlbuildExtraArgs:
|
||||
"-docflags '-colorize-code -short-functors -charset utf-8'"
|
||||
XOCamlbuildLibraries:
|
||||
containers, containers.iter, containers.data,
|
||||
containers.string, containers.bigarray, containers.thread,
|
||||
containers.string, containers.thread,
|
||||
containers.advanced, containers.io, containers.unix, containers.sexp
|
||||
|
||||
Executable run_benchs
|
||||
|
|
@ -178,7 +167,7 @@ Executable run_qtest
|
|||
Build$: flag(tests) && flag(bigarray) && flag(unix) && flag(advanced)
|
||||
BuildDepends: containers, containers.string, containers.iter,
|
||||
containers.io, containers.advanced, containers.sexp,
|
||||
containers.bigarray, containers.unix, containers.thread,
|
||||
containers.unix, containers.thread,
|
||||
containers.data,
|
||||
sequence, gen, unix, oUnit, qcheck
|
||||
|
||||
|
|
|
|||
|
|
@ -136,13 +136,6 @@ CCLevenshtein
|
|||
CCParse
|
||||
}
|
||||
|
||||
{4 Bigarrays}
|
||||
|
||||
{b deprecated} (use package bigstring instead)
|
||||
Use bigarrays to hold large strings and map files directly into memory.
|
||||
|
||||
{!modules: CCBigstring CCArray1}
|
||||
|
||||
{4 Advanced}
|
||||
|
||||
{b findlib name}: containers.advanced
|
||||
|
|
|
|||
|
|
@ -1,753 +0,0 @@
|
|||
(*
|
||||
copyright (c) 2013-2015, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*)
|
||||
|
||||
(** {1 Bigarrays of dimension 1 *)
|
||||
|
||||
module A = Bigarray.Array1
|
||||
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a or_error = [`Ok of 'a | `Error of string]
|
||||
type random = Random.State.t
|
||||
|
||||
type json = [ `Assoc of (string * json) list
|
||||
| `Bool of bool
|
||||
| `Float of float
|
||||
| `Int of int
|
||||
| `List of json list
|
||||
| `Null
|
||||
| `String of string ]
|
||||
type 'a to_json = 'a -> json
|
||||
type 'a of_json = json -> 'a or_error
|
||||
|
||||
type ('a, 'b, 'perm) t =
|
||||
('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
|
||||
constraint 'perm = [< `R | `W]
|
||||
|
||||
type ('a, 'b, 'perm) array_ = ('a, 'b, 'perm) t
|
||||
|
||||
exception WrongDimension
|
||||
|
||||
let make ?x ~kind n =
|
||||
let a = A.create kind Bigarray.c_layout n in
|
||||
begin match x with
|
||||
| None -> ()
|
||||
| Some x -> A.fill a x
|
||||
end;
|
||||
a
|
||||
|
||||
let make_int n = make ~kind:Bigarray.int n
|
||||
let make_char n = make ~kind:Bigarray.char n
|
||||
let make_int8s n = make ~kind:Bigarray.int8_signed n
|
||||
let make_int8u n = make ~kind:Bigarray.int8_unsigned n
|
||||
let make_int16s n = make ~kind:Bigarray.int16_signed n
|
||||
let make_int16u n = make ~kind:Bigarray.int16_unsigned n
|
||||
let make_int32 n = make ~kind:Bigarray.int32 n
|
||||
let make_int64 n = make ~kind:Bigarray.int64 n
|
||||
let make_native n = make ~kind:Bigarray.nativeint n
|
||||
let make_float32 n = make ~kind:Bigarray.float32 n
|
||||
let make_float64 n = make ~kind:Bigarray.float64 n
|
||||
let make_complex32 n = make ~kind:Bigarray.complex32 n
|
||||
let make_complex64 n = make ~kind:Bigarray.complex64 n
|
||||
|
||||
let init ~kind ~f n =
|
||||
let a = A.create kind Bigarray.c_layout n in
|
||||
for i = 0 to n-1 do
|
||||
A.unsafe_set a i (f i)
|
||||
done;
|
||||
a
|
||||
|
||||
(*$T
|
||||
let a = init ~kind:Bigarray.int 10 ~f:(fun x->x) in \
|
||||
CCList.(0 -- 9) |> List.for_all (fun i -> get a i = i)
|
||||
*)
|
||||
|
||||
let of_bigarray a = a
|
||||
let to_bigarray a = a
|
||||
|
||||
let ro (t : ('a,'b,[>`R]) t) : ('a,'b,[`R]) t = t
|
||||
let wo (t : ('a,'b,[>`W]) t) : ('a,'b,[`W]) t = t
|
||||
|
||||
let fill = A.fill
|
||||
|
||||
let copy a =
|
||||
let b = make ~kind:(A.kind a) (A.dim a) in
|
||||
A.blit a b;
|
||||
b
|
||||
|
||||
let length a = A.dim a
|
||||
|
||||
(*$T
|
||||
length (make_int 42) = 42
|
||||
*)
|
||||
|
||||
let set = A.set
|
||||
|
||||
let get = A.get
|
||||
|
||||
let blit = A.blit
|
||||
|
||||
let sub = A.sub
|
||||
|
||||
let iter ~f a =
|
||||
for i = 0 to A.dim a - 1 do
|
||||
f (A.unsafe_get a i)
|
||||
done
|
||||
|
||||
exception LocalExit
|
||||
|
||||
let for_all ~f a =
|
||||
try
|
||||
for i = 0 to A.dim a - 1 do
|
||||
if not (f (A.unsafe_get a i)) then raise LocalExit
|
||||
done;
|
||||
true
|
||||
with LocalExit -> false
|
||||
|
||||
let exists ~f a =
|
||||
try
|
||||
for i = 0 to A.dim a - 1 do
|
||||
if f (A.unsafe_get a i) then raise LocalExit
|
||||
done;
|
||||
false
|
||||
with LocalExit -> true
|
||||
|
||||
(*$T
|
||||
init ~kind:Bigarray.int 10 ~f:(fun x->x) |> for_all ~f:(fun x -> x<10)
|
||||
init ~kind:Bigarray.int 10 ~f:(fun x->x) |> exists ~f:(fun x -> x=5)
|
||||
*)
|
||||
|
||||
let iteri ~f a =
|
||||
for i = 0 to A.dim a - 1 do
|
||||
f i (A.unsafe_get a i)
|
||||
done
|
||||
|
||||
let foldi f acc a =
|
||||
let rec fold' f acc a i =
|
||||
if i = A.dim a then acc
|
||||
else
|
||||
let acc = f acc i (A.unsafe_get a i) in
|
||||
fold' f acc a (i+1)
|
||||
in
|
||||
fold' f acc a 0
|
||||
|
||||
let pp pp_x out a =
|
||||
Format.pp_print_char out '[';
|
||||
iteri a
|
||||
~f:(fun i x ->
|
||||
if i > 0 then Format.fprintf out ",@ ";
|
||||
pp_x out x
|
||||
);
|
||||
Format.pp_print_char out ']';
|
||||
()
|
||||
|
||||
module Bool = struct
|
||||
type ('a, 'perm) t = (int, 'a, 'perm) array_
|
||||
|
||||
let set a i x = A.set a i (if x then 1 else 0)
|
||||
|
||||
let get a i = A.get a i <> 0
|
||||
|
||||
let zeroes n = make ~x:0 ~kind:Bigarray.int8_unsigned n
|
||||
let ones n = make ~x:1 ~kind:Bigarray.int8_unsigned n
|
||||
|
||||
let iter_zeroes ~f a =
|
||||
for i = 0 to A.dim a - 1 do
|
||||
if A.unsafe_get a i = 0 then f i
|
||||
done
|
||||
|
||||
let iter_ones ~f a =
|
||||
for i = 0 to A.dim a - 1 do
|
||||
if A.unsafe_get a i > 0 then f i
|
||||
done
|
||||
|
||||
let cardinal a =
|
||||
let rec fold a i acc =
|
||||
if i = A.dim a then acc
|
||||
else
|
||||
let acc = if A.get a i <> 0 then acc+1 else acc in
|
||||
fold a (i+1) acc
|
||||
in
|
||||
fold a 0 0
|
||||
|
||||
let or_ ?res a b =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim r <> max (A.dim a) (A.dim b) then raise WrongDimension;
|
||||
A.fill r 0;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (max (A.dim a) (A.dim b))
|
||||
in
|
||||
(* ensure [a] is no longer than [b] *)
|
||||
let a, b = if A.dim a < A.dim b then a, b else b, a in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
if A.unsafe_get a i > 0 || A.unsafe_get b i > 0
|
||||
then set b i true
|
||||
done;
|
||||
res
|
||||
|
||||
let and_ ?res a b =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim r <> max (A.dim a) (A.dim b) then raise WrongDimension;
|
||||
A.fill r 0;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (max (A.dim a) (A.dim b))
|
||||
in
|
||||
(* ensure [a] is no longer than [b] *)
|
||||
let a, b = if A.dim a < A.dim b then a, b else b, a in
|
||||
for i=0 to A.dim a - 1 do
|
||||
if A.unsafe_get a i > 0 && A.unsafe_get b i > 0
|
||||
then set res i true
|
||||
done;
|
||||
res
|
||||
|
||||
let not_ ?res a =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim r <> A.dim a then raise WrongDimension;
|
||||
A.fill r 0;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i=0 to A.dim a - 1 do
|
||||
if A.unsafe_get a i = 0 then set res i true
|
||||
done;
|
||||
res
|
||||
|
||||
(* assumes dimensions are ok and [A.dim a >= A.dim b] *)
|
||||
let mix_ a b ~res =
|
||||
let na = A.dim a
|
||||
and nb = A.dim b in
|
||||
assert (nb <= na);
|
||||
(* a has more bits, and we group them in successive chunks of size [d] *)
|
||||
let step = 1 + (na + nb) / nb in
|
||||
for i = 0 to na + nb - 1 do
|
||||
let q, r = i / step, i mod step in
|
||||
if r = 0
|
||||
then set res i (get b q)
|
||||
else set res i (get a (q + r - 1))
|
||||
done
|
||||
|
||||
let mix ?res a b =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a + A.dim b <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~kind:(A.kind a) (A.dim a + A.dim b)
|
||||
in
|
||||
if A.dim a < A.dim b then mix_ b a ~res else mix_ a b ~res;
|
||||
res
|
||||
|
||||
let rec big_or_ a b i j acc =
|
||||
if j = A.dim b then acc
|
||||
else (* acc xor (a[i+j] and b[j]) *)
|
||||
let acc = acc <> (get a ((i+j) mod A.dim a) && get b j) in
|
||||
big_or_ a b i (j+1) acc
|
||||
|
||||
(* [into[i] = big_or_{j in [0...nb-1]} (a[i+j-1 mod na] and b[j]) *)
|
||||
let convolution ?res a ~by:b =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a < A.dim b || A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim res - 1 do
|
||||
if big_or_ a b i 0 false then set res i true
|
||||
done;
|
||||
res
|
||||
|
||||
let pp out a = pp
|
||||
(fun oc b ->
|
||||
Format.pp_print_char oc (if b>0 then '1' else '0')
|
||||
) out a
|
||||
end
|
||||
|
||||
let append ?res a b =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a + A.dim b <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~kind:(A.kind a) (A.dim a + A.dim b)
|
||||
in
|
||||
let n = A.dim a in
|
||||
A.blit a (A.sub res 0 n);
|
||||
A.blit b (A.sub res n (A.dim b));
|
||||
res
|
||||
|
||||
let map ?res ~f a =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i=0 to A.dim a - 1 do
|
||||
A.set res i (f (A.unsafe_get a i))
|
||||
done;
|
||||
res
|
||||
|
||||
let map2 ?res ~f a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim r <> A.dim a then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i=0 to A.dim a - 1 do
|
||||
A.set res i (f (A.unsafe_get a i) (A.unsafe_get b i))
|
||||
done;
|
||||
res
|
||||
|
||||
let filter ?res ~f a =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:Bigarray.int8_unsigned (A.dim a)
|
||||
in
|
||||
for i=0 to A.dim a - 1 do
|
||||
if f (A.unsafe_get a i)
|
||||
then Bool.set res i true
|
||||
done;
|
||||
res
|
||||
|
||||
module type S = sig
|
||||
type elt
|
||||
type ('a, 'perm) t = (elt, 'a, 'perm) array_
|
||||
|
||||
val add :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, 'perm) t
|
||||
(** Elementwise sum
|
||||
@raise WrongDimension if dimensions do not fit *)
|
||||
|
||||
val mult :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, 'perm) t
|
||||
(** Elementwise product *)
|
||||
|
||||
val scalar_add :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
x:elt ->
|
||||
('a, 'perm) t
|
||||
(** @raise WrongDimension if dimensions do not fit *)
|
||||
|
||||
val scalar_mult :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
x:elt ->
|
||||
('a, 'perm) t
|
||||
(** @raise WrongDimension if dimensions do not fit *)
|
||||
|
||||
val sum_elt : (_, [>`R]) t -> elt
|
||||
(** Efficient sum of elements *)
|
||||
|
||||
val product_elt : (_, [>`R]) t -> elt
|
||||
(** Efficient product of elements *)
|
||||
|
||||
val dot_product : (_, [>`R]) t -> (_, [>`R]) t -> elt
|
||||
(** [dot_product a b] returns [sum_i a(i)*b(i)] with the given
|
||||
sum and product, on [elt].
|
||||
[dot_product a b = sum_elt (product a b)]
|
||||
@raise WrongDimension if [a] and [b] do not have the same size *)
|
||||
|
||||
module Infix : sig
|
||||
val ( * ) : ('a, [>`R]) t -> ('a, [>`R]) t -> ('a, 'perm) t
|
||||
(** Alias to {!mult} *)
|
||||
|
||||
val ( + ) : ('a, [>`R]) t -> (_, [>`R]) t -> ('a, 'perm) t
|
||||
(** Alias to {!add} *)
|
||||
|
||||
val ( *! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
|
||||
(** Alias to {!scalar_mult} *)
|
||||
|
||||
val ( +! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
|
||||
(** Alias to {!scalar_add} *)
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
end
|
||||
|
||||
module Int = struct
|
||||
type elt = int
|
||||
type ('a, 'perm) t = (elt, 'a, 'perm) array_
|
||||
|
||||
let add ?res a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i + A.unsafe_get b i)
|
||||
done;
|
||||
res
|
||||
|
||||
let mult ?res a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i * A.unsafe_get b i)
|
||||
done;
|
||||
res
|
||||
|
||||
let scalar_add ?res a ~x =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i + x)
|
||||
done;
|
||||
res
|
||||
|
||||
let scalar_mult ?res a ~x =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0 ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i * x)
|
||||
done;
|
||||
res
|
||||
|
||||
let dot_product a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let r = ref 0 in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
r := !r + (A.unsafe_get a i * A.unsafe_get b i)
|
||||
done;
|
||||
!r
|
||||
|
||||
let sum_elt a =
|
||||
let r = ref 0 in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
r := !r + A.unsafe_get a i
|
||||
done;
|
||||
!r
|
||||
|
||||
let product_elt a =
|
||||
let r = ref 1 in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
r := !r * A.unsafe_get a i
|
||||
done;
|
||||
!r
|
||||
|
||||
module Infix = struct
|
||||
let ( + ) a b = add a b
|
||||
let ( * ) a b = mult a b
|
||||
|
||||
let ( +! ) a x = scalar_add a ~x
|
||||
let ( *! ) a x = scalar_mult a ~x
|
||||
end
|
||||
|
||||
include Infix
|
||||
end
|
||||
|
||||
module Float = struct
|
||||
type elt = float
|
||||
type ('a, 'perm) t = (elt, 'a, 'perm) array_
|
||||
|
||||
let add ?res a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i +. A.unsafe_get b i)
|
||||
done;
|
||||
res
|
||||
|
||||
let mult ?res a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i *. A.unsafe_get b i)
|
||||
done;
|
||||
res
|
||||
|
||||
let scalar_add ?res a ~x =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i +. x)
|
||||
done;
|
||||
res
|
||||
|
||||
let scalar_mult ?res a ~x =
|
||||
let res = match res with
|
||||
| Some r ->
|
||||
if A.dim a <> A.dim r then raise WrongDimension;
|
||||
r
|
||||
| None -> make ~x:0. ~kind:(A.kind a) (A.dim a)
|
||||
in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
A.set res i (A.unsafe_get a i *. x)
|
||||
done;
|
||||
res
|
||||
|
||||
let dot_product a b =
|
||||
if A.dim a <> A.dim b then raise WrongDimension;
|
||||
let r = ref 0. in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
r := !r +. (A.unsafe_get a i *. A.unsafe_get b i)
|
||||
done;
|
||||
!r
|
||||
|
||||
let sum_elt a =
|
||||
let r = ref 0. in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
r := !r +. A.unsafe_get a i
|
||||
done;
|
||||
!r
|
||||
|
||||
let product_elt a =
|
||||
let r = ref 1. in
|
||||
for i = 0 to A.dim a - 1 do
|
||||
r := !r *. A.unsafe_get a i
|
||||
done;
|
||||
!r
|
||||
|
||||
module Infix = struct
|
||||
let ( + ) a b = add a b
|
||||
let ( * ) a b = mult a b
|
||||
|
||||
let ( +! ) a x = scalar_add a ~x
|
||||
let ( *! ) a x = scalar_mult a ~x
|
||||
end
|
||||
|
||||
include Infix
|
||||
end
|
||||
|
||||
let to_list a =
|
||||
let l = foldi (fun acc _ x -> x::acc) [] a in
|
||||
List.rev l
|
||||
|
||||
let to_array a =
|
||||
if A.dim a = 0 then [||]
|
||||
else (
|
||||
let b = Array.make (A.dim a) (A.get a 0) in
|
||||
for i = 1 to A.dim a - 1 do
|
||||
Array.unsafe_set b i (A.unsafe_get a i)
|
||||
done;
|
||||
b
|
||||
)
|
||||
|
||||
let to_seq a yield = iter a ~f:yield
|
||||
|
||||
let of_array ~kind a = A.of_array kind Bigarray.c_layout a
|
||||
|
||||
exception OfYojsonError of string
|
||||
|
||||
let to_yojson (f:'a -> json) a : json =
|
||||
let l = foldi (fun l _ x -> f x :: l) [] a in
|
||||
`List (List.rev l)
|
||||
|
||||
let int_to_yojson i = `Int i
|
||||
let int_of_yojson = function
|
||||
| `Int i -> `Ok i
|
||||
| `Float f -> `Ok (int_of_float f)
|
||||
| `String s -> (try `Ok (int_of_string s) with _ -> `Error "expected int")
|
||||
| _ -> `Error "expected int"
|
||||
|
||||
let float_to_yojson f = `Float f
|
||||
let float_of_yojson = function
|
||||
| `Float f -> `Ok f
|
||||
| `Int i -> `Ok (float_of_int i)
|
||||
| _ -> `Error "expected float"
|
||||
|
||||
let of_yojson
|
||||
~(kind:('a,'b) Bigarray.kind)
|
||||
(f: json -> 'a or_error)
|
||||
(j : json) : ('a,'b,'perm) t or_error
|
||||
=
|
||||
let unwrap_ = function
|
||||
| `Ok x -> x
|
||||
| `Error msg -> raise (OfYojsonError msg)
|
||||
in
|
||||
let map_l l = List.map (fun x -> unwrap_ (f x)) l
|
||||
and of_list l =
|
||||
let a = make ~kind (List.length l) in
|
||||
List.iteri (fun i b -> set a i b) l;
|
||||
a
|
||||
in
|
||||
try
|
||||
match j with
|
||||
| `List l -> `Ok (of_list (map_l l))
|
||||
| _ -> raise (OfYojsonError "invalid json (expected list)")
|
||||
with OfYojsonError msg ->
|
||||
`Error msg
|
||||
|
||||
|
||||
module View = struct
|
||||
type 'a t = {
|
||||
len : int;
|
||||
view : 'a view
|
||||
}
|
||||
and _ view =
|
||||
| Arr : ('a, _, _) array_ -> 'a view
|
||||
| Map : ('a -> 'b) * 'a t -> 'b view
|
||||
| Map2 : ('a -> 'b -> 'c) * 'a t * 'b t -> 'c view
|
||||
| Select : (int, _, _) array_ * 'a t -> 'a view
|
||||
| SelectA : int array * 'a t -> 'a view
|
||||
| SelectV : int t * 'a t -> 'a view
|
||||
| Raw :
|
||||
('a, 'b, [>`R]) array_ *
|
||||
(('a, 'b, [>`R]) array_ -> int) *
|
||||
(('a, 'b, [>`R]) array_ -> int -> 'a) ->
|
||||
'a view
|
||||
|
||||
let length t = t.len
|
||||
|
||||
let rec get
|
||||
: type a. a t -> int -> a
|
||||
= fun v i -> match v.view with
|
||||
| Arr a -> A.get a i
|
||||
| Map (f, a) -> f (get a i)
|
||||
| Map2 (f, a1, a2) -> f (get a1 i) (get a2 i)
|
||||
| Select (idx, a) -> get a (A.get idx i)
|
||||
| SelectA (idx, a) -> get a (Array.get idx i)
|
||||
| SelectV (idx, a) -> get a (get idx i)
|
||||
| Raw (a, _, f) -> f a i
|
||||
|
||||
let rec iteri
|
||||
: type a. f:(int -> a -> unit) -> a t -> unit
|
||||
= fun ~f v -> match v.view with
|
||||
| Arr a ->
|
||||
for i = 0 to A.dim a - 1 do
|
||||
f i (A.unsafe_get a i)
|
||||
done
|
||||
| Map (g, a') ->
|
||||
iteri a' ~f:(fun i x -> f i (g x))
|
||||
| Map2 (g, a1, a2) ->
|
||||
iteri a1 ~f:(fun i x -> let y = get a2 i in f i (g x y))
|
||||
| Select (idx, a) ->
|
||||
for i = 0 to A.dim idx - 1 do
|
||||
let j = A.unsafe_get idx i in
|
||||
f i (get a j)
|
||||
done
|
||||
| SelectA (idx, a) ->
|
||||
Array.iteri (fun i j -> f i (get a j)) idx
|
||||
| SelectV (idx, a) ->
|
||||
for i=0 to length idx - 1 do
|
||||
let j = get idx i in
|
||||
f i (get a j)
|
||||
done
|
||||
| Raw (a, len, g) ->
|
||||
for i=0 to len a - 1 do
|
||||
f i (g a i)
|
||||
done
|
||||
|
||||
let of_array a = {len=A.dim a; view=Arr a}
|
||||
|
||||
let map ~f a = {len=length a; view=Map(f, a)}
|
||||
let map2 ~f a b =
|
||||
if length a <> length b then raise WrongDimension;
|
||||
{len=length a; view=Map2(f, a, b)}
|
||||
|
||||
let select ~idx a = {len=A.dim idx; view=Select(idx,a)}
|
||||
let select_a ~idx a = {len=Array.length idx; view=SelectA(idx,a)}
|
||||
let select_view ~idx a = {len=length idx; view=SelectV(idx,a)}
|
||||
|
||||
let foldi f acc a =
|
||||
let acc = ref acc in
|
||||
iteri a ~f:(fun i x -> acc := f !acc i x);
|
||||
!acc
|
||||
|
||||
let raw ~length ~get a = {len=length a; view=Raw (a, length, get) }
|
||||
|
||||
module type S = sig
|
||||
type elt
|
||||
val mult : elt t -> elt t -> elt t
|
||||
val add : elt t -> elt t -> elt t
|
||||
val sum : elt t -> elt
|
||||
val prod : elt t -> elt
|
||||
val add_scalar : elt t -> x:elt -> elt t
|
||||
val mult_scalar : elt t -> x:elt -> elt t
|
||||
end
|
||||
|
||||
module Int = struct
|
||||
type elt = int
|
||||
let add a b = map2 ~f:(+) a b
|
||||
let mult a b = map2 ~f:( * ) a b
|
||||
let sum a = foldi (fun acc _ x -> acc+x) 0 a
|
||||
let prod a = foldi (fun acc _ x -> acc*x) 1 a
|
||||
let add_scalar a ~x = map ~f:(fun y -> x+y) a
|
||||
let mult_scalar a ~x = map ~f:(fun y -> x*y) a
|
||||
end
|
||||
|
||||
module Float = struct
|
||||
type elt = float
|
||||
let add a b = map2 ~f:(+.) a b
|
||||
let mult a b = map2 ~f:( *. ) a b
|
||||
let sum a = foldi (fun acc _ x -> acc+.x) 0. a
|
||||
let prod a = foldi (fun acc _ x -> acc*.x) 1. a
|
||||
let add_scalar a ~x = map ~f:(fun y -> x+.y) a
|
||||
let mult_scalar a ~x = map ~f:(fun y -> x*.y) a
|
||||
end
|
||||
|
||||
let to_array ?res ?kind a =
|
||||
let res = match res, kind with
|
||||
| Some r, None ->
|
||||
if A.dim r <> length a then raise WrongDimension;
|
||||
r
|
||||
| None, Some kind -> A.create kind Bigarray.c_layout (length a)
|
||||
| None, None
|
||||
| Some _, Some _ -> invalid_arg "View.to_array"
|
||||
in
|
||||
iteri a ~f:(fun i x -> A.unsafe_set res i x);
|
||||
res
|
||||
end
|
||||
|
|
@ -1,371 +0,0 @@
|
|||
(*
|
||||
copyright (c) 2013-2015, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*)
|
||||
|
||||
(** {1 Bigarrays of dimension 1}
|
||||
|
||||
@deprecated do not use, this was always experimental
|
||||
{b NOTE this module will be removed soon and should not be depended upon}
|
||||
|
||||
{b status: deprecated}
|
||||
@since 0.12 *)
|
||||
|
||||
(** {2 used types} *)
|
||||
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a or_error = [`Ok of 'a | `Error of string]
|
||||
type random = Random.State.t
|
||||
|
||||
type json = [ `Assoc of (string * json) list
|
||||
| `Bool of bool
|
||||
| `Float of float
|
||||
| `Int of int
|
||||
| `List of json list
|
||||
| `Null
|
||||
| `String of string ]
|
||||
type 'a to_json = 'a -> json
|
||||
type 'a of_json = json -> 'a or_error
|
||||
|
||||
(** {2 Type Declarations} *)
|
||||
|
||||
type ('a, 'b, 'perm) t constraint 'perm = [< `R | `W]
|
||||
(** Array of OCaml values of type ['a] with C representation of type [b']
|
||||
with permissions ['perm] *)
|
||||
|
||||
type ('a, 'b, 'perm) array_ = ('a, 'b, 'perm) t
|
||||
|
||||
exception WrongDimension
|
||||
(** Raised when arrays do not have expected length *)
|
||||
|
||||
(** {2 Basic Operations} *)
|
||||
|
||||
val make : ?x:'a -> kind:('a,'b) Bigarray.kind -> int -> ('a, 'b, 'perm) t
|
||||
(** New array with undefined elements
|
||||
@param kind the kind of bigarray
|
||||
@param x optional element to fill every slot
|
||||
@param n the number of elements *)
|
||||
|
||||
val make_int : int -> (int, Bigarray.int_elt, 'perm) t
|
||||
val make_char : int -> (char, Bigarray.int8_unsigned_elt, 'perm) t
|
||||
val make_int8s : int -> (int, Bigarray.int8_signed_elt, 'perm) t
|
||||
val make_int8u : int -> (int, Bigarray.int8_unsigned_elt, 'perm) t
|
||||
val make_int16s : int -> (int, Bigarray.int16_signed_elt, 'perm) t
|
||||
val make_int16u : int -> (int, Bigarray.int16_unsigned_elt, 'perm) t
|
||||
val make_int32 : int -> (int32, Bigarray.int32_elt, 'perm) t
|
||||
val make_int64 : int -> (int64, Bigarray.int64_elt, 'perm) t
|
||||
val make_native : int -> (nativeint, Bigarray.nativeint_elt, 'perm) t
|
||||
val make_float32 : int -> (float, Bigarray.float32_elt, 'perm) t
|
||||
val make_float64 : int -> (float, Bigarray.float64_elt, 'perm) t
|
||||
val make_complex32 : int -> (Complex.t, Bigarray.complex32_elt, 'perm) t
|
||||
val make_complex64 : int -> (Complex.t, Bigarray.complex64_elt, 'perm) t
|
||||
|
||||
val init : kind:('a, 'b) Bigarray.kind -> f:(int -> 'a) -> int -> ('a, 'b, 'perm) t
|
||||
(** Initialize with given size and initialization function *)
|
||||
|
||||
val of_bigarray : ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t -> ('a, 'b, 'perm) t
|
||||
(** Convert from a big array *)
|
||||
|
||||
val to_bigarray : ('a, 'b, [`R | `W]) t -> ('a, 'b, Bigarray.c_layout) Bigarray.Array1.t
|
||||
(** Obtain the underlying array *)
|
||||
|
||||
val ro : ('a, 'b, [>`R]) t -> ('a, 'b, [`R]) t
|
||||
(** Change permission (old reference to array might still be mutable!) *)
|
||||
|
||||
val wo : ('a, 'b, [>`W]) t -> ('a, 'b, [`W]) t
|
||||
(** Change permission *)
|
||||
|
||||
val length : (_, _, [>`R]) t -> int
|
||||
(** Number of elements *)
|
||||
|
||||
val set : ('a, _, [>`W]) t -> int -> 'a -> unit
|
||||
(** set n-th element *)
|
||||
|
||||
val get : ('a, _, [>`R]) t -> int -> 'a
|
||||
(** Get n-th element *)
|
||||
|
||||
val fill : ('a, _, [>`W]) t -> 'a -> unit
|
||||
(** [fill a x] fills [a] with [x] *)
|
||||
|
||||
val sub : ('a, 'b, 'perm) t -> int -> int -> ('a, 'b, 'perm) t
|
||||
(** [sub a i len] takes the slice of length [len] starting at offset [i] *)
|
||||
|
||||
val blit : ('a, 'b, [>`R]) t -> ('a, 'b, [>`W]) t -> unit
|
||||
(** blit the first array to the second *)
|
||||
|
||||
val copy : ('a, 'b, [>`R]) t -> ('a, 'b, 'perm) t
|
||||
(** Fresh copy *)
|
||||
|
||||
val iter : f:('a -> unit) -> ('a, _, [>`R]) t -> unit
|
||||
(** [iter a ~f] calls [f v] where [get a i = v] for each [i < length a].
|
||||
It iterates on all bits in increasing order *)
|
||||
|
||||
val iteri : f:(int -> 'a -> unit) -> ('a, _, [>`R]) t -> unit
|
||||
(** [iteri a ~f] calls [f i v] where [get a i = v] for each [i < length a].
|
||||
It iterates on all elements in increasing order *)
|
||||
|
||||
val foldi : ('b -> int -> 'a -> 'b) -> 'b -> ('a, _, [>`R]) t -> 'b
|
||||
|
||||
val for_all : f:('a -> bool) -> ('a, _, [>`R]) t -> bool
|
||||
|
||||
val exists : f:('a -> bool) -> ('a, _, [>`R]) t -> bool
|
||||
|
||||
val pp : 'a printer -> ('a, _, [>`R]) t printer
|
||||
(** Print the SDR nicely *)
|
||||
|
||||
(** {2 Boolean Vectors} *)
|
||||
|
||||
module Bool : sig
|
||||
type ('b, 'perm) t = (int, 'b, 'perm) array_
|
||||
(** A simple bitvector based on some integral type ['b] *)
|
||||
|
||||
val get : (_, [>`R]) t -> int -> bool
|
||||
|
||||
val set : (_, [>`W]) t -> int -> bool -> unit
|
||||
|
||||
val zeroes : int -> (Bigarray.int8_unsigned_elt, 'perm) t
|
||||
val ones : int -> (Bigarray.int8_unsigned_elt, 'perm) t
|
||||
|
||||
val iter_zeroes : f:(int -> unit) -> (_, [>`R]) t -> unit
|
||||
(** [iter_ones ~f a] calls [f i] for every index [i] such that [get a i = false] *)
|
||||
|
||||
val iter_ones : f:(int -> unit) -> (_, [>`R]) t -> unit
|
||||
(** [iter_ones ~f a] calls [f i] for every index [i] such that [get a i = true] *)
|
||||
|
||||
val cardinal : (_, [>`R]) t -> int
|
||||
(** Number of ones *)
|
||||
|
||||
val pp : (_,[>`R]) t printer
|
||||
(** Print the bitvector nicely *)
|
||||
|
||||
(** {6 Operations} *)
|
||||
|
||||
val or_ : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, [>`R]) t -> ('b, 'perm) t
|
||||
(** [or_ a b ~into] puts the boolean "or" of [a] and [b] in [into]
|
||||
expects [length into = max (length a) (length b)]
|
||||
@raise WrongDimension if dimensions do not match *)
|
||||
|
||||
val and_ : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, [>`R]) t -> ('b, 'perm) t
|
||||
(** Boolean conjunction. See {!or} for the parameters *)
|
||||
|
||||
val not_ : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, 'perm) t
|
||||
(** Boolean negation (negation of a 0 becomes a 1) *)
|
||||
|
||||
val mix : ?res:('b, [>`W] as 'perm) t -> ('b, [>`R]) t -> ('b, [>`R]) t -> ('b, 'perm) t
|
||||
(** [mix a b ~into] assumes [length a + length b = length into] and
|
||||
mixes (interleaves) bits of [a] and [b] in [into].
|
||||
@raise WrongDimension if dimensions do not match *)
|
||||
|
||||
val convolution : ?res:('b, [>`W] as 'perm) t -> ('b,[>`R]) t -> by:('b, [>`R]) t -> ('b,'perm) t
|
||||
(** [convolution a ~by:b ~into] assumes [length into = length a >= length b]
|
||||
and computes the boolean convolution of [a] by [b]
|
||||
@raise WrongDimension if dimensions do not match *)
|
||||
end
|
||||
|
||||
(** {2 Operations} *)
|
||||
|
||||
val map :
|
||||
?res:('a, 'b, ([>`W] as 'perm)) t ->
|
||||
f:('a -> 'a) ->
|
||||
('a, 'b, [>`R]) t ->
|
||||
('a, 'b, 'perm) t
|
||||
|
||||
val map2 :
|
||||
?res:('a, 'b, ([>`W] as 'perm)) t ->
|
||||
f:('a -> 'a2 -> 'a) ->
|
||||
('a, 'b, [>`R]) t ->
|
||||
('a2, _, [>`R]) t ->
|
||||
('a, 'b, 'perm) t
|
||||
|
||||
val append :
|
||||
?res:('a, 'b, ([>`W] as 'perm)) t ->
|
||||
('a, 'b, [>`R]) t ->
|
||||
('a, 'b, [>`R]) t ->
|
||||
('a, 'b, 'perm) t
|
||||
(** [append a b ~into] assumes [length a + length b = length into] and
|
||||
copies [a] and [b] side by side in [into]
|
||||
@raise WrongDimension if dimensions do not match *)
|
||||
|
||||
val filter :
|
||||
?res:(Bigarray.int8_unsigned_elt, [>`W] as 'perm) Bool.t ->
|
||||
f:('a -> bool) ->
|
||||
('a, 'b, [>`R]) t ->
|
||||
(Bigarray.int8_unsigned_elt, 'perm) Bool.t
|
||||
|
||||
module type S = sig
|
||||
type elt
|
||||
type ('a, 'perm) t = (elt, 'a, 'perm) array_
|
||||
|
||||
val add :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, 'perm) t
|
||||
(** Elementwise sum
|
||||
@raise WrongDimension if dimensions do not fit *)
|
||||
|
||||
val mult :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, [>`R]) t ->
|
||||
('a, 'perm) t
|
||||
(** Elementwise product *)
|
||||
|
||||
val scalar_add :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
x:elt ->
|
||||
('a, 'perm) t
|
||||
(** @raise WrongDimension if dimensions do not fit *)
|
||||
|
||||
val scalar_mult :
|
||||
?res:('a, [>`W] as 'perm) t ->
|
||||
('a, [>`R]) t ->
|
||||
x:elt ->
|
||||
('a, 'perm) t
|
||||
(** @raise WrongDimension if dimensions do not fit *)
|
||||
|
||||
val sum_elt : (_, [>`R]) t -> elt
|
||||
(** Efficient sum of elements *)
|
||||
|
||||
val product_elt : (_, [>`R]) t -> elt
|
||||
(** Efficient product of elements *)
|
||||
|
||||
val dot_product : (_, [>`R]) t -> (_, [>`R]) t -> elt
|
||||
(** [dot_product a b] returns [sum_i a(i)*b(i)] with the given
|
||||
sum and product, on [elt].
|
||||
[dot_product a b = sum_elt (product a b)]
|
||||
@raise WrongDimension if [a] and [b] do not have the same size *)
|
||||
|
||||
module Infix : sig
|
||||
val ( * ) : ('a, [>`R]) t -> ('a, [>`R]) t -> ('a, 'perm) t
|
||||
(** Alias to {!mult} *)
|
||||
|
||||
val ( + ) : ('a, [>`R]) t -> (_, [>`R]) t -> ('a, 'perm) t
|
||||
(** Alias to {!add} *)
|
||||
|
||||
val ( *! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
|
||||
(** Alias to {!scalar_mult} *)
|
||||
|
||||
val ( +! ) : ('a, [>`R]) t -> elt -> ('a, 'perm) t
|
||||
(** Alias to {!scalar_add} *)
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
end
|
||||
|
||||
module Int : S with type elt = int
|
||||
|
||||
module Float : S with type elt = float
|
||||
|
||||
(** {2 Conversions} *)
|
||||
|
||||
val to_list : ('a, _, [>`R]) t -> 'a list
|
||||
val to_array : ('a, _, [>`R]) t -> 'a array
|
||||
val to_seq : ('a, _, [>`R]) t -> 'a sequence
|
||||
|
||||
val of_array : kind:('a, 'b) Bigarray.kind -> 'a array -> ('a, 'b, 'perm) t
|
||||
|
||||
(** {2 Serialization} *)
|
||||
|
||||
val to_yojson : 'a to_json -> ('a, _, [>`R]) t to_json
|
||||
val of_yojson : kind:('a, 'b) Bigarray.kind -> 'a of_json -> ('a, 'b, 'perm) t of_json
|
||||
|
||||
val int_to_yojson : int to_json
|
||||
val int_of_yojson : int of_json
|
||||
val float_to_yojson : float to_json
|
||||
val float_of_yojson : float of_json
|
||||
|
||||
(** {2 Views} *)
|
||||
|
||||
module View : sig
|
||||
type 'a t
|
||||
(** A view on an array or part of an array *)
|
||||
|
||||
val of_array : ('a, _, [>`R]) array_ -> 'a t
|
||||
|
||||
val get : 'a t -> int -> 'a
|
||||
(** [get v i] returns the [i]-th element of [v]. Caution, this is not
|
||||
as cheap as a regular array indexing, and it might involve recursion.
|
||||
@raise Invalid_argument if index out of bounds *)
|
||||
|
||||
val length : _ t -> int
|
||||
(** [length v] is the number of elements of [v] *)
|
||||
|
||||
val map : f:('a -> 'b) -> 'a t -> 'b t
|
||||
(** Map values *)
|
||||
|
||||
val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
|
||||
(** Map values
|
||||
@raise WrongDimension if lengths do not fit *)
|
||||
|
||||
val select : idx:(int, _, [>`R]) array_ -> 'a t -> 'a t
|
||||
(** [select ~idx v] is the view that has length [length idx]
|
||||
and such that [get (select ~idx a) i = get a (get idx i)] *)
|
||||
|
||||
val select_a : idx:int array -> 'a t -> 'a t
|
||||
(** See {!select} *)
|
||||
|
||||
val select_view : idx:int t -> 'a t -> 'a t
|
||||
(** See {!select} *)
|
||||
|
||||
val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
|
||||
(** Fold on values with their index *)
|
||||
|
||||
val iteri : f:(int -> 'a -> unit) -> 'a t -> unit
|
||||
(** [iteri ~f v] iterates on elements of [v] with their index *)
|
||||
|
||||
module type S = sig
|
||||
type elt
|
||||
val mult : elt t -> elt t -> elt t
|
||||
val add : elt t -> elt t -> elt t
|
||||
val sum : elt t -> elt
|
||||
val prod : elt t -> elt
|
||||
val add_scalar : elt t -> x:elt -> elt t
|
||||
val mult_scalar : elt t -> x:elt -> elt t
|
||||
end
|
||||
|
||||
module Int : sig
|
||||
include S with type elt = int
|
||||
end
|
||||
|
||||
module Float : sig
|
||||
include S with type elt = float
|
||||
(* TODO: more, like trigo functions *)
|
||||
end
|
||||
|
||||
val raw :
|
||||
length:(('a, 'b, [>`R]) array_ -> int) ->
|
||||
get:(('a, 'b, [>`R]) array_ -> int -> 'a) ->
|
||||
('a, 'b, [>`R]) array_ ->
|
||||
'a t
|
||||
|
||||
val to_array :
|
||||
?res:('a, 'b, [>`W] as 'perm) array_ ->
|
||||
?kind:('a, 'b) Bigarray.kind ->
|
||||
'a t ->
|
||||
('a, 'b, 'perm) array_
|
||||
(** [to_array v] returns a fresh copy of the content of [v].
|
||||
Exactly one of [res] and [kind] must be provided *)
|
||||
end
|
||||
|
|
@ -1,213 +0,0 @@
|
|||
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(** {1 Interface to 1-dimension Bigarrays of bytes (char)} *)
|
||||
|
||||
module B = Bigarray.Array1
|
||||
|
||||
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
|
||||
|
||||
let create size = B.create Bigarray.char Bigarray.c_layout size
|
||||
|
||||
let empty = create 0
|
||||
|
||||
let init size f =
|
||||
let a = create size in
|
||||
for i = 0 to size-1 do
|
||||
B.unsafe_set a i (f i)
|
||||
done;
|
||||
a
|
||||
|
||||
let fill = B.fill
|
||||
|
||||
let get = B.get
|
||||
|
||||
let set = B.set
|
||||
|
||||
let size = B.dim
|
||||
let length = B.dim
|
||||
|
||||
let sub = B.sub
|
||||
|
||||
let blit a i b j len =
|
||||
let a' = sub a i len in
|
||||
let b' = sub b j len in
|
||||
B.blit a' b'
|
||||
|
||||
let copy a =
|
||||
let b = create (size a) in
|
||||
B.blit a b;
|
||||
b
|
||||
|
||||
(*$T
|
||||
copy (of_string "abcd") |> to_string = "abcd"
|
||||
*)
|
||||
|
||||
let fold f acc a =
|
||||
let rec fold' f acc a i len =
|
||||
if i = len then acc
|
||||
else
|
||||
let acc = f acc (get a i) in
|
||||
fold' f acc a (i+1) len
|
||||
in
|
||||
fold' f acc a 0 (size a)
|
||||
|
||||
let iter f a =
|
||||
let n = size a in
|
||||
for i = 0 to n-1 do
|
||||
f (get a i)
|
||||
done
|
||||
|
||||
let rec equal_rec a b i len =
|
||||
i = len
|
||||
||
|
||||
( get a i = get b i && equal_rec a b (i+1) len)
|
||||
|
||||
let equal a b =
|
||||
size a = size b
|
||||
&&
|
||||
equal_rec a b 0 (size a)
|
||||
|
||||
(*$Q
|
||||
Q.(pair printable_string printable_string) (fun (s1, s2) -> \
|
||||
let a1 = of_string s1 and a2 = of_string s2 in \
|
||||
equal a1 a2 = (s1 = s2))
|
||||
*)
|
||||
|
||||
let rec compare_rec a b i len_a len_b =
|
||||
if i=len_a && i=len_b then 0
|
||||
else if i=len_a then -1
|
||||
else if i=len_b then 1
|
||||
else
|
||||
match Char.compare (get a i) (get b i) with
|
||||
| 0 -> compare_rec a b (i+1) len_a len_b
|
||||
| n -> n
|
||||
|
||||
let compare a b =
|
||||
compare_rec a b 0 (size a) (size b)
|
||||
|
||||
(*$T
|
||||
compare (of_string "abc") (of_string "abd") < 0
|
||||
compare (of_string "abc") (of_string "abcd") < 0
|
||||
compare (of_string "abcd") (of_string "abc") > 0
|
||||
compare (of_string "abc") (of_string "b") < 0
|
||||
*)
|
||||
|
||||
(*$Q
|
||||
Q.(pair string string) (fun (s1, s2) -> \
|
||||
let a1 = of_string s1 and a2 = of_string s2 in \
|
||||
CCInt.sign (compare a1 a2) = CCInt.sign (String.compare s1 s2))
|
||||
*)
|
||||
|
||||
(** {2 Conversions} *)
|
||||
|
||||
let to_bytes a =
|
||||
Bytes.init (size a) (fun i -> B.unsafe_get a i)
|
||||
|
||||
let of_bytes b =
|
||||
init (Bytes.length b) (fun i -> Bytes.get b i)
|
||||
|
||||
let of_bytes_slice b i len =
|
||||
if i < 0 || i+len > Bytes.length b then invalid_arg "CCBigstring";
|
||||
init len (fun j -> Bytes.get b (i+j))
|
||||
|
||||
let sub_bytes a i len =
|
||||
if i < 0 || i+len > size a then invalid_arg "CCBigstring";
|
||||
Bytes.init len (fun j -> B.get a (i+j))
|
||||
|
||||
let blit_to_bytes a i b j len =
|
||||
if i < 0 || j < 0 || i+len > size a || j+len > Bytes.length b
|
||||
then invalid_arg "CCBigstring";
|
||||
for x=0 to len-1 do
|
||||
Bytes.set b (j+x) (B.get a (i+x))
|
||||
done
|
||||
|
||||
let blit_of_bytes a i b j len =
|
||||
if i < 0 || j < 0 || i+len > Bytes.length a || j+len > size b
|
||||
then invalid_arg "CCBigstring";
|
||||
for x=0 to len-1 do
|
||||
B.set b (j+x) (Bytes.get a (i+x))
|
||||
done
|
||||
|
||||
let to_string a =
|
||||
CCString.init (size a) (fun i -> B.unsafe_get a i)
|
||||
|
||||
let of_string s =
|
||||
init (String.length s) (fun i -> String.get s i)
|
||||
|
||||
let of_string_slice s i len =
|
||||
if i < 0 || i+len > String.length s then invalid_arg "CCBigstring";
|
||||
init len (fun j -> String.get s (i+j))
|
||||
|
||||
let sub_string a i len =
|
||||
if i < 0 || i+len > size a then invalid_arg "CCBigstring";
|
||||
CCString.init len (fun j -> B.get a (i+j))
|
||||
|
||||
(*$T
|
||||
of_string_slice "abcde" 1 3 |> to_string = "bcd"
|
||||
*)
|
||||
|
||||
let blit_of_string a i b j len =
|
||||
if i < 0 || j < 0 || i+len > String.length a || j+len > size b
|
||||
then invalid_arg "CCBigstring";
|
||||
for x=0 to len-1 do
|
||||
B.set b (j+x) (String.get a (i+x))
|
||||
done
|
||||
|
||||
type 'a gen = unit -> 'a option
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
let to_seq a k = iter k a
|
||||
|
||||
let to_gen a =
|
||||
let i = ref 0 in
|
||||
let n = size a in
|
||||
fun () ->
|
||||
if !i = n then None
|
||||
else (
|
||||
let x = get a !i in
|
||||
incr i;
|
||||
Some x
|
||||
)
|
||||
|
||||
(*$T
|
||||
of_string "abcd" |> to_gen |> Gen.to_string = "abcd"
|
||||
*)
|
||||
|
||||
let to_seq_slice a i len =
|
||||
to_seq (sub a i len)
|
||||
|
||||
let to_gen_slice a i len =
|
||||
to_gen (sub a i len)
|
||||
|
||||
let print out s =
|
||||
Format.pp_print_string out "bigstring \"";
|
||||
iter
|
||||
(function
|
||||
| '\n' -> Format.pp_print_string out "\\n"
|
||||
| '\t' -> Format.pp_print_string out "\\t"
|
||||
| '\\' -> Format.pp_print_string out "\\\\"
|
||||
| c -> Format.pp_print_char out c
|
||||
) s;
|
||||
Format.pp_print_char out '"'
|
||||
|
||||
(** {2 Memory-map} *)
|
||||
|
||||
let map_file_descr ?pos ?(shared=false) fd len =
|
||||
B.map_file fd ?pos Bigarray.char Bigarray.c_layout shared len
|
||||
|
||||
let with_map_file ?pos ?len ?(mode=0o644) ?(flags=[Open_rdonly]) ?shared name f =
|
||||
let ic = open_in_gen flags mode name in
|
||||
let len = match len with
|
||||
| None -> in_channel_length ic
|
||||
| Some n -> n
|
||||
in
|
||||
let a = map_file_descr ?pos ?shared (Unix.descr_of_in_channel ic) len in
|
||||
try
|
||||
let x = f a in
|
||||
close_in ic;
|
||||
x
|
||||
with e ->
|
||||
close_in ic;
|
||||
raise e
|
||||
|
|
@ -1,116 +0,0 @@
|
|||
|
||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
(** {1 Interface to 1-dimension Bigarrays of bytes (char)}
|
||||
|
||||
@deprecated use the package [bigstring] instead.
|
||||
|
||||
{b status: deprecated, do not use anymore}
|
||||
|
||||
@since 0.7 *)
|
||||
|
||||
type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
|
||||
|
||||
val create : int -> t
|
||||
(** Create a new bigstring of the given size. *)
|
||||
|
||||
val empty : t
|
||||
(** Empty string *)
|
||||
|
||||
val init : int -> (int -> char) -> t
|
||||
(** Initialize with the given function (called at every index) *)
|
||||
|
||||
val fill : t -> char -> unit
|
||||
(** Fill with a single byte *)
|
||||
|
||||
val size : t -> int
|
||||
(** Number of bytes *)
|
||||
|
||||
val length : t -> int
|
||||
(** Alias for [size].
|
||||
@since 0.8 *)
|
||||
|
||||
val get : t -> int -> char
|
||||
|
||||
val set : t -> int -> char -> unit
|
||||
|
||||
val blit : t -> int -> t -> int -> int -> unit
|
||||
(** Blit a slice of the bigstring into another *)
|
||||
|
||||
val copy : t -> t
|
||||
(** Copy of the string *)
|
||||
|
||||
val sub : t -> int -> int -> t
|
||||
(** [sub s i len] takes a slice of length [len] from the string [s], starting
|
||||
at offset [i].
|
||||
@raise Invalid_argument if [i, len] doesn't designate a valid substring *)
|
||||
|
||||
val fold : ('a -> char -> 'a) -> 'a -> t -> 'a
|
||||
|
||||
val iter : (char -> unit) -> t -> unit
|
||||
|
||||
val equal : t -> t -> bool
|
||||
|
||||
val compare : t -> t -> int
|
||||
(** Lexicographic order *)
|
||||
|
||||
(** {2 Conversions} *)
|
||||
|
||||
val to_bytes : t -> Bytes.t
|
||||
|
||||
val of_bytes : Bytes.t -> t
|
||||
|
||||
val of_bytes_slice : Bytes.t -> int -> int -> t
|
||||
|
||||
val sub_bytes : t -> int -> int -> Bytes.t
|
||||
|
||||
val blit_to_bytes : t -> int -> Bytes.t -> int -> int -> unit
|
||||
|
||||
val blit_of_bytes : Bytes.t -> int -> t -> int -> int -> unit
|
||||
|
||||
val to_string : t -> string
|
||||
|
||||
val of_string : string -> t
|
||||
|
||||
val of_string_slice : string -> int -> int -> t
|
||||
|
||||
val sub_string : t -> int -> int -> string
|
||||
|
||||
val blit_of_string : string -> int -> t -> int -> int -> unit
|
||||
|
||||
type 'a gen = unit -> 'a option
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
val to_seq : t -> char sequence
|
||||
|
||||
val to_gen : t -> char gen
|
||||
|
||||
val to_seq_slice : t -> int -> int -> char sequence
|
||||
|
||||
val to_gen_slice : t -> int -> int -> char gen
|
||||
|
||||
val print : t printer
|
||||
(** @since 0.13 *)
|
||||
|
||||
(** {2 Memory-map} *)
|
||||
|
||||
val with_map_file :
|
||||
?pos:int64 -> ?len:int -> ?mode:int -> ?flags:open_flag list -> ?shared:bool ->
|
||||
string -> (t -> 'a) -> 'a
|
||||
(** [with_map_file name f] maps the file into memory, opening it, and
|
||||
call [f] with a slice [pos.... pos+len] of the bytes of the file
|
||||
where [len] is the length of the file if not provided.
|
||||
When [f] returns, the file is closed.
|
||||
@param pos offset in the file (default 0)
|
||||
@param shared if true, modifications are shared between processes that
|
||||
have mapped this file (requires the filedescr to be open in write mode).
|
||||
@param mode the mode for the file, if it's created
|
||||
@param flags opening flags (default rdonly)
|
||||
see {!Bigarray.Array1.map_file} for more details *)
|
||||
|
||||
val map_file_descr : ?pos:int64 -> ?shared:bool -> Unix.file_descr -> int -> t
|
||||
(** [map_file_descr descr len] is a lower-level access to an underlying file descriptor.
|
||||
@param shared if true, modifications are shared between processes that
|
||||
have mapped this file (requires the filedescr to be open in write mode).
|
||||
see {!Bigarray.Array1.map_file} for more details *)
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
(** {!CCIO} has moved into {!Containers}, the main library.
|
||||
|
||||
The reason is that it has no additional dependency and is arguably a
|
||||
useful completement to parts of {!Pervasives} (the channel management)
|
||||
|
||||
As a result, linking "containers" rather than "containers.io" should be
|
||||
enough if one needs {!CCIO}. *)
|
||||
Loading…
Add table
Reference in a new issue