Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fix for bug #3017: wrong handling of the unresolvability status

in clenvtac and error-printing code. 


git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@16383 85f007b7-540e-0410-9357-904b9bb8a0f7
  • Loading branch information...
commit d5b13126177a7f30069d0512f1d08b34e00e3fee 1 parent f5ab2e3
authored April 03, 2013
1  dev/include
@@ -33,6 +33,7 @@
33 33
 #install_printer  (* constr_substituted *) ppsconstr;; 
34 34
 #install_printer  (* universe *)  ppuni;;
35 35
 #install_printer  (* universes *)  ppuniverses;;
  36
+#install_printer  (* constraints *)  ppconstraints;;
36 37
 #install_printer  (* type_judgement *) pptype;;
37 38
 #install_printer  (* judgement *) ppj;;
38 39
 
16  pretyping/typeclasses.ml
@@ -513,13 +513,6 @@ let mark_resolvability b sigma =
513 513
 let mark_unresolvables sigma = mark_resolvability false sigma
514 514
 let mark_resolvables sigma = mark_resolvability true sigma
515 515
 
516  
-let has_typeclasses evd =
517  
-  Evd.fold_undefined (fun ev evi has -> has ||
518  
-    (is_class_evar evd evi && is_resolvable evi))
519  
-    evd false
520  
-
521  
-let solve_instanciations_problem = ref (fun _ _ _ _ _ -> assert false)
522  
-
523 516
 open Evar_kinds
524 517
 type evar_filter = Evar_kinds.t -> bool
525 518
 
@@ -529,6 +522,13 @@ let no_goals_or_obligations = function
529 522
   | GoalEvar | QuestionMark _ -> false
530 523
   | _ -> true
531 524
 
  525
+let has_typeclasses filter evd =
  526
+  Evd.fold_undefined (fun ev evi has -> has ||
  527
+    (filter (snd evi.evar_source) && is_class_evar evd evi && is_resolvable evi))
  528
+    evd false
  529
+
  530
+let solve_instanciations_problem = ref (fun _ _ _ _ _ -> assert false)
  531
+
532 532
 let resolve_typeclasses ?(filter=no_goals) ?(split=true) ?(fail=true) env evd =
533  
-  if not (has_typeclasses evd) then evd
  533
+  if not (has_typeclasses filter evd) then evd
534 534
   else !solve_instanciations_problem env evd filter split fail
3  proofs/clenvtac.ml
@@ -61,8 +61,9 @@ let clenv_refine with_evars ?(with_classes=true) clenv gls =
61 61
   let clenv = clenv_pose_dependent_evars with_evars clenv in
62 62
   let evd' =
63 63
     if with_classes then
64  
-      Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars
  64
+      let evd' = Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars
65 65
         ~fail:(not with_evars) clenv.env clenv.evd
  66
+      in Typeclasses.mark_unresolvables evd'
66 67
     else clenv.evd
67 68
   in
68 69
   let clenv = { clenv with evd = evd' } in
4  toplevel/himsg.ml
@@ -775,10 +775,10 @@ let pr_constraints printenv env evm =
775 775
 
776 776
 let explain_unsatisfiable_constraints env evd constr =
777 777
   let evm = Evd.undefined_evars (Evarutil.nf_evar_map_undefined evd) in
778  
-  (* Remove goal evars *)
  778
+  (* Remove evars that are not subject to resolution. *)
779 779
   let undef = fold_undefined 
780 780
     (fun ev evi evm' -> 
781  
-       if is_goal_evar evi then Evd.remove evm' ev else evm') evm evm
  781
+       if not (Typeclasses.is_resolvable evi) then Evd.remove evm' ev else evm') evm evm
782 782
   in
783 783
   match constr with
784 784
   | None ->

0 notes on commit d5b1312

Please sign in to comment.
Something went wrong with that request. Please try again.