+ let _,p,gl =
+ build_proof bag
+ status goalproof newproof subsumption_id subsumption_subst proof_menv
+ in
+ p,gl
+;;
+(* **************** HERE ENDS THE PARAMODULATION STUFF ******************** *)
+
+(* exported version of given_clause *)
+let given_clause
+ bag maxm status active passive goal_steps saturation_steps max_time
+=
+ reset_refs();
+ maxmeta := maxm;
+ let max_l l =
+ List.fold_left
+ (fun acc e -> let _,_,_,menv,_ = Equality.open_equality e in
+ List.fold_left (fun acc (i,_,_) -> max i acc) acc menv)
+ 0 l
+ in
+ let active_l = fst active in
+ let passive_l = fst passive in
+ let ma = max_l active_l in
+ let mp = max_l passive_l in
+ assert (maxm > max ma mp);
+ let proof, goalno = status in
+ let uri, metasenv, meta_proof, term_to_prove = proof in
+ 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
+ Utils.set_goal_symbols cleaned_goal; (* DISACTIVATED *)
+ let goal = [], List.filter (fun (i,_,_)->i<>goalno) metasenv, cleaned_goal in
+ let env = metasenv,context,CicUniv.empty_ugraph in
+ prerr_endline ">>>>>> ACTIVES >>>>>>>>";
+ List.iter (fun e -> prerr_endline (Equality.string_of_equality ~env e))
+ active_l;
+ prerr_endline ">>>>>>>>>>>>>>";
+ let goals = make_goal_set goal in
+ match
+ given_clause bag eq_uri env goals passive active
+ goal_steps saturation_steps max_time
+ with
+ | ParamodulationFailure (_,a,p) ->
+ None, a, p, !maxmeta
+ | ParamodulationSuccess
+ ((goalproof,newproof,subsumption_id,subsumption_subst, proof_menv),a,p) ->
+ let subst, proof, gl =
+ build_proof bag
+ status goalproof newproof subsumption_id subsumption_subst proof_menv
+ in
+ Some (subst, proof,gl),a,p, !maxmeta
+;;
+
+let demodulate_tac ~dbd ((proof,goal)(*s initialstatus*)) =
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goal metasenv in
+ let irl = CicMkImplicit.identity_relocation_list_for_metavariable context in
+ let initgoal = [], [], ty in
+ let eq_uri = eq_of_goal ty in
+ let bag, equalities, cache, maxm =
+ find_equalities dbd (proof,goal) false None AutoCache.cache_empty
+ in
+ let table =
+ List.fold_left
+ (fun tbl eq -> Indexing.index tbl eq)
+ Indexing.empty equalities
+ in
+ let changed,(newproof,newmetasenv, newty) =
+ Indexing.demodulation_goal bag
+ (metasenv,context,CicUniv.empty_ugraph) table initgoal
+ in
+ if changed then
+ begin
+ let opengoal = Equality.Exact (Cic.Meta(maxm,irl)) in
+ let proofterm,_ =
+ Equality.build_goal_proof bag
+ eq_uri newproof opengoal ty [] context metasenv
+ in
+ let extended_metasenv = (maxm,context,newty)::metasenv in
+ let extended_status =
+ (curi,extended_metasenv,pbo,pty),goal in
+ let (status,newgoals) =
+ ProofEngineTypes.apply_tactic
+ (PrimitiveTactics.apply_tac ~term:proofterm)
+ extended_status in
+ (status,maxm::newgoals)
+ end
+ else (* if newty = ty then *)
+ raise (ProofEngineTypes.Fail (lazy "no progress"))
+ (*else ProofEngineTypes.apply_tactic
+ (ReductionTactics.simpl_tac
+ ~pattern:(ProofEngineTypes.conclusion_pattern None)) initialstatus*)
+;;
+
+let demodulate_tac ~dbd = ProofEngineTypes.mk_tactic (demodulate_tac ~dbd);;
+
+let rec find_in_ctx i name = function
+ | [] -> raise (ProofEngineTypes.Fail (lazy ("Hypothesis not found: " ^ name)))
+ | Some (Cic.Name name', _)::tl when name = name' -> i
+ | _::tl -> find_in_ctx (i+1) name tl
+;;
+
+let rec position_of i x = function
+ | [] -> assert false
+ | j::tl when j <> x -> position_of (i+1) x tl
+ | _ -> i
+;;
+
+(* Syntax:
+ * auto superposition target = NAME
+ * [table = NAME_LIST] [demod_table = NAME_LIST] [subterms_only]
+ *
+ * - if table is omitted no superposition will be performed
+ * - if demod_table is omitted no demodulation will be prformed
+ * - subterms_only is passed to Indexing.superposition_right
+ *
+ * lists are coded using _ (example: H_H1_H2)
+ *)
+
+let superposition_tac ~target ~table ~subterms_only ~demod_table status =
+ reset_refs();
+ let proof,goalno = status in
+ let curi,metasenv,pbo,pty = proof in
+ let metano,context,ty = CicUtil.lookup_meta goalno metasenv in
+ let eq_uri,tty = eq_and_ty_of_goal ty in
+ let env = (metasenv, context, CicUniv.empty_ugraph) in
+ let names = Utils.names_of_context context in
+ let bag = Equality.mk_equality_bag () in
+ let eq_index, equalities, maxm,cache =
+ Equality_retrieval.find_context_equalities 0 bag None context proof AutoCache.cache_empty
+ in
+ let eq_what =
+ let what = find_in_ctx 1 target context in
+ List.nth equalities (position_of 0 what eq_index)
+ in
+ let eq_other =
+ if table <> "" then
+ let other =
+ let others = Str.split (Str.regexp "_") table in
+ List.map (fun other -> find_in_ctx 1 other context) others
+ in
+ List.map
+ (fun other -> List.nth equalities (position_of 0 other eq_index))
+ other
+ else
+ []
+ in
+ let index = List.fold_left Indexing.index Indexing.empty eq_other in
+ let maxm, eql =
+ if table = "" then maxm,[eq_what] else
+ Indexing.superposition_right bag
+ ~subterms_only eq_uri maxm env index eq_what
+ in
+ prerr_endline ("Superposition right:");
+ prerr_endline ("\n eq: " ^ Equality.string_of_equality eq_what ~env);
+ prerr_endline ("\n table: ");
+ List.iter (fun e -> prerr_endline (" " ^ Equality.string_of_equality e ~env)) eq_other;
+ prerr_endline ("\n result: ");
+ List.iter (fun e -> prerr_endline (Equality.string_of_equality e ~env)) eql;
+ prerr_endline ("\n result (cut&paste): ");
+ List.iter
+ (fun e ->
+ let t = Equality.term_of_equality eq_uri e in
+ prerr_endline (CicPp.pp t names))
+ eql;
+ prerr_endline ("\n result proofs: ");
+ List.iter (fun e ->
+ prerr_endline (let _,p,_,_,_ = Equality.open_equality e in
+ let s = match p with Equality.Exact _ -> Subst.empty_subst | Equality.Step (s,_) -> s in
+ Subst.ppsubst s ^ "\n" ^
+ CicPp.pp (Equality.build_proof_term bag eq_uri [] 0 p) names)) eql;
+ if demod_table <> "" then
+ begin
+ let eql =
+ if eql = [] then [eq_what] else eql
+ in
+ let demod =
+ let demod = Str.split (Str.regexp "_") demod_table in
+ List.map (fun other -> find_in_ctx 1 other context) demod
+ in
+ let eq_demod =
+ List.map
+ (fun demod -> List.nth equalities (position_of 0 demod eq_index))
+ demod
+ in
+ let table = List.fold_left Indexing.index Indexing.empty eq_demod in
+ let maxm,eql =
+ List.fold_left
+ (fun (maxm,acc) e ->
+ let maxm,eq =
+ Indexing.demodulation_equality bag eq_uri maxm env table e
+ in
+ maxm,eq::acc)
+ (maxm,[]) eql
+ in
+ let eql = List.rev eql in
+ prerr_endline ("\n result [demod]: ");
+ List.iter
+ (fun e -> prerr_endline (Equality.string_of_equality e ~env)) eql;
+ prerr_endline ("\n result [demod] (cut&paste): ");
+ List.iter
+ (fun e ->
+ let t = Equality.term_of_equality eq_uri e in
+ prerr_endline (CicPp.pp t names))
+ eql;
+ end;
+ proof,[goalno]
+;;
+
+let get_stats () = ""
+(*
+ <:show<Saturation.>> ^ Indexing.get_stats () ^ Founif.get_stats () ^
+ Equality.get_stats ()