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

42
src/bin_client/client_rpc_commands.ml
View File

@ -156,17 +156,17 @@ let editor_fill_in ?(show_optionals=true) schema =
and edit () =
(* launch the user's editor on it *)
let editor_cmd =
try let ed = Sys.getenv "EDITOR" in Lwt_process.shell (ed ^ " " ^ tmp)
with Not_found ->
try let ed = Sys.getenv "VISUAL" in Lwt_process.shell (ed ^ " " ^ tmp)
with Not_found ->
if Sys.win32 then
let ed =
match Sys.getenv_opt "EDITOR", Sys.getenv_opt "VISUAL" with
| Some ed, _ -> ed
| None, Some ed -> ed
| None, None when Sys.win32 ->
(* TODO: I have no idea what I'm doing here *)
("", [| "notepad.exe" ; tmp |])
else
"notepad.exe"
| _ ->
(* TODO: vi on MacOSX ? *)
("", [| "nano" ; tmp |])
in
"nano" in
Lwt_process.shell (ed ^ " " ^ tmp) in
(Lwt_process.open_process_none editor_cmd) # status >>= function
| Unix.WEXITED 0 ->
reread () >>= fun json ->
@ -311,17 +311,17 @@ let schema meth url (cctxt : #Client_context.full) =
let open RPC_description in
RPC_description.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin
match RPC_service.MethMap.find meth services with
| exception Not_found ->
match RPC_service.MethMap.find_opt meth services with
| None ->
cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return_unit
| { input = Some input ; output } ->
| Some ({ input = Some input ; output }) ->
let json = `O [ "input", Json_schema.to_json (fst input) ;
"output", Json_schema.to_json (fst output) ] in
cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
return_unit
| { input = None ; output } ->
| Some ({ input = None ; output }) ->
let json = `O [ "output", Json_schema.to_json (fst output) ] in
cctxt#message "%a" Json_repr.(pp (module Ezjsonm)) json >>= fun () ->
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
RPC_description.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin
match RPC_service.MethMap.find meth services with
| exception Not_found ->
match RPC_service.MethMap.find_opt meth services with
| None ->
cctxt#message
"No service found at this URL (but this is a valid prefix)\n%!" >>= fun () ->
return_unit
| { input = Some input ; output } ->
| Some ({ input = Some input ; output }) ->
cctxt#message
"@[<v 0>\
@[<v 2>Input format:@,%a@]@,\
@ -355,7 +355,7 @@ let format binary meth url (cctxt : #Client_context.io_rpcs) =
pp input
pp output >>= fun () ->
return_unit
| { input = None ; output } ->
| Some ({ input = None ; output }) ->
cctxt#message
"@[<v 0>\
@[<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
RPC_description.describe cctxt ~recurse:false args >>=? function
| Static { services } -> begin
match RPC_service.MethMap.find meth services with
| exception Not_found ->
match RPC_service.MethMap.find_opt meth services with
| None ->
cctxt#message
"No service found at this URL with this method \
(but this is a valid prefix)\n%!" >>= fun () ->
return_unit
| { input = None } ->
| Some ({ input = None }) ->
cctxt#generic_json_call meth uri >>=?
display_answer cctxt
| { input = Some input } ->
| Some ({ input = Some input }) ->
fill_in ~show_optionals:false (fst input) >>= function
| Error msg ->
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"
-% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
Client_keys.list_keys cctxt >>=? fun all_keys ->
match List.find (fun (_, h, _, _) -> Signature.Public_key_hash.equal h pkh) all_keys with
| exception Not_found ->
match List.find_opt (fun (_, h, _, _) -> Signature.Public_key_hash.equal h pkh) all_keys with
| None ->
log Tag.DSL.(fun f ->
f "No public key found for hash %a"
-% t event "not_found_public_key"
-% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
Lwt.fail Not_found
| (_, _, None, _) ->
| Some (_, _, None, _) ->
log Tag.DSL.(fun f ->
f "No public key found for hash %a"
-% t event "not_found_public_key"
-% a Signature.Public_key_hash.Logging.tag pkh) >>= fun () ->
Lwt.fail Not_found
| (name, _, Some pk, _) ->
| Some (name, _, Some pk, _) ->
log Tag.DSL.(fun f ->
f "Found public key for hash %a (name: %s)"
-% 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
("", "")
else if s.[0] = '[' then begin (* inline IPv6 *)
match String.rindex s ']' with
| exception Not_found ->
match String.rindex_opt s ']' with
| None ->
invalid_arg "Utils.parse_addr_port (missing ']')"
| pos ->
| Some pos ->
let addr = String.sub s 1 (pos - 1) in
let port =
if pos = len - 1 then
@ -72,10 +72,10 @@ module Id = struct
check_port port ;
addr, port
end else begin
match String.rindex s ']' with
| _pos ->
match String.rindex_opt s ']' with
| Some _pos ->
invalid_arg "Utils.parse_addr_port (unexpected char ']')"
| exception Not_found ->
| None ->
match String.index s ':' with
| exception _ -> s, ""
| pos ->

49
src/lib_clic/clic.ml
View File

@ -272,18 +272,16 @@ let group_commands commands =
List.fold_left
(fun (grouped, ungrouped) (Ex (Command { group ; _ }) as command) ->
match group with
| None ->
(grouped, command :: ungrouped)
| None -> (grouped, command :: ungrouped)
| Some group ->
try
let ({ title ; _ }, r) =
List.find (fun ({ name ; _ }, _) -> group.name = name) grouped in
match
List.find_opt (fun ({ name ; _ }, _) -> group.name = name) grouped with
| None -> ((group, ref [ command ]) :: grouped, ungrouped)
| Some ({ title ; _ }, r) ->
if title <> group.title then
invalid_arg "Clic.usage: duplicate group name" ;
r := command :: !r ;
(grouped, ungrouped)
with Not_found ->
((group, ref [ command ]) :: grouped, ungrouped))
(grouped, ungrouped))
([], [])
commands in
List.map (fun (g, c) -> (g, List.rev !c))
@ -579,15 +577,15 @@ let parse_arg :
fun ?command spec args_dict ctx ->
match spec with
| Arg { parameter = (long, _) ; kind = { converter ; _ } ; _ } ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return_none
| [] -> return_none
| [ s ] ->
begin match TzString.Map.find_opt long args_dict with
| None
| Some [] -> return_none
| Some [ s ] ->
(trace
(Bad_option_argument ("--" ^ long, command))
(converter ctx s)) >>|? fun x ->
Some x
| _ :: _ ->
| Some (_ :: _) ->
fail (Multiple_occurences ("--" ^ long, command))
end
| DefArg { parameter = (long, _) ; kind = { converter ; _ } ; default ; _ } ->
@ -599,22 +597,22 @@ let parse_arg :
(Format.sprintf
"Value provided as default for '%s' could not be parsed by converter function."
long) end >>=? fun default ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return default
| [] -> return default
| [ s ] ->
begin match TzString.Map.find_opt long args_dict with
| None
| Some [] -> return default
| Some [ s ] ->
(trace
(Bad_option_argument (long, command))
(converter ctx s))
| _ :: _ ->
| Some (_ :: _) ->
fail (Multiple_occurences (long, command))
end
| Switch { parameter = (long, _) ; _ } ->
begin match TzString.Map.find long args_dict with
| exception Not_found -> return_false
| [] -> return_false
| [ _ ] -> return_true
| _ :: _ -> fail (Multiple_occurences (long, command))
begin match TzString.Map.find_opt long args_dict with
| None
| Some [] -> return_false
| Some [ _ ] -> return_true
| Some (_ :: _) -> fail (Multiple_occurences (long, command))
end
| Constant c -> return c
@ -656,8 +654,9 @@ let check_help_flag ?command = function
| _ -> return_unit
let add_occurrence long value acc =
try TzString.Map.add long (TzString.Map.find long acc) acc
with Not_found -> TzString.Map.add long [ value ] acc
match TzString.Map.find_opt long acc with
| Some v -> TzString.Map.add long v acc
| None -> TzString.Map.add long [ value ] acc
let make_args_dict_consume ?command spec 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
let find_signer_for_key ~scheme =
match Hashtbl.find signers_table scheme with
| exception Not_found ->
match Hashtbl.find_opt signers_table scheme with
| None ->
fail (Unregistered_key_scheme scheme)
| signer -> return signer
| Some signer -> return signer
let registered_signers () : (string * (module SIGNER)) list =
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
Atom.tag tag_size resume state @@ fun (ctag, state) ->
match
List.find
List.find_opt
(function
| Case { tag = Tag tag } -> tag = ctag
| Case { tag = Json_only } -> false)
cases
with
| exception Not_found -> Error (Unexpected_tag ctag)
| Case { encoding ; inj } ->
| None -> Error (Unexpected_tag ctag)
| Some (Case { encoding ; inj }) ->
read_rec whole encoding state @@ fun (v, state) ->
k (inj v, state)
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
let register_peer pool peer_id =
match P2p_peer.Table.find pool.known_peer_ids peer_id with
| exception Not_found ->
match P2p_peer.Table.find_opt pool.known_peer_ids peer_id with
| None ->
Lwt_condition.broadcast pool.events.new_peer () ;
let peer =
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 ;
log pool (New_peer peer_id) ;
peer
| peer -> peer
| Some peer -> peer
(***************************************************************************)

15
src/lib_protocol_environment/tezos_protocol_environment_memory.ml
View File

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

39
src/lib_shell/distributed_db.ml
View File

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

89
src/lib_shell/distributed_db_functors.ml
View File

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

1
src/lib_shell/distributed_db_functors.mli
View File

@ -127,6 +127,7 @@ module type MEMORY_TABLE = sig
type key
val create: int -> 'a t
val find: 'a t -> key -> 'a
val find_opt: 'a t -> key -> 'a option
val add: 'a t -> key -> 'a -> unit
val replace: 'a t -> key -> 'a -> 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 l = Leaf { id = 0; key; value; mask } in
match WeakTreeTbl.find weak_tree_tbl l with
| exception Not_found ->
match WeakTreeTbl.find_opt weak_tree_tbl l with
| None ->
set_id l (next ());
WeakTreeTbl.add weak_tree_tbl l;
l
| l -> l
| Some l -> l
let node ~prefix ~mask ~true_ ~false_ =
let l = Node { id = 0; mask; prefix; true_; false_ } in
match WeakTreeTbl.find weak_tree_tbl l with
| exception Not_found ->
match WeakTreeTbl.find_opt weak_tree_tbl l with
| None ->
set_id l (next ());
WeakTreeTbl.add weak_tree_tbl l;
l
| l -> l
| Some l -> l
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 rec map_reduce_ne t =
match Map_cache.find cache t with
| v -> v
| exception Not_found ->
match Map_cache.find_opt cache t with
| Some v -> v
| None ->
let v =
match t with
| T.Leaf leaf ->

4
src/lib_stdlib/tzString.ml
View File

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