Skip to content

Commit

Permalink
Minor refactoring around code structuring.
Browse files Browse the repository at this point in the history
- Trim whitespace
- compact multi-line code into one where possible.
  • Loading branch information
zoj613 committed Dec 23, 2024
1 parent 155b66c commit 00ade96
Show file tree
Hide file tree
Showing 10 changed files with 92 additions and 192 deletions.
9 changes: 2 additions & 7 deletions zarr-eio/src/storage.ml
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,7 @@ module FilesystemStore = struct
type t = {root : Eio.Fs.dir_ty Eio.Path.t; perm : Eio.File.Unix_perm.t}

let fspath_to_key t (path : Eio.Fs.dir_ty Eio.Path.t) =
let s = snd path in
let pos = String.length (snd t.root) + 1 in
let s = snd path and pos = String.length (snd t.root) + 1 in
String.sub s pos (String.length s - pos)

let key_to_fspath t key = Eio.Path.(t.root / key)
Expand Down Expand Up @@ -98,12 +97,10 @@ module FilesystemStore = struct
List.fold_left (add ~t ~dir) acc (Eio.Path.read_dir dir)

let list t = walk t [] t.root

let list_prefix t prefix = walk t [] (key_to_fspath t prefix)

let is_member t key = Eio.Path.is_file (key_to_fspath t key)

let erase t key = Eio.Path.unlink (key_to_fspath t key)
let rename t k k' = Eio.Path.rename (key_to_fspath t k) (key_to_fspath t k')

let erase_prefix t pre =
(* if prefix points to the root of the store, only delete sub-dirs and files.*)
Expand All @@ -119,8 +116,6 @@ module FilesystemStore = struct
in
let dir = key_to_fspath t prefix in
List.partition_map (choose ~t ~dir) (Eio.Path.read_dir dir)

let rename t k k' = Eio.Path.rename (key_to_fspath t k) (key_to_fspath t k')
end

let create ?(perm=0o700) ~env dirname =
Expand Down
22 changes: 8 additions & 14 deletions zarr-lwt/src/storage.ml
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ module Deferred = struct
let return_unit = Lwt.return_unit
let iter = Lwt_list.iter_s
let fold_left = Lwt_list.fold_left_s
let concat_map f l = Lwt.map List.concat (Lwt_list.map_s f l)
let concat_map f l = Lwt.map List.concat (Lwt_list.map_p f l)

module Infix = struct
let (>>=) = Lwt.Infix.(>>=)
Expand Down Expand Up @@ -47,8 +47,8 @@ module FilesystemStore = struct
Lwt_unix.file_exists parent_dir >>= maybe_create ~perm parent_dir

let size t key =
let file_length path () = Lwt.map Int64.to_int (Lwt_io.file_length path) in
let filepath = key_to_fspath t key in
let file_length path () = Lwt.map Int64.to_int (Lwt_io.file_length path)
and filepath = key_to_fspath t key in
Lwt.catch (file_length filepath) (Fun.const @@ Deferred.return 0)

let get t key =
Expand Down Expand Up @@ -126,16 +126,6 @@ module FilesystemStore = struct
in
Lwt_stream.fold_s (accumulate ~t) (Lwt_unix.files_of_directory dir) acc

let list t = walk t [] (key_to_fspath t "")

let list_prefix t prefix = walk t [] (key_to_fspath t prefix)

let is_member t key = Lwt_unix.file_exists (key_to_fspath t key)

let erase t key = Lwt_unix.unlink (key_to_fspath t key)

let erase_prefix t pre = list_prefix t pre >>= Lwt_list.iter_s (erase t)

let list_dir t prefix =
let choose ~t ~dir x = match Filename.concat dir x with
| p when Sys.is_directory p -> Either.right @@ (fspath_to_key t p) ^ "/"
Expand All @@ -147,6 +137,11 @@ module FilesystemStore = struct
let+ dir_contents = Lwt_stream.to_list relevant in
List.partition_map (choose ~t ~dir) dir_contents

let list t = walk t [] (key_to_fspath t "")
let list_prefix t prefix = walk t [] (key_to_fspath t prefix)
let is_member t key = Lwt_unix.file_exists (key_to_fspath t key)
let erase t key = Lwt_unix.unlink (key_to_fspath t key)
let erase_prefix t pre = list_prefix t pre >>= Lwt_list.iter_s (erase t)
let rename t k k' = Lwt_unix.rename (key_to_fspath t k) (key_to_fspath t k')
end

Expand Down Expand Up @@ -192,7 +187,6 @@ module AmazonS3Store = struct
Lwt.catch (return_or_raise res) (on_exception ~not_found)

let raise_not_found k () = raise (Zarr.Storage.Key_not_found k)

let empty_Ls = Fun.const ([], S3.Ls.Done)

let fold_continuation ~return ~more = function
Expand Down
12 changes: 4 additions & 8 deletions zarr-sync/src/storage.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ module FilesystemStore = struct
module IO = struct
module Deferred = Deferred

type t = {dirname : string; perm : Unix.file_perm}
type t = {dirname : string; perm : int}

let fspath_to_key t path =
let pos = String.length t.dirname + 1 in
Expand Down Expand Up @@ -72,7 +72,6 @@ module FilesystemStore = struct
Out_channel.flush oc

let is_member t key = Sys.file_exists (key_to_fspath t key)

let erase t key = Sys.remove (key_to_fspath t key)

let size t key =
Expand All @@ -88,12 +87,6 @@ module FilesystemStore = struct
let dir_contents = Array.to_list (Sys.readdir dir) in
List.fold_left (accumulate ~t) acc dir_contents

let list t = walk t [] (key_to_fspath t "")

let list_prefix t prefix = walk t [] (key_to_fspath t prefix)

let erase_prefix t pre = List.iter (erase t) (list_prefix t pre)

let list_dir t prefix =
let choose ~t ~dir x = match Filename.concat dir x with
| p when Sys.is_directory p -> Either.right @@ (fspath_to_key t p) ^ "/"
Expand All @@ -103,6 +96,9 @@ module FilesystemStore = struct
let dir_contents = Array.to_list (Sys.readdir dir) in
List.partition_map (choose ~t ~dir) dir_contents

let list t = walk t [] (key_to_fspath t "")
let list_prefix t prefix = walk t [] (key_to_fspath t prefix)
let erase_prefix t pre = List.iter (erase t) (list_prefix t pre)
let rename t k k' = Sys.rename (key_to_fspath t k) (key_to_fspath t k')
end

Expand Down
16 changes: 5 additions & 11 deletions zarr/src/extensions.ml
Original file line number Diff line number Diff line change
Expand Up @@ -4,21 +4,17 @@ module RegularGrid = struct
type t = int array

let chunk_shape : t -> int array = Fun.id
let ceildiv x y = Float.(to_int @@ ceil (of_int x /. of_int y))
let floordiv x y = Float.(to_int @@ floor (of_int x /. of_int y))
let grid_shape t array_shape = Array.map2 ceildiv array_shape t
let index_coord_pair t coord = (Array.map2 floordiv coord t, Array.map2 Int.rem coord t)
let ( = ) x y = x = y

let create : array_shape:int array -> int array -> t
= fun ~array_shape chunk_shape ->
if Array.(length chunk_shape <> length array_shape) || Util.(max chunk_shape > max array_shape)
then raise Grid_shape_mismatch else chunk_shape

let ceildiv x y = Float.(to_int @@ ceil (of_int x /. of_int y))

let floordiv x y = Float.(to_int @@ floor (of_int x /. of_int y))

let grid_shape t array_shape = Array.map2 ceildiv array_shape t

let index_coord_pair t coord =
(Array.map2 floordiv coord t, Array.map2 Int.rem coord t)

(* returns all chunk indices in this regular grid *)
let indices t array_shape =
grid_shape t array_shape
Expand All @@ -27,8 +23,6 @@ module RegularGrid = struct
|> Ndarray.Indexing.cartesian_prod
|> List.map Array.of_list

let ( = ) x y = x = y

let to_yojson : t -> Yojson.Safe.t = fun t ->
let chunk_shape = `List (List.map (fun x -> `Int x) @@ Array.to_list t) in
`Assoc
Expand Down
27 changes: 7 additions & 20 deletions zarr/src/metadata.ml
Original file line number Diff line number Diff line change
Expand Up @@ -236,31 +236,21 @@ module Array = struct
&& x.storage_transformers = y.storage_transformers

let shape t = t.shape

let codecs t = t.codecs

let dimension_names t = t.dimension_names

let attributes t = t.attributes

let chunk_shape t = RegularGrid.chunk_shape t.chunk_grid

let index_coord_pair t coord = RegularGrid.index_coord_pair t.chunk_grid coord

let chunk_key t index = ChunkKeyEncoding.encode t.chunk_key_encoding index

let chunk_indices t shape = RegularGrid.indices t.chunk_grid shape

let encode t = Yojson.Safe.to_string (to_yojson t)
let update_attributes t attrs = {t with attributes = attrs}
let update_shape t shape = {t with shape}

let decode s = match of_yojson (Yojson.Safe.from_string s) with
| Error e -> raise (Parse_error e)
| Ok m -> m

let update_attributes t attrs = {t with attributes = attrs}

let update_shape t shape = {t with shape}

let is_valid_kind
: type a. t -> a Ndarray.dtype -> bool
= fun t kind -> match kind, t.data_type with
Expand Down Expand Up @@ -317,14 +307,17 @@ end
module Group = struct
type t = {zarr_format : int; node_type : string; attributes : Yojson.Safe.t}

let default = {zarr_format = 3; node_type = "group"; attributes = `Null}

let to_yojson : t -> Yojson.Safe.t = fun t ->
let l = [("zarr_format", `Int t.zarr_format); ("node_type", `String t.node_type)] in
match t.attributes with
| `Null -> `Assoc l
| x -> `Assoc (l @ [("attributes", x)])

let default = {zarr_format = 3; node_type = "group"; attributes = `Null}
let encode t = Yojson.Safe.to_string (to_yojson t)
let update_attributes t attrs = {t with attributes = attrs}
let attributes t = t.attributes

let of_yojson x =
let open Yojson.Safe.Util in
let open Util.Result_syntax in
Expand All @@ -348,12 +341,6 @@ module Group = struct
| Error e -> raise (Parse_error e)
| Ok m -> m

let encode t = Yojson.Safe.to_string (to_yojson t)

let update_attributes t attrs = {t with attributes = attrs}

let attributes t = t.attributes

let show t =
Format.sprintf
{|"{zarr_format=%d; node_type=%s; attributes=%s}"|}
Expand Down
63 changes: 14 additions & 49 deletions zarr/src/ndarray.ml
Original file line number Diff line number Diff line change
Expand Up @@ -15,12 +15,6 @@ type _ dtype =
| Int : int dtype
| Nativeint : nativeint dtype

type 'a t =
{shape : int array
;strides : int array
;dtype : 'a dtype
;data : 'a array}

let dtype_size : type a. a dtype -> int = function
| Char -> 1
| Bool -> 1
Expand All @@ -47,36 +41,25 @@ let make_strides shape =
let n = Array.length shape - 1 in
Array.init (n + 1) (fun i -> cumprod shape (i + 1) n)

let create dtype shape fv =
{shape
;dtype
;strides = make_strides shape
;data = Array.make (Util.prod shape) fv}

let init dtype shape f =
{shape
;dtype
;strides = make_strides shape
;data = Array.init (Util.prod shape) f}

type 'a t = {shape : int array; strides : int array; dtype : 'a dtype; data : 'a array}
let equal x y = x.data = y.data && x.shape = y.shape && x.dtype = y.dtype && x.strides = y.strides
(* 1d index of coord [i0; ...; in] is SUM(i0 * strides[0] + ... + in * strides[n-1] *)
let coord_to_index i s = Array.fold_left (fun a (x, y) -> Int.add a (x * y)) 0 @@ Array.combine i s
let create dtype shape fv = {shape; dtype; strides = make_strides shape; data = Array.make (Util.prod shape) fv}
let init dtype shape f = {shape; dtype; strides = make_strides shape; data = Array.init (Util.prod shape) f}
let of_array dtype shape xs = {shape; dtype; strides = make_strides shape; data = xs}
let data_type t = t.dtype

let size t = Util.prod t.shape

let ndims t = Array.length t.shape

let shape t = t.shape

let get t i = t.data.(coord_to_index i t.strides)
let set t i x = t.data.(coord_to_index i t.strides) <- x
let fill t v = Array.iteri (fun i _ -> t.data.(i) <- v) t.data
let map f t = {t with data = Array.map f t.data}
let iteri f t = Array.iteri f t.data
let iter f t = Array.iter f t.data
let byte_size t = size t * dtype_size t.dtype

let to_array t = t.data

let of_array dtype shape xs =
{shape; dtype; strides = make_strides shape; data = xs}

(* 1d index of coord [i0; ...; in] is SUM(i0 * strides[0] + ... + in * strides[n-1] *)
let coord_to_index i s =
Array.fold_left (fun a (x, y) -> Int.add a (x * y)) 0 @@ Array.combine i s
let shape t = t.shape

(* This snippet is adapted from the Owl project.
Expand All @@ -88,18 +71,6 @@ let index_to_coord ~strides i j =
j.(k) <- i mod strides.(k - 1) / strides.(k)
done

let get t i = t.data.(coord_to_index i t.strides)

let set t i x = t.data.(coord_to_index i t.strides) <- x

let iteri f t = Array.iteri f t.data

let fill t v = Array.iteri (fun i _ -> t.data.(i) <- v) t.data

let map f t = {t with data = Array.map f t.data}

let iter f t = Array.iter f t.data

module B = Bigarray

let to_bigarray :
Expand Down Expand Up @@ -148,12 +119,6 @@ let of_bigarray :
| B.Complex32 -> f Complex32
| B.Complex64 -> f Complex64

let equal x y =
x.data = y.data
&& x.shape = y.shape
&& x.dtype = y.dtype
&& x.strides = y.strides

(* validation for [axis] is done at the boundaries of the system and thus doing
so inside this function would be redundant work. Also, the output array
shares internal data with the input. Since this function is only ever
Expand Down
Loading

0 comments on commit 00ade96

Please sign in to comment.