diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Utilities.ml | 12 | ||||
| -rw-r--r-- | lib/Utilities.mli | 6 | ||||
| -rw-r--r-- | lib/evaluators/FOL.ml | 2 | ||||
| -rw-r--r-- | lib/kernel/Initialization.ml | 2 | ||||
| -rw-r--r-- | lib/kernel/Merkle.ml | 4 | ||||
| -rw-r--r-- | lib/kernel/Path.ml | 2 |
6 files changed, 16 insertions, 12 deletions
diff --git a/lib/Utilities.ml b/lib/Utilities.ml index 03d1eea..1e25176 100644 --- a/lib/Utilities.ml +++ b/lib/Utilities.ml @@ -7,12 +7,14 @@ end module Option = struct let ( let* ) = Option.bind let fmap f m = Option.bind m f + let ( |>> ) = Option.bind let sequence = function None -> Ok None | Some x -> Result.map Option.some x end module Result = struct let ( let* ) = Result.bind let fmap f m = Result.bind m f + let ( |>> ) = Result.bind end module type SEQUENCE = sig @@ -20,21 +22,21 @@ 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_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b end module Generic (S : SEQUENCE) = struct let sequence ms = let open Result in - S.fold + S.fold_right (fun m acc -> let* acc = acc in let* m = m in Ok (S.cons m acc) ) ms (Ok S.empty) - let fold_left f init ms = + let foldm_left f init ms = let open Result in S.fold_left (fun acc m -> @@ -49,7 +51,7 @@ module List = struct let empty = [] let cons x xs = x :: xs - let fold = List.fold_right + let fold_right = List.fold_right let fold_left = List.fold_left end @@ -65,7 +67,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_right f xs acc = BatFingerTree.fold_right (Fun.flip f) acc xs let fold_left = BatFingerTree.fold_left end diff --git a/lib/Utilities.mli b/lib/Utilities.mli index fb38966..7af9f03 100644 --- a/lib/Utilities.mli +++ b/lib/Utilities.mli @@ -6,18 +6,20 @@ end module Result : sig val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result + val ( |>> ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result val fmap : ('a -> ('b, 'e) result) -> ('a, 'e) result -> ('b, 'e) result 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 foldm_left : ('a -> 'b -> ('a, 'e) result) -> 'a -> 'b list -> ('a, 'e) result val concat_map : ('a -> ('b list, 'e) result) -> 'a list -> ('b list, 'e) result val hd_opt : 'a list -> 'a option end module Option : sig val ( let* ) : 'a option -> ('a -> 'b option) -> 'b option + val ( |>> ) : 'a option -> ('a -> 'b option) -> 'b option val fmap : ('a -> 'b option) -> 'a option -> 'b option val sequence : ('a, 'b) result option -> ('a option, 'b) result end @@ -33,7 +35,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 foldm_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 d5518ae..90f79ca 100644 --- a/lib/evaluators/FOL.ml +++ b/lib/evaluators/FOL.ml @@ -92,7 +92,7 @@ let instantiate within = let restrict attributes description = let open Utilities.Result in - Utilities.FingerTree.fold_left + Utilities.FingerTree.foldm_left (fun restricted name -> let* attribute = BatMap.String.find_opt name description diff --git a/lib/kernel/Initialization.ml b/lib/kernel/Initialization.ml index bcafce6..54bb76d 100644 --- a/lib/kernel/Initialization.ml +++ b/lib/kernel/Initialization.ml @@ -14,7 +14,7 @@ let bind namespace (name, handle) = let namespace entries = let into = Namespace.make () in - Utilities.List.fold_left (fun () -> bind into) () entries |> Result.map (fun () -> into) + Utilities.List.foldm_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 78ab5a5..6b44c41 100644 --- a/lib/kernel/Merkle.ml +++ b/lib/kernel/Merkle.ml @@ -328,7 +328,7 @@ functor let open Utilities.Result in with_batch tx (fun () -> let* _ = empty_under tx in - Utilities.List.fold_left + Utilities.List.foldm_left (fun node (key, value) -> insert tx key value node) empty bindings ) @@ -340,7 +340,7 @@ functor |> BatFingerTree.fold_left (fun acc (k, v) -> f acc k v) acc |> Result.ok | Trunk {children; _} -> - Utilities.FingerTree.fold_left + Utilities.FingerTree.foldm_left (fun acc addr -> let* node = find' tx addr in fold_left tx f acc node ) diff --git a/lib/kernel/Path.ml b/lib/kernel/Path.ml index 4859584..24d3d10 100644 --- a/lib/kernel/Path.ml +++ b/lib/kernel/Path.ml @@ -120,7 +120,7 @@ let assoc_all handle changes = in (* each step derives from the last; only the steps in between are ours to release *) - Utilities.List.fold_left + Utilities.List.foldm_left (fun current change -> let* next = assoc_on current change in if current != node then Handle.release current; |