From c14f134c00cef3dbca8c4a66f9847094f3fd119c Mon Sep 17 00:00:00 2001
From: msozeau
Date: Sun, 7 Mar 2010 18:49:23 +0000
Subject: Fix treatment of remaining unification constraints: raise a more
 informative exception if some constraints do not unify. All calls except one
 used to raise a less informative exception when the constraints weren't
 solved.

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12849 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 plugins/subtac/subtac_command.ml     | 2 +-
 plugins/subtac/subtac_pretyping.ml   | 2 +-
 plugins/subtac/subtac_pretyping_F.ml | 8 ++++----
 3 files changed, 6 insertions(+), 6 deletions(-)

(limited to 'plugins')

diff --git a/plugins/subtac/subtac_command.ml b/plugins/subtac/subtac_command.ml
index a2dd7d777d..f51dd54099 100644
--- a/plugins/subtac/subtac_command.ml
+++ b/plugins/subtac/subtac_command.ml
@@ -453,7 +453,7 @@ let interp_recursive fixkind l boxed =
   let fixdefs = List.map out_def fixdefs in
 
   (* Instantiate evars and check all are resolved *)
-  let evd,_ = Evarconv.consider_remaining_unif_problems env_rec !evdref in
+  let evd = Evarconv.consider_remaining_unif_problems env_rec !evdref in
   let evd = Typeclasses.resolve_typeclasses
     ~onlyargs:true ~split:true ~fail:false env_rec evd
   in
diff --git a/plugins/subtac/subtac_pretyping.ml b/plugins/subtac/subtac_pretyping.ml
index 54f7aff1b1..7753971244 100644
--- a/plugins/subtac/subtac_pretyping.ml
+++ b/plugins/subtac/subtac_pretyping.ml
@@ -70,7 +70,7 @@ let merge_evms x y =
 let interp env isevars c tycon =
   let j = pretype tycon env isevars ([],[]) c in
   let _ = isevars := Evarutil.nf_evar_map !isevars in
-  let evd,_ = consider_remaining_unif_problems env !isevars in
+  let evd = consider_remaining_unif_problems env !isevars in
 (*   let unevd = undefined_evars evd in *)
   let unevd' = Typeclasses.resolve_typeclasses ~onlyargs:true ~split:true ~fail:true env evd in
   let unevd' = Typeclasses.resolve_typeclasses ~onlyargs:false ~split:true ~fail:false env unevd' in
diff --git a/plugins/subtac/subtac_pretyping_F.ml b/plugins/subtac/subtac_pretyping_F.ml
index f909f9e0a9..47882e771a 100644
--- a/plugins/subtac/subtac_pretyping_F.ml
+++ b/plugins/subtac/subtac_pretyping_F.ml
@@ -576,11 +576,11 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct
 	  (pretype tycon env evdref lvar c).uj_val
       | IsType ->
 	  (pretype_type empty_valcon env evdref lvar c).utj_val in
-    evdref := fst (consider_remaining_unif_problems env !evdref);
+    evdref := consider_remaining_unif_problems env !evdref;
     if resolve_classes then
-      evdref :=
-        Typeclasses.resolve_typeclasses ~onlyargs:false
+      (evdref := Typeclasses.resolve_typeclasses ~onlyargs:false
 	  ~split:true ~fail:fail_evar env !evdref;
+       evdref := consider_remaining_unif_problems env !evdref);
     let c = if expand_evar then nf_evar !evdref c' else c' in
     if fail_evar then check_evars env Evd.empty !evdref c;
     c
@@ -593,7 +593,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct
   let understand_judgment sigma env c =
     let evdref = ref (create_evar_defs sigma) in
     let j = pretype empty_tycon env evdref ([],[]) c in
-    let evd,_ = consider_remaining_unif_problems env !evdref in
+    let evd = consider_remaining_unif_problems env !evdref in
     let j = j_nf_evar evd j in
     check_evars env sigma evd (mkCast(j.uj_val,DEFAULTcast, j.uj_type));
     j
-- 
cgit v1.2.3