let print ?(depth=0) s =
prerr_endline (String.make (2*depth) ' '^Lazy.force s)
let noprint ?(depth=0) _ = ()
-let debug_print = print
+let debug_print = noprint
open Continuationals.Stack
open NTacStatus
let vcompare (_,v1) (_,v2) =
Pervasives.compare (relevance v1) (relevance v2) in
let l = List.sort vcompare l in
+ let short_name r =
+ Filename.chop_extension
+ (Filename.basename (NReference.string_of_reference r))
+ in
let vstring (a,v)=
- NotationPp.pp_term status (Ast.NCic (NCic.Const a)) ^ ": rel = " ^
+ short_name a ^ ": rel = " ^
(string_of_float (relevance v)) ^
"; uses = " ^ (string_of_int !(v.uses)) ^
"; nom = " ^ (string_of_int !(v.nominations)) in
let open_goals = head_goals status#stack in
let open_goal = List.hd open_goals in
let ngty = get_goalty status open_goal in
+ let _,_,metasenv,subst,_ = status#obj in
let ctx = apply_subst_context ~fix_projections:true status (ctx_of ngty) in
let c = ref 0 in
List.fold_left
c:= !c+1;
let t = NCic.Rel !c in
try
- let ty = NCicTypeChecker.typeof status [] [] ctx t in
+ let ty = NCicTypeChecker.typeof status subst metasenv ctx t in
if is_a_fact status (mk_cic_term ctx ty) then
- (noprint(lazy("eq indexing " ^ (status#ppterm ctx [] [] ty)));
- NCicParamod.forward_infer_step status [] [] ctx eq_cache t ty)
+ (noprint(lazy("eq indexing " ^ (status#ppterm ctx subst metasenv ty)));
+ NCicParamod.forward_infer_step status metasenv subst ctx eq_cache t ty)
else
- (noprint (lazy ("not a fact: " ^ (status#ppterm ctx [] [] ty)));
+ (noprint (lazy ("not a fact: " ^ (status#ppterm ctx subst metasenv ty)));
eq_cache)
with
| NCicTypeChecker.TypeCheckerFailure _
List.map fst (List.filter (fun (i,_) -> not (List.mem_assoc i present)) past)
;;
-(* paramodulation has only an implicit knoweledge of the symmetry of equality;
+(* paramodulation has only an implicit knowledge of the symmetry of equality;
hence it is in trouble in proving (a = b) = (b = a) *)
let try_sym tac status g =
(* put the right uri *)
let diff = og_no - old_og_no in
debug_print (lazy ("expected branching: " ^ (string_of_int res)));
debug_print (lazy ("actual: branching" ^ (string_of_int diff)));
- (* one goal is closed by the application *)
- if og_no - old_og_no >= res then
+ (* some flexibility *)
+ if diff > res && res > 0 (* facts are never pruned *) then
(debug_print (lazy ("branch factor for: " ^ (ppterm status cict) ^ " = "
- ^ (string_of_int res) ^ " vs. " ^ (string_of_int og_no)));
+ ^ (string_of_int res) ^ " vs. " ^ (string_of_int diff)));
debug_print ~depth (lazy "strange application"); None)
else
(incr candidate_no; Some ((!candidate_no,t),status))
(* we compute candidates to be applied in normal mode, splitted in
facts and not facts *)
let candidates_facts,candidates_other =
- (* warning : the order between global_cands and local_cand is
- relevant. In this way we process first local cands *)
- let l1,l2 = List.partition test (global_cands@local_cands) in
+ let gl1,gl2 = List.partition test global_cands in
+ let ll1,ll2 = List.partition test local_cands in
(* if the goal is an equation we avoid to apply unit equalities,
since superposition should take care of them; refl is an
exception since it prompts for convertibility *)
- let l1 = if is_eq then [Ast.Ident("refl",`Ambiguous)] else l1 in
+ let l1 = if is_eq then [Ast.Ident("refl",`Ambiguous)] else gl1@ll1 in
let l2 =
(* if smart given candidates are applied in smart mode *)
- if by && smart then []
- else if by then given_candidates
- else l2
+ if by && smart then ll2
+ else if by then given_candidates@ll2
+ else gl2@ll2
in l1,l2
in
(* we now compute candidates to be applied in smart mode, splitted in
let smart_candidates_facts, smart_candidates_other =
if is_prod || not(smart) then [],[]
else
- let l1,l2 = List.partition test (smart_local_cands@smart_global_cands) in
- let l1 = if is_eq then [] else l1 in
- let l2 = if by then given_candidates else l2
- in
- l1,l2
+ let sgl1,sgl2 = List.partition test smart_global_cands in
+ let sll1,sll2 = List.partition test smart_local_cands in
+ let l1 = if is_eq then [] else sgl1@sll1 in
+ let l2 =
+ if by && smart then given_candidates@sll2
+ else if by then sll2
+ else sgl2@sll2
+ in l1,l2
in
candidates_facts,
smart_candidates_facts,
(* pp_th status facts; *)
(*
NDiscriminationTree.DiscriminationTree.iter status#auto_cache (fun p t ->
- debug_print (lazy(
+ (*debug_*)print (lazy(
NDiscriminationTree.NCicIndexable.string_of_path p ^ " |--> " ^
String.concat "\n " (List.map (
status#ppterm ~metasenv:[] ~context:[] ~subst:[])
in
let s = s#set_stack stack in
trace_ref := trace;
- oldstatus#set_status s
+ oldstatus#set_status s
in
let s = up_to depth depth in
- debug_print (print_stat status statistics);
+ debug_print (print_stat status statistics);
debug_print(lazy
("TIME ELAPSED:"^string_of_float(Unix.gettimeofday()-.initial_time)));
debug_print(lazy