| _ -> None
;;
-let find_all_subsumed bag env table (goalproof,menv,ty) =
+let find_all_subsumed bag maxm env table (goalproof,menv,ty) =
match ty with
| Cic.Appl[Cic.MutInd(uri,_,_);eq_ty;left;right]
when LibraryObjects.is_eq_URI uri ->
let goal_equation =
- Equality.mk_equality bag
- (0,Equality.Exact (Cic.Implicit None),(eq_ty,left,right,Utils.Eq),menv)
+ (Equality.mk_equality bag
+ (0,Equality.Exact (Cic.Implicit None),(eq_ty,left,right,Utils.Eq),menv))
in
- List.map
+ List.map
(fun (subst, equality, swapped ) ->
let (_,p,(ty,l,r,_),m,id) = Equality.open_equality equality in
let cicmenv = Subst.apply_subst_metasenv subst (m @ menv) in
+ Indexing.check_for_duplicates cicmenv "from subsumption";
let p =
if swapped then
Equality.symmetric bag eq_ty l id uri m
(let _,context,_ = env in
try
let s,m,_ =
- Founif.unification m m context left right CicUniv.empty_ugraph
+ Founif.unification [] m context left right CicUniv.empty_ugraph
in
let reflproof = Equality.Exact (Equality.refl_proof uri eq_ty left) in
let m = Subst.apply_subst_metasenv s m in
aux metasenv 0 p
;;
-let fix_metasenv metasenv =
+let fix_metasenv context metasenv =
List.fold_left
(fun m (i,c,t) ->
- let m,t = fix_proof m c false t in
+ let m,t = fix_proof m context false t in
let m = List.filter (fun (j,_,_) -> j<>i) m in
- (i,c,t)::m)
+ (i,context,t)::m)
metasenv metasenv
;;
+
(* status: input proof status
* goalproof: forward steps on goal
* newproof: backward steps
in
(* Equality.draw_proof bag names goalproof newproof subsumption_id; *)
let goal_proof = Subst.apply_subst subsumption_subst goal_proof in
- let real_menv = fix_metasenv (proof_menv@metasenv) in
+ (* assert (metasenv=[]); *)
+ let real_menv = fix_metasenv context (proof_menv@metasenv) in
let real_menv,goal_proof =
fix_proof real_menv context false goal_proof in
(*
let _, context, type_of_goal = CicUtil.lookup_meta goalno metasenv in
let env = metasenv,context,CicUniv.empty_ugraph in
let cleaned_goal = Utils.remove_local_context type_of_goal in
+ let canonical_menv,other_menv =
+ List.partition (fun (_,c,_) -> c = context) metasenv in
+ prerr_endline ("other menv = " ^ (CicMetaSubst.ppmetasenv [] other_menv));
+ let metasenv = List.map (fun (i,_,ty)-> (i,[],ty)) canonical_menv in
let goal = [], List.filter (fun (i,_,_)->i<>goalno) metasenv, cleaned_goal in
debug_print (lazy (string_of_int (List.length (fst active))));
(* we simplify using both actives passives *)
List.fold_left
(fun (l,tbl) eq -> eq::l,(Indexing.index tbl eq))
active (list_of_passive passive) in
+ let (_,_,ty) = goal in
+ debug_print (lazy ("prima " ^ CicPp.ppterm ty));
let _,goal = simplify_goal bag env goal table in
let (_,_,ty) = goal in
- debug_print (lazy (CicPp.ppterm ty));
- let subsumed = find_all_subsumed bag env (snd table) goal in
+ debug_print (lazy ("in mezzo " ^ CicPp.ppterm ty));
+ let subsumed = find_all_subsumed bag !maxmeta env (snd table) goal in
+ debug_print (lazy ("dopo " ^ CicPp.ppterm ty));
let subsumed_or_id =
match (check_if_goal_is_identity env goal) with
None -> subsumed
List.map
(fun
(goalproof,newproof,subsumption_id,subsumption_subst, proof_menv) ->
+ let subst, proof, gl =
build_proof bag
- status goalproof newproof subsumption_id subsumption_subst proof_menv)
- subsumed_or_id in
- res, !maxmeta
+ status goalproof newproof subsumption_id subsumption_subst proof_menv
+ in
+ let uri, metasenv, subst, meta_proof, term_to_prove, attrs = proof in
+ let proof = uri, other_menv@metasenv, subst, meta_proof, term_to_prove, attrs in
+ (subst, proof,gl)) subsumed_or_id
+ in res, !maxmeta
let given_clause
let _, context, type_of_goal = CicUtil.lookup_meta goalno metasenv in
let eq_uri = eq_of_goal type_of_goal in
let cleaned_goal = Utils.remove_local_context type_of_goal in
+ let canonical_menv,other_menv =
+ List.partition (fun (_,c,_) -> c = context) metasenv in
+ prerr_endline ("other menv = " ^ (CicMetaSubst.ppmetasenv [] other_menv));
Utils.set_goal_symbols cleaned_goal; (* DISACTIVATED *)
- let metasenv' = List.filter (fun (i,_,_)->i<>goalno) metasenv in
+ let canonical_menv = List.map (fun (i,_,ty)-> (i,[],ty)) canonical_menv in
+ let metasenv' = List.filter (fun (i,_,_)->i<>goalno) canonical_menv in
let goal = [], metasenv', cleaned_goal in
let env = metasenv,context,CicUniv.empty_ugraph in
debug_print (lazy ">>>>>> ACTIVES >>>>>>>>");
debug_print (lazy ">>>>>>>>>>>>>>");
let goals = make_goal_set goal in
match
-(* given_caluse non prende in input maxm ????? *)
given_clause bag eq_uri env goals passive active
goal_steps saturation_steps max_time
with
build_proof bag
status goalproof newproof subsumption_id subsumption_subst proof_menv
in
+ let uri, metasenv, subst, meta_proof, term_to_prove, attrs = proof in
+ let proof = uri, other_menv@metasenv, subst, meta_proof, term_to_prove, attrs in
Some (subst, proof,gl),a,p, !maxmeta
;;
+
let add_to_passive eql passives =
add_to_passive passives eql eql
;;