let debug s = () (*prerr_endline s*) ;; let nparamod rdb metasenv subst context t table = let max_nb_iter = 999999999 in let amount_of_time = 300.0 in let module C = struct let metasenv = metasenv let subst = subst let context = context end in let nb_iter = ref 0 in let module B = NCicBlob.NCicBlob(C) in let module Pp = Pp.Pp (B) in let module FU = FoUnif.Founif(B) in let module IDX = Index.Index(B) in let module Sup = Superposition.Superposition(B) in let module Utils = FoUtils.Utils(B) in let module WeightOrderedPassives = struct type t = B.t Terms.passive_clause let compare = Utils.compare_passive_clauses_weight end in let module AgeOrderedPassives = struct type t = B.t Terms.passive_clause let compare = Utils.compare_passive_clauses_age end in let module WeightPassiveSet = Set.Make(WeightOrderedPassives) in let module AgePassiveSet = Set.Make(AgeOrderedPassives) in let add_passive_clause ?(no_weight=false) (passives_w,passives_a) cl = let cl = if no_weight then (0,cl) else Utils.mk_passive_clause cl in WeightPassiveSet.add cl passives_w, AgePassiveSet.add cl passives_a in let remove_passive_clause (passives_w,passives_a) cl = let passives_w = WeightPassiveSet.remove cl passives_w in let passives_a = AgePassiveSet.remove cl passives_a in passives_w,passives_a in let add_passive_clauses (passives_w,passives_a) new_clauses = let new_clauses_w,new_clauses_a = List.fold_left add_passive_clause (WeightPassiveSet.empty,AgePassiveSet.empty) new_clauses in (WeightPassiveSet.union new_clauses_w passives_w, AgePassiveSet.union new_clauses_a passives_a) in let is_passive_set_empty (passives_w,passives_a) = if (WeightPassiveSet.is_empty passives_w) then begin assert (AgePassiveSet.is_empty passives_a); true end else begin assert (not (AgePassiveSet.is_empty passives_a)); false end in let passive_set_cardinal (passives_w,_) = WeightPassiveSet.cardinal passives_w in let passive_singleton cl = (WeightPassiveSet.singleton cl,AgePassiveSet.singleton cl) in let passive_empty_set = (WeightPassiveSet.empty,AgePassiveSet.empty) in let pick_min_passive use_age (passives_w,passives_a) = if use_age then AgePassiveSet.min_elt passives_a else WeightPassiveSet.min_elt passives_w in let timeout = Unix.gettimeofday () +. amount_of_time in (* TODO : global age over facts and goals (without comparing weights) *) let select passives g_passives = if is_passive_set_empty passives then begin assert (not (is_passive_set_empty g_passives)); let g_cl = pick_min_passive false g_passives in (true,snd g_cl,passives,remove_passive_clause g_passives g_cl) end else let cl = pick_min_passive false passives in if is_passive_set_empty g_passives then (false,snd cl,remove_passive_clause passives cl,g_passives) else let g_cl = pick_min_passive false g_passives in if (fst cl <= fst g_cl) then (false,snd cl,remove_passive_clause passives cl,g_passives) else (true,snd g_cl,passives,remove_passive_clause g_passives g_cl) in let backward_infer_step bag maxvar actives passives g_actives g_passives g_current = (* superposition left, simplifications on goals *) debug "infer_left step..."; let bag, maxvar, new_goals = Sup.infer_left bag maxvar g_current actives in debug "Performed infer_left step"; bag, maxvar, actives, passives, g_current::g_actives, (add_passive_clauses g_passives new_goals) in let forward_infer_step bag maxvar actives passives g_actives g_passives current = (* forward step *) (* e = select P * * e' = demod A e * * A' = demod [e'] A * * A'' = A' + e' * * e'' = fresh e' * * new = supright e'' A'' * * new'= demod A'' new * * P' = P + new' *) debug "Forward infer step..."; debug "Selected and simplified"; (* debug ("Fact after simplification :" ^ Pp.pp_unit_clause current); *) let bag, maxvar, actives, new_clauses = Sup.infer_right bag maxvar current actives in debug "Demodulating goals with actives..."; (* keep goals demodulated w.r.t. actives and check if solved *) let bag, g_actives = List.fold_left (fun (bag,acc) c -> match Sup.simplify_goal maxvar (snd actives) bag acc c with | None -> bag, acc | Some (bag,c) -> bag,c::acc) (bag,[]) g_actives in let ctable = IDX.index_unit_clause IDX.DT.empty current in let bag, maxvar, new_goals = List.fold_left (fun (bag,m,acc) g -> let bag, m, ng = Sup.infer_left bag m g ([current],ctable) in bag,m,ng@acc) (bag,maxvar,[]) g_actives in bag, maxvar, actives, add_passive_clauses passives new_clauses, g_actives, add_passive_clauses g_passives new_goals in let rec given_clause bag maxvar actives passives g_actives g_passives = (* prerr_endline "Bag :"; prerr_endline (Pp.pp_bag bag); prerr_endline "Active table :"; (List.iter (fun x -> prerr_endline (Pp.pp_unit_clause x)) (fst actives)); *) incr nb_iter; if !nb_iter = max_nb_iter then raise (Failure "No iterations left !"); if Unix.gettimeofday () > timeout then raise (Failure "Timeout !"); let rec aux_select passives g_passives = let backward,current,passives,g_passives = select passives g_passives in if backward then match Sup.simplify_goal maxvar (snd actives) bag g_actives current with | None -> aux_select passives g_passives | Some x -> let bag,g_current = x in backward_infer_step bag maxvar actives passives g_actives g_passives g_current else (* debug ("Selected fact : " ^ Pp.pp_unit_clause current); *) match Sup.keep_simplified current actives bag maxvar with (* match Sup.one_pass_simplification current actives bag maxvar with*) | None -> aux_select passives g_passives | Some x -> let (current, bag, actives) = x in forward_infer_step bag maxvar actives passives g_actives g_passives current in let bag,maxvar,actives,passives,g_actives,g_passives = aux_select passives g_passives in debug (Printf.sprintf "Number of active goals : %d" (List.length g_actives)); debug (Printf.sprintf "Number of passive goals : %d" (passive_set_cardinal g_passives)); debug (Printf.sprintf "Number of actives : %d" (List.length (fst actives))); debug (Printf.sprintf "Number of passives : %d" (passive_set_cardinal passives)); given_clause bag maxvar actives passives g_actives g_passives in let mk_clause bag maxvar (t,ty) = let (proof,ty) = B.saturate t ty in let c, maxvar = Utils.mk_unit_clause maxvar ty proof in let bag, c = Utils.add_to_bag bag c in bag, maxvar, c in let bag, maxvar, goal = mk_clause Terms.M.empty 0 t in let g_actives = [] in let g_passives = (* passive_singleton (Utils.mk_passive_clause goal)*) passive_singleton (0,goal) in let passives, bag, maxvar = List.fold_left (fun (cl, bag, maxvar) t -> let bag, maxvar, c = mk_clause bag maxvar t in (add_passive_clause ~no_weight:true cl c), bag, maxvar) (passive_empty_set, bag, maxvar) table in let actives = [], IDX.DT.empty in try given_clause bag maxvar actives passives g_actives g_passives with | Sup.Success (bag, _, (i,_,_,_)) -> let l = let rec traverse ongoal (accg,acce) i = match Terms.M.find i bag with | (id,_,_,Terms.Exact _) -> if ongoal then [i],acce else if (List.mem i acce) then accg,acce else accg,acce@[i] | (_,_,_,Terms.Step (_,i1,i2,_,_,_)) -> if (not ongoal) && (List.mem i acce) then accg,acce else let accg,acce = traverse false (traverse ongoal (accg,acce) i1) i2 in if ongoal then i::accg,acce else accg,i::acce in let gsteps,esteps = traverse true ([],[]) i in (List.rev esteps)@gsteps in prerr_endline (Printf.sprintf "Found proof in %d iterations, %fs" !nb_iter (Unix.gettimeofday() -. timeout +. amount_of_time)); (* prerr_endline "Proof:"; List.iter (fun x -> prerr_endline (string_of_int x); prerr_endline (Pp.pp_unit_clause (Terms.M.find x bag))) l;*) let proofterm = B.mk_proof bag i l in prerr_endline (Printf.sprintf "Got proof term, %fs" (Unix.gettimeofday() -. timeout +. amount_of_time)); let metasenv, proofterm = let rec aux k metasenv = function | NCic.Meta _ as t -> metasenv, t | NCic.Implicit _ -> let metasenv,i,_,_=NCicMetaSubst.mk_meta metasenv context `Term in metasenv, NCic.Meta (i,(k,NCic.Irl (List.length context))) | t -> NCicUntrusted.map_term_fold_a (fun _ k -> k+1) k aux metasenv t in aux 0 metasenv proofterm in let metasenv, subst, proofterm, _prooftype = NCicRefiner.typeof (rdb#set_coerc_db NCicCoercion.empty_db) metasenv subst context proofterm None in proofterm, metasenv, subst | Failure s -> prerr_endline s; prerr_endline (Printf.sprintf "FAILURE in %d iterations" !nb_iter); assert false ;;