diff options
| author | Hugo Herbelin | 2020-11-01 17:48:49 +0100 |
|---|---|---|
| committer | Hugo Herbelin | 2020-11-14 09:29:15 +0100 |
| commit | c3853226d1325b452f797309fbb8461ee45a64db (patch) | |
| tree | 980f7f107645c6f54815e2235f5562c0e6b1eff8 /pretyping/evarconv.ml | |
| parent | 473160ebe4a835dde50d6c209ab17c7e1b84979c (diff) | |
Avoiding encapsulating exceptions w/o a handler in NotFoundInstance.
Fixes #13266 (see #12675, 8641cb7385).
Diffstat (limited to 'pretyping/evarconv.ml')
| -rw-r--r-- | pretyping/evarconv.ml | 14 |
1 files changed, 4 insertions, 10 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml index 90af143a2d..4091e5329c 100644 --- a/pretyping/evarconv.ml +++ b/pretyping/evarconv.ml @@ -1312,6 +1312,7 @@ let check_selected_occs env sigma c occ occs = raise (PretypeError (env,sigma,NoOccurrenceFound (c,None))) else () +(* Error local to the module *) exception TypingFailed of evar_map let set_of_evctx l = @@ -1342,12 +1343,6 @@ let thin_evars env sigma sign c = let c' = applyrec (env,0) c in (!sigma, c') -exception NotFoundInstance of exn -let () = CErrors.register_handler (function - | NotFoundInstance e -> - Some Pp.(str "Failed to instantiate evar: " ++ CErrors.print e) - | _ -> None) - let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = try let evi = Evd.find_undefined evd evk in @@ -1490,9 +1485,8 @@ let second_order_matching flags env_rhs evd (evk,args) (test,argoccs) rhs = List.exists (fun c -> isVarId evd id (EConstr.of_constr c)) l -> instantiate_evar evar_unify flags env_rhs evd ev vid | _ -> evd) - with e when CErrors.noncritical e -> - let e, info = Exninfo.capture e in - Exninfo.iraise (NotFoundInstance e, info) + with IllTypedInstance _ (* from instantiate_evar *) | TypingFailed _ -> + user_err (Pp.str "Cannot find an instance.") else ((if debug_ho_unification () then let evi = Evd.find evd evk in @@ -1709,7 +1703,7 @@ let solve_unconstrained_impossible_cases env evd = let evd' = Evd.merge_context_set Evd.univ_flexible_alg ?loc evd' ctx in let ty = j_type j in let flags = default_flags env in - instantiate_evar evar_unify flags env evd' evk ty + instantiate_evar evar_unify flags env evd' evk ty (* should we protect from raising IllTypedInstance? *) | _ -> evd') evd evd let solve_unif_constraints_with_heuristics env |