Add support for let*/let+ syntax language extension.

examples/inmemory_zipstore.ml

@@ -22,6 +22,7 @@ end = struct
   module Z = struct
     module Deferred = Zarr_lwt.Deferred
     open Deferred.Infix
+    open Deferred.Syntax
 
     type t =
       {mutable ic : Zipc.t
@@ -54,7 +55,7 @@ end = struct
           | Ok s -> s
 
     let get_partial_values t key ranges =
-      get t key >>| fun data ->
+      let+ data = get t key in
       let size = String.length data in
       ranges |> List.map @@ fun (ofs, len) ->
       let f v = String.sub data ofs v in
@@ -157,33 +158,33 @@ end = struct
           ~mode:Lwt_io.Output
           t.path
           (fun oc ->
-            let open Lwt.Infix in
+            let open Lwt.Syntax in
             match Zipc.to_binary_string t.ic with
             | Error e -> failwith e
             | Ok s' ->
               if String.equal s s' then Lwt.return_unit else
-              Lwt_io.write oc s' >>= fun () -> Lwt_io.flush oc))
+              let* () = Lwt_io.write oc s' in Lwt_io.flush oc))
 end
 
 let _ =
   Lwt_main.run @@ begin
   let open Zarr.Node in
-  let open MemoryZipStore.Deferred.Infix in
+  let open MemoryZipStore.Deferred.Syntax in
 
   let printlist = [%show: string list] in
   MemoryZipStore.with_open "examples/data/testdata.zip" @@ fun store ->
-  MemoryZipStore.find_all_nodes store >>= fun (xs, _) ->
+  let* xs, _ = MemoryZipStore.find_all_nodes store in
   print_endline @@ "All array nodes: " ^ printlist (List.map ArrayNode.to_path xs);
   let anode = List.hd @@ List.filter
     (fun node -> ArrayNode.to_path node = "/some/group/name") xs in
   let slice = Owl_types.[|R [0; 20]; I 10; R []|] in
-  MemoryZipStore.read_array store anode slice Bigarray.Char >>= fun x ->
+  let* x = MemoryZipStore.read_array store anode slice Bigarray.Char in
   print_string @@ "BEFORE: " ^ Owl_pretty.dsnda_to_string x;
   let x' =
     Owl.Dense.Ndarray.Generic.map
       (fun _ -> Owl_stats_dist.uniform_int_rvs ~a:0 ~b:255 |> Char.chr) x in
-  MemoryZipStore.write_array store anode slice x' >>= fun () ->
-  MemoryZipStore.read_array store anode slice Bigarray.Char >>| fun y ->
+  let* () = MemoryZipStore.write_array store anode slice x' in
+  let+ y = MemoryZipStore.read_array store anode slice Bigarray.Char in
   print_string @@ "AFTER: " ^ Owl_pretty.dsnda_to_string y;
   print_endline "Zip store has been update."
   end

examples/readonly_zipstore.ml

@@ -31,7 +31,6 @@ end = struct
 
   module Z = struct
     module Deferred = Zarr_eio.Deferred
-    open Deferred.Infix
 
     type t = Zip.in_file
 
@@ -51,7 +50,7 @@ end = struct
       | exception Not_found -> raise (Zarr.Storage.Key_not_found key)
 
     let get_partial_values t key ranges =
-      get t key >>= fun data ->
+      let data = get t key in
       let size = String.length data in
       ranges |> Eio.Fiber.List.map @@ fun (ofs, len) ->
       let f v = String.sub data ofs v in

zarr-eio/src/deferred.ml

@@ -9,3 +9,8 @@ module Infix = struct
   let (>>=) x f = f x
   let (>>|) = (>>=)
 end
+
+module Syntax = struct
+  let (let*) x f = f x
+  let (let+) = (let*)
+end

zarr-lwt/src/deferred.ml

@@ -9,3 +9,8 @@ module Infix = struct
   let (>>=) = Lwt.Infix.(>>=)
   let (>>|) = Lwt.Infix.(>|=) 
 end
+
+module Syntax = struct
+  let (let*) = Lwt.bind
+  let (let+) x f = Lwt.map f x
+end

zarr-lwt/src/storage.ml

@@ -7,6 +7,7 @@ module FilesystemStore = struct
   module FS = struct
     module Deferred = Deferred
     open Deferred.Infix
+    open Deferred.Syntax
 
     type t = {dirname : string; perm : Lwt_unix.file_perm}
 
@@ -20,19 +21,19 @@ module FilesystemStore = struct
       let parent_dir = Filename.dirname fn in
       Lwt_unix.file_exists parent_dir >>= function
       | false ->
-        create_parent_dir parent_dir perm >>= fun () ->
+        let* () = create_parent_dir parent_dir perm in
         Lwt_unix.mkdir parent_dir perm
       | true -> Lwt.return_unit
 
     let size t key =
       Lwt_io.file_length (key_to_fspath t key) >>| Int64.to_int
 
     let get t key =
-      size t key >>= fun bufsize ->
+      let* bsize = size t key in
       Lwt.catch
         (fun () ->
           Lwt_io.with_file
-            ~buffer:(Lwt_bytes.create bufsize)
+            ~buffer:(Lwt_bytes.create bsize)
             ~flags:Unix.[O_RDONLY; O_NONBLOCK]
             ~perm:t.perm
             ~mode:Lwt_io.Input
@@ -44,28 +45,27 @@ module FilesystemStore = struct
         | exn -> raise exn)
 
     let get_partial_values t key ranges =
-      size t key >>= fun tot ->
-      let l =
-        List.fold_left
-          (fun a (s, l) ->
-            Option.fold
-              ~none:(Int.max a (tot - s)) ~some:(Int.max a) l) 0 ranges in
+      let* tot = size t key in
+      let l = List.fold_left
+        (fun a (s, l) ->
+          Option.fold ~none:(Int.max a (tot - s)) ~some:(Int.max a) l) 0 ranges
+      in
       Lwt_io.with_file
         ~buffer:(Lwt_bytes.create l)
         ~flags:Unix.[O_RDONLY; O_NONBLOCK]
         ~perm:t.perm
         ~mode:Lwt_io.Input
         (key_to_fspath t key)
-        (fun ic ->
+        @@ fun ic ->
           Lwt_list.map_s
             (fun (ofs, len) -> 
               let count = Option.fold ~none:(tot - ofs) ~some:Fun.id len in
-              Lwt_io.set_position ic @@ Int64.of_int ofs >>= fun () ->
-              Lwt_io.read ~count ic) ranges)
+              let* () = Lwt_io.set_position ic @@ Int64.of_int ofs in
+              Lwt_io.read ~count ic) ranges
 
     let set t key value =
       let filename = key_to_fspath t key in
-      create_parent_dir filename t.perm >>= fun () ->
+      let* () = create_parent_dir filename t.perm in
       Lwt_io.with_file
         ~buffer:(Lwt_bytes.create @@ String.length value)
         ~flags:Unix.[O_WRONLY; O_TRUNC; O_CREAT; O_NONBLOCK]
@@ -83,11 +83,11 @@ module FilesystemStore = struct
         ~perm:t.perm
         ~mode:Lwt_io.Output
         (key_to_fspath t key)
-        (fun oc ->
+        @@ fun oc ->
           Lwt_list.iter_s
             (fun (ofs, value) ->
-              Lwt_io.set_position oc @@ Int64.of_int ofs >>= fun () ->
-              Lwt_io.write oc value) rvs)
+              let* () = Lwt_io.set_position oc @@ Int64.of_int ofs in
+              Lwt_io.write oc value) rvs
 
     let list t =
       let rec filter_concat acc dir =
@@ -142,7 +142,7 @@ module FilesystemStore = struct
               | _ -> Lwt.return a)
           (Lwt_unix.files_of_directory dir) acc
       in
-      filter_concat (S.empty, []) (key_to_fspath t "") >>| fun (y, x) ->
+      let+ y, x = filter_concat (S.empty, []) @@ key_to_fspath t "" in
       x, S.elements y
   end
 

zarr-sync/src/deferred.ml

@@ -9,3 +9,8 @@ module Infix = struct
   let (>>=) x f = f x
   let (>>|) = (>>=)
 end
+
+module Syntax = struct
+  let (let*) x f = f x
+  let (let+) = (let*)
+end

zarr-sync/src/storage.ml

@@ -6,7 +6,6 @@ end
 module FilesystemStore = struct
   module FS = struct
     module Deferred = Deferred
-    open Deferred.Infix
 
     type t = {dirname : string; perm : Unix.file_perm}
 
@@ -99,7 +98,7 @@ module FilesystemStore = struct
       in aux [] @@ key_to_fspath t ""
 
     let erase_prefix t pre =
-      list_prefix t pre >>| List.iter @@ erase t
+      List.iter (erase t) @@ list_prefix t pre
 
     let list_dir t prefix =
       let module StrSet = Zarr.Util.StrSet in

zarr/src/codecs/array_to_bytes.ml

@@ -337,14 +337,15 @@ end = struct
         | Ok v -> v :: l, r
         | Error _ -> l, c :: r) encoded ([], [])
     in
-    (match codecs with
-    | [] -> Error "No codec chain specified for sharding_indexed."
-    | y -> Ok y)
-    >>= fun codecs ->
-    (match filter_partition (ArrayToBytes.of_yojson chunk_shape) codecs with
-    | [x], rest -> Ok (x, rest)
-    | _ -> Error "Must be exactly one array->bytes codec.")
-    >>= fun (a2b, rest) ->
+    let* codecs = match codecs with
+      | [] -> Error "No codec chain specified for sharding_indexed."
+      | y -> Ok y
+    in
+    let* a2b, rest =
+      match filter_partition (ArrayToBytes.of_yojson chunk_shape) codecs with
+      | [x], rest -> Ok (x, rest)
+      | _ -> Error "Must be exactly one array->bytes codec."
+    in
     let a2a, rest = filter_partition (ArrayToArray.of_yojson chunk_shape) rest in
     let b2b, rest = filter_partition BytesToBytes.of_yojson rest in
     match rest with
@@ -360,57 +361,56 @@ end = struct
     let extract name =
       Yojson.Safe.Util.filter_map
         (fun (n, v) -> if n = name then Some v else None) assoc in
-    (match extract "chunk_shape" with
-    | [] -> Error ("sharding_indexed must contain a chunk_shape field")
-    | x :: _ ->
-      List.fold_right (fun a acc ->
-        acc >>= fun k ->
-        match a with
-        | `Int i when i > 0 -> Ok (i :: k)
-        | _ -> Error "chunk_shape must only contain positive integers.")
-        (Yojson.Safe.Util.to_list x) (Ok []))
-    >>= fun l'->
+    let* l' = match extract "chunk_shape" with
+      | [] -> Error ("sharding_indexed must contain a chunk_shape field")
+      | x :: _ ->
+        List.fold_right (fun a acc ->
+          let* k = acc in
+          match a with
+          | `Int i when i > 0 -> Ok (i :: k)
+          | _ -> Error "chunk_shape must only contain positive integers.")
+          (Yojson.Safe.Util.to_list x) (Ok [])
+    in
     let chunk_shape = Array.of_list l' in
-    (match extract "index_location" with
-    | [] -> Error "sharding_indexed must have a index_location field"
-    | x :: _ ->
-      match x with
-      | `String "end" -> Ok End
-      | `String "start" -> Ok Start
-      | _ -> Error "index_location must only be 'end' or 'start'")
-    >>= fun index_location ->
-    (match extract "codecs" with
-    | [] -> Error "sharding_indexed must have a codecs field"
-    | x :: _ ->
-      chain_of_yojson chunk_shape @@ Yojson.Safe.Util.to_list x)
-    >>= fun codecs ->
-    (match extract "index_codecs" with
-    | [] -> Error "sharding_indexed must have a index_codecs field"
-    | x :: _ ->
-      let cps = Array.map2 (/) shard_shape chunk_shape in
-      let idx_shape = Array.append cps [|2|] in
-      chain_of_yojson idx_shape @@ Yojson.Safe.Util.to_list x)
-    >>= fun ic ->
+    let* index_location = match extract "index_location" with
+      | [] -> Error "sharding_indexed must have a index_location field"
+      | x :: _ ->
+        match x with
+        | `String "end" -> Ok End
+        | `String "start" -> Ok Start
+        | _ -> Error "index_location must only be 'end' or 'start'"
+    in
+    let* codecs = match extract "codecs" with
+      | [] -> Error "sharding_indexed must have a codecs field"
+      | x :: _ ->
+        chain_of_yojson chunk_shape @@ Yojson.Safe.Util.to_list x
+    in
+    let* ic = match extract "index_codecs" with
+      | [] -> Error "sharding_indexed must have a index_codecs field"
+      | x :: _ ->
+        let cps = Array.map2 (/) shard_shape chunk_shape in
+        let idx_shape = Array.append cps [|2|] in
+        chain_of_yojson idx_shape @@ Yojson.Safe.Util.to_list x
+    in
     (* Ensure index_codecs only contains fixed size
        array->bytes and bytes->bytes codecs. *)
     let msg = "index_codecs must not contain variable-sized codecs." in
-    List.fold_right
+    let* b2b = List.fold_right
       (fun c acc ->
-        acc >>= fun l ->
+        let* l = acc in
         match c with
         | `Crc32c -> Ok (`Crc32c :: l)
         | `Gzip _ -> Error msg) ic.b2b (Ok [])
-    >>= fun b2b ->
-    (match ic.a2b with
+    in
+    let+ a2b = match ic.a2b with
       | `Bytes e -> Ok (`Bytes e)
-      | `ShardingIndexed _ -> Error msg)
-    >>| fun a2b ->
-    {index_codecs = {ic with a2b; b2b}; index_location; codecs; chunk_shape}
+      | `ShardingIndexed _ -> Error msg
+    in {index_codecs = {ic with a2b; b2b}; index_location; codecs; chunk_shape}
 end
 
 module Make (Io : Types.IO) = struct
   open Io
-  open Deferred.Infix
+  open Deferred.Syntax
   open ShardingIndexedCodec
   type t = ShardingIndexedCodec.t
 
@@ -423,7 +423,7 @@ module Make (Io : Types.IO) = struct
       match t.index_location with
       | Start -> get_partial [0, Some is], is
       | End -> get_partial [csize - is, None], 0 in
-    l >>= fun xs ->
+    let* xs = l in
     let idx_arr = fst @@ decode_index t cps @@ List.hd xs in
     let grid = RegularGrid.create ~array_shape:repr.shape t.chunk_shape in
     let m =
@@ -443,7 +443,7 @@ module Make (Io : Types.IO) = struct
           let nb = Stdint.Uint64.to_int @@ Any.get idx_arr nc in
           (pad + ofs, Some nb), (oc, nc, ofs, nb)) bindings
     in
-    get_partial ranges >>= fun xs ->
+    let* xs = get_partial ranges in
     let repr' = {repr with shape = t.chunk_shape} in
     let bsize, inplace, append = 
     List.fold_left
@@ -459,14 +459,14 @@ module Make (Io : Types.IO) = struct
             a + nb', l, (a, s) :: r)) 
       (csize - pad, [], []) List.(combine (combine xs coords) bindings)
     in
-    begin match inplace with
+    let* () = match inplace with
       | [] -> Deferred.return_unit
       | xs -> set_partial xs
-    end >>= fun () ->
-    begin match append with
+    in
+    let* () = match append with
       | [] -> Deferred.return_unit
       | xs -> set_partial ~append:true xs
-    end >>= fun () ->
+    in
     let ib = encode_index_chain t.index_codecs idx_arr in
     match t.index_location with
     | Start -> set_partial [0, ib]
@@ -479,7 +479,7 @@ module Make (Io : Types.IO) = struct
       match t.index_location with
       | Start -> get_partial [0, Some is], is
       | End -> get_partial [csize - is, None], 0 in
-    l >>= fun xs ->
+    let* xs = l in
     let idx_arr = fst @@ decode_index t cps @@ List.hd xs in
     let grid = RegularGrid.create ~array_shape:repr.shape t.chunk_shape in
     let m =
@@ -497,7 +497,7 @@ module Make (Io : Types.IO) = struct
           let nb = Stdint.Uint64.to_int @@ Any.get idx_arr nc in
           pad + ofs, Some nb) ArrayMap.(bindings m)
     in
-    get_partial ranges >>| fun xs ->
+    let+ xs = get_partial ranges in
     let repr' = {repr with shape = t.chunk_shape} in
     List.concat_map
       (fun (x, (_, z)) ->