* http://cs.unibo.it/helm/.
*)
- let debug_print = ignore (*prerr_endline *)
+(* $Id$ *)
+
+ let debug = false
+ let debug_print s = if debug then prerr_endline (Lazy.force s)
(* let debug_print = fun _ -> () *)
+(* Profiling code
let new_experimental_hint =
let profile = CicUtil.profile "new_experimental_hint" in
fun ~dbd ~facts ?signature ~universe status ->
- profile (MetadataQuery.new_experimental_hint ~dbd ~facts ?signature ~universe) status
+ profile.profile (MetadataQuery.new_experimental_hint ~dbd ~facts ?signature ~universe) status
+*) let new_experimental_hint = MetadataQuery.new_experimental_hint
(* In this versions of auto_tac we maintain an hash table of all inspected
goals. We assume that the context is invariant for application.
let module PT = PrimitiveTactics in
let _,metasenv,_,_ = proof in
let _,context,ty = CicUtil.lookup_meta goal metasenv in
- let ctxlen = List.length context in
let rec find n = function
| [] -> []
| hd::tl ->
let res =
(* we should check that the hypothesys has not been cleared *)
- if List.nth context (ctxlen - n) = None then
+ if List.nth context (n-1) = None then
None
else
try
*)
Some (subst,(proof, goal_list))
with
- PET.Fail _ -> None
+ PET.Fail _ -> None
in
(match res with
| Some res -> res::(find (n+1) tl)
exception NoOtherChoices;;
-let is_in_metasenv goal metasenv =
- try
- let (_, ey ,ty) =
- CicUtil.lookup_meta goal metasenv in
- true
- with CicUtil.Meta_not_found _ -> false
-
let rec auto_single dbd proof goal ey ty depth width sign already_seen_goals
universe
=
let _,metasenv,p,_ = proof in
(* first of all we check if the goal has been already
inspected *)
- assert (is_in_metasenv goal metasenv);
+ assert (CicUtil.exists_meta goal metasenv);
let exitus =
try Hashtbl.find inspected_goals ty
with Not_found -> NotYetInspected in
match exitus with
Yes (bo,_) ->
(*
- debug_print "ALREADY PROVED!!!!!!!!!!!!!!!!!!!!!!!!!!!!";
- debug_print (CicPp.ppterm ty);
+ debug_print (lazy "ALREADY PROVED!!!!!!!!!!!!!!!!!!!!!!!!!!!!");
+ debug_print (lazy (CicPp.ppterm ty));
*)
let subst_in =
(* if we just apply the subtitution, the type
proof goal subst_in metasenv in
[(subst_in,(proof,[],sign))]
| No d when (d >= depth) ->
- (* debug_print "PRUNED!!!!!!!!!!!!!!!!!!!!!!!!!!!!"; *)
+ (* debug_print (lazy "PRUNED!!!!!!!!!!!!!!!!!!!!!!!!!!!!"); *)
[] (* the empty list means no choices, i.e. failure *)
| No _
| NotYetInspected ->
- debug_print ("CURRENT GOAL = " ^ CicPp.ppterm ty);
- debug_print ("CURRENT PROOF = " ^ CicPp.ppterm p);
- debug_print ("CURRENT HYP = " ^ CicPp.ppcontext ey);
+ debug_print (lazy ("CURRENT GOAL = " ^ CicPp.ppterm ty));
+ debug_print (lazy ("CURRENT PROOF = " ^ CicPp.ppterm p));
+ debug_print (lazy ("CURRENT HYP = " ^ CicPp.ppcontext ey));
let sign, new_sign =
if is_meta_closed then
None, Some (MetadataConstraints.signature_of ty)
in
if not (cty = ty) then
begin
- debug_print ("ty = "^CicPp.ppterm ty);
- debug_print ("cty = "^CicPp.ppterm cty);
+ debug_print (lazy ("ty = "^CicPp.ppterm ty));
+ debug_print (lazy ("cty = "^CicPp.ppterm cty));
assert false
end
Hashtbl.add inspected_goals
| [] -> []
| (subst,(proof, goals, sign))::tl ->
let _,metasenv,_,_ = proof in
- let is_in_metasenv (goal, _) =
- try
- let (_, ey ,ty) = CicUtil.lookup_meta goal metasenv in
- true
- with CicUtil.Meta_not_found _ -> false
+ let goals'=
+ List.filter (fun (goal, _) -> CicUtil.exists_meta goal metasenv) goals
in
- let goals'= List.filter is_in_metasenv goals in
auto_new_aux dbd
width already_seen_goals universe ((subst,(proof, goals', sign))::tl)
let default_depth = 5
let default_width = 3
-let auto_tac ?(depth=default_depth) ?(width=default_width) ~(dbd:Mysql.dbd)
+(*
+let auto_tac ?(depth=default_depth) ?(width=default_width) ~(dbd:HMysql.dbd)
()
=
let auto_tac dbd (proof,goal) =
let universe = MetadataQuery.signature_of_goal ~dbd (proof,goal) in
Hashtbl.clear inspected_goals;
- debug_print "Entro in Auto";
+ debug_print (lazy "Entro in Auto");
let id t = t in
+ let t1 = Unix.gettimeofday () in
match auto_new dbd width [] universe [id,(proof, [(goal,depth)],None)] with
- [] -> debug_print("Auto failed");
+ [] -> debug_print (lazy "Auto failed");
raise (ProofEngineTypes.Fail "No Applicable theorem")
- | (_,(proof,[],_))::_ ->
- debug_print "AUTO_TAC HA FINITO";
+ | (_,(proof,[],_))::_ ->
+ let t2 = Unix.gettimeofday () in
+ debug_print (lazy "AUTO_TAC HA FINITO");
let _,_,p,_ = proof in
- debug_print (CicPp.ppterm p);
+ debug_print (lazy (CicPp.ppterm p));
+ Printf.printf "tempo: %.9f\n" (t2 -. t1);
(proof,[])
| _ -> assert false
in
ProofEngineTypes.mk_tactic (auto_tac dbd)
;;
+*)
+(*
+let paramodulation_tactic = ref
+ (fun dbd ?full ?depth ?width status ->
+ raise (ProofEngineTypes.Fail (lazy "Not Ready yet...")));;
+let term_is_equality = ref
+ (fun term -> debug_print (lazy "term_is_equality E` DUMMY!!!!"); false);;
+*)
+
+let auto_tac ?(depth=default_depth) ?(width=default_width) ?paramodulation
+ ?full ~(dbd:HMysql.dbd) () =
+ let auto_tac dbd (proof, goal) =
+ let normal_auto () =
+ let universe = MetadataQuery.signature_of_goal ~dbd (proof, goal) in
+ Hashtbl.clear inspected_goals;
+ debug_print (lazy "Entro in Auto");
+ let id t = t in
+ let t1 = Unix.gettimeofday () in
+ match
+ auto_new dbd width [] universe [id, (proof, [(goal, depth)], None)]
+ with
+ [] -> debug_print(lazy "Auto failed");
+ raise (ProofEngineTypes.Fail (lazy "No Applicable theorem"))
+ | (_,(proof,[],_))::_ ->
+ let t2 = Unix.gettimeofday () in
+ debug_print (lazy "AUTO_TAC HA FINITO");
+ let _,_,p,_ = proof in
+ debug_print (lazy (CicPp.ppterm p));
+ debug_print (lazy (Printf.sprintf "tempo: %.9f\n" (t2 -. t1)));
+ (proof,[])
+ | _ -> assert false
+ in
+ let full = match full with None -> false | Some _ -> true in
+ let paramodulation_ok =
+ match paramodulation with
+ | None -> false
+ | Some _ ->
+ let _, metasenv, _, _ = proof in
+ let _, _, meta_goal = CicUtil.lookup_meta goal metasenv in
+ full || (Inference.term_is_equality meta_goal)
+ in
+ if paramodulation_ok then (
+ debug_print (lazy "USO PARAMODULATION...");
+(* try *)
+ Saturation.saturate dbd ~depth ~width ~full (proof, goal)
+(* with ProofEngineTypes.Fail _ -> *)
+(* normal_auto () *)
+ ) else
+ normal_auto ()
+ in
+ ProofEngineTypes.mk_tactic (auto_tac dbd)
+;;
projects / helm.git / blobdiff