result fold left

6 files changed, 24 insertions, 26 deletions

diff --git a/lib/Utilities.ml b/lib/Utilities.ml
index c16be2e..b7fe364 100644
--- a/lib/Utilities.ml
+++ b/lib/Utilities.ml
@@ -21,6 +21,7 @@ module type SEQUENCE = sig
   val empty : 'a t
   val cons : 'a -> 'a t -> 'a t
   val fold : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
 end
 
 module Generic (S : SEQUENCE) = struct
@@ -32,6 +33,14 @@ module Generic (S : SEQUENCE) = struct
         let* m = m in
         Ok (S.cons m acc) )
       ms (Ok S.empty)
+
+  let fold_left f init ms =
+    let open Result in
+    S.fold_left
+      (fun acc m ->
+        let* acc = acc in
+        f acc m )
+      (Ok init) ms
 end
 
 module List = struct
@@ -41,6 +50,7 @@ module List = struct
     let empty = []
     let cons x xs = x :: xs
     let fold = List.fold_right
+    let fold_left = List.fold_left
   end
 
   include Generic (ListSequence)
@@ -55,6 +65,7 @@ module FingerTree = struct
     let empty = BatFingerTree.empty
     let cons x xs = BatFingerTree.cons xs x
     let fold f xs acc = BatFingerTree.fold_right (Fun.flip f) acc xs
+    let fold_left = BatFingerTree.fold_left
   end
 
   include Generic (FingerTreeSequence)
diff --git a/lib/Utilities.mli b/lib/Utilities.mli
index 4ab7674..59bc1fc 100644
--- a/lib/Utilities.mli
+++ b/lib/Utilities.mli
@@ -11,6 +11,7 @@ end
 
 module List : sig
   val sequence : ('a, 'b) result list -> ('a list, 'b) result
+  val fold_left : ('a -> 'b -> ('a, 'e) result) -> 'a -> 'b list -> ('a, 'e) result
   val hd_opt : 'a list -> 'a option
 end
 
@@ -31,6 +32,7 @@ module FingerTree : sig
   val map2 : ('a -> 'b -> 'c) -> 'a BatFingerTree.t -> 'b BatFingerTree.t -> 'c BatFingerTree.t
   val zip : 'a BatFingerTree.t -> 'b BatFingerTree.t -> ('a * 'b) BatFingerTree.t
   val sequence : ('a, 'b) result BatFingerTree.t -> ('a BatFingerTree.t, 'b) result
+  val fold_left : ('a -> 'b -> ('a, 'e) result) -> 'a -> 'b BatFingerTree.t -> ('a, 'e) result
   val join : string BatFingerTree.t -> string -> string
 end
 
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml
index d5c6851..92b1c38 100644
--- a/lib/evaluators/FOL.ml
+++ b/lib/evaluators/FOL.ml
@@ -92,15 +92,14 @@ let instantiate within =
 
 let restrict attributes description =
   let open Utilities.Result in
-  BatFingerTree.fold_left
+  Utilities.FingerTree.fold_left
     (fun restricted name ->
-      let* restricted = restricted in
       let* attribute =
         BatMap.String.find_opt name description
         |> Option.to_result ~none:(Error.unknown_attribute name)
       in
       Ok (BatMap.String.add name attribute restricted) )
-    (Ok BatMap.String.empty) attributes
+    BatMap.String.empty attributes
 
 let rec describe =
   let open Utilities.Result in
diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml
index 518fe4f..bcafce6 100644
--- a/lib/kernel/Initialization.ml
+++ b/lib/kernel/Initialization.ml
@@ -14,15 +14,7 @@ let bind namespace (name, handle) =
 
 let namespace entries =
   let into = Namespace.make () in
-  let open Utilities.Result in
-  let* () =
-    List.fold_left
-      (fun acc entry ->
-        let* () = acc in
-        bind into entry )
-      (Ok ()) entries
-  in
-  Ok into
+  Utilities.List.fold_left (fun () -> bind into) () entries |> Result.map (fun () -> into)
 
 (* A subsystem's root holds what is its own and not data: its
    evaluators, and whatever else it registers beside them. *)
diff --git a/lib/kernel/Merkle.ml b/lib/kernel/Merkle.ml
index 266a560..78ab5a5 100644
--- a/lib/kernel/Merkle.ml
+++ b/lib/kernel/Merkle.ml
@@ -29,9 +29,7 @@ module type TREE = functor (S : Abstract.Storage.STORAGE) (K : KEY) -> sig
   val insert :
     S.transaction -> K.t -> address -> node -> (node, Concepts.Condition.condition) result
 
-  val of_list :
-    S.transaction -> (K.t * address) list -> (node, Concepts.Condition.condition) result
-
+  val of_list : S.transaction -> (K.t * address) list -> (node, Concepts.Condition.condition) result
   val remove : S.transaction -> K.t -> node -> (node, Concepts.Condition.condition) result
   val lookup : S.transaction -> K.t -> node -> (address option, Concepts.Condition.condition) result
 
@@ -330,11 +328,9 @@ functor
       let open Utilities.Result in
       with_batch tx (fun () ->
           let* _ = empty_under tx in
-          List.fold_left
-            (fun node (key, value) ->
-              let* node = node in
-              insert tx key value node )
-            (Ok empty) bindings )
+          Utilities.List.fold_left
+            (fun node (key, value) -> insert tx key value node)
+            empty bindings )
 
     let rec fold_left tx f acc =
       let open Utilities.Result in
@@ -344,12 +340,11 @@ functor
           |> BatFingerTree.fold_left (fun acc (k, v) -> f acc k v) acc
           |> Result.ok
       | Trunk {children; _} ->
-          BatFingerTree.fold_left
+          Utilities.FingerTree.fold_left
             (fun acc addr ->
-              let* acc = acc in
               let* node = find' tx addr in
               fold_left tx f acc node )
-            (Ok acc) children
+            acc children
 
     let keys tx node =
       fold_left tx (fun acc k _ -> BatFingerTree.snoc acc k) BatFingerTree.empty node
diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml
index 0814b1c..a6879b6 100644
--- a/lib/kernel/Path.ml
+++ b/lib/kernel/Path.ml
@@ -122,13 +122,12 @@ let assoc_all handle changes =
         in
         (* each step derives from the last; only the steps in between are
            ours to release *)
-        List.fold_left
+        Utilities.List.fold_left
           (fun current change ->
-            let* current = current in
             let* next = assoc_on current change in
             if current != node then Handle.release current;
             Ok next )
-          (Ok node)
+          node
           (children @ List.map (fun (_, key, value) -> key, value) here)
   in
   apply [] handle changes