aboutsummaryrefslogtreecommitdiff
path: root/pretyping
diff options
context:
space:
mode:
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/evarconv.ml10
-rw-r--r--pretyping/unification.ml7
2 files changed, 12 insertions, 5 deletions
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index a926985664..6bf621b055 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -889,10 +889,14 @@ let second_order_matching ts env_rhs evd (evk,args) argoccs rhs =
in
force_instantiation evd !evsref
| [] ->
- Evd.define evk rhs evd in
-
+ let evd =
+ try Evarsolve.check_evar_instance evd evk rhs (evar_conv_x ts)
+ with IllTypedInstance _ -> raise (TypingFailed evd)
+ in
+ Evd.define evk rhs evd
+ in
abstract_free_holes evd subst, true
- with TypingFailed evd -> Evd.define evk rhs evd, false
+ with TypingFailed evd -> evd, false
let second_order_matching_with_args ts env evd ev l t =
(*
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index 7eca9f2cec..7b6fb262a8 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -92,8 +92,11 @@ let abstract_list_all_with_dependencies env evd typ c l =
let evd,b =
Evarconv.second_order_matching empty_transparent_state
env evd ev' argoccs c in
- let p = nf_evar evd (existential_value evd (destEvar ev)) in
- if b then evd, p else error_cannot_find_well_typed_abstraction env evd p l None
+ if b then
+ let p = nf_evar evd (existential_value evd (destEvar ev)) in
+ evd, p
+ else error_cannot_find_well_typed_abstraction env evd
+ (nf_evar evd c) l None
(**)