diff --git a/compiler/src/codegen/comp_wasm_prim.re b/compiler/src/codegen/comp_wasm_prim.re index d04d187501..5ebe35beb2 100644 --- a/compiler/src/codegen/comp_wasm_prim.re +++ b/compiler/src/codegen/comp_wasm_prim.re @@ -146,9 +146,9 @@ let op_map = { }; let get_op = name => - try(OpHash.find(op_map, name)) { - | Not_found => - failwith(Printf.sprintf("internal: Wasm instruction not registered")) + switch (OpHash.find_opt(op_map, name)) { + | Some(op) => op + | None => failwith("internal: Wasm instruction not registered") }; let compile_wasm_prim1 = (wasm_mod, env, instr, ret_type, arg) => { diff --git a/compiler/src/codegen/concatlist.re b/compiler/src/codegen/concatlist.re index 20af047376..5bd5f31bf8 100644 --- a/compiler/src/codegen/concatlist.re +++ b/compiler/src/codegen/concatlist.re @@ -135,14 +135,14 @@ let rec rev = cl => let rec hd = cl => switch (cl) { | Singleton(e) - | Cons(e, _) => e - | Snoc(l, e) when is_empty(l) => e + | Cons(e, _) => Some(e) + | Snoc(l, e) when is_empty(l) => Some(e) | Snoc(l, _) => hd(l) | Append(l1, _) when !is_empty(l1) => hd(l1) | Append(_, l2) => hd(l2) - | Wrapped([hd, ..._]) => hd + | Wrapped([hd, ..._]) => Some(hd) | Wrapped([]) - | Empty => raise(Not_found) + | Empty => None }; let rec tl = cl => diff --git a/compiler/src/codegen/concatlist.rei b/compiler/src/codegen/concatlist.rei index 1ebc4aaf4d..efd4a30217 100644 --- a/compiler/src/codegen/concatlist.rei +++ b/compiler/src/codegen/concatlist.rei @@ -47,15 +47,11 @@ let rev: t('a) => t('a); /** Returns the first element of the given concatlist. If the list has no elements, [Failure "hd"] is raised. */ -/** Returns all but the first element of the given concatlist. If the list has no tail, - [Failure "tl"] is raised. */ -let hd: t('a) => 'a; +let hd: t('a) => option('a); /** Returns all but the first element of the given concatlist. If the list has no tail, [Failure "tl"] is raised. */ -/** Returns the last element of the given concatlist. If the list has no tail, - [Failure "last"] is raised. */ let tl: t('a) => t('a); diff --git a/compiler/src/codegen/transl_anf.re b/compiler/src/codegen/transl_anf.re index 8ff84a4345..d88021cbb5 100644 --- a/compiler/src/codegen/transl_anf.re +++ b/compiler/src/codegen/transl_anf.re @@ -156,20 +156,19 @@ let get_stack_size = () => { }; let find_id = (id, env) => - try(Ident.find_same(id, env.ce_binds)) { - | Not_found => - let alloc = Ident.find_same(id, global_table^); - MGlobalBind(global_name(id), alloc); + switch (Ident.find_same_opt(id, env.ce_binds)) { + | Some(v) => v + | None => + switch (Ident.find_same_opt(id, global_table^)) { + | Some(alloc) => MGlobalBind(global_name(id), alloc) + | None => raise(Not_found) + } }; let worklist_reset = () => Queue.clear(compilation_worklist); let worklist_enqueue = elt => Queue.add(elt, compilation_worklist); let worklist_empty = () => Queue.is_empty(compilation_worklist); -let worklist_pop = () => - switch (Queue.take_opt(compilation_worklist)) { - | None => raise(Not_found) - | Some(hd) => hd - }; +let worklist_pop = () => Queue.take_opt(compilation_worklist); let wasm_import_name = (mod_, name) => Printf.sprintf("wimport_%s_%s", mod_, name); @@ -734,14 +733,11 @@ let compile_worklist_elt = ({body, env}: worklist_elt) => | Precompiled(block, stack_size) => (block, stack_size) }; -let fold_left_pop = (f, base) => { - let rec help = acc => - if (worklist_empty()) { - acc; - } else { - help(f(acc, worklist_pop())); - }; - help(base); +let rec fold_left_pop = (f, base) => { + switch (worklist_pop()) { + | None => base + | Some(elt) => fold_left_pop(f, f(base, elt)) + }; }; let compile_remaining_worklist = () => { diff --git a/compiler/src/language_server/hover.re b/compiler/src/language_server/hover.re index 2ea5cc5363..e583e1dd40 100644 --- a/compiler/src/language_server/hover.re +++ b/compiler/src/language_server/hover.re @@ -124,15 +124,18 @@ let declaration_lens = (ident: Ident.t, decl: Types.type_declaration) => { let include_lens = (env: Env.t, path: Path.t) => { let header = grain_code_block("module " ++ Path.name(path)); - let decl = Env.find_module(path, None, env); - let module_decl = - switch (Modules.get_provides(decl)) { - | [_, ..._] => Some(module_lens(decl)) - | [] => None + switch (Env.find_module_opt(path, None, env)) { + | Some(decl) => + let module_decl = + switch (Modules.get_provides(decl)) { + | [_, ..._] => Some(module_lens(decl)) + | [] => None + }; + switch (module_decl) { + | Some(mod_sig) => Some(markdown_join(header, mod_sig)) + | None => Some(header) }; - switch (module_decl) { - | Some(mod_sig) => markdown_join(header, mod_sig) - | None => header + | None => None }; }; @@ -188,10 +191,7 @@ let process = | [Module({decl, loc}), ..._] => send_hover(~id, ~range=Utils.loc_to_range(loc), module_lens(decl)) | [Include({path, loc}), ..._] => - let hover_lens = - try(Some(include_lens(program.env, path))) { - | Not_found => None - }; + let hover_lens = include_lens(program.env, path); switch (hover_lens) { | Some(lens) => send_hover(~id, ~range=Utils.loc_to_range(loc), lens) | None => send_no_result(~id) diff --git a/compiler/src/language_server/sourcetree.re b/compiler/src/language_server/sourcetree.re index c2069e7589..60fc75a0c5 100644 --- a/compiler/src/language_server/sourcetree.re +++ b/compiler/src/language_server/sourcetree.re @@ -531,8 +531,8 @@ module Sourcetree: Sourcetree = { switch (stmt.ttop_desc) { | TTopModule(decl) => let path = Path.PIdent(decl.tmod_id); - try({ - let mod_decl = Env.find_module(path, None, stmt.ttop_env); + switch (Env.find_module_opt(path, None, stmt.ttop_env)) { + | Some(mod_decl) => segments := [ ( @@ -545,9 +545,8 @@ module Sourcetree: Sourcetree = { }), ), ...segments^, - ]; - }) { - | Not_found => () + ] + | None => () }; | TTopInclude(inc) => segments := diff --git a/compiler/src/middle_end/optimize_constants.re b/compiler/src/middle_end/optimize_constants.re index ebbe6163ea..4a413f1355 100644 --- a/compiler/src/middle_end/optimize_constants.re +++ b/compiler/src/middle_end/optimize_constants.re @@ -41,14 +41,12 @@ module ConstantPropagationArg: Anf_mapper.MapArgument = { let leave_imm_expression = ({imm_desc: desc} as i) => switch (desc) { | ImmId(id) => - try({ - let value = Ident.find_same(id, known_constants^); - { + switch (Ident.find_same_opt(id, known_constants^)) { + | Some(value) => { ...i, imm_desc: value, - }; - }) { - | Not_found => i + } + | None => i } | _ => i }; diff --git a/compiler/src/parsing/identifier.re b/compiler/src/parsing/identifier.re index 36cc731c9b..cef8b4d1ad 100644 --- a/compiler/src/parsing/identifier.re +++ b/compiler/src/parsing/identifier.re @@ -55,11 +55,12 @@ let last = | IdentExternal(_, s) => s.txt; let rec split_at_dots = (s, pos) => - try({ - let dot = String.index_from(s, pos, '.'); - [String.sub(s, pos, dot - pos), ...split_at_dots(s, dot + 1)]; - }) { - | Not_found => [String.sub(s, pos, String.length(s) - pos)] + switch (String.index_from_opt(s, pos, '.')) { + | Some(dot) => [ + String.sub(s, pos, dot - pos), + ...split_at_dots(s, dot + 1), + ] + | None => [String.sub(s, pos, String.length(s) - pos)] }; let flatten = n => { diff --git a/compiler/src/typed/ctype.re b/compiler/src/typed/ctype.re index e0d008b50d..a7629eb76b 100644 --- a/compiler/src/typed/ctype.re +++ b/compiler/src/typed/ctype.re @@ -251,13 +251,12 @@ let rec free_vars_rec = (real, ty) => { switch (ty.desc, really_closed^) { | (TTyVar(_), _) => free_variables := [(ty, real), ...free_variables^] | (TTyConstr(path, tl, _), Some(env)) => - try({ - let (_, body, _) = Env.find_type_expansion(path, env); + switch (Env.find_type_expansion_opt(path, env)) { + | Some((_, body, _)) => if (repr(body).level != generic_level) { free_variables := [(ty, real), ...free_variables^]; - }; - }) { - | Not_found => () + } + | None => () }; List.iter(free_vars_rec(true), tl); | _ => iter_type_expr(free_vars_rec(true), ty) @@ -446,15 +445,11 @@ let forward_try_expand_once = (without this constraint, the type system would actually be unsound.) */ let get_level = (env, p) => - try( - switch (Env.find_type(p, env).type_newtype_level) { - | None => Path.binding_time(p) - | Some((x, _)) => x - } - ) { - | Not_found => - /* no newtypes in predef */ - Path.binding_time(p) + switch (Env.find_type_opt(p, env)) { + | Some({type_newtype_level: None}) => Path.binding_time(p) + | Some({type_newtype_level: Some((x, _))}) => x + /* no newtypes in predef */ + | None => Path.binding_time(p) }; let rec normalize_package_path = (env, p) => @@ -475,11 +470,10 @@ let rec normalize_package_path = (env, p) => | _ -> p*/ let is_newtype = (env, p) => - try({ - let decl = Env.find_type(p, env); - decl.type_newtype_level != None && decl.type_kind == TDataAbstract; - }) { - | Not_found => false + switch (Env.find_type_opt(p, env)) { + | Some({type_newtype_level, type_kind}) => + type_newtype_level != None && type_kind == TDataAbstract + | None => false }; let rec update_level = (env, level, expand, ty) => { @@ -628,11 +622,9 @@ type inv_type_expr = { let rec inv_type = (hash, pty, ty) => { let ty = repr(ty); - try({ - let inv = TypeHash.find(hash, ty); - inv.inv_parents = pty @ inv.inv_parents; - }) { - | Not_found => + switch (TypeHash.find_opt(hash, ty)) { + | Some(inv) => inv.inv_parents = pty @ inv.inv_parents + | None => let inv = { inv_type: ty, inv_parents: pty, @@ -650,14 +642,13 @@ let compute_univars = ty => { switch (inv.inv_type.desc) { | TTyPoly(_ty, tl) when List.memq(univ, List.map(repr, tl)) => () | _ => - try({ - let univs = TypeHash.find(node_univars, inv.inv_type); + switch (TypeHash.find_opt(node_univars, inv.inv_type)) { + | Some(univs) => if (!TypeSet.mem(univ, univs^)) { univs := TypeSet.add(univ, univs^); List.iter(add_univar(univ), inv.inv_parents); - }; - }) { - | Not_found => + } + | None => TypeHash.add( node_univars, inv.inv_type, @@ -675,8 +666,9 @@ let compute_univars = ty => { inverted, ); ty => - try((TypeHash.find(node_univars, ty))^) { - | Not_found => TypeSet.empty + switch (TypeHash.find_opt(node_univars, ty)) { + | Some(univs) => univs^ + | None => TypeSet.empty }; }; @@ -833,8 +825,9 @@ let reset_reified_var_counter = () => reified_var_counter := Vars.empty; local constraints */ let get_new_abstract_name = s => { let index = - try(Vars.find(s, reified_var_counter^) + 1) { - | Not_found => 0 + switch (Vars.find_opt(s, reified_var_counter^)) { + | Some(index) => index + 1 + | None => 0 }; reified_var_counter := Vars.add(s, index, reified_var_counter^); if (index == 0 && s != "" && s.[String.length(s) - 1] != '$') { @@ -1164,7 +1157,7 @@ let check_abbrev_env = env => 4. The expansion requires the expansion of another abbreviation, and this other expansion fails. */ -let expand_abbrev_gen = (kind, find_type_expansion, env, ty) => { +let expand_abbrev_gen = (kind, find_type_expansion_opt, env, ty) => { check_abbrev_env(env); switch (ty) { | {desc: TTyConstr(path, args, abbrev), level} => @@ -1185,8 +1178,8 @@ let expand_abbrev_gen = (kind, find_type_expansion, env, ty) => { let ty' = repr(ty') /* assert (ty != ty'); */; /* PR#7324 */ ty'; | None => - switch (find_type_expansion(path, env)) { - | exception Not_found => + switch (find_type_expansion_opt(path, env)) { + | None => /* another way to expand is to normalize the path itself */ let path' = Env.normalize_path(None, env, path); if (Path.same(path, path')) { @@ -1194,7 +1187,7 @@ let expand_abbrev_gen = (kind, find_type_expansion, env, ty) => { } else { newty2(level, TTyConstr(path', args, abbrev)); }; - | (params, body, lv) => + | Some((params, body, lv)) => /* prerr_endline ("add a "^string_of_kind kind^" expansion for "^Path.name path);*/ let ty' = @@ -1208,7 +1201,7 @@ let expand_abbrev_gen = (kind, find_type_expansion, env, ty) => { /* Expand respecting privacy */ let expand_abbrev = (env, ty) => - expand_abbrev_gen(Public, Env.find_type_expansion, env, ty); + expand_abbrev_gen(Public, Env.find_type_expansion_opt, env, ty); /* Expand once the head of a type */ let expand_head_once = (env, ty) => @@ -1344,8 +1337,8 @@ let expand_head_opt = (env, ty) => { let enforce_constraints = (env, ty) => switch (ty) { | {desc: TTyConstr(path, args, _abbrev), level} => - try({ - let decl = Env.find_type(path, env); + switch (Env.find_type_opt(path, env)) { + | Some(decl) => ignore( subst( env, @@ -1357,9 +1350,8 @@ let enforce_constraints = (env, ty) => args, newvar2(level), ), - ); - }) { - | Not_found => () + ) + | None => () } | _ => assert(false) }; @@ -1369,35 +1361,28 @@ let enforce_constraints = (env, ty) => let full_expand = (env, ty) => repr(expand_head(env, ty)); /* - Check whether the abbreviation expands to a well-defined type. - During the typing of a class, abbreviations for correspondings - types expand to non-generic types. + Check whether the abbreviation expands to a well-defined type. + During the typing of a class, abbreviations for correspondings + types expand to non-generic types. */ let generic_abbrev = (env, path) => - try({ - let (_, body, _) = Env.find_type_expansion(path, env); - repr(body).level == generic_level; - }) { - | Not_found => false + switch (Env.find_type_expansion_opt(path, env)) { + | Some((_, body, _)) => repr(body).level == generic_level + | None => false }; let generic_private_abbrev = (env, path) => - try( - switch (Env.find_type(path, env)) { - | {type_kind: TDataAbstract, type_manifest: Some(body)} => - repr(body).level == generic_level - | _ => false - } - ) { - | Not_found => false + switch (Env.find_type_opt(path, env)) { + | Some({type_kind: TDataAbstract, type_manifest: Some(body)}) => + repr(body).level == generic_level + | _ => false }; let is_contractive = (env, p) => - try({ - let decl = Env.find_type(p, env); - in_pervasives(p) && decl.type_manifest == None || is_datatype(decl); - }) { - | Not_found => false + switch (Env.find_type_opt(p, env)) { + | Some(decl) => + in_pervasives(p) && decl.type_manifest == None || is_datatype(decl) + | None => false }; /*****************/ @@ -1523,8 +1508,9 @@ let rec local_non_recursive_abbrev = (strict, visited, env, p, ty) => { ) { | Cannot_expand => let params = - try(Env.find_type(p', env).type_params) { - | Not_found => args + switch (Env.find_type_opt(p', env)) { + | Some({type_params}) => type_params + | None => args }; List.iter2( @@ -1570,11 +1556,9 @@ let rec unify_univar = (t1, t2) => fun | [(cl1, cl2), ...rem] => { let find_univ = (t, cl) => - try({ - let (_, r) = List.find(((t', _)) => t === repr(t'), cl); - Some(r); - }) { - | Not_found => None + switch (List.find_opt(((t', _)) => t === repr(t'), cl)) { + | Some((_, r)) => Some(r) + | None => None }; switch (find_univ(t1, cl1), find_univ(t2, cl2)) { @@ -1600,17 +1584,14 @@ let occur_univar = (env, ty) => { ty.level = pivot_level - ty.level; true; } else { - try({ - let bound' = TypeMap.find(ty, visited^); - if (TypeSet.exists(x => !TypeSet.mem(x, bound), bound')) { - visited := - TypeMap.add(ty, TypeSet.inter(bound, bound'), visited^); - true; - } else { - false; - }; - }) { - | Not_found => + switch (TypeMap.find_opt(ty, visited^)) { + | Some(bound') + when TypeSet.exists(x => !TypeSet.mem(x, bound), bound') => + visited := + TypeMap.add(ty, TypeSet.inter(bound, bound'), visited^); + true; + | Some(_) => false + | None => visited := TypeMap.add(ty, bound, visited^); true; }; @@ -1627,21 +1608,16 @@ let occur_univar = (env, ty) => { | TTyConstr(_, [], _) => () | TTyConstr(p, tl, _) => /*let td = Env.find_type p env in*/ - try( - List.iter( - /*2*/ - t /*v*/ => - /*if Variance.(mem May_pos v || mem May_neg v) - then **/ occur_rec( - bound, - t, - ), - tl, - ) - ) { - /*td.type_variance*/ - | Not_found => List.iter(occur_rec(bound), tl) - } + List.iter( + /*2*/ + t /*v*/ => + /*if Variance.(mem May_pos v || mem May_neg v) + then **/ occur_rec( + bound, + t, + ), + tl, + ) | _ => iter_type_expr(occur_rec(bound), ty) }; }; @@ -1924,14 +1900,13 @@ let non_aliasable = (p, decl) => in_current_module(p) && decl.type_newtype_level == None; let is_instantiable = (env, p) => - try({ - let decl = Env.find_type(p, env); + switch (Env.find_type_opt(p, env)) { + | Some(decl) => decl.type_kind == TDataAbstract && decl.type_arity == 0 && decl.type_manifest == None - && !non_aliasable(p, decl); - }) { - | Not_found => false + && !non_aliasable(p, decl) + | None => false }; /* PR#7113: -safe-string should be a global property */ @@ -1986,8 +1961,9 @@ let rec mcomp = (type_pairs, env, t1, t2) => if (t1' === t2') { (); } else { - try(TypePairs.find(type_pairs, (t1', t2'))) { - | Not_found => + switch (TypePairs.find_opt(type_pairs, (t1', t2'))) { + | Some(v) => v + | None => TypePairs.add(type_pairs, (t1', t2'), ()); switch (t1'.desc, t2'.desc) { | (TTyVar(_), _) @@ -2155,13 +2131,9 @@ let find_lowest_level = ty => { }; let find_newtype_level = (env, path) => - try( - switch (Env.find_type(path, env).type_newtype_level) { - | Some(x) => x - | None => raise(Not_found) - } - ) { - | Not_found => + switch (Env.find_type_opt(path, env)) { + | Some({type_newtype_level: Some(x)}) => x + | _ => let lev = Path.binding_time(path); (lev, lev); }; @@ -2299,15 +2271,7 @@ let unify_eq = (t1, t2) => || ( switch (umode^) { | Expression => false - | Pattern => - try( - { - TypePairs.find(unify_eq_set, order_type_pair(t1, t2)); - true; - } - ) { - | Not_found => false - } + | Pattern => TypePairs.mem(unify_eq_set, order_type_pair(t1, t2)) } ); @@ -2748,8 +2712,9 @@ let rec moregen = (inst_nongen, type_pairs, env, t1, t2) => if (t1' === t2') { (); } else { - try(TypePairs.find(type_pairs, (t1', t2'))) { - | Not_found => + switch (TypePairs.find_opt(type_pairs, (t1', t2'))) { + | Some(v) => v + | None => TypePairs.add(type_pairs, (t1', t2'), ()); switch (t1'.desc, t2'.desc) { | (TTyVar(_), _) when may_instantiate(inst_nongen, t1') => @@ -2962,8 +2927,9 @@ let rec eqtype = (rename, type_pairs, subst, env, t1, t2) => if (t1' === t2') { (); } else { - try(TypePairs.find(type_pairs, (t1', t2'))) { - | Not_found => + switch (TypePairs.find_opt(type_pairs, (t1', t2'))) { + | Some(v) => v + | None => TypePairs.add(type_pairs, (t1', t2'), ()); switch (t1'.desc, t2'.desc) { | (TTyVar(_), TTyVar(_)) when rename => @@ -3194,8 +3160,9 @@ let rec nondep_type_rec = (env, id, ty) => | TTyUniVar(_) => ty | TTyLink(ty) => nondep_type_rec(env, id, ty) | _ => - try(TypeHash.find(nondep_hash, ty)) { - | Not_found => + switch (TypeHash.find_opt(nondep_hash, ty)) { + | Some(v) => v + | None => let ty' = newgenvar(); /* Stub */ TypeHash.add(nondep_hash, ty, ty'); ty'.desc = ( @@ -3270,14 +3237,12 @@ let nondep_type_decl = (env, mid, id, is_covariant, decl) => | Not_found when is_covariant => TDataAbstract } and tm = - try( - switch (decl.type_manifest) { - | None => None - | Some(ty) => - Some(unroll_abbrev(id, params, nondep_type_rec(env, mid, ty))) + switch (decl.type_manifest) { + | None => None + | Some(ty) => + try(Some(unroll_abbrev(id, params, nondep_type_rec(env, mid, ty)))) { + | Not_found when is_covariant => None } - ) { - | Not_found when is_covariant => None }; clear_hash(); @@ -3376,11 +3341,9 @@ let () = Env.same_constr := same_constr; let maybe_pointer_type = (env, typ) => switch (repr(typ).desc) { | TTyConstr(p, _args, _abbrev) => - try({ - let type_decl = Env.find_type(p, env); - type_decl.type_allocation == Managed; - }) { - | Not_found => true + switch (Env.find_type_opt(p, env)) { + | Some(type_decl) => type_decl.type_allocation == Managed + | None => true /* This can happen due to e.g. missing -I options, causing some .cmi files to be unavailable. Maybe we should emit a warning. */ diff --git a/compiler/src/typed/disambiguation.re b/compiler/src/typed/disambiguation.re index 5c4ac4eb7b..58d7550f82 100644 --- a/compiler/src/typed/disambiguation.re +++ b/compiler/src/typed/disambiguation.re @@ -23,10 +23,7 @@ let mk_expected = (~explanation=?, ty) => { }; let rec expand_path = (env, p) => { - let decl = - try(Some(Env.find_type(p, env))) { - | Not_found => None - }; + let decl = Env.find_type_opt(p, env); switch (decl) { | Some({type_manifest: Some(ty)}) => @@ -80,8 +77,9 @@ module NameChoice = /*Env.mark_type_used env (Path.last tpath) (Env.find_type tpath env);*/ switch (lid.txt) { | Identifier.IdentName(s) => - try(List.find(nd => get_name(nd) == s.txt, descrs)) { - | Not_found => + switch (List.find_opt(nd => get_name(nd) == s.txt, descrs)) { + | Some(v) => v + | None => let names = List.map(get_name, descrs); raise( Error( diff --git a/compiler/src/typed/env.re b/compiler/src/typed/env.re index d86d747eb8..0035b5bbc1 100644 --- a/compiler/src/typed/env.re +++ b/compiler/src/typed/env.re @@ -235,11 +235,12 @@ module TycompTbl = { }; let rec find_same = (id, tbl) => - try(Ident.find_same(id, tbl.current)) { - | Not_found as exn => + switch (Ident.find_same_opt(id, tbl.current)) { + | Some(v) => v + | None => switch (tbl.opened) { | Some({next, _}) => find_same(id, next) - | None => raise(exn) + | None => raise(Not_found) } }; @@ -267,8 +268,8 @@ module TycompTbl = { | Some({using, next, components}) => let rest = find_all(name, next); switch (Tbl.find(name, components)) { - | exception Not_found => rest - | opened => + | None => rest + | Some(opened) => List.map( desc => (desc, mk_callback(rest, name, desc, using)), opened, @@ -379,27 +380,31 @@ module IdTbl = { }; let rec find_same = (id, tbl) => - try(Ident.find_same(id, tbl.current)) { - | Not_found as exn => + switch (Ident.find_same_opt(id, tbl.current)) { + | Some(v) => v + | None => switch (tbl.opened) { | Some({next, _}) => find_same(id, next) - | None => raise(exn) + | None => raise(Not_found) } }; let rec find_name = (~mark, name, tbl) => - try({ - let (id, desc) = Ident.find_name(name, tbl.current); - (PIdent(id), desc); - }) { - | Not_found as exn => + switch (Ident.find_name_opt(name, tbl.current)) { + | Some((id, desc)) => (PIdent(id), desc) + | None => switch (tbl.opened) { | Some({using, root, next, components, aliases}) => try({ - let (descr, pos) = Tbl.find(name, components); + let (descr, pos) = + switch (Tbl.find(name, components)) { + | None => raise(Not_found) + | Some(v) => v + }; let aliased_name = - try(Tbl.find(name, aliases)) { - | Not_found => name + switch (Tbl.find(name, aliases)) { + | None => name + | Some(name) => name }; let res = (PExternal(root, aliased_name), descr); if (mark) { @@ -416,52 +421,42 @@ module IdTbl = { }) { | Not_found => find_name(~mark, name, next) } - | None => raise(exn) + | None => raise(Not_found) } }; let rec update = (name, f, tbl) => - try({ - let (id, desc) = Ident.find_name(name, tbl.current); + switch (Ident.find_name_opt(name, tbl.current)) { + | Some((id, desc)) => let new_desc = f(desc); { ...tbl, current: Ident.add(id, new_desc, tbl.current), }; - }) { - | Not_found => + | None => switch (tbl.opened) { | Some({root, using, next, components, aliases}) => - try({ - let (desc, pos) = Tbl.find(name, components); - let new_desc = f(desc); - let components = Tbl.add(name, (new_desc, pos), components); - { - ...tbl, - opened: - Some({ - root, - using, - next, - components, - aliases, - }), + let (components, next) = + switch (Tbl.find(name, components)) { + | Some((desc, pos)) => + let new_desc = f(desc); + let components = Tbl.add(name, (new_desc, pos), components); + (components, next); + | None => + let next = update(name, f, next); + (components, next); }; - }) { - | Not_found => - let next = update(name, f, next); - { - ...tbl, - opened: - Some({ - root, - using, - next, - components, - aliases, - }), - }; - } + { + ...tbl, + opened: + Some({ + root, + using, + next, + components, + aliases, + }), + }; | None => tbl } }; @@ -475,11 +470,12 @@ module IdTbl = { switch (tbl.opened) { | None => [] | Some({root, using: _, next, components}) => - try({ - let (desc, pos) = Tbl.find(name, components); - [(PExternal(root, name), desc), ...find_all(name, next)]; - }) { - | Not_found => find_all(name, next) + switch (Tbl.find(name, components)) { + | Some((desc, pos)) => [ + (PExternal(root, name), desc), + ...find_all(name, next), + ] + | None => find_all(name, next) } } ); @@ -919,8 +915,10 @@ let rec find_module_descr = (path, filename, env) => { } | PExternal(m, s) => let c = get_components(find_module_descr(m, filename, env)); - let (descr, _pos) = Tbl.find(s, c.comp_components); - descr; + switch (Tbl.find(s, c.comp_components)) { + | Some((descr, _pos)) => descr + | None => raise(Not_found) + }; }; }; @@ -929,8 +927,10 @@ let find = (proj1, proj2, path, env) => | PIdent(id) => IdTbl.find_same(id, proj1(env)) | PExternal(m, n) => let c = get_components(find_module_descr(m, None, env)); - let (data, _pos) = Tbl.find(n, proj2(c)); - data; + switch (Tbl.find(n, proj2(c))) { + | Some((data, _pos)) => data + | None => raise(Not_found) + }; }; let find_tycomp = (proj1, proj2, path, env) => @@ -939,7 +939,7 @@ let find_tycomp = (proj1, proj2, path, env) => | PExternal(m, n) => let c = get_components(find_module_descr(m, None, env)); switch (Tbl.find(n, proj2(c))) { - | [cstr, ..._] => cstr + | Some([cstr, ..._]) => cstr | _ => raise(Not_found) }; }; @@ -973,7 +973,11 @@ let find_extension_full = (path, env) => { | PIdent(id) => TycompTbl.find_same(id, env.constructors) | PExternal(p, s) => let comps = get_components(find_module_descr(p, None, env)); - let cstrs = Tbl.find(s, comps.comp_constrs); + let cstrs = + switch (Tbl.find(s, comps.comp_constrs)) { + | None => raise(Not_found) + | Some(cstrs) => cstrs + }; List.find( cstr => switch (cstr.cstr_tag) { @@ -988,8 +992,9 @@ let find_extension_full = (path, env) => { let rec find_type_full = (path, env) => switch (path) { | PIdent(_) => - try((PathMap.find(path, env.local_constraints), ([], []))) { - | Not_found => find_type_data(path, env) + switch (PathMap.find_opt(path, env.local_constraints)) { + | Some(decl) => (decl, ([], [])) + | None => find_type_data(path, env) } | PExternal(p, name) => if (name == "#extension#") { @@ -1012,6 +1017,10 @@ and find_cstr = (path, name, env) => { }; let find_type = (p, env) => fst(find_type_full(p, env)); +let find_type_opt = (p, env) => + try(Some(find_type(p, env))) { + | Not_found => None + }; let find_type_descrs = (p, env) => snd(find_type_full(p, env)); @@ -1038,8 +1047,14 @@ let find_module = (path, filename, env) => } | PExternal(m, n) => let c = get_components(find_module_descr(m, filename, env)); - let (data, _pos) = Tbl.find(n, c.comp_modules); - EnvLazy.force(subst_modtype_maker, data); + switch (Tbl.find(n, c.comp_modules)) { + | Some((data, _pos)) => EnvLazy.force(subst_modtype_maker, data) + | None => raise(Not_found) + }; + }; +let find_module_opt = (path, filename, env) => + try(Some(find_module(path, filename, env))) { + | Not_found => None }; let find_module_chain = (path, env) => { @@ -1054,8 +1069,16 @@ let find_module_chain = (path, env) => { | PExternal(m, s) => let (data, components) = find(m, env); let c = get_components(components); - let (decl, _pos) = Tbl.find(s, c.comp_modules); - let (components, _pos) = Tbl.find(s, c.comp_components); + let (decl, _pos) = + switch (Tbl.find(s, c.comp_modules)) { + | Some(v) => v + | None => raise(Not_found) + }; + let (components, _pos) = + switch (Tbl.find(s, c.comp_components)) { + | Some(v) => v + | None => raise(Not_found) + }; ([EnvLazy.force(subst_modtype_maker, decl), ...data], components); }; }; @@ -1076,13 +1099,10 @@ let rec normalize_path = (lax, env, path) => | PIdent(_) => expand_path(lax, env, path) } and expand_path = (lax, env, path) => - try( - switch (find_module(path, None, env)) { - | {md_type: TModAlias(path1)} => normalize_path(lax, env, path1) - | _ => path - } - ) { - | Not_found + switch (find_module_opt(path, None, env)) { + | Some({md_type: TModAlias(path1)}) => normalize_path(lax, env, path1) + | Some(_) => path + | None when lax || ( @@ -1091,6 +1111,7 @@ and expand_path = (lax, env, path) => | _ => true } ) => path + | None => raise(Not_found) }; let normalize_path = (oloc, env, path) => @@ -1112,48 +1133,35 @@ let normalize_path_prefix = (oloc, env, path) => }; /*| PApply _ -> assert false*/ -/* Find the manifest type associated to a type when appropriate: - - the type should be public */ -let find_type_expansion = (path, env) => { - let decl = find_type(path, env); - switch (decl.type_manifest) { - | Some(body) => ( - decl.type_params, - body, - Option.map(snd, decl.type_newtype_level), - ) - /* The manifest type of Private abstract data types without - private row are still considered unknown to the type system. - Hence, this case is caught by the following clause that also handles - purely abstract data types without manifest type definition. */ - | _ => raise(Not_found) - }; -}; - /* Find the manifest type information associated to a type, i.e. the necessary information for the compiler's type-based optimisations. In particular, the manifest type associated to a private abstract type is revealed for the sake of compiler's type-based optimisations. */ let find_type_expansion_opt = (path, env) => { - let decl = find_type(path, env); - switch (decl.type_manifest) { - /* The manifest type of Private abstract data types can still get - an approximation using their manifest type. */ - | Some(body) => ( - decl.type_params, - body, - Option.map(snd, decl.type_newtype_level), - ) - | _ => raise(Not_found) + let decl = find_type_opt(path, env); + switch (decl) { + | Some({type_params, type_newtype_level, type_manifest: Some(body)}) => + /* The manifest type of Private abstract data types can still get + an approximation using their manifest type. */ + Some((type_params, body, Option.map(snd, type_newtype_level))) + | _ => None }; }; -let find_modtype_expansion = (path, env) => - switch (find_modtype(path, env).mtd_type) { +/* Find the manifest type associated to a type when appropriate: + - the type should be public */ +let find_type_expansion = (path, env) => + switch (find_type_expansion_opt(path, env)) { + | Some(v) => v + /* The manifest type of Private abstract data types without + private row are still considered unknown to the type system. + Hence, this case is caught by the following clause that also handles + purely abstract data types without manifest type definition. */ | None => raise(Not_found) - | Some(mty) => mty }; +let find_modtype_expansion = (path, env) => find_modtype(path, env).mtd_type; + let has_local_constraints = env => !PathMap.is_empty(env.local_constraints); /* Currently a no-op */ @@ -1168,8 +1176,10 @@ let rec lookup_module_descr_aux = (~mark, id, env) => | IdentName({txt: s}) => IdTbl.find_name(~mark, s, env.components) | IdentExternal(m, {txt: n}) => let (p, descr) = lookup_module_descr(~mark, m, env); - let (descr, pos) = Tbl.find(n, get_components(descr).comp_components); - (PExternal(p, n), descr); + switch (Tbl.find(n, get_components(descr).comp_components)) { + | Some((descr, pos)) => (PExternal(p, n), descr) + | None => raise(Not_found) + }; } ) @@ -1216,12 +1226,15 @@ and lookup_module = (~loc=?, ~load, ~mark, id, filename, env): Path.t => | Identifier.IdentExternal(l, {txt: s}) => let (p, descr) = lookup_module_descr(~mark, l, env); let c = get_components(descr); - let (comps, _) = Tbl.find(s, c.comp_components); - if (mark) { - mark_module_used(env, s, comps.loc); + switch (Tbl.find(s, c.comp_components)) { + | Some((comps, _)) => + if (mark) { + mark_module_used(env, s, comps.loc); + }; + let p = PExternal(p, s); + p; + | None => raise(Not_found) }; - let p = PExternal(p, s); - p; }; let lookup_idtbl = (~mark, proj1, proj2, id, env) => @@ -1230,8 +1243,10 @@ let lookup_idtbl = (~mark, proj1, proj2, id, env) => | IdentName({txt: s}) => IdTbl.find_name(~mark, s, proj1(env)) | IdentExternal(m, {txt: n}) => let (p, desc) = lookup_module_descr(~mark, m, env); - let (data, pos) = Tbl.find(n, proj2(get_components(desc))); - (PExternal(p, n), data); + switch (Tbl.find(n, proj2(get_components(desc)))) { + | Some((data, pos)) => (PExternal(p, n), data) + | None => raise(Not_found) + }; } ); @@ -1242,8 +1257,9 @@ let lookup_tycomptbl = (~mark, proj1, proj2, id, env) => | IdentExternal(m, {txt: n}) => let (p, desc) = lookup_module_descr(~mark, m, env); let comps = - try(Tbl.find(n, proj2(get_components(desc)))) { - | Not_found => [] + switch (Tbl.find(n, proj2(get_components(desc)))) { + | Some(v) => v + | None => [] }; List.map(data => (data, () => ()), comps); } @@ -1283,11 +1299,9 @@ let lookup_label = (~mark, lid, env) => }; let mark_type_path = (env, path) => - try({ - let decl = find_type(path, env); - mark_type_used(env, Path.last(path), decl); - }) { - | Not_found => () + switch (find_type_opt(path, env)) { + | Some(decl) => mark_type_used(env, Path.last(path), decl) + | None => () }; let ty_path = t => @@ -1442,11 +1456,9 @@ let used_persistent = () => { let find_all_comps = (proj, s, (p, mcomps)) => { let comps = get_components(mcomps); - try({ - let (c, n) = Tbl.find(s, proj(comps)); - [(PExternal(p, s), c)]; - }) { - | Not_found => [] + switch (Tbl.find(s, proj(comps))) { + | Some((c, n)) => [(PExternal(p, s), c)] + | None => [] }; }; @@ -1478,9 +1490,11 @@ let rec scrape_alias = (env, ~path=?, mty) => switch (mty, path) { | (TModIdent(p), _) | (TModAlias(p), _) => - try(scrape_alias(env, find_modtype_expansion(p, env), ~path?)) { - | Not_found => mty - } + let mod_typ = find_modtype_expansion(p, env); + switch (mod_typ) { + | Some(mod_typ) => scrape_alias(env, mod_typ, ~path?) + | None => mty + }; | (mty, Some(path)) => strengthen^(~aliasable=true, env, mty, path) | _ => mty }; @@ -1533,15 +1547,17 @@ let rec prefix_idents = (root, pos, sub) => let prefix_idents = (root, sub, sg) => if (sub == Subst.identity) { let sgs = - try(Hashtbl.find(prefixed_sg, root)) { - | Not_found => + switch (Hashtbl.find_opt(prefixed_sg, root)) { + | Some(v) => v + | None => let sgs = ref([]); Hashtbl.add(prefixed_sg, root, sgs); sgs; }; - try(List.assq(sg, sgs^)) { - | Not_found => + switch (List.assq_opt(sg, sgs^)) { + | Some(r) => r + | None => let r = prefix_idents(root, 0, sub, sg); sgs := [(sg, r), ...sgs^]; r; @@ -1566,8 +1582,9 @@ let check_value_name = (name, loc) => let add_to_tbl = (id, decl, tbl) => { let decls = - try(Tbl.find(id, tbl)) { - | Not_found => [] + switch (Tbl.find(id, tbl)) { + | Some(decls) => decls + | None => [] }; Tbl.add(id, [decl, ...decls], tbl); }; @@ -2105,11 +2122,11 @@ let use_partial_signature = (root, items, env0) => { | Parsetree.PUseValue({name, alias, loc}) => let (old_name, new_name) = apply_alias(name, alias); switch (Tbl.find(old_name, comps.comp_values)) { - | exception Not_found => + | None => error( Value_not_found_in_module(name.loc, old_name, Path.name(root)), ) - | (descr, pos) as d => + | Some((descr, pos) as d) => new_comps.comp_values = Tbl.add(new_name, d, new_comps.comp_values); TUseValue({ @@ -2121,7 +2138,7 @@ let use_partial_signature = (root, items, env0) => { | PUseModule({name, alias, loc}) => let (old_name, new_name) = apply_alias(name, alias); switch (Tbl.find(old_name, comps.comp_modules)) { - | exception Not_found => + | None => let possible_type = if (Tbl.mem(old_name, comps.comp_types)) { Some(old_name); @@ -2136,13 +2153,16 @@ let use_partial_signature = (root, items, env0) => { possible_type, ), ); - | (descr, pos) as d => + | Some((descr, pos) as d) => new_comps.comp_modules = Tbl.add(new_name, d, new_comps.comp_modules); new_comps.comp_components = Tbl.add( new_name, - Tbl.find(old_name, comps.comp_components), + switch (Tbl.find(old_name, comps.comp_components)) { + | Some(v) => v + | None => raise(Not_found) + }, new_comps.comp_components, ); aliases := Tbl.add(new_name, old_name, aliases^); @@ -2155,11 +2175,11 @@ let use_partial_signature = (root, items, env0) => { | PUseType({name, alias, loc}) => let (old_name, new_name) = apply_alias(name, alias); switch (Tbl.find(old_name, comps.comp_types)) { - | exception Not_found => + | None => error( Type_not_found_in_module(name.loc, old_name, Path.name(root)), ) - | ((decl, (constructors, labels)), _) as descr => + | Some(((decl, (constructors, labels)), _) as descr) => new_comps.comp_types = Tbl.add(new_name, descr, new_comps.comp_types); aliases := Tbl.add(new_name, old_name, aliases^); @@ -2168,7 +2188,10 @@ let use_partial_signature = (root, items, env0) => { new_comps.comp_constrs = Tbl.add( cstr_name, - Tbl.find(cstr_name, comps.comp_constrs), + switch (Tbl.find(cstr_name, comps.comp_constrs)) { + | Some(v) => v + | None => raise(Not_found) + }, new_comps.comp_constrs, ) }, @@ -2179,7 +2202,10 @@ let use_partial_signature = (root, items, env0) => { new_comps.comp_labels = Tbl.add( lbl_name, - Tbl.find(lbl_name, comps.comp_labels), + switch (Tbl.find(lbl_name, comps.comp_labels)) { + | Some(v) => v + | None => raise(Not_found) + }, new_comps.comp_labels, ) }, @@ -2194,7 +2220,7 @@ let use_partial_signature = (root, items, env0) => { | PUseException({name, alias, loc}) => let (old_name, new_name) = apply_alias(name, alias); switch (Tbl.find(old_name, comps.comp_constrs)) { - | exception Not_found => + | None => error( Exception_not_found_in_module( name.loc, @@ -2202,7 +2228,7 @@ let use_partial_signature = (root, items, env0) => { Path.name(root), ), ) - | cstrs => + | Some(cstrs) => let (ext, cstr_name) = List.find_map( cstr => @@ -2217,7 +2243,10 @@ let use_partial_signature = (root, items, env0) => { new_comps.comp_constrs = Tbl.add( new_name, - Tbl.find(cstr_name, comps.comp_constrs), + switch (Tbl.find(cstr_name, comps.comp_constrs)) { + | Some(v) => v + | None => raise(Not_found) + }, new_comps.comp_constrs, ); TUseException({ @@ -2450,10 +2479,10 @@ let rec get_type_path = type_expr => { let get_type_definition_loc = (type_expr, env) => { switch (get_type_path(type_expr)) { | Some(path) => - switch (find_type(path, env)) { - | exception Not_found => None - | {type_loc} when type_loc == Location.dummy_loc => None - | {type_loc} => Some(type_loc) + switch (find_type_opt(path, env)) { + | None => None + | Some({type_loc}) when type_loc == Location.dummy_loc => None + | Some({type_loc}) => Some(type_loc) } | _ => None }; diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei index a7f253fd94..b3eab663a4 100644 --- a/compiler/src/typed/env.rei +++ b/compiler/src/typed/env.rei @@ -60,19 +60,22 @@ let without_cmis: ('a => 'b, 'a) => 'b; /* By-path lookups */ let find_value: (Path.t, t) => value_description; let find_type: (Path.t, t) => type_declaration; +let find_type_opt: (Path.t, t) => option(type_declaration); let find_type_descrs: (Path.t, t) => type_descriptions; let find_constructor: (Path.t, t) => constructor_description; let find_module_chain: (Path.t, t) => list(module_declaration); let find_module: (Path.t, option(string), t) => module_declaration; +let find_module_opt: + (Path.t, option(string), t) => option(module_declaration); let find_modtype: (Path.t, t) => modtype_declaration; let find_type_expansion: (Path.t, t) => (list(type_expr), type_expr, option(int)); let find_type_expansion_opt: - (Path.t, t) => (list(type_expr), type_expr, option(int)); + (Path.t, t) => option((list(type_expr), type_expr, option(int))); /* Find the manifest type information associated to a type for the sake of the compiler's type-based optimisations. */ -let find_modtype_expansion: (Path.t, t) => module_type; +let find_modtype_expansion: (Path.t, t) => option(module_type); let normalize_path: (option(Location.t), t, Path.t) => Path.t; /** Normalize the path to a concrete value or module. If the option is None, allow returning dangling paths. diff --git a/compiler/src/typed/ident.re b/compiler/src/typed/ident.re index 8f21805c85..a9e3279f47 100644 --- a/compiler/src/typed/ident.re +++ b/compiler/src/typed/ident.re @@ -283,34 +283,29 @@ let rec add = (id, data) => }; }; -let rec find_stamp = s => +let rec find_stamp_opt = s => fun - | None => raise(Not_found) + | None => None | Some(k) => if (k.ident.stamp == s) { - k.data; + Some(k.data); } else { - find_stamp(s, k.previous); + find_stamp_opt(s, k.previous); }; -let find_stamp_opt = (s, o) => - try(Some(find_stamp(s, o))) { - | Not_found => None - }; - -let rec find_same = id => +let rec find_same_opt = id => fun - | Empty => raise(Not_found) + | Empty => None | Node(l, k, r, _) => { let c = compare(id.name, k.ident.name); if (c == 0) { if (id.stamp == k.ident.stamp) { - k.data; + Some(k.data); } else { - find_stamp(id.stamp, k.previous); + find_stamp_opt(id.stamp, k.previous); }; } else { - find_same( + find_same_opt( id, if (c < 0) { l; @@ -321,20 +316,15 @@ let rec find_same = id => }; }; -let find_same_opt = (id, tbl) => - try(Some(find_same(id, tbl))) { - | Not_found => None - }; - -let rec find_name = name => +let rec find_name_opt = name => fun - | Empty => raise(Not_found) + | Empty => None | Node(l, k, r, _) => { let c = compare(name, k.ident.name); if (c == 0) { - (k.ident, k.data); + Some((k.ident, k.data)); } else { - find_name( + find_name_opt( name, if (c < 0) { l; @@ -345,11 +335,6 @@ let rec find_name = name => }; }; -let find_name_opt = (name, tbl) => - try(Some(find_name(name, tbl))) { - | Not_found => None - }; - let rec get_all = fun | None => [] diff --git a/compiler/src/typed/ident.rei b/compiler/src/typed/ident.rei index 1814d27a6d..e5bc123dc9 100644 --- a/compiler/src/typed/ident.rei +++ b/compiler/src/typed/ident.rei @@ -76,9 +76,7 @@ type tbl('a); let empty: tbl('a); let add: (t, 'a, tbl('a)) => tbl('a); let find_same_opt: (t, tbl('a)) => option('a); -let find_same: (t, tbl('a)) => 'a; let find_name_opt: (string, tbl('a)) => option((t, 'a)); -let find_name: (string, tbl('a)) => (t, 'a); let find_all: (string, tbl('a)) => list((t, 'a)); let fold_name: ((t, 'a, 'b) => 'b, tbl('a), 'b) => 'b; let fold_all: ((t, 'a, 'b) => 'b, tbl('a), 'b) => 'b; diff --git a/compiler/src/typed/includemod.re b/compiler/src/typed/includemod.re index ec4a9c28a1..f5edc5eed2 100644 --- a/compiler/src/typed/includemod.re +++ b/compiler/src/typed/includemod.re @@ -160,23 +160,21 @@ let extension_constructors = (~loc, env, ~mark, cxt, subst, id, ext1, ext2) => { exception Dont_match; let may_expand_module_path = (env, path) => - try( - { - ignore(Env.find_modtype_expansion(path, env)); - true; - } - ) { - | Not_found => false + switch (Env.find_modtype_expansion(path, env)) { + | Some(_) => true + | None => false }; let expand_module_path = (env, cxt, path) => - try(Env.find_modtype_expansion(path, env)) { - | Not_found => raise(Error([(cxt, env, Unbound_modtype_path(path))])) + switch (Env.find_modtype_expansion(path, env)) { + | Some(mty) => mty + | None => raise(Error([(cxt, env, Unbound_modtype_path(path))])) }; let expand_module_alias = (env, cxt, path) => - try(Env.find_module(path, None, env).md_type) { - | Not_found => raise(Error([(cxt, env, Unbound_module_path(path))])) + switch (Env.find_module_opt(path, None, env)) { + | Some({md_type}) => md_type + | _ => raise(Error([(cxt, env, Unbound_module_path(path))])) }; /* @@ -491,8 +489,8 @@ and signatures = (~loc, env, ~mark, cxt, subst, sig1, sig2) => { | _ => (name2, true) }; - try({ - let (id1, item1, pos1) = Tbl.find(name2, comps1); + switch (Tbl.find(name2, comps1)) { + | Some((id1, item1, pos1)) => let new_subst = switch (item2) { | TSigType(_) => Subst.add_type(id2, PIdent(id1), subst) @@ -511,8 +509,7 @@ and signatures = (~loc, env, ~mark, cxt, subst, sig1, sig2) => { unpaired, rem, ); - }) { - | Not_found => + | None => let unpaired = if (report) { [ diff --git a/compiler/src/typed/mtype.re b/compiler/src/typed/mtype.re index 7806d7d3e1..e5bfb91dfe 100644 --- a/compiler/src/typed/mtype.re +++ b/compiler/src/typed/mtype.re @@ -23,9 +23,11 @@ open Types; let rec scrape = (env, mty) => switch (mty) { | TModIdent(p) => - try(scrape(env, Env.find_modtype_expansion(p, env))) { - | Not_found => mty - } + let mod_typ = Env.find_modtype_expansion(p, env); + switch (mod_typ) { + | Some(mod_typ) => scrape(env, mod_typ) + | None => mty + }; | _ => mty }; @@ -155,11 +157,9 @@ let scrape_for_type_of = (env, mty) => { let rec loop = (env, path, mty) => switch (mty, path) { | (TModAlias(path), _) => - try({ - let md = Env.find_module(path, None, env); - loop(env, Some(path), md.md_type); - }) { - | Not_found => mty + switch (Env.find_module_opt(path, None, env)) { + | Some(md) => loop(env, Some(path), md.md_type) + | None => mty } | (mty, Some(path)) => strengthen(~aliasable=false, env, mty, path) | _ => mty @@ -168,117 +168,6 @@ let scrape_for_type_of = (env, mty) => { loop(env, None, mty); }; -/* In nondep_supertype, env is only used for the type it assigns to id. - Hence there is no need to keep env up-to-date by adding the bindings - traversed. */ - -type variance = - | Co - | Contra - | Strict; - -let nondep_supertype = (env, mid, mty) => { - let rec nondep_mty = (env, va, mty) => - switch (mty) { - | TModIdent(p) => - if (Path.isfree(mid, p)) { - nondep_mty(env, va, Env.find_modtype_expansion(p, env)); - } else { - mty; - } - | TModAlias(p) => - if (Path.isfree(mid, p)) { - nondep_mty(env, va, Env.find_module(p, None, env).md_type); - } else { - mty; - } - | TModSignature(sg) => TModSignature(nondep_sig(env, va, sg)) - } - /*| Mty_functor(param, arg, res) -> - let var_inv = - match va with Co -> Contra | Contra -> Co | Strict -> Strict in - Mty_functor(param, Option.map (nondep_mty env var_inv) arg, - nondep_mty - (Env.add_module ~arg:true param - (Btype.default_mty arg) env) va res)*/ - - and nondep_sig = (env, va) => - fun - | [] => [] - | [item, ...rem] => { - let rem' = nondep_sig(env, va, rem); - switch (item) { - | TSigValue(id, d) => [ - TSigValue( - id, - { - ...d, - val_type: Ctype.nondep_type(env, mid, d.val_type), - }, - ), - ...rem', - ] - | TSigType(id, d, rs) => [ - TSigType( - id, - Ctype.nondep_type_decl(env, mid, id, va == Co, d), - rs, - ), - ...rem', - ] - | TSigTypeExt(id, ext, es) => [ - TSigTypeExt( - id, - Ctype.nondep_extension_constructor(env, mid, ext), - es, - ), - ...rem', - ] - | TSigModule(id, md, rs) => [ - TSigModule( - id, - { - ...md, - md_type: nondep_mty(env, va, md.md_type), - }, - rs, - ), - ...rem', - ] - | TSigModType(id, d) => - try([TSigModType(id, nondep_modtype_decl(env, d)), ...rem']) { - | Not_found => - switch (va) { - | Co => [ - TSigModType( - id, - { - mtd_type: None, - mtd_loc: Location.dummy_loc /*mtd_attributes=[]*/, - }, - ), - ...rem', - ] - | _ => raise(Not_found) - } - } - }; - } - /*| Sig_class(id, d, rs) -> - Sig_class(id, Ctype.nondep_class_declaration env mid d, rs) - :: rem' - | Sig_class_type(id, d, rs) -> - Sig_class_type(id, Ctype.nondep_cltype_declaration env mid d, rs) - :: rem'*/ - - and nondep_modtype_decl = (env, mtd) => { - ...mtd, - mtd_type: Option.map(nondep_mty(env, Strict), mtd.mtd_type), - }; - - nondep_mty(env, Co, mty); -}; - let enrich_typedecl = (env, p, id, decl) => switch (decl.type_manifest) { | Some(_) => decl @@ -488,8 +377,9 @@ let rec get_arg_paths = (PathSet.union (get_arg_paths p1) (get_arg_paths p2)))*/ let rec rollback_path = (subst, p) => - try(PIdent(PathMap.find(p, subst))) { - | Not_found => + switch (PathMap.find_opt(p, subst)) { + | Some(p') => PIdent(p') + | None => switch (p) { | PIdent(_) /*| Papply _*/ => p | PExternal(p1, s) => @@ -506,8 +396,9 @@ let rec collect_ids = (subst, bindings, p) => switch (rollback_path(subst, p)) { | PIdent(id) => let ids = - try(collect_ids(subst, bindings, Ident.find_same(id, bindings))) { - | Not_found => Ident.Set.empty + switch (Ident.find_same_opt(id, bindings)) { + | Some(id) => collect_ids(subst, bindings, id) + | None => Ident.Set.empty }; Ident.Set.add(id, ids); diff --git a/compiler/src/typed/parmatch.re b/compiler/src/typed/parmatch.re index 121fbeede5..8b034083e0 100644 --- a/compiler/src/typed/parmatch.re +++ b/compiler/src/typed/parmatch.re @@ -190,7 +190,7 @@ let all_coherent = column => { }; switch ( - List.find( + List.find_opt( head_pat => switch (head_pat.pat_desc) { | TPatVar(_) @@ -202,10 +202,10 @@ let all_coherent = column => { column, ) ) { - | exception Not_found => + | None => /* only omegas on the column: the column is coherent. */ true - | discr_pat => List.for_all(coherent_heads(discr_pat), column) + | Some(discr_pat) => List.for_all(coherent_heads(discr_pat), column) }; }; @@ -444,9 +444,9 @@ let record_arg = ph => { let extract_fields = (fields, arg) => { let get_field = (pos, arg) => { - switch (List.find(((_, lbl, _)) => pos == lbl.lbl_pos, arg)) { - | (_, _, p) => p - | exception Not_found => omega + switch (List.find_opt(((_, lbl, _)) => pos == lbl.lbl_pos, arg)) { + | Some((_, _, p)) => p + | None => omega }; }; List.map(((_, lbl, _)) => get_field(lbl.lbl_pos, arg), fields); @@ -915,19 +915,15 @@ let pats_of_type = (~always=false, env, ty) => { let ty' = Ctype.expand_head(env, ty); switch (ty'.desc) { | TTyConstr(path, _, _) => - try( - switch (Env.find_type(path, env).type_kind) { - | TDataVariant(cl) - when - always - || List.length(cl) == 1 - || List.for_all(cd => cd.Types.cd_res != None, cl) => - let (cstrs, _) = Env.find_type_descrs(path, env); - List.map(pat_of_constr(make_pat(TPatAny, ty, env)), cstrs); - | _ => [omega] - } - ) { - | Not_found => [omega] + switch (Env.find_type_opt(path, env)) { + | Some({type_kind: TDataVariant(cl)}) + when + always + || List.length(cl) == 1 + || List.for_all(cd => cd.Types.cd_res != None, cl) => + let (cstrs, _) = Env.find_type_descrs(path, env); + List.map(pat_of_constr(make_pat(TPatAny, ty, env)), cstrs); + | _ => [omega] } | TTyTuple(tl) => [ make_pat(TPatTuple(omegas(List.length(tl))), ty, env), diff --git a/compiler/src/typed/printtyp.re b/compiler/src/typed/printtyp.re index 65540656f9..abe494e5c5 100644 --- a/compiler/src/typed/printtyp.re +++ b/compiler/src/typed/printtyp.re @@ -22,15 +22,17 @@ let rec identifier = ppf => let unique_names = ref(Ident.empty); let ident_name = id => - try(Ident.find_same(id, unique_names^)) { - | Not_found => Ident.name(id) + switch (Ident.find_same_opt(id, unique_names^)) { + | Some(name) => name + | None => Ident.name(id) }; let add_unique = id => - try(ignore(Ident.find_same(id, unique_names^))) { - | Not_found => + switch (Ident.find_same_opt(id, unique_names^)) { + | None => unique_names := Ident.add(id, Ident.unique_toplevel_name(id), unique_names^) + | Some(_) => () }; let ident = (ppf, id) => { @@ -275,8 +277,8 @@ let rec uniq = | [a, ...l] => !List.memq(a, l) && uniq(l); let rec normalize_type_path = (~cache=false, env, p) => - try({ - let (params, ty, _) = Env.find_type_expansion(p, env); + switch (Env.find_type_expansion_opt(p, env)) { + | Some((params, ty, _)) => let params = List.map(repr, params); switch (repr(ty)) { | {desc: TTyConstr(p1, tyl, _)} => @@ -295,8 +297,7 @@ let rec normalize_type_path = (~cache=false, env, p) => }; | ty => (p, Nth(index(params, ty))) }; - }) { - | Not_found => (Env.normalize_path(None, env, p), Id) + | None => (Env.normalize_path(None, env, p), Id) }; let penalty = s => @@ -350,17 +351,15 @@ let set_printing_env = env => { let (p1, s1) = normalize_type_path(env, p', ~cache=true); /* Format.eprintf "%a -> %a = %a@." path p path p' path p1 */ if (s1 == Id) { - try({ - let r = PathMap.find(p1, printing_map^); + switch (PathMap.find_opt(p1, printing_map^)) { + | Some(r) => switch (r^) { | Paths(l) => r := Paths([p, ...l]) | Best(p') => r := Paths([p, p']) - }; - }) { - /* assert false */ - | Not_found => - printing_map := - PathMap.add(p1, ref(Paths([p])), printing_map^) + } + | None => + /* assert false */ + printing_map := PathMap.add(p1, ref(Best(p)), printing_map^) }; }; }, @@ -405,8 +404,8 @@ let is_unambiguous = (path, env) => { let rec get_best_path = r => switch (r^) { - | Best(p') => p' - | Paths([]) => raise(Not_found) + | Best(p') => Some(p') + | Paths([]) => None | Paths(l) => r := Paths([]); List.iter( @@ -433,16 +432,18 @@ let best_type_path = p => let get_path = () => get_best_path(PathMap.find(p', printing_map^)); while (printing_cont^ != [] && ( - try(fst(path_size(get_path())) > printing_depth^) { - | Not_found => true + switch (get_path()) { + | Some(p) => fst(path_size(p)) > printing_depth^ + | None => true } )) { printing_cont := List.map(snd, Env.run_iter_cont(printing_cont^)); incr(printing_depth); }; let p'' = - try(get_path()) { - | Not_found => p' + switch (get_path()) { + | Some(p) => p + | None => p' }; /* Format.eprintf "%a = %a -> %a@." path p path p' path p''; */ (p'', s); @@ -511,10 +512,12 @@ let rec new_weak_name = (ty, ()) => { let name_of_type = (name_generator, t) => /* We've already been through repr at this stage, so t is our representative of the union-find class. */ - try(List.assq(t, names^)) { - | Not_found => - try(TypeMap.find(t, weak_var_map^)) { - | Not_found => + switch (List.assq_opt(t, names^)) { + | Some(name) => name + | None => + switch (TypeMap.find_opt(t, weak_var_map^)) { + | Some(v) => v + | None => let name = switch (t.desc) { | TTyVar(Some(name)) @@ -1474,8 +1477,9 @@ let explain = (mis, ppf) => let warn_on_missing_def = (env, ppf, t) => switch (t.desc) { | TTyConstr(p, _, _) => - try(ignore(Env.find_type(p, env): Types.type_declaration)) { - | Not_found => + switch (Env.find_type_opt(p, env)) { + | Some(_) => () + | None => fprintf( ppf, "@,@[%a is abstract because no corresponding cmi file was found in path.@]", diff --git a/compiler/src/typed/subst.re b/compiler/src/typed/subst.re index 61f1f0ab51..1299843a30 100644 --- a/compiler/src/typed/subst.re +++ b/compiler/src/typed/subst.re @@ -95,8 +95,9 @@ let loc = (s, x) => }; let rec module_path = (s, path) => - try(PathMap.find(path, s.modules)) { - | Not_found => + switch (PathMap.find_opt(path, s.modules)) { + | Some(p) => p + | None => switch (path) { | PIdent(_) => path | PExternal(p, n) => PExternal(module_path(s, p), n) @@ -106,21 +107,18 @@ let rec module_path = (s, path) => let modtype_path = s => fun | PIdent(id) as p => - try( - switch (Tbl.find(id, s.modtypes)) { - | TModIdent(p) => p - | _ => fatal_error("Subst.modtype_path") - } - ) { - | Not_found => p + switch (Tbl.find(id, s.modtypes)) { + | Some(TModIdent(p)) => p + | Some(_) => fatal_error("Subst.modtype_path") + | None => p } | PExternal(p, n) => PExternal(module_path(s, p), n); let type_path = (s, path) => - switch (PathMap.find(path, s.types)) { - | Path(p) => p - | Type_function(_) => assert(false) - | exception Not_found => + switch (PathMap.find_opt(path, s.types)) { + | Some(Path(p)) => p + | Some(Type_function(_)) => assert(false) + | None => switch (path) { | PIdent(_) => path | PExternal(p, n) => PExternal(module_path(s, p), n) @@ -128,10 +126,10 @@ let type_path = (s, path) => }; let to_subst_by_type_function = (s, p) => - switch (PathMap.find(p, s.types)) { - | Path(_) => false - | Type_function(_) => true - | exception Not_found => false + switch (PathMap.find_opt(p, s.types)) { + | Some(Path(_)) => false + | Some(Type_function(_)) => true + | None => false }; /* Special type ids for saved signatures */ @@ -213,11 +211,10 @@ let rec typexp = (s, ty) => { switch (desc) { | TTyConstr(p, args, _abbrev) => let args = List.map(typexp(s), args); - switch (PathMap.find(p, s.types)) { - | exception Not_found => - TTyConstr(type_path(s, p), args, ref(TMemNil)) - | Path(_) => TTyConstr(type_path(s, p), args, ref(TMemNil)) - | Type_function({params, body}) => + switch (PathMap.find_opt(p, s.types)) { + | None => TTyConstr(type_path(s, p), args, ref(TMemNil)) + | Some(Path(_)) => TTyConstr(type_path(s, p), args, ref(TMemNil)) + | Some(Type_function({params, body})) => ctype_apply_env_empty^(params, body, args).desc }; | _ => copy_type_desc(typexp(s), desc) @@ -353,8 +350,9 @@ let rec modtype = s => | TModAlias(p) as mty => switch (p) { | PIdent(id) => - try(Tbl.find(id, s.modtypes)) { - | Not_found => mty + switch (Tbl.find(id, s.modtypes)) { + | Some(mty) => mty + | None => mty } | PExternal(p, n) => TModIdent(PExternal(module_path(s, p), n)) } diff --git a/compiler/src/typed/translprim.re b/compiler/src/typed/translprim.re index 2b3606362a..32d83f42b6 100644 --- a/compiler/src/typed/translprim.re +++ b/compiler/src/typed/translprim.re @@ -1529,8 +1529,9 @@ let transl_prim = (env, desc) => { let core_loc = desc.pprim_loc; let prim = - try(PrimMap.find(prim_map, desc.pprim_name.txt)) { - | Not_found => failwith("This primitive does not exist.") + switch (PrimMap.find_opt(prim_map, desc.pprim_name.txt)) { + | Some(p) => p + | None => failwith("This primitive does not exist.") }; let disable_gc = [ diff --git a/compiler/src/typed/translsig.re b/compiler/src/typed/translsig.re index 850f69d686..2ac2fba6d6 100644 --- a/compiler/src/typed/translsig.re +++ b/compiler/src/typed/translsig.re @@ -8,11 +8,9 @@ let reset_type_variables = () => used_type_variables := Tbl.empty; let rec collect_type_vars = typ => switch (typ.desc) { | TTyVar(_) => - try({ - let type_exprs = Tbl.find(typ.id, used_type_variables^); - type_exprs := [typ, ...type_exprs^]; - }) { - | Not_found => + switch (Tbl.find(typ.id, used_type_variables^)) { + | Some(type_exprs) => type_exprs := [typ, ...type_exprs^] + | None => used_type_variables := Tbl.add(typ.id, ref([typ]), used_type_variables^) } @@ -36,14 +34,11 @@ let link_type_vars = ty => { let desc = switch (texpr.desc) { | TTyVar(_) as ty => - try({ - let vars = Tbl.find(texpr.id, used_type_variables^); - if (List.length(vars^) < 2) { - raise(Not_found); - }; - TTyLink(List.hd(vars^)); - }) { - | Not_found => ty + switch (Tbl.find(texpr.id, used_type_variables^)) { + | Some(vars) when List.length(vars^) >= 2 => + TTyLink(List.hd(vars^)) + | Some(_) + | None => ty } | TTyArrow(tyl, ret, c) => TTyArrow( diff --git a/compiler/src/typed/type_utils.re b/compiler/src/typed/type_utils.re index d6d6f4f8e7..3399b4522a 100644 --- a/compiler/src/typed/type_utils.re +++ b/compiler/src/typed/type_utils.re @@ -3,10 +3,11 @@ open Types; let rec get_allocation_type = (env, ty) => { switch (ty.desc) { | TTyConstr(path, _, _) => - try(Env.find_type(path, env).type_allocation) { + switch (Env.find_type_opt(path, env)) { + | Some({type_allocation}) => type_allocation // Types not in the environment come from other modules and are nested in // types we do know about; we treat them as Managed Grain values. - | Not_found => Managed + | None => Managed } | TTySubst(linked) | TTyLink(linked) => get_allocation_type(env, linked) diff --git a/compiler/src/typed/typecore.re b/compiler/src/typed/typecore.re index 9d3fc47805..a4d20c7b92 100644 --- a/compiler/src/typed/typecore.re +++ b/compiler/src/typed/typecore.re @@ -507,8 +507,8 @@ let get_newtype_level = () => let rec last = lst => switch (lst) { - | [] => raise(Not_found) - | [e] => e + | [] => None + | [e] => Some(e) | [_, ...es] => last(es) }; @@ -518,8 +518,9 @@ let rec final_subexpression = sexp => | PExpWhile(_, e) | PExpMatch(_, {txt: [{pmb_body: e}, ..._]}) => final_subexpression(e) | PExpBlock(es) => - try(final_subexpression(last(es))) { - | Not_found => sexp + switch (last(es)) { + | Some(e) => final_subexpression(e) + | None => sexp } | _ => sexp }; @@ -539,7 +540,11 @@ let rec is_nonexpansive = exp => | TExpPrim2(_, e1, e2) => is_nonexpansive(e1) && is_nonexpansive(e2) | TExpIf(c, t, f) => is_nonexpansive(t) && is_nonexpansive(f) | TExpWhile(c, b) => is_nonexpansive(b) - | TExpBlock([_, ..._] as es) => is_nonexpansive(last(es)) + | TExpBlock([_, ..._] as es) => + switch (last(es)) { + | Some(e) => is_nonexpansive(e) + | None => failwith("Impossible: empty block in Typecore.is_nonexpansive") + } | TExpConstruct(_, _, TExpConstrTuple(el)) => List.for_all(is_nonexpansive, el) | _ => false @@ -604,7 +609,11 @@ let rec type_approx = (env, sexp: Parsetree.expression) => TComOk, ), ) - | PExpBlock([_, ..._] as es) => type_approx(env, last(es)) + | PExpBlock([_, ..._] as es) => + switch (last(es)) { + | Some(e) => type_approx(env, e) + | None => failwith("Impossible: empty block in Typecore.type_approx") + } | _ => newvar() }; diff --git a/compiler/src/typed/typedecl.re b/compiler/src/typed/typedecl.re index 2ee1587916..f53063879c 100644 --- a/compiler/src/typed/typedecl.re +++ b/compiler/src/typed/typedecl.re @@ -414,15 +414,10 @@ let check_well_founded = (env, loc, path, to_check, ty) => { }; }; let (fini, parents) = - try({ - let prev = TypeMap.find(ty, visited^); - if (TypeSet.subset(parents, prev)) { - (true, parents); - } else { - (false, TypeSet.union(parents, prev)); - }; - }) { - | Not_found => (false, parents) + switch (TypeMap.find_opt(ty, visited^)) { + | Some(prev) when TypeSet.subset(parents, prev) => (true, parents) + | Some(prev) => (false, TypeSet.union(parents, prev)) + | None => (false, parents) }; if (fini) { @@ -533,8 +528,8 @@ let check_recursion = (env, loc, path, decl, to_check) => a non-regular abbreviation). */ (to_check(path') && !List.mem(path', prev_exp)) { /* Attempt expansion */ - try({ - let (params0, body0, _) = Env.find_type_expansion(path', env); + switch (Env.find_type_expansion_opt(path', env)) { + | Some((params0, body0, _)) => let (params, body) = Ctype.instance_parameterized_type(params0, body0); try(List.iter2(Ctype.unify(env), params, args')) { @@ -547,8 +542,7 @@ let check_recursion = (env, loc, path, decl, to_check) => ) }; check_regular(path', args, [path', ...prev_exp], body); - }) { - | Not_found => () + | None => () }; }; List.iter(check_regular(cpath, args, prev_exp), args'); @@ -598,15 +592,13 @@ let check_duplicates = sdecl_list => { | PDataVariant(cl) => List.iter( pcd => - try({ - let name' = Hashtbl.find(constrs, pcd.pcd_name.txt); - ignore(name'); - }) { + switch (Hashtbl.find_opt(constrs, pcd.pcd_name.txt)) { + | Some(name') => ignore(name') /*Location.prerr_warning pcd.pcd_loc (Warnings.Duplicate_definitions ("constructor", pcd.pcd_name.txt, name', sdecl.ptype_name.txt))*/ - | Not_found => + | None => Hashtbl.add(constrs, pcd.pcd_name.txt, sdecl.pdata_name.txt) }, cl, @@ -614,16 +606,15 @@ let check_duplicates = sdecl_list => { | PDataRecord(ll) => List.iter( pld => - try({ - let name' = - Hashtbl.find(labels, Identifier.last(pld.pld_name.txt)); - ignore(name'); - }) { - /*Location.prerr_warning pld.pcd_loc - (Warnings.Duplicate_definitions - ("constructor", pld.pcd_name.txt, name', - sdecl.ptype_name.txt))*/ - | Not_found => + switch ( + Hashtbl.find_opt(labels, Identifier.last(pld.pld_name.txt)) + ) { + | Some(name') => ignore(name') + | None => + /*Location.prerr_warning pld.pcd_loc + (Warnings.Duplicate_definitions + ("constructor", pld.pcd_name.txt, name', + sdecl.ptype_name.txt))*/ Hashtbl.add( labels, Identifier.last(pld.pld_name.txt), @@ -1033,8 +1024,8 @@ let transl_exception = (env, sext) => { open Format; let explain_unbound_gen = (ppf, tv, tl, typ, kwd, pr) => - try({ - let ti = List.find(ti => Ctype.deep_occur(tv, typ(ti)), tl); + switch (List.find_opt(ti => Ctype.deep_occur(tv, typ(ti)), tl)) { + | Some(ti) => let ty0 = /* Hack to force aliasing when needed */ Btype.newgenty(TTyTuple([tv])) /*(Tobject(tv, ref None))*/; @@ -1048,8 +1039,7 @@ let explain_unbound_gen = (ppf, tv, tl, typ, kwd, pr) => Printtyp.type_expr, tv, ); - }) { - | Not_found => () + | None => () }; let explain_unbound = (ppf, tv, tl, typ, kwd, lab) => diff --git a/compiler/src/typed/typedtree.re b/compiler/src/typed/typedtree.re index ffb705f517..da0766000d 100644 --- a/compiler/src/typed/typedtree.re +++ b/compiler/src/typed/typedtree.re @@ -710,14 +710,15 @@ let rev_let_bound_idents = pat => List.map(fst, rev_let_bound_idents_with_loc(pat)); let let_bound_idents = pat => List.map(fst, let_bound_idents_with_loc(pat)); -let alpha_var = (env, id) => List.assoc(id, env); +let alpha_var = (env, id) => List.assoc_opt(id, env); let rec alpha_pat = (env, {pat_desc: desc, _} as p) => switch (desc) { | TPatVar(id, s) => let new_desc = - try(TPatVar(alpha_var(env, id), s)) { - | Not_found => TPatAny + switch (alpha_var(env, id)) { + | Some(alpha_id) => TPatVar(alpha_id, s) + | None => TPatAny }; { ...p, @@ -725,11 +726,12 @@ let rec alpha_pat = (env, {pat_desc: desc, _} as p) => }; | TPatAlias(p1, id, s) => let new_p = alpha_pat(env, p1); - try({ - ...p, - pat_desc: TPatAlias(new_p, alpha_var(env, id), s), - }) { - | Not_found => new_p + switch (alpha_var(env, id)) { + | Some(alpha_id) => { + ...p, + pat_desc: TPatAlias(new_p, alpha_id, s), + } + | None => new_p }; | _ => { ...p, diff --git a/compiler/src/typed/typemod.re b/compiler/src/typed/typemod.re index f81efe93d8..98ffa1daf0 100644 --- a/compiler/src/typed/typemod.re +++ b/compiler/src/typed/typemod.re @@ -320,8 +320,8 @@ let enrich_type_decls = (anchor, decls, oldenv, newenv) => switch (decl.type_manifest) { | Some(_) => decl | None => - try({ - let orig_decl = Env.find_type(p, oldenv); + switch (Env.find_type_opt(p, oldenv)) { + | Some(orig_decl) => if (orig_decl.type_arity != decl.type_arity) { decl; } else { @@ -334,9 +334,8 @@ let enrich_type_decls = (anchor, decls, oldenv, newenv) => ), ), }; - }; - }) { - | Not_found => decl + } + | None => decl } }; }; diff --git a/compiler/src/typed/typetexp.re b/compiler/src/typed/typetexp.re index 60fbebbf7c..bdfba3393e 100644 --- a/compiler/src/typed/typetexp.re +++ b/compiler/src/typed/typetexp.re @@ -229,9 +229,9 @@ let new_global_var = (~name=?, ()) => let newvar = (~name=?, ()) => newvar(~name=?validate_name(name), ()); let type_variable = (loc, name) => - try(Tbl.find(name, type_variables^)) { - | Not_found => - raise(Error(loc, Env.empty, Unbound_type_variable("'" ++ name))) + switch (Tbl.find(name, type_variables^)) { + | Some(ty) => ty + | None => raise(Error(loc, Env.empty, Unbound_type_variable("'" ++ name))) }; let transl_type_param = (env, styp) => { @@ -246,19 +246,13 @@ let transl_type_param = (env, styp) => { ctyp_loc: loc, }; | PTyVar(name) => + if (name != "" && name.[0] == '_') { + raise(Error(loc, Env.empty, Invalid_variable_name("'" ++ name))); + }; let ty = - try( - { - if (name != "" && name.[0] == '_') { - raise( - Error(loc, Env.empty, Invalid_variable_name("'" ++ name)), - ); - }; - ignore(Tbl.find(name, type_variables^)); - raise(Already_bound); - } - ) { - | Not_found => + switch (Tbl.find(name, type_variables^)) { + | Some(_) => raise(Already_bound) + | None => let v = new_global_var(~name, ()); type_variables := Tbl.add(name, v, type_variables^); v; @@ -315,16 +309,16 @@ and transl_type_aux = (env, policy, styp) => { ctyp(TTyAny, ty); | PTyVar(name) => - let ty = { - if (name != "" && name.[0] == '_') { - raise( - Error(styp.ptyp_loc, env, Invalid_variable_name("'" ++ name)), - ); - }; - try(instance(env, List.assoc(name, univars^))) { - | Not_found => - try(instance(env, fst(Tbl.find(name, used_variables^)))) { - | Not_found => + if (name != "" && name.[0] == '_') { + raise(Error(styp.ptyp_loc, env, Invalid_variable_name("'" ++ name))); + }; + let ty = + switch (List.assoc_opt(name, univars^)) { + | Some(type_expr) => instance(env, type_expr) + | None => + switch (Tbl.find(name, used_variables^)) { + | Some((type_expr, _)) => instance(env, type_expr) + | None => let v = if (policy == Univars) { new_pre_univar(~name, ()); @@ -337,7 +331,6 @@ and transl_type_aux = (env, policy, styp) => { v; } }; - }; ctyp(TTyVar(name), ty); | PTyArrow(stl, st2) => @@ -479,8 +472,9 @@ let globalize_used_variables = (env, fixed) => { Btype.backtrack(snap); false; }) { - try(r := [(loc, v, Tbl.find(name, type_variables^)), ...r^]) { - | Not_found => + switch (Tbl.find(name, type_variables^)) { + | Some(v2) => r := [(loc, v, v2), ...r^] + | None => if (fixed && Btype.is_Tvar(repr(ty))) { raise( Error( diff --git a/compiler/src/utils/consistbl.re b/compiler/src/utils/consistbl.re index 56fa4fd496..64acfe4520 100644 --- a/compiler/src/utils/consistbl.re +++ b/compiler/src/utils/consistbl.re @@ -56,23 +56,21 @@ module Make = exception Not_available(Module_name.t); let check = (tbl, name, crc, source) => - try({ - let (old_crc, old_source) = Module_name.Tbl.find(tbl, name); + switch (Module_name.Tbl.find_opt(tbl, name)) { + | Some((old_crc, old_source)) => if (crc != old_crc) { raise(Inconsistency(name, source, old_source)); - }; - }) { - | Not_found => Module_name.Tbl.add(tbl, name, (crc, source)) + } + | None => Module_name.Tbl.add(tbl, name, (crc, source)) }; let check_noadd = (tbl, name, crc, source) => - try({ - let (old_crc, old_source) = Module_name.Tbl.find(tbl, name); + switch (Module_name.Tbl.find_opt(tbl, name)) { + | Some((old_crc, old_source)) => if (crc != old_crc) { raise(Inconsistency(name, source, old_source)); - }; - }) { - | Not_found => raise(Not_available(name)) + } + | None => raise(Not_available(name)) }; let lookup_opt = (tbl, name) => { @@ -82,17 +80,19 @@ module Make = let set = (tbl, name, crc, source) => Module_name.Tbl.add(tbl, name, (crc, source)); - let source = (tbl, name) => snd(Module_name.Tbl.find(tbl, name)); + let source = (tbl, name) => + switch (Module_name.Tbl.find_opt(tbl, name)) { + | Some((_, filepath)) => Some(filepath) + | None => None + }; let extract = (l, tbl) => { let l = List.sort_uniq(Module_name.compare, l); List.fold_left( (assc, name) => - try({ - let (crc, _) = Module_name.Tbl.find(tbl, name); - [(name, Some(crc)), ...assc]; - }) { - | Not_found => [(name, None), ...assc] + switch (Module_name.Tbl.find_opt(tbl, name)) { + | Some((crc, _)) => [(name, Some(crc)), ...assc] + | None => [(name, None), ...assc] }, [], l, @@ -102,11 +102,9 @@ module Make = let extract_map = (mod_names, tbl) => Module_name.Set.fold( (name, result) => - try({ - let (crc, _) = Module_name.Tbl.find(tbl, name); - Module_name.Map.add(name, Some(crc), result); - }) { - | Not_found => Module_name.Map.add(name, None, result) + switch (Module_name.Tbl.find_opt(tbl, name)) { + | Some((crc, _)) => Module_name.Map.add(name, Some(crc), result) + | None => Module_name.Map.add(name, None, result) }, mod_names, Module_name.Map.empty, diff --git a/compiler/src/utils/consistbl.rei b/compiler/src/utils/consistbl.rei index a156d48f75..81169ef47f 100644 --- a/compiler/src/utils/consistbl.rei +++ b/compiler/src/utils/consistbl.rei @@ -60,10 +60,9 @@ module Make: [crc] in [tbl], even if [name] already had a different CRC associated with [name] in [tbl]. */ - let source: (t, Module_name.t) => filepath; - /* [source tbl name] returns the file name associated with [name] - if the latter has an associated CRC in [tbl]. - Raise [Not_found] otherwise. */ + let source: (t, Module_name.t) => option(filepath); + /* [source tbl name] returns the Some(file name) associated with [name] + if the latter has an associated CRC in [tbl], None otherwise. */ let extract: (list(Module_name.t), t) => list((Module_name.t, option(Digest.t))); diff --git a/compiler/src/utils/tbl.re b/compiler/src/utils/tbl.re index 6017e07953..71c5f8515a 100644 --- a/compiler/src/utils/tbl.re +++ b/compiler/src/utils/tbl.re @@ -81,11 +81,11 @@ let rec add = (x, data) => let rec find = x => fun - | Empty => raise(Not_found) + | Empty => None | Node(l, v, d, r, _) => { let c = compare(x, v); if (c == 0) { - d; + Some(d); } else { find( x, @@ -100,11 +100,11 @@ let rec find = x => let rec find_str = (x: string) => fun - | Empty => raise(Not_found) + | Empty => None | Node(l, v, d, r, _) => { let c = compare(x, v); if (c == 0) { - d; + Some(d); } else { find_str( x, diff --git a/compiler/src/utils/tbl.rei b/compiler/src/utils/tbl.rei index 0c492ca185..8e5c1811dc 100644 --- a/compiler/src/utils/tbl.rei +++ b/compiler/src/utils/tbl.rei @@ -20,8 +20,8 @@ type t('k, 'v); let empty: t('k, 'v); let add: ('k, 'v, t('k, 'v)) => t('k, 'v); -let find: ('k, t('k, 'v)) => 'v; -let find_str: (string, t(string, 'v)) => 'v; +let find: ('k, t('k, 'v)) => option('v); +let find_str: (string, t(string, 'v)) => option('v); let mem: ('k, t('k, 'v)) => bool; let remove: ('k, t('k, 'v)) => t('k, 'v); let iter: (('k, 'v) => unit, t('k, 'v)) => unit; diff --git a/compiler/test/utils/concatlist.re b/compiler/test/utils/concatlist.re index b54336391b..d3a6c5d574 100644 --- a/compiler/test/utils/concatlist.re +++ b/compiler/test/utils/concatlist.re @@ -24,7 +24,7 @@ describe("aux/concatlist", ({test}) => { test("hd", ({expect}) => { let res = hd(append(empty, cons(1, empty))); - expect.int(res).toBe(1); + expect.option(res).toBe(Some(1)); }); test("tl", ({expect}) => {