diff options
Diffstat (limited to 'proofs')
| -rw-r--r-- | proofs/clenv.ml | 3 | ||||
| -rw-r--r-- | proofs/evar_refiner.ml | 20 | ||||
| -rw-r--r-- | proofs/logic.ml | 5 | ||||
| -rw-r--r-- | proofs/proofview.ml | 3 |
4 files changed, 13 insertions, 18 deletions
diff --git a/proofs/clenv.ml b/proofs/clenv.ml index b5770c8a78..8c4faa11cf 100644 --- a/proofs/clenv.ml +++ b/proofs/clenv.ml @@ -431,8 +431,7 @@ 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 (_,_,ActualTypeNotCoercible (_,_,NotClean _)) as e -> - raise e + | PretypeError (_,_,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 3d37074428..36268de1ee 100644 --- a/proofs/evar_refiner.ml +++ b/proofs/evar_refiner.ml @@ -25,17 +25,15 @@ let depends_on_evar evk _ (pbty,_,t1,t2) = with NoHeadEvar -> false let define_and_solve_constraints evk c evd = - 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." + 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 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 7472918690..2835eb5429 100644 --- a/proofs/logic.ml +++ b/proofs/logic.ml @@ -55,9 +55,8 @@ let rec catchable_exception = function | Tacred.ReductionTacticError _ (* unification errors *) | PretypeError(_,_,(CannotUnify _|CannotUnifyLocal _|CannotGeneralize _ - |NoOccurrenceFound _|CannotUnifyBindingType _ - |ActualTypeNotCoercible _|UnifOccurCheck _ - |CannotFindWellTypedAbstraction _ + |NoOccurrenceFound _|CannotUnifyBindingType _|NotClean _ + |CannotFindWellTypedAbstraction _|OccurCheck _ |UnsolvableImplicit _)) -> true | Typeclasses_errors.TypeClassError (_, Typeclasses_errors.UnsatisfiableConstraints _) -> true diff --git a/proofs/proofview.ml b/proofs/proofview.ml index 87a1e02a86..2802acfc1a 100644 --- a/proofs/proofview.ml +++ b/proofs/proofview.ml @@ -401,8 +401,7 @@ let rec catchable_exception = function | Nametab.GlobalizationError _ | PretypeError (_,_,VarNotFound _) (* unification errors *) | PretypeError(_,_,(CannotUnify _|CannotUnifyLocal _|CannotGeneralize _ - |NoOccurrenceFound _|CannotUnifyBindingType _ - |ActualTypeNotCoercible _ + |NoOccurrenceFound _|CannotUnifyBindingType _|NotClean _ |CannotFindWellTypedAbstraction _ |UnsolvableImplicit _)) -> true | Typeclasses_errors.TypeClassError |