X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matitaB%2Fcomponents%2Fng_tactics%2FnnAuto.ml;h=1fa530e782054d30ca02a7da400ed7ef9b0123b3;hb=89fc31fc5cc01e8860cf67a8e096c24125370d31;hp=697355db296cd2dc74a5c247b3dcd743b2ffe955;hpb=bb8f6e4e6d605e2ee354e19a86bf634e9a6b81a7;p=helm.git diff --git a/matitaB/components/ng_tactics/nnAuto.ml b/matitaB/components/ng_tactics/nnAuto.ml index 697355db2..1fa530e78 100644 --- a/matitaB/components/ng_tactics/nnAuto.ml +++ b/matitaB/components/ng_tactics/nnAuto.ml @@ -72,8 +72,12 @@ let print_stat status tbl = 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 @@ -294,6 +298,7 @@ let index_local_equations eq_cache status = 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 @@ -301,12 +306,12 @@ let index_local_equations eq_cache status = 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 _ @@ -591,7 +596,7 @@ let compare_statuses ~past ~present = 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 *) @@ -986,9 +991,9 @@ let try_candidate ?(smart=0) flags depth status eq_cache ctx t = debug_print (lazy ("expected branching: " ^ (string_of_int res))); debug_print (lazy ("actual: branching" ^ (string_of_int diff))); (* some flexibility *) - if og_no - old_og_no > res then + 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)) @@ -1729,7 +1734,7 @@ let auto_tac ~params:(univ,flags) ?(trace_ref=ref []) status = (* 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:[]) @@ -1800,10 +1805,10 @@ let auto_tac ~params:(univ,flags) ?(trace_ref=ref []) status = 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