diff --git a/src/lib_client_base_unix/client_config.ml b/src/lib_client_base_unix/client_config.ml index 422de8d729ee70c582957bbcb8b453ee383e0f84..93a66a286407affbd2f40167341f8846c5ded0ec 100644 --- a/src/lib_client_base_unix/client_config.ml +++ b/src/lib_client_base_unix/client_config.ml @@ -328,15 +328,16 @@ let wait_parameter () = let protocol_parameter () = parameter (fun _ arg -> - try - let (hash, _commands) = - List.find - (fun (hash, _commands) -> - String.has_prefix ~prefix:arg (Protocol_hash.to_b58check hash)) - (Client_commands.get_versions ()) - in - return_some hash - with Not_found -> fail (Invalid_protocol_argument arg)) + match + Seq.find_first + (fun (hash, _commands) -> + String.has_prefix ~prefix:arg (Protocol_hash.to_b58check hash)) + (Client_commands.get_versions ()) + with + | Some (hash, _commands) -> + return_some hash + | None -> + fail (Invalid_protocol_argument arg)) (* Command-line only args (not in config file) *) let base_dir_arg () = diff --git a/src/lib_client_base_unix/client_main_run.ml b/src/lib_client_base_unix/client_main_run.ml index 05aa7c5890a6768349e06b2a98da22bb5a8232cb..5185886434b1d186e824e5c3f32494f3804e3a0b 100644 --- a/src/lib_client_base_unix/client_main_run.ml +++ b/src/lib_client_base_unix/client_main_run.ml @@ -35,7 +35,7 @@ let builtin_commands = no_options (fixed ["list"; "understood"; "protocols"]) (fun () (cctxt : #Client_context.full) -> - Lwt_list.iter_s + Seq.iter_s (fun (ver, _) -> cctxt#message "%a" Protocol_hash.pp_short ver) (Client_commands.get_versions ()) >>= fun () -> return_unit) ] diff --git a/src/lib_client_commands/client_commands.ml b/src/lib_client_commands/client_commands.ml index 47587e3d68ed203b7e96da2262235dc3641ab89b..a2e5ec40e857002ee3bd9ed4fb6b1aa43e6095b0 100644 --- a/src/lib_client_commands/client_commands.ml +++ b/src/lib_client_commands/client_commands.ml @@ -33,8 +33,7 @@ exception Version_not_found let versions = Protocol_hash.Table.create 7 -let get_versions () = - Protocol_hash.Table.fold (fun k c acc -> (k, c) :: acc) versions [] +let get_versions () = Protocol_hash.Table.to_seq versions let register name commands = let previous = diff --git a/src/lib_client_commands/client_commands.mli b/src/lib_client_commands/client_commands.mli index 361acd889b3349a13cc90f322616dc520c413ef2..59a9a825980aae97a4a709e9ff7dae62f291341d 100644 --- a/src/lib_client_commands/client_commands.mli +++ b/src/lib_client_commands/client_commands.mli @@ -36,4 +36,4 @@ val register : Protocol_hash.t -> (network option -> command list) -> unit val commands_for_version : Protocol_hash.t -> network option -> command list val get_versions : - unit -> (Protocol_hash.t * (network option -> command list)) list + unit -> (Protocol_hash.t * (network option -> command list)) Seq.t diff --git a/src/lib_event_logging/internal_event.ml b/src/lib_event_logging/internal_event.ml index 384a420e69ac06dcab9fc57e7c4b55d4e51a73e7..5da1ae9631ab3d5f5aa9a2b6727ddb60ce93fe49 100644 --- a/src/lib_event_logging/internal_event.ml +++ b/src/lib_event_logging/internal_event.ml @@ -285,10 +285,8 @@ module All_sinks = struct let module S = (val definition : SINK with type t = a) in S.handle ?section sink def v in - List.fold_left - (fun prev -> function Active {sink; definition; _} -> - prev >>=? fun () -> handle sink definition) - return_unit + iter_s + (function Active {sink; definition; _} -> handle sink definition) !active let pp_state fmt () = diff --git a/src/lib_p2p/p2p_maintenance.ml b/src/lib_p2p/p2p_maintenance.ml index aec91cb22b848cbb581ee6ef0f8ba178e0fa2871..d158a3d4cd12eeca30bf4485b1de301d369ee3bd 100644 --- a/src/lib_p2p/p2p_maintenance.ml +++ b/src/lib_p2p/p2p_maintenance.ml @@ -104,12 +104,12 @@ let classify pool private_mode start_time seen_points point pi = with points in [contactable]. It returns the number of established connections *) let establish t contactable = - let try_to_connect acc point = + let try_to_connect count point = protect ~canceler:t.canceler (fun () -> P2p_connect_handler.connect t.connect_handler point) - >>= function Ok _ -> acc >|= succ | Error _ -> acc + >|= function Ok _ -> succ count | Error _ -> count in - List.fold_left try_to_connect (Lwt.return 0) contactable + Lwt_list.fold_left_s try_to_connect 0 contactable (* [connectable t start_time expected seen_points] selects at most [expected] connections candidates from the known points, not in [seen] diff --git a/src/lib_p2p/p2p_pool.ml b/src/lib_p2p/p2p_pool.ml index b147a9eb28e8388aabad84b673a6ac02ec66d8e3..82f17702d973c30f686e333598b62bd4f6f3f26b 100644 --- a/src/lib_p2p/p2p_pool.ml +++ b/src/lib_p2p/p2p_pool.ml @@ -216,17 +216,15 @@ let connection_of_peer_id pool peer_id = (* Every running connection matching the point's ip address is returned. *) let connections_of_addr pool addr = - P2p_point.Table.fold - (fun (addr', _) p acc -> - if Ipaddr.V6.compare addr addr' = 0 then - match P2p_point_state.get p with - | P2p_point_state.Running {data; _} -> - data :: acc - | _ -> - acc - else acc) - pool.connected_points - [] + P2p_point.Table.to_seq pool.connected_points + |> Seq.filter_map (fun ((addr', _), p) -> + if Ipaddr.V6.compare addr addr' = 0 then + match P2p_point_state.get p with + | P2p_point_state.Running {data; _} -> + Some data + | _ -> + None + else None) let get_addr pool peer_id = Option.map @@ -271,7 +269,7 @@ module Points = struct let ban pool (addr, _port) = P2p_acl.IPBlacklist.add pool.acl addr ; (* Kick [addr]:* if it is in `Running` state. *) - Lwt_list.iter_p + Seq.iter_p (fun conn -> P2p_conn.disconnect conn) (connections_of_addr pool addr) diff --git a/src/lib_protocol_updater/registered_protocol.ml b/src/lib_protocol_updater/registered_protocol.ml index 52c6e99feaec1b75f421e2ec14d7a784026a9fb5..6a3e4594a2d39a54492f3e9fe2d985f397cb6409 100644 --- a/src/lib_protocol_updater/registered_protocol.ml +++ b/src/lib_protocol_updater/registered_protocol.ml @@ -117,9 +117,9 @@ let get_result hash = | None -> fail (Unregistered_protocol hash) -let list () = VersionTable.fold (fun _ p acc -> p :: acc) versions [] +let seq () = VersionTable.to_seq_values versions -let list_embedded () = VersionTable.fold (fun k _ acc -> k :: acc) sources [] +let seq_embedded () = VersionTable.to_seq_keys sources let get_embedded_sources hash = VersionTable.find sources hash diff --git a/src/lib_protocol_updater/registered_protocol.mli b/src/lib_protocol_updater/registered_protocol.mli index 12310784de6d08222a0d287cf87a06844032c0bd..358d0e53174bf5477fd8e93d06bfba7bd7da3312 100644 --- a/src/lib_protocol_updater/registered_protocol.mli +++ b/src/lib_protocol_updater/registered_protocol.mli @@ -46,13 +46,13 @@ type t = (module T) val mem : Protocol_hash.t -> bool -val list : unit -> t list +val seq : unit -> t Seq.t val get : Protocol_hash.t -> t option val get_result : Protocol_hash.t -> t tzresult Lwt.t -val list_embedded : unit -> Protocol_hash.t list +val seq_embedded : unit -> Protocol_hash.t Seq.t val get_embedded_sources : Protocol_hash.t -> Protocol.t option diff --git a/src/lib_requester/requester.ml b/src/lib_requester/requester.ml index 26d66e456a971d89df50a0fe0f10e2b246041aca..f3eefe382fa5c71d3fdf4d419326cf3d9ba06430 100644 --- a/src/lib_requester/requester.ml +++ b/src/lib_requester/requester.ml @@ -437,10 +437,8 @@ end = struct P2p_peer.Map.empty in P2p_peer.Map.iter (Request.send state.param) requests ; - P2p_peer.Map.fold - (fun peer request acc -> - acc - >>= fun () -> + P2p_peer.Map.iter_s + (fun peer request -> Lwt_list.iter_s (fun key -> lwt_debug @@ -451,7 +449,6 @@ end = struct -% a P2p_peer.Id.Logging.tag peer)) request) requests - Lwt.return_unit >>= fun () -> loop state in loop state diff --git a/src/lib_shell/chain_validator.ml b/src/lib_shell/chain_validator.ml index 499e2e67256d64cca56e431e7ad62fff713fcd90..9877bf8de5377e3287d8eb18a2e9304e6a922ac5 100644 --- a/src/lib_shell/chain_validator.ml +++ b/src/lib_shell/chain_validator.ml @@ -537,11 +537,7 @@ let on_close w = [] in Lwt.join - ( ( match nv.prevalidator with - | Some prevalidator -> - Prevalidator.shutdown prevalidator - | None -> - Lwt.return_unit ) + ( Lwt_utils.may ~f:Prevalidator.shutdown nv.prevalidator :: Lwt_utils.may ~f:(fun (_, shutdown) -> shutdown ()) nv.child :: pvs ) diff --git a/src/lib_shell/distributed_db.ml b/src/lib_shell/distributed_db.ml index 03f0afe932b857a51ed841b38d1dcf952aa0e138..6962f8a6b185982eefdccae94b9fed30ae332975 100644 --- a/src/lib_shell/distributed_db.ml +++ b/src/lib_shell/distributed_db.ml @@ -228,22 +228,21 @@ let deactivate chain_db = let chain_id = State.Chain.id chain_db.reader_chain_db.chain_state in Chain_id.Table.remove active_chains chain_id ; let sends = - P2p_peer.Table.fold - (fun gid conn acc -> + P2p_peer.Table.iter_ep + (fun gid conn -> chain_db.reader_chain_db.callback.disconnection gid ; chain_db.reader_chain_db.active_peers := P2p_peer.Set.remove gid !(chain_db.reader_chain_db.active_peers) ; P2p_peer.Table.remove chain_db.reader_chain_db.active_connections gid ; - P2p.send p2p conn (Deactivate chain_id) :: acc) + P2p.send p2p conn (Deactivate chain_id)) chain_db.reader_chain_db.active_connections - [] in Error_monad.dont_wait (fun exc -> Format.eprintf "Uncaught exception: %s\n%!" (Printexc.to_string exc)) (fun trace -> Format.eprintf "Uncaught error: %a\n%!" Error_monad.pp_print_error trace) - (fun () -> join_ep sends) ; + (fun () -> sends) ; Distributed_db_requester.Raw_operation.shutdown chain_db.reader_chain_db.operation_db >>= fun () -> diff --git a/src/lib_shell/monitor_directory.ml b/src/lib_shell/monitor_directory.ml index a30e2c92781079312bc7108a1335fee7f47f4f26..7361e737ae4fc8aa50173e07d107fdcc3c83a4c5 100644 --- a/src/lib_shell/monitor_directory.ml +++ b/src/lib_shell/monitor_directory.ml @@ -67,12 +67,16 @@ let build_rpc_directory validator mainchain_validator = | [] -> Lwt.return_true | chains -> - let chain_id = State.Block.chain_id block in - Lwt_list.filter_map_p - (Chain_directory.get_chain_id_opt state) + let that_chain_id = State.Block.chain_id block in + Lwt_list.exists_p + (fun chain -> + Chain_directory.get_chain_id_opt state chain + >|= function + | None -> + false + | Some this_chain_id -> + Chain_id.equal this_chain_id that_chain_id) chains - >>= fun chains -> - Lwt.return (List.exists (Chain_id.equal chain_id) chains) in let in_protocols block = match q#protocols with diff --git a/src/lib_shell/node.ml b/src/lib_shell/node.ml index 9652fc956385330f12f79ae1610da248ad252547..1a1dd1c361f1b775b610c79a9093cf12a677dedb 100644 --- a/src/lib_shell/node.ml +++ b/src/lib_shell/node.ml @@ -176,8 +176,8 @@ module Local_logging = Internal_event.Legacy_logging.Make_semantic (struct end) let store_known_protocols state = - let embedded_protocols = Registered_protocol.list_embedded () in - Lwt_list.iter_s + let embedded_protocols = Registered_protocol.seq_embedded () in + Seq.iter_s (fun protocol_hash -> State.Protocol.known state protocol_hash >>= function @@ -264,7 +264,7 @@ let check_and_fix_storage_consistency state vp = (* Make sure to remove the block only after updating the head *) State.Block.remove block in - iter_s + Seq.iter_es (fun chain_state -> Chain.head chain_state >>= fun block -> check_block 500 chain_state block) chains diff --git a/src/lib_shell/p2p_reader.ml b/src/lib_shell/p2p_reader.ml index c04fd029d71d57de6ef11bb405c6abf04289b24b..19d3f434c0b48b37a5acddd8a721a2032d43f29d 100644 --- a/src/lib_shell/p2p_reader.ml +++ b/src/lib_shell/p2p_reader.ml @@ -105,38 +105,21 @@ let may_handle_global state chain_id f = f chain_db let find_pending_operations {peer_active_chains; _} h i = - Chain_id.Table.fold - (fun _chain_id chain_db acc -> - match acc with - | Some _ -> - acc - | None - when Distributed_db_requester.Raw_operations.pending - chain_db.operations_db - (h, i) -> - Some chain_db - | None -> - None) - peer_active_chains - None + Chain_id.Table.to_seq_values peer_active_chains + |> Seq.find_first (fun chain_db -> + Distributed_db_requester.Raw_operations.pending + chain_db.operations_db + (h, i)) let find_pending_operation {peer_active_chains; _} h = - Chain_id.Table.fold - (fun _chain_id chain_db acc -> - match acc with - | Some _ -> - acc - | None - when Distributed_db_requester.Raw_operation.pending - chain_db.operation_db - h -> - Some chain_db - | None -> - None) - peer_active_chains - None + Chain_id.Table.to_seq_values peer_active_chains + |> Seq.find_first (fun chain_db -> + Distributed_db_requester.Raw_operation.pending chain_db.operation_db h) let read_operation state h = + (* NOTE: to optimise this into an early-return map-and-search we need either a + special [Seq.find_first_map : ('a -> 'b option) -> 'a Seq.t -> 'b option] + or we need a [Seq.map_s] that is lazy. *) Chain_id.Table.fold_s (fun chain_id chain_db acc -> match acc with @@ -161,20 +144,11 @@ let read_block_header {disk; _} h = Lwt.return_none let find_pending_block_header {peer_active_chains; _} h = - Chain_id.Table.fold - (fun _chain_id chain_db acc -> - match acc with - | Some _ -> - acc - | None - when Distributed_db_requester.Raw_block_header.pending - chain_db.block_header_db - h -> - Some chain_db - | None -> - None) - peer_active_chains - None + Chain_id.Table.to_seq_values peer_active_chains + |> Seq.find_first (fun chain_db -> + Distributed_db_requester.Raw_block_header.pending + chain_db.block_header_db + h) let deactivate gid chain_db = chain_db.callback.disconnection gid ; diff --git a/src/lib_shell/prevalidation.ml b/src/lib_shell/prevalidation.ml index a277b5431cea9f5e606d955aff6c022588256e1a..5b789e4452440139d2f2f93c1fa376975ff7ff5c 100644 --- a/src/lib_shell/prevalidation.ml +++ b/src/lib_shell/prevalidation.ml @@ -290,7 +290,10 @@ let preapply ~user_activated_upgrades ~user_activated_protocol_overrides Prevalidation.create ~protocol_data ~predecessor ~timestamp () >>=? fun validation_state -> Lwt_list.fold_left_s - (fun (acc_validation_result, acc_validation_state) operations -> + (fun ( acc_validation_passes, + acc_validation_result_rev, + acc_validation_state ) + operations -> Lwt_list.fold_left_s (fun (acc_validation_result, acc_validation_state) op -> match Prevalidation.parse op with @@ -313,16 +316,20 @@ let preapply ~user_activated_upgrades ~user_activated_protocol_overrides } in Lwt.return - (acc_validation_result @ [new_validation_result], new_validation_state)) - ([], validation_state) + ( acc_validation_passes + 1, + new_validation_result :: acc_validation_result_rev, + new_validation_state )) + (0, [], validation_state) operations + >>= fun (validation_passes, validation_result_list_rev, validation_state) -> + Lwt.return (List.rev validation_result_list_rev, validation_state) >>= fun (validation_result_list, validation_state) -> let operations_hash = Operation_list_list_hash.compute - (List.map + (List.rev_map (fun r -> Operation_list_hash.compute (List.map fst r.Preapply_result.applied)) - validation_result_list) + validation_result_list_rev) in Prevalidation.status validation_state >>=? fun {block_result; _} -> @@ -350,7 +357,7 @@ let preapply ~user_activated_upgrades ~user_activated_protocol_overrides proto_level; predecessor = State.Block.hash predecessor; timestamp; - validation_passes = List.length validation_result_list; + validation_passes; operations_hash; fitness; context = Context_hash.zero (* place holder *); diff --git a/src/lib_shell/protocol_directory.ml b/src/lib_shell/protocol_directory.ml index 6ed74d1c7edac9ed3a8b9f6cc6ba3a110a8b1ade..b60a3629675e5783005e7632c4dbacf78c06f8b5 100644 --- a/src/lib_shell/protocol_directory.ml +++ b/src/lib_shell/protocol_directory.ml @@ -35,9 +35,7 @@ let build_rpc_directory block_validator state = State.Protocol.list state >>= fun set -> let protocols = - Protocol_hash.Set.add_seq - (List.to_seq @@ Registered_protocol.list_embedded ()) - set + Protocol_hash.Set.add_seq (Registered_protocol.seq_embedded ()) set in RPC_answer.return (Protocol_hash.Set.elements protocols)) ; register1 Protocol_services.S.contents (fun hash () () -> diff --git a/src/lib_shell/snapshots.ml b/src/lib_shell/snapshots.ml index 25f16ebddf6c64642c419971c06276159360a543..fd5e8c5743a1d60cf251ed6f867f1424bd3b3b73 100644 --- a/src/lib_shell/snapshots.ml +++ b/src/lib_shell/snapshots.ml @@ -952,7 +952,7 @@ let import ?(reconstruct = false) ?patch_context ~data_dir (fun () -> let k_store_pruned_blocks data = Store.with_atomic_rw store (fun () -> - Error_monad.iter_s + Lwt_list.iter_s (fun (pruned_header_hash, pruned_block) -> Store.Block.Pruned_contents.store (block_store, pruned_header_hash) @@ -972,9 +972,9 @@ let import ?(reconstruct = false) ?patch_context ~data_dir (block_store, pruned_header_hash) i v) - pruned_block.operation_hashes - >>= fun () -> return_unit) + pruned_block.operation_hashes) data) + >>= fun () -> return_unit in (* Restore context and fetch data *) restore_contexts diff --git a/src/lib_shell/state.ml b/src/lib_shell/state.ml index 25462b5bc5d13c70ae1f678f7ab26a9c59f05feb..71d0c4589c2b528317eea9614c6619b79e226510 100644 --- a/src/lib_shell/state.ml +++ b/src/lib_shell/state.ml @@ -368,23 +368,17 @@ end let locked_valid_heads_for_checkpoint block_store data checkpoint = Store.Chain_data.Known_heads.read_all data.chain_data_store >>= fun heads -> - Block_hash.Set.fold - (fun head acc -> - let valid_header = - Header.read_opt (block_store, head) - >|= Option.unopt_assert ~loc:__POS__ - >>= fun header -> - Locked_block.is_valid_for_checkpoint block_store head header checkpoint - >>= fun valid -> Lwt.return (valid, header) - in - acc - >>= fun (valid_heads, invalid_heads) -> - valid_header - >>= fun (valid, header) -> + Block_hash.Set.fold_s + (fun head (valid_heads, invalid_heads) -> + Header.read_opt (block_store, head) + >|= Option.unopt_assert ~loc:__POS__ + >>= fun header -> + Locked_block.is_valid_for_checkpoint block_store head header checkpoint + >>= fun valid -> if valid then Lwt.return ((head, header) :: valid_heads, invalid_heads) else Lwt.return (valid_heads, (head, header) :: invalid_heads)) heads - (Lwt.return ([], [])) + ([], []) (* Tag as invalid all blocks in `heads` and their predecessors whose level strictly higher to 'level'. *) @@ -725,8 +719,7 @@ module Chain = struct let all state = Shared.use state.global_data (fun {chains; _} -> - Lwt.return - @@ Chain_id.Table.fold (fun _ chain acc -> chain :: acc) chains []) + Lwt.return @@ Chain_id.Table.to_seq_values chains) let id {chain_id; _} = chain_id @@ -1627,20 +1620,17 @@ let best_known_head_for_checkpoint chain_state checkpoint = header = genesis_header; } in - Block_hash.Set.fold + Block_hash.Set.fold_s (fun head best -> - let valid_predecessor = find_valid_predecessor head in - best - >>= fun best -> - valid_predecessor - >>= fun pred -> + find_valid_predecessor head + >|= fun pred -> if Fitness.( pred.header.shell.fitness > best.header.shell.fitness) - then Lwt.return pred - else Lwt.return best) + then pred + else best) heads - (Lwt.return genesis))) + genesis)) module Protocol = struct include Protocol diff --git a/src/lib_shell/state.mli b/src/lib_shell/state.mli index 032559f403f35f5f7cb3c46282f1d72f928dc1e2..98e4543ccb2891286eea00a9d333acc1028d32bf 100644 --- a/src/lib_shell/state.mli +++ b/src/lib_shell/state.mli @@ -68,7 +68,7 @@ module Chain : sig val test : chain_state -> Chain_id.t option Lwt.t (** Returns all the known chains. *) - val all : global_state -> chain_state list Lwt.t + val all : global_state -> chain_state Seq.t Lwt.t (** Destroy a chain: this completely removes from the local storage all the data associated to the chain (this includes blocks and diff --git a/src/lib_stdlib_unix/internal_event_unix.ml b/src/lib_stdlib_unix/internal_event_unix.ml index 07684ede2f842c78b0c5a0ef84f0eb3e52a8c8dd..0d7d1308c4a324ddcad083e1b9f6f41c29083416 100644 --- a/src/lib_stdlib_unix/internal_event_unix.ml +++ b/src/lib_stdlib_unix/internal_event_unix.ml @@ -48,12 +48,7 @@ module Configuration = struct >>=? fun json -> protect (fun () -> return (Data_encoding.Json.destruct encoding json)) - let apply {activate} = - List.fold_left - (fun prev uri -> - prev >>=? fun () -> Internal_event.All_sinks.activate uri) - return_unit - activate + let apply {activate} = iter_s Internal_event.All_sinks.activate activate end let env_var_name = "TEZOS_EVENTS_CONFIG" @@ -80,17 +75,14 @@ let init ?lwt_log_sink ?(configuration = Configuration.default) () = |> List.filter (( <> ) "") |> List.map Uri.of_string in - List.fold_left - (fun prev uri -> - prev - >>=? fun () -> + iter_s + (fun uri -> match Uri.scheme uri with | None -> Configuration.of_file (Uri.path uri) >>=? fun cfg -> Configuration.apply cfg | Some _ -> Internal_event.All_sinks.activate uri) - return_unit uris >>=? fun () -> Internal_event.Debug_event.( diff --git a/src/lib_storage/store_helpers.ml b/src/lib_storage/store_helpers.ml index e8d6da36b0fa39bcd834b1d1c30de1d953b0593c..4a025b3380cc0d03b8d51a86c4fe042861e827ff 100644 --- a/src/lib_storage/store_helpers.ml +++ b/src/lib_storage/store_helpers.ml @@ -260,9 +260,8 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct let store_all s new_set = read_all s >>= fun old_set -> - Lwt_list.iter_p (remove s) Set.(elements (diff old_set new_set)) - >>= fun () -> - Lwt_list.iter_p (store s) Set.(elements (diff new_set old_set)) + Set.iter_p (remove s) (Set.diff old_set new_set) + >>= fun () -> Set.iter_p (store s) (Set.diff new_set old_set) end module Make_map (N : NAME) (V : VALUE) = struct @@ -317,15 +316,7 @@ module Make_indexed_substore (S : STORE) (I : INDEX) = struct let read_all s = fold s ~init:Map.empty ~f:(fun i v set -> Lwt.return (Map.add i v set)) - let store_all s map = - remove_all s - >>= fun () -> - Map.fold - (fun k v acc -> - let res = store s k v in - acc >>= fun () -> res) - map - Lwt.return_unit + let store_all s map = remove_all s >>= fun () -> Map.iter_p (store s) map end end @@ -386,9 +377,8 @@ struct let store_all s new_set = read_all s >>= fun old_set -> - Lwt_list.iter_p (remove s) Set.(elements (diff old_set new_set)) - >>= fun () -> - Lwt_list.iter_p (store s) Set.(elements (diff new_set old_set)) + Set.iter_p (remove s) (Set.diff old_set new_set) + >>= fun () -> Set.iter_p (store s) (Set.diff new_set old_set) end module Make_map (S : STORE) (I : INDEX) (V : VALUE) = struct @@ -480,15 +470,7 @@ struct let read_all s = fold s ~init:Map.empty ~f:(fun i v set -> Lwt.return (Map.add i v set)) - let store_all s map = - remove_all s - >>= fun () -> - Map.fold - (fun k v acc -> - let res = store s k v in - acc >>= fun () -> res) - map - Lwt.return_unit + let store_all s map = remove_all s >>= fun () -> Map.iter_p (store s) map end module Integer_index = struct