X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_paramodulation%2Fparamod.ml;h=b32a5b1be43bdeb5b13444903d9573f88aadeff8;hb=c091ca7a030a85a529543de98e45c54284028b63;hp=8903ec02fc1c24082fe54d53ddbb32006ec761c4;hpb=a15dc157f7e63db12b9a7b59cf00aea108d7e073;p=helm.git diff --git a/helm/software/components/ng_paramodulation/paramod.ml b/helm/software/components/ng_paramodulation/paramod.ml index 8903ec02f..b32a5b1be 100644 --- a/helm/software/components/ng_paramodulation/paramod.ml +++ b/helm/software/components/ng_paramodulation/paramod.ml @@ -4,7 +4,6 @@ let debug s = let nparamod rdb metasenv subst context t table = let nb_iter = ref 200 in - prerr_endline "========================================"; let module C = struct let metasenv = metasenv let subst = subst @@ -67,10 +66,10 @@ let nparamod rdb metasenv subst context t table = bag, maxvar, g_current::g_actives, (PassiveSet.union new_goals g_passives) in - prerr_endline + debug (Printf.sprintf "Number of active goals : %d" (List.length g_actives)); - prerr_endline + debug (Printf.sprintf "Number of passive goals : %d" (PassiveSet.cardinal g_passives)); @@ -91,7 +90,7 @@ let nparamod rdb metasenv subst context t table = | None -> assert false | Some (current, passives) -> debug ("Selected fact : " ^ Pp.pp_unit_clause current); - match Sup.keep_simplified current actives bag with + match Sup.keep_simplified current actives bag maxvar with (* match Sup.one_pass_simplification current actives bag with *) | None -> aux_simplify passives | Some x -> x,passives @@ -129,9 +128,9 @@ let nparamod rdb metasenv subst context t table = PassiveSet.union new_clauses passives, PassiveSet.union new_goals g_passives in - prerr_endline + debug (Printf.sprintf "Number of actives : %d" (List.length (fst actives))); - prerr_endline + debug (Printf.sprintf "Number of passives : %d" (PassiveSet.cardinal passives)); given_clause bag maxvar actives passives g_actives g_passives @@ -165,27 +164,43 @@ let nparamod rdb metasenv subst context t table = Set.Make(struct type t=int let compare=Pervasives.compare end) in let all id = - let rec traverse acc i = + let rec traverse ongoal (accg,acce) i = match Terms.M.find i bag with - | (_,_,_,Terms.Exact _) -> acc + | (_,_,_,Terms.Exact _) -> accg, acce | (_,_,_,Terms.Step (_,i1,i2,_,_,_)) -> - traverse (traverse (C.add i1 (C.add i2 acc)) i1) i2 + let accg, acce = + if ongoal then C.add i1 accg, acce + else accg, C.add i1 acce + in + let acce = C.add i2 acce in + traverse false (traverse ongoal (accg,acce) i1) i2 in - C.elements (traverse C.empty id) + traverse true (C.empty,C.empty) id in - S.topological_sort (all i) all + let esteps = + S.topological_sort (C.elements (snd (all i))) + (fun i -> C.elements (C.union (snd (all i)) (fst (all i)) )) + in + let gsteps = + S.topological_sort (C.elements (fst (all i))) + (fun i -> C.elements (fst (all i))) + in + let gsteps = List.rev gsteps in + esteps@(i::gsteps) in - prerr_endline "YES!"; - prerr_endline "Proof:"; - List.iter (fun x -> - prerr_endline (Pp.pp_unit_clause (Terms.M.find x bag))) l; - let proofterm = B.mk_proof bag l in - prerr_endline - (NCicPp.ppterm ~metasenv:C.metasenv ~subst:C.subst ~context:C.context - proofterm); - let _metasenv, _subst, _proofterm, _prooftype = - NCicRefiner.typeof rdb C.metasenv C.subst C.context proofterm None + debug "YES!"; + debug ("Meeting point : " ^ (string_of_int i)); + debug "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 (NCicPp.ppterm ~metasenv:C.metasenv + ~subst:C.subst ~context:C.context proofterm); + let metasenv, subst, proofterm, _prooftype = + NCicRefiner.typeof + (rdb#set_coerc_db NCicCoercion.empty_db) + C.metasenv C.subst C.context proofterm None in - () - | Failure _ -> prerr_endline "FAILURE"; + proofterm, metasenv, subst + | Failure _ -> prerr_endline "FAILURE"; assert false ;;