let meta_convertibility_aux table t1 t2 =
let module C = Cic in
- let rec aux table t1 t2 =
+ let rec aux ((table_l,table_r) as table) t1 t2 =
match t1, t2 with
+ | C.Meta (m1, tl1), C.Meta (m2, tl2) when m1 = m2 -> table
+ | C.Meta (m1, tl1), C.Meta (m2, tl2) when m1 < m2 -> aux table t2 t1
| C.Meta (m1, tl1), C.Meta (m2, tl2) ->
- (try
- if List.assoc m1 table = m2 then table
- else raise NotMetaConvertible
- with Not_found ->
- try ignore(List.assoc m2 table);raise NotMetaConvertible
- with Not_found -> (m1,m2)::table)
+ let m1_binding, table_l =
+ try List.assoc m1 table_l, table_l
+ with Not_found -> m2, (m1, m2)::table_l
+ and m2_binding, table_r =
+ try List.assoc m2 table_r, table_r
+ with Not_found -> m1, (m2, m1)::table_r
+ in
+ if (m1_binding <> m2) || (m2_binding <> m1) then
+ raise NotMetaConvertible
+ else table_l,table_r
| C.Var (u1, ens1), C.Var (u2, ens2)
| C.Const (u1, ens1), C.Const (u2, ens2) when (UriManager.eq u1 u2) ->
aux_ens table ens1 ens2
true
else
try
- let table = meta_convertibility_aux [] left left' in
+ let table = meta_convertibility_aux ([],[]) left left' in
let _ = meta_convertibility_aux table right right' in
true
with NotMetaConvertible ->
try
- let table = meta_convertibility_aux [] left right' in
+ let table = meta_convertibility_aux ([],[]) left right' in
let _ = meta_convertibility_aux table right left' in
true
with NotMetaConvertible ->
true
else
try
- ignore(meta_convertibility_aux [] t1 t2);
+ ignore(meta_convertibility_aux ([],[]) t1 t2);
true
with NotMetaConvertible ->
false
let is_weak_identity eq =
let _,_,(_,left, right,_),_,_ = open_equality eq in
- left = right (* doing metaconv here is meaningless *)
+ left = right
+ (* doing metaconv here is meaningless *)
;;
let is_identity (_, context, ugraph) eq =
eq_uri goalproof initial type_of_goal side_effects
context proof_menv
in
-(* prerr_endline ("PROOF: " ^ CicPp.pp goal_proof names); *)
+ (* prerr_endline ("PROOF: " ^ CicPp.pp goal_proof names); *)
let goal_proof = Subst.apply_subst subsumption_subst goal_proof in
let metas_still_open_in_proof = Utils.metas_of_term goal_proof in
-(*prerr_endline (CicPp.pp goal_proof names);*)
- (* ?? *)
+ (* prerr_endline (CicPp.pp goal_proof names); *)
let goal_proof = (* Subst.apply_subst subsumption_subst *) goal_proof in
let side_effects_t =
List.map (Subst.apply_subst subsumption_subst) side_effects_t
in
(* replacing fake mets with real ones *)
-(* prerr_endline "replacing metas..."; *)
+ (* prerr_endline "replacing metas..."; *)
let irl=CicMkImplicit.identity_relocation_list_for_metavariable context in
let goal_proof_menv, what, with_what,free_meta =
List.fold_left
(fun (acc1,acc2,acc3,uniq) (i,_,ty) ->
match uniq with
| Some m ->
-(* acc1, (Cic.Meta(i,[]))::acc2, m::acc3, uniq *)
- (i,context,ty)::acc1, (Cic.Meta(i,[]))::acc2, (Cic.Meta(i,irl))::acc3, uniq
+(* acc1, (Cic.Meta(i,[]))::acc2, m::acc3, uniq *)
+ (i,context,ty)::acc1, (Cic.Meta(i,[]))::acc2,
+ (Cic.Meta(i,irl))::acc3, uniq
| None ->
[i,context,ty], (Cic.Meta(i,[]))::acc2,
(Cic.Meta(i,irl)) ::acc3,Some (Cic.Meta(i,irl)))
([],[],[],None)
(List.filter
- (fun (i,_,_) -> List.mem i metas_still_open_in_proof)
+ (fun (i,_,_) ->
+ List.mem i metas_still_open_in_proof
+ (*&& not(List.mem i metas_still_open_in_goal)*))
proof_menv)
in
let replace where =
(ProofEngineHelpers.compare_metasenvs
~oldmetasenv:metasenv ~newmetasenv:goal_proof_menv)
in
-(* prerr_endline ("freemetas: " ^ String.concat "," (List.map string_of_int
- * free_metas) ); *)
+ (* prerr_endline
+ * ("freemetas: " ^
+ * String.concat "," (List.map string_of_int free_metas) ); *)
(* check/refine/... build the new proof *)
let replaced_goal =
ProofEngineReduction.replace
prerr_endline "THE PROOF DOES NOT TYPECHECK!";
raise exn
in
+
+ let metas_of_proof = Utils.metas_of_term goal_proof in
+
let proof, real_metasenv =
ProofEngineHelpers.subst_meta_and_metasenv_in_proof
proof goalno (CicMetaSubst.apply_subst final_subst) real_menv
in
let open_goals =
+ HExtlib.list_uniq (List.sort Pervasives.compare metas_of_proof)
+ in
+(*
match free_meta with Some(Cic.Meta(m,_)) when m<>goalno ->[m] | _ ->[]
in
+*)
(*
Printf.eprintf
"GOALS APERTI: %s\nMETASENV PRIMA:\n%s\nMETASENV DOPO:\n%s\n"