diff options
Diffstat (limited to 'proofs')
| -rw-r--r-- | proofs/clenv.ml | 3 | ||||
| -rw-r--r-- | proofs/evar_refiner.ml | 21 | ||||
| -rw-r--r-- | proofs/logic.ml | 5 | ||||
| -rw-r--r-- | proofs/proofview.ml | 3 |
4 files changed, 19 insertions, 13 deletions
diff --git a/proofs/clenv.ml b/proofs/clenv.ml index 158f8e94f2..6177040cc3 100644 --- a/proofs/clenv.ml +++ b/proofs/clenv.ml @@ -434,7 +434,8 @@ let clenv_unify_binding_type clenv c t u = let evd,c = w_coerce_to_type (cl_env clenv) clenv.evd c t u in TypeProcessed, { clenv with evd = evd }, c with - | PretypeError (_,_,NotClean _) as e -> raise e + | PretypeError (_,_,ActualTypeNotCoercible (_,_,NotClean _)) as e -> + raise e | e when precatchable_exception e -> TypeNotProcessed, clenv, c diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml index 71a07326f9..92ee55e433 100644 --- a/proofs/evar_refiner.ml +++ b/proofs/evar_refiner.ml @@ -11,6 +11,7 @@ open Util open Names open Evd open Evarutil +open Evarsolve (******************************************) (* Instantiation of existential variables *) @@ -23,15 +24,17 @@ let depends_on_evar evk _ (pbty,_,t1,t2) = with NoHeadEvar -> false let define_and_solve_constraints evk c evd = - try - let evd = define evk c evd in - let (evd,pbs) = extract_changed_conv_pbs evd (depends_on_evar evk) in - fst (List.fold_left - (fun (evd,b as p) (pbty,env,t1,t2) -> - if b then Evarconv.evar_conv_x full_transparent_state env evd pbty t1 t2 else p) (evd,true) - pbs) - with e when Pretype_errors.precatchable_exception e -> - error "Instance does not satisfy constraints." + let evd = define evk c evd in + let (evd,pbs) = extract_changed_conv_pbs evd (depends_on_evar evk) in + match + List.fold_left + (fun p (pbty,env,t1,t2) -> match p with + | Success evd -> Evarconv.evar_conv_x full_transparent_state env evd pbty t1 t2 + | UnifFailure _ as x -> x) (Success evd) + pbs + with + | Success evd -> evd + | UnifFailure _ -> error "Instance does not satisfy the constraints." let w_refine (evk,evi) (ltac_var,rawc) sigma = if Evd.is_defined sigma evk then diff --git a/proofs/logic.ml b/proofs/logic.ml index 267e9d5bf2..80a2e1d1ab 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -50,8 +50,9 @@ let rec catchable_exception = function | Tacred.ReductionTacticError _ (* unification errors *) | PretypeError(_,_,(CannotUnify _|CannotUnifyLocal _|CannotGeneralize _ - |NoOccurrenceFound _|CannotUnifyBindingType _|NotClean _ - |CannotFindWellTypedAbstraction _|OccurCheck _ + |NoOccurrenceFound _|CannotUnifyBindingType _ + |ActualTypeNotCoercible _|UnifOccurCheck _ + |CannotFindWellTypedAbstraction _ |UnsolvableImplicit _|AbstractionOverMeta _)) -> true | Typeclasses_errors.TypeClassError (_, Typeclasses_errors.UnsatisfiableConstraints _) -> true diff --git a/proofs/proofview.ml b/proofs/proofview.ml index c18c48744e..7b384b13e2 100644 --- a/proofs/proofview.ml +++ b/proofs/proofview.ml @@ -342,7 +342,8 @@ let rec catchable_exception = function | Nametab.GlobalizationError _ | PretypeError (_,_,VarNotFound _) (* unification errors *) | PretypeError(_,_,(CannotUnify _|CannotUnifyLocal _|CannotGeneralize _ - |NoOccurrenceFound _|CannotUnifyBindingType _|NotClean _ + |NoOccurrenceFound _|CannotUnifyBindingType _ + |ActualTypeNotCoercible _ |CannotFindWellTypedAbstraction _ |UnsolvableImplicit _)) -> true | Typeclasses_errors.TypeClassError |