balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Everywhere: exception Not_found -> _opt

Browse Source
This commit is contained in:
Vincent Bernardoff 2018-06-30 12:04:06 +02:00 committed by Grégoire Henry
parent 2c28d3b202
commit 41f6757ef8
13 changed files with 150 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/bin_client/client_rpc_commands.ml
View File

@ -156,17 +156,17 @@ let editor_fill_in ?(show_optionals=true) schema =
and edit () = and edit () =
(* launch the user's editor on it *) (* launch the user's editor on it *)
let editor_cmd = let editor_cmd =
try let ed = Sys.getenv "EDITOR" in Lwt_process.shell (ed ^ " " ^ tmp) let ed =
with Not_found -> match Sys.getenv_opt "EDITOR", Sys.getenv_opt "VISUAL" with
try let ed = Sys.getenv "VISUAL" in Lwt_process.shell (ed ^ " " ^ tmp) | Some ed, _ -> ed
with Not_found -> | None, Some ed -> ed
if Sys.win32 then | None, None when Sys.win32 ->
(* TODO: I have no idea what I'm doing here *) (* TODO: I have no idea what I'm doing here *)
("", [| "notepad.exe" ; tmp |]) "notepad.exe"
else | _ ->
(* TODO: vi on MacOSX ? *) (* TODO: vi on MacOSX ? *)
("", [| "nano" ; tmp |]) "nano" in
in Lwt_process.shell (ed ^ " " ^ tmp) in
(Lwt_process.open_process_none editor_cmd) # status >>= function (Lwt_process.open_process_none editor_cmd) # status >>= function
| Unix.WEXITED 0 -> | Unix.WEXITED 0 ->
reread () >>= fun json -> reread () >>= fun json ->
@ -311,17 +311,17 @@ let schema meth url (cctxt : #Client_context.full) =
let open RPC_description in let open RPC_description in
RPC_description.describe cctxt ~recurse:false args >>=? function RPC_description.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC_service.MethMap.find meth services with match RPC_service.MethMap.find_opt meth services with
| exception Not_found -> | None ->
cctxt#message cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return_unit return_unit
| { input = Some input ; output } -> | Some ({ input = Some input ; output }) ->
let json = `O [ "input", Json_schema.to_json (fst input) ; let json = `O [ "input", Json_schema.to_json (fst input) ;
"output", Json_schema.to_json (fst output) ] in "output", Json_schema.to_json (fst output) ] in
cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () -> cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
return_unit return_unit
| { input = None ; output } -> | Some ({ input = None ; output }) ->
let json = `O [ "output", Json_schema.to_json (fst output) ] in let json = `O [ "output", Json_schema.to_json (fst output) ] in
cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () -> cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
return_unit return_unit
@ -341,12 +341,12 @@ let format binary meth url (cctxt : #Client_context.io_rpcs) =
(fun ppf (schema, _) -> Json_schema.pp ppf schema) in (fun ppf (schema, _) -> Json_schema.pp ppf schema) in
RPC_description.describe cctxt ~recurse:false args >>=? function RPC_description.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC_service.MethMap.find meth services with match RPC_service.MethMap.find_opt meth services with
| exception Not_found -> | None ->
cctxt#message cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () -> "No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return_unit return_unit
| { input = Some input ; output } -> | Some ({ input = Some input ; output }) ->
cctxt#message cctxt#message
"@[<v 0>\ "@[<v 0>\
@[<v 2>Input format:@,%a@]@,\ @[<v 2>Input format:@,%a@]@,\
@ -355,7 +355,7 @@ let format binary meth url (cctxt : #Client_context.io_rpcs) =
pp input pp input
pp output >>= fun () -> pp output >>= fun () ->
return_unit return_unit
| { input = None ; output } -> | Some ({ input = None ; output }) ->
cctxt#message cctxt#message
"@[<v 0>\ "@[<v 0>\
@[<v 2>Output format:@,%a@]@,\ @[<v 2>Output format:@,%a@]@,\
@ -392,16 +392,16 @@ let call meth raw_url (cctxt : #Client_context.full) =
let args = String.split_path (Uri.path uri) in let args = String.split_path (Uri.path uri) in
RPC_description.describe cctxt ~recurse:false args >>=? function RPC_description.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin | Static { services } -> begin
match RPC_service.MethMap.find meth services with match RPC_service.MethMap.find_opt meth services with
| exception Not_found -> | None ->
cctxt#message cctxt#message
"No service found at this URL with this method \ "No service found at this URL with this method \
(but this is a valid prefix)\n%!" >>= fun () -> (but this is a valid prefix)\n%!" >>= fun () ->
return_unit return_unit
| { input = None } -> | Some ({ input = None }) ->
cctxt#generic_json_call meth uri >>=? cctxt#generic_json_call meth uri >>=?
display_answer cctxt display_answer cctxt
| { input = Some input } -> | Some ({ input = Some input }) ->
fill_in ~show_optionals:false (fst input) >>= function fill_in ~show_optionals:false (fst input) >>= function
| Error msg -> | Error msg ->
cctxt#error "%s" msg >>= fun () -> cctxt#error "%s" msg >>= fun () ->

8
src/bin_signer/handler.ml
View File

@ -86,20 +86,20 @@ let public_key (cctxt : #Client_context.wallet) pkh =
-% t event "request_for_public_key" -% t event "request_for_public_key"
-% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () -> -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
Client_keys.list_keys cctxt >>=? fun all_keys -> Client_keys.list_keys cctxt >>=? fun all_keys ->
match List.find (fun (_, h, _, _) -> Signature.Public_key_hash.equal h pkh) all_keys with match List.find_opt (fun (_, h, _, _) -> Signature.Public_key_hash.equal h pkh) all_keys with
| exception Not_found -> | None ->
log Tag.DSL.(fun f -> log Tag.DSL.(fun f ->
f "No public key found for hash %a" f "No public key found for hash %a"
-% t event "not_found_public_key" -% t event "not_found_public_key"
-% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () -> -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
Lwt.fail Not_found Lwt.fail Not_found
| (_, _, None, _) -> | Some (_, _, None, _) ->
log Tag.DSL.(fun f -> log Tag.DSL.(fun f ->
f "No public key found for hash %a" f "No public key found for hash %a"
-% t event "not_found_public_key" -% t event "not_found_public_key"
-% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () -> -% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
Lwt.fail Not_found Lwt.fail Not_found
| (name, _, Some pk, _) -> | Some (name, _, Some pk, _) ->
log Tag.DSL.(fun f -> log Tag.DSL.(fun f ->
f "Found public key for hash %a (name: %s)" f "Found public key for hash %a (name: %s)"
-% t event "found_public_key" -% t event "found_public_key"

12
src/lib_base/p2p_point.ml
View File

@ -57,10 +57,10 @@ module Id = struct
if len = 0 then if len = 0 then
("", "") ("", "")
else if s.[0] = '[' then begin (* inline IPv6 *) else if s.[0] = '[' then begin (* inline IPv6 *)
match String.rindex s ']' with match String.rindex_opt s ']' with
| exception Not_found -> | None ->
invalid_arg "Utils.parse_addr_port (missing ']')" invalid_arg "Utils.parse_addr_port (missing ']')"
| pos -> | Some pos ->
let addr = String.sub s 1 (pos - 1) in let addr = String.sub s 1 (pos - 1) in
let port = let port =
if pos = len - 1 then if pos = len - 1 then
@ -72,10 +72,10 @@ module Id = struct
check_port port ; check_port port ;
addr, port addr, port
end else begin end else begin
match String.rindex s ']' with match String.rindex_opt s ']' with
| _pos -> | Some _pos ->
invalid_arg "Utils.parse_addr_port (unexpected char ']')" invalid_arg "Utils.parse_addr_port (unexpected char ']')"
| exception Not_found -> | None ->
match String.index s ':' with match String.index s ':' with
| exception _ -> s, "" | exception _ -> s, ""
| pos -> | pos ->

55
src/lib_clic/clic.ml
View File

@ -272,18 +272,16 @@ let group_commands commands =
List.fold_left List.fold_left
(fun (grouped, ungrouped) (Ex (Command { group ; _ }) as command) -> (fun (grouped, ungrouped) (Ex (Command { group ; _ }) as command) ->
match group with match group with
| None -> | None -> (grouped, command :: ungrouped)
(grouped, command :: ungrouped)
| Some group -> | Some group ->
try match
let ({ title ; _ }, r) = List.find_opt (fun ({ name ; _ }, _) -> group.name = name) grouped with
List.find (fun ({ name ; _ }, _) -> group.name = name) grouped in | None -> ((group, ref [ command ]) :: grouped, ungrouped)
if title <> group.title then | Some ({ title ; _ }, r) ->
invalid_arg "Clic.usage: duplicate group name" ; if title <> group.title then
r := command :: !r ; invalid_arg "Clic.usage: duplicate group name" ;
(grouped, ungrouped) r := command :: !r ;
with Not_found -> (grouped, ungrouped))
((group, ref [ command ]) :: grouped, ungrouped))
([], []) ([], [])
commands in commands in
List.map (fun (g, c) -> (g, List.rev !c)) List.map (fun (g, c) -> (g, List.rev !c))
@ -579,15 +577,15 @@ let parse_arg :
fun ?command spec args_dict ctx -> fun ?command spec args_dict ctx ->
match spec with match spec with
| Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } -> | Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } ->
begin match TzString.Map.find long args_dict with begin match TzString.Map.find_opt long args_dict with
| exception Not_found -> return_none | None
| [] -> return_none | Some [] -> return_none
| [ s ] -> | Some [ s ] ->
(trace (trace
(Bad_option_argument ("--" ^ long, command)) (Bad_option_argument ("--" ^ long, command))
(converter ctx s)) >>|? fun x -> (converter ctx s)) >>|? fun x ->
Some x Some x
| _ :: _ -> | Some (_ :: _) ->
fail (Multiple_occurences ("--" ^ long, command)) fail (Multiple_occurences ("--" ^ long, command))
end end
| DefArg { parameter = (long, _) ; kind = { converter ; _ } ; default ; _ } -> | DefArg { parameter = (long, _) ; kind = { converter ; _ } ; default ; _ } ->
@ -599,22 +597,22 @@ let parse_arg :
(Format.sprintf (Format.sprintf
"Value provided as default for '%s' could not be parsed by converter function." "Value provided as default for '%s' could not be parsed by converter function."
long) end >>=? fun default -> long) end >>=? fun default ->
begin match TzString.Map.find long args_dict with begin match TzString.Map.find_opt long args_dict with
| exception Not_found -> return default | None
| [] -> return default | Some [] -> return default
| [ s ] -> | Some [ s ] ->
(trace (trace
(Bad_option_argument (long, command)) (Bad_option_argument (long, command))
(converter ctx s)) (converter ctx s))
| _ :: _ -> | Some (_ :: _) ->
fail (Multiple_occurences (long, command)) fail (Multiple_occurences (long, command))
end end
| Switch { parameter = (long, _) ; _ } -> | Switch { parameter = (long, _) ; _ } ->
begin match TzString.Map.find long args_dict with begin match TzString.Map.find_opt long args_dict with
| exception Not_found -> return_false | None
| [] -> return_false | Some [] -> return_false
| [ _ ] -> return_true | Some [ _ ] -> return_true
| _ :: _ -> fail (Multiple_occurences (long, command)) | Some (_ :: _) -> fail (Multiple_occurences (long, command))
end end
| Constant c -> return c | Constant c -> return c
@ -656,8 +654,9 @@ let check_help_flag ?command = function
| _ -> return_unit | _ -> return_unit
let add_occurrence long value acc = let add_occurrence long value acc =
try TzString.Map.add long (TzString.Map.find long acc) acc match TzString.Map.find_opt long acc with
with Not_found -> TzString.Map.add long [ value ] acc | Some v -> TzString.Map.add long v acc
| None -> TzString.Map.add long [ value ] acc
let make_args_dict_consume ?command spec args = let make_args_dict_consume ?command spec args =
let rec make_args_dict completing arities acc args = let rec make_args_dict completing arities acc args =

6
src/lib_client_base/client_keys.ml
View File

@ -158,10 +158,10 @@ let register_signer signer =
Hashtbl.replace signers_table Signer.scheme signer Hashtbl.replace signers_table Signer.scheme signer
let find_signer_for_key ~scheme = let find_signer_for_key ~scheme =
match Hashtbl.find signers_table scheme with match Hashtbl.find_opt signers_table scheme with
| exception Not_found -> | None ->
fail (Unregistered_key_scheme scheme) fail (Unregistered_key_scheme scheme)
| signer -> return signer | Some signer -> return signer
let registered_signers () : (string * (module SIGNER)) list = let registered_signers () : (string * (module SIGNER)) list =
Hashtbl.fold (fun k v acc -> (k, v) :: acc) signers_table [] Hashtbl.fold (fun k v acc -> (k, v) :: acc) signers_table []

6
src/lib_data_encoding/binary_stream_reader.ml
View File

@ -329,14 +329,14 @@ let rec read_rec
| Union { tag_size ; cases } -> begin | Union { tag_size ; cases } -> begin
Atom.tag tag_size resume state @@ fun (ctag, state) -> Atom.tag tag_size resume state @@ fun (ctag, state) ->
match match
List.find List.find_opt
(function (function
| Case { tag = Tag tag } -> tag = ctag | Case { tag = Tag tag } -> tag = ctag
| Case { tag = Json_only } -> false) | Case { tag = Json_only } -> false)
cases cases
with with
| exception Not_found -> Error (Unexpected_tag ctag) | None -> Error (Unexpected_tag ctag)
| Case { encoding ; inj } -> | Some (Case { encoding ; inj }) ->
read_rec whole encoding state @@ fun (v, state) -> read_rec whole encoding state @@ fun (v, state) ->
k (inj v, state) k (inj v, state)
end end

6
src/lib_p2p/p2p_pool.ml
View File

@ -371,8 +371,8 @@ let gc_peer_ids ({ peer_meta_config = { score } ;
log pool Gc_peer_ids log pool Gc_peer_ids
let register_peer pool peer_id = let register_peer pool peer_id =
match P2p_peer.Table.find pool.known_peer_ids peer_id with match P2p_peer.Table.find_opt pool.known_peer_ids peer_id with
| exception Not_found -> | None ->
Lwt_condition.broadcast pool.events.new_peer () ; Lwt_condition.broadcast pool.events.new_peer () ;
let peer = let peer =
P2p_peer_state.Info.create peer_id P2p_peer_state.Info.create peer_id
@ -383,7 +383,7 @@ let register_peer pool peer_id =
P2p_peer.Table.add pool.known_peer_ids peer_id peer ; P2p_peer.Table.add pool.known_peer_ids peer_id peer ;
log pool (New_peer peer_id) ; log pool (New_peer peer_id) ;
peer peer
| peer -> peer | Some peer -> peer
(***************************************************************************) (***************************************************************************)

19
src/lib_protocol_environment/tezos_protocol_environment_memory.ml
View File

@ -54,22 +54,13 @@ module Context = struct
if m == v then None else Some v if m == v then None else Some v
| [], (Key _ | Dir _), None -> Some empty | [], (Key _ | Dir _), None -> Some empty
| n :: k, Dir m, _ -> begin | n :: k, Dir m, _ -> begin
match raw_set (StringMap.find n m) k v with match raw_set (Option.unopt ~default:empty
| exception Not_found -> begin (StringMap.find_opt n m)) k v with
match raw_set empty k v with
| None -> None
| Some rm ->
if rm = empty then
Some (Dir (StringMap.remove n m))
else
Some (Dir (StringMap.add n rm m))
end
| None -> None | None -> None
| Some rm when rm = empty ->
Some (Dir (StringMap.remove n m))
| Some rm -> | Some rm ->
if rm = empty then Some (Dir (StringMap.add n rm m))
Some (Dir (StringMap.remove n m))
else
Some (Dir (StringMap.add n rm m))
end end
| _ :: _, Key _, None -> None | _ :: _, Key _, None -> None
| _ :: _, Key _, Some _ -> | _ :: _, Key _, Some _ ->

41
src/lib_shell/distributed_db.ml
View File

@ -446,19 +446,19 @@ let read_operation { active_chains } h =
module P2p_reader = struct module P2p_reader = struct
let may_activate global_db state chain_id f = let may_activate global_db state chain_id f =
match Chain_id.Table.find state.peer_active_chains chain_id with match Chain_id.Table.find_opt state.peer_active_chains chain_id with
| chain_db -> | Some chain_db ->
f chain_db f chain_db
| exception Not_found -> | None ->
match Chain_id.Table.find global_db.active_chains chain_id with match Chain_id.Table.find_opt global_db.active_chains chain_id with
| chain_db -> | Some chain_db ->
chain_db.active_peers := chain_db.active_peers :=
P2p_peer.Set.add state.gid !(chain_db.active_peers) ; P2p_peer.Set.add state.gid !(chain_db.active_peers) ;
P2p_peer.Table.add chain_db.active_connections P2p_peer.Table.add chain_db.active_connections
state.gid state ; state.gid state ;
Chain_id.Table.add state.peer_active_chains chain_id chain_db ; Chain_id.Table.add state.peer_active_chains chain_id chain_db ;
f chain_db f chain_db
| exception Not_found -> | None ->
(* TODO decrease peer score. *) (* TODO decrease peer score. *)
Lwt.return_unit Lwt.return_unit
@ -469,18 +469,18 @@ module P2p_reader = struct
P2p_peer.Table.remove chain_db.active_connections state.gid P2p_peer.Table.remove chain_db.active_connections state.gid
let may_handle state chain_id f = let may_handle state chain_id f =
match Chain_id.Table.find state.peer_active_chains chain_id with match Chain_id.Table.find_opt state.peer_active_chains chain_id with
| exception Not_found -> | None ->
(* TODO decrease peer score *) (* TODO decrease peer score *)
Lwt.return_unit Lwt.return_unit
| chain_db -> | Some chain_db ->
f chain_db f chain_db
let may_handle_global global_db chain_id f = let may_handle_global global_db chain_id f =
match Chain_id.Table.find global_db.active_chains chain_id with match Chain_id.Table.find_opt global_db.active_chains chain_id with
| exception Not_found -> | None ->
Lwt.return_unit Lwt.return_unit
| chain_db -> | Some chain_db ->
f chain_db f chain_db
module Handle_msg_Logging = module Handle_msg_Logging =
@ -787,8 +787,8 @@ let create disk p2p =
let activate ({ p2p ; active_chains } as global_db) chain_state = let activate ({ p2p ; active_chains } as global_db) chain_state =
let chain_id = State.Chain.id chain_state in let chain_id = State.Chain.id chain_state in
match Chain_id.Table.find active_chains chain_id with match Chain_id.Table.find_opt active_chains chain_id with
| exception Not_found -> | None ->
let active_peers = ref P2p_peer.Set.empty in let active_peers = ref P2p_peer.Set.empty in
let p2p_request = let p2p_request =
{ data = () ; { data = () ;
@ -817,7 +817,7 @@ let activate ({ p2p ; active_chains } as global_db) chain_state =
end) ; end) ;
Chain_id.Table.add active_chains chain_id chain ; Chain_id.Table.add active_chains chain_id chain ;
chain chain
| chain -> | Some chain ->
chain chain
let set_callback chain_db callback = let set_callback chain_db callback =
@ -840,8 +840,7 @@ let deactivate chain_db =
Lwt.return_unit Lwt.return_unit
let get_chain { active_chains } chain_id = let get_chain { active_chains } chain_id =
try Some (Chain_id.Table.find active_chains chain_id) Chain_id.Table.find_opt active_chains chain_id
with Not_found -> None
let greylist { global_db = { p2p } } peer_id = let greylist { global_db = { p2p } } peer_id =
Lwt.return (P2p.greylist_peer p2p peer_id) Lwt.return (P2p.greylist_peer p2p peer_id)
@ -984,10 +983,10 @@ let broadcast chain_db msg =
chain_db.active_connections chain_db.active_connections
let try_send chain_db peer_id msg = let try_send chain_db peer_id msg =
try match P2p_peer.Table.find_opt chain_db.active_connections peer_id with
let conn = P2p_peer.Table.find chain_db.active_connections peer_id in | None -> ()
ignore (P2p.try_send chain_db.global_db.p2p conn.conn msg : bool) | Some conn ->
with Not_found -> () ignore (P2p.try_send chain_db.global_db.p2p conn.conn msg : bool)
let send chain_db ?peer msg = let send chain_db ?peer msg =
match peer with match peer with

89
src/lib_shell/distributed_db_functors.ml
View File

@ -75,6 +75,7 @@ module type MEMORY_TABLE = sig
type key type key
val create: int -> 'a t val create: int -> 'a t
val find: 'a t -> key -> 'a val find: 'a t -> key -> 'a
val find_opt: 'a t -> key -> 'a option
val add: 'a t -> key -> 'a -> unit val add: 'a t -> key -> 'a -> unit
val replace: 'a t -> key -> 'a -> unit val replace: 'a t -> key -> 'a -> unit
val remove: 'a t -> key -> unit val remove: 'a t -> key -> unit
@ -143,22 +144,22 @@ end = struct
| Found of value | Found of value
let known s k = let known s k =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> Disk_table.known s.disk k | None -> Disk_table.known s.disk k
| Pending _ -> Lwt.return_false | Some (Pending _) -> Lwt.return_false
| Found _ -> Lwt.return_true | Some (Found _) -> Lwt.return_true
let read_opt s k = let read_opt s k =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> Disk_table.read_opt s.disk k | None -> Disk_table.read_opt s.disk k
| Found v -> Lwt.return_some v | Some (Found v) -> Lwt.return_some v
| Pending _ -> Lwt.return_none | Some (Pending _) -> Lwt.return_none
let read_exn s k = let read_exn s k =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> Disk_table.read_exn s.disk k | None -> Disk_table.read_exn s.disk k
| Found v -> Lwt.return v | Some (Found v) -> Lwt.return v
| Pending _ -> Lwt.fail Not_found | Some (Pending _) -> Lwt.fail Not_found
type error += Missing_data of key type error += Missing_data of key
type error += Canceled of key type error += Canceled of key
@ -200,20 +201,20 @@ end = struct
(fun key -> Timeout key) (fun key -> Timeout key)
let read s k = let read s k =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> | None ->
trace (Missing_data k) @@ trace (Missing_data k) @@
Disk_table.read s.disk k Disk_table.read s.disk k
| Found v -> return v | Some (Found v) -> return v
| Pending _ -> fail (Missing_data k) | Some (Pending _) -> fail (Missing_data k)
let wrap s k ?timeout t = let wrap s k ?timeout t =
let t = Lwt.protected t in let t = Lwt.protected t in
Lwt.on_cancel t begin fun () -> Lwt.on_cancel t begin fun () ->
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> () | None -> ()
| Found _ -> () | Some (Found _) -> ()
| Pending data -> | Some (Pending data) ->
data.waiters <- data.waiters - 1 ; data.waiters <- data.waiters - 1 ;
if data.waiters = 0 then begin if data.waiters = 0 then begin
Memory_table.remove s.memory k ; Memory_table.remove s.memory k ;
@ -228,37 +229,37 @@ end = struct
Lwt.pick [ t ; timeout ] Lwt.pick [ t ; timeout ]
let fetch s ?peer ?timeout k param = let fetch s ?peer ?timeout k param =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> begin | None -> begin
Disk_table.read_opt s.disk k >>= function Disk_table.read_opt s.disk k >>= function
| Some v -> return v | Some v -> return v
| None -> | None ->
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> begin | None -> begin
let waiter, wakener = Lwt.wait () in let waiter, wakener = Lwt.wait () in
Memory_table.add s.memory k Memory_table.add s.memory k
(Pending { waiter ; wakener ; waiters = 1 ; param }) ; (Pending { waiter ; wakener ; waiters = 1 ; param }) ;
Scheduler.request s.scheduler peer k ; Scheduler.request s.scheduler peer k ;
wrap s k ?timeout waiter wrap s k ?timeout waiter
end end
| Pending data -> | Some (Pending data) ->
Scheduler.request s.scheduler peer k ; Scheduler.request s.scheduler peer k ;
data.waiters <- data.waiters + 1 ; data.waiters <- data.waiters + 1 ;
wrap s k ?timeout data.waiter wrap s k ?timeout data.waiter
| Found v -> return v | Some (Found v) -> return v
end end
| Pending data -> | Some (Pending data) ->
Scheduler.request s.scheduler peer k ; Scheduler.request s.scheduler peer k ;
data.waiters <- data.waiters + 1 ; data.waiters <- data.waiters + 1 ;
wrap s k ?timeout data.waiter wrap s k ?timeout data.waiter
| Found v -> return v | Some (Found v) -> return v
let prefetch s ?peer ?timeout k param = let prefetch s ?peer ?timeout k param =
try ignore (fetch s ?peer ?timeout k param) with _ -> () try ignore (fetch s ?peer ?timeout k param) with _ -> ()
let notify s p k v = let notify s p k v =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> begin | None -> begin
Disk_table.known s.disk k >>= function Disk_table.known s.disk k >>= function
| true -> | true ->
Scheduler.notify_duplicate s.scheduler p k ; Scheduler.notify_duplicate s.scheduler p k ;
@ -267,7 +268,7 @@ end = struct
Scheduler.notify_unrequested s.scheduler p k ; Scheduler.notify_unrequested s.scheduler p k ;
Lwt.return_unit Lwt.return_unit
end end
| Pending { wakener = w ; param } -> begin | Some (Pending { wakener = w ; param }) -> begin
match Precheck.precheck k param v with match Precheck.precheck k param v with
| None -> | None ->
Scheduler.notify_invalid s.scheduler p k ; Scheduler.notify_invalid s.scheduler p k ;
@ -281,13 +282,13 @@ end = struct
Lwt_watcher.notify s.input (k, v) ; Lwt_watcher.notify s.input (k, v) ;
Lwt.return_unit Lwt.return_unit
end end
| Found _ -> | Some (Found _) ->
Scheduler.notify_duplicate s.scheduler p k ; Scheduler.notify_duplicate s.scheduler p k ;
Lwt.return_unit Lwt.return_unit
let inject s k v = let inject s k v =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> begin | None -> begin
Disk_table.known s.disk k >>= function Disk_table.known s.disk k >>= function
| true -> | true ->
Lwt.return_false Lwt.return_false
@ -295,18 +296,18 @@ end = struct
Memory_table.add s.memory k (Found v) ; Memory_table.add s.memory k (Found v) ;
Lwt.return_true Lwt.return_true
end end
| Pending _ | Some (Pending _)
| Found _ -> | Some (Found _) ->
Lwt.return_false Lwt.return_false
let clear_or_cancel s k = let clear_or_cancel s k =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> () | None -> ()
| Pending { wakener = w ; _ } -> | Some (Pending { wakener = w ; _ }) ->
Scheduler.notify_cancelation s.scheduler k ; Scheduler.notify_cancelation s.scheduler k ;
Memory_table.remove s.memory k ; Memory_table.remove s.memory k ;
Lwt.wakeup_later w (Error [Canceled k]) Lwt.wakeup_later w (Error [Canceled k])
| Found _ -> Memory_table.remove s.memory k | Some (Found _) -> Memory_table.remove s.memory k
let watch s = Lwt_watcher.create_stream s.input let watch s = Lwt_watcher.create_stream s.input
@ -316,10 +317,10 @@ end = struct
{ scheduler ; disk ; memory ; input ; global_input } { scheduler ; disk ; memory ; input ; global_input }
let pending s k = let pending s k =
match Memory_table.find s.memory k with match Memory_table.find_opt s.memory k with
| exception Not_found -> false | None -> false
| Found _ -> false | Some (Found _) -> false
| Pending _ -> true | Some (Pending _) -> true
end end

1
src/lib_shell/distributed_db_functors.mli
View File

@ -127,6 +127,7 @@ module type MEMORY_TABLE = sig
type key type key
val create: int -> 'a t val create: int -> 'a t
val find: 'a t -> key -> 'a val find: 'a t -> key -> 'a
val find_opt: 'a t -> key -> 'a option
val add: 'a t -> key -> 'a -> unit val add: 'a t -> key -> 'a -> unit
val replace: 'a t -> key -> 'a -> unit val replace: 'a t -> key -> 'a -> unit
val remove: 'a t -> key -> unit val remove: 'a t -> key -> unit

18
src/lib_stdlib/hashPtree.ml
View File

@ -246,21 +246,21 @@ end = struct
let leaf ~key ~mask value = let leaf ~key ~mask value =
let l = Leaf { id = 0; key; value; mask } in let l = Leaf { id = 0; key; value; mask } in
match WeakTreeTbl.find weak_tree_tbl l with match WeakTreeTbl.find_opt weak_tree_tbl l with
| exception Not_found -> | None ->
set_id l (next ()); set_id l (next ());
WeakTreeTbl.add weak_tree_tbl l; WeakTreeTbl.add weak_tree_tbl l;
l l
| l -> l | Some l -> l
let node ~prefix ~mask ~true_ ~false_ = let node ~prefix ~mask ~true_ ~false_ =
let l = Node { id = 0; mask; prefix; true_; false_ } in let l = Node { id = 0; mask; prefix; true_; false_ } in
match WeakTreeTbl.find weak_tree_tbl l with match WeakTreeTbl.find_opt weak_tree_tbl l with
| exception Not_found -> | None ->
set_id l (next ()); set_id l (next ());
WeakTreeTbl.add weak_tree_tbl l; WeakTreeTbl.add weak_tree_tbl l;
l l
| l -> l | Some l -> l
let empty = Empty let empty = Empty
@ -970,9 +970,9 @@ module Make(P:Ptree_sig.Prefix)(V:Value) = struct
let cache : M.result Map_cache.t = Map_cache.create 10 let cache : M.result Map_cache.t = Map_cache.create 10
let rec map_reduce_ne t = let rec map_reduce_ne t =
match Map_cache.find cache t with match Map_cache.find_opt cache t with
| v -> v | Some v -> v
| exception Not_found -> | None ->
let v = let v =
match t with match t with
| T.Leaf leaf -> | T.Leaf leaf ->

4
src/lib_stdlib/tzString.ml
View File

@ -87,9 +87,7 @@ let common_prefix s1 s2 =
loop 0 loop 0
let mem_char s c = let mem_char s c =
match String.index s c with String.index_opt s c <> None
| exception Not_found -> false
| _ -> true
let fold_left f init s = let fold_left f init s =
let acc = ref init in let acc = ref init in