let symbols_counter = ref 0;;
(* non-recursive Knuth-Bendix term ordering by default *)
-Utils.compare_terms := Utils.rpo;;
+(* Utils.compare_terms := Utils.rpo;; *)
(* Utils.compare_terms := Utils.nonrec_kbo;; *)
(* Utils.compare_terms := Utils.ao;; *)
type theorem = Cic.term * Cic.term * Cic.metasenv;;
-
-let symbols_of_equality ((_, _, (_, left, right, _), _, _) as equality) =
+let symbols_of_equality (_, _, (_, left, right, _), _, _) =
let m1 = symbols_of_term left in
let m =
TermMap.fold
m
;;
-
module OrderedEquality = struct
type t = Inference.equality
and pp = List.map (fun e -> (Positive, e)) pp in
pn @ pp, Some pt
in
- let all = active_list @ pl in
let t2 = Unix.gettimeofday () in
fs_time_info.build_all <- fs_time_info.build_all +. (t2 -. t1);
and pp = List.map (fun e -> (Positive, e)) pp in
pn @ pp, Some pt
in
- let all = if pl = [] then active_list else active_list @ pl in
let demodulate table goal =
let newmeta, newgoal =
and pp = List.map (fun e -> (Positive, e)) pp in
pn @ pp, Some pt
in
- let all = if pl = [] then active_list else active_list @ pl in
let a_theorems, p_theorems = theorems in
let demodulate table theorem =
let newmeta, newthm =
let aux (goal, r) tl =
let propagate_subst subst (proof, metas, term) =
let rec repl = function
- | NoProof -> NoProof
+ | NoProof -> NoProof
| BasicProof t ->
BasicProof (CicMetaSubst.apply_subst subst t)
| ProofGoalBlock (p, pb) ->
al @ [(sign, current)], Indexing.index tbl current
in
let passive = add_to_passive passive new' in
- let (_, ns), (_, ps), _ = passive in
given_clause dbd env goals theorems passive active
| true, goal ->
let proof =
let init () = ();;
-(* UGLY SIDE EFFECT...
-if connect_to_auto then (
- AutoTactic.paramodulation_tactic := saturate;
- AutoTactic.term_is_equality := Inference.term_is_equality;
-);;
-*)
-
let retrieve_and_print dbd term metasenv ugraph =
let module C = Cic in
let module T = CicTypeChecker in
in
let ugraph = CicUniv.empty_ugraph in
let env = (metasenv, context, ugraph) in
- let goal = Inference.BasicProof new_meta_goal, [], goal in
let t1 = Unix.gettimeofday () in
let lib_eq_uris, library_equalities, maxm =
- find_library_equalities dbd context (proof, goal') (maxm+2)
- in
+ find_library_equalities dbd context (proof, goal') (maxm+2) in
let t2 = Unix.gettimeofday () in
- maxmeta := maxm+2;
- let equalities =
- let equalities = (* equalities @ *) library_equalities in
- debug_print
- (lazy
- (Printf.sprintf "\n\nequalities:\n%s\n"
- (String.concat "\n"
- (List.map
- (fun (u, e) ->
-(* Printf.sprintf "%s: %s" *)
- (UriManager.string_of_uri u)
-(* (string_of_equality e) *)
- )
- equalities))));
- debug_print (lazy "SIMPLYFYING EQUALITIES...");
- let rec simpl e others others_simpl =
- let (u, e) = e in
- let active = List.map (fun (u, e) -> (Positive, e))
- (others @ others_simpl) in
- let tbl =
- List.fold_left
- (fun t (_, e) -> Indexing.index t e)
- Indexing.empty active
- in
- let res = forward_simplify env (Positive, e) (active, tbl) in
- match others with
- | hd::tl -> (
- match res with
- | None -> simpl hd tl others_simpl
- | Some e -> simpl hd tl ((u, (snd e))::others_simpl)
- )
- | [] -> (
- match res with
- | None -> others_simpl
- | Some e -> (u, (snd e))::others_simpl
- )
- in
- match equalities with
- | [] -> []
- | hd::tl ->
- let others = tl in (* List.map (fun e -> (Positive, e)) tl in *)
- let res =
- List.rev (simpl (*(Positive,*) hd others [])
- in
- debug_print
- (lazy
- (Printf.sprintf "\nequalities AFTER:\n%s\n"
- (String.concat "\n"
- (List.map
- (fun (u, e) ->
- Printf.sprintf "%s: %s"
- (UriManager.string_of_uri u)
- (string_of_equality e)
- )
- res))));
- res
+ maxmeta := maxm+2;
+ let equalities = (* equalities @ *) library_equalities in
+ debug_print
+ (lazy
+ (Printf.sprintf "\n\nequalities:\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (fun (u, e) ->
+(* Printf.sprintf "%s: %s" *)
+ (UriManager.string_of_uri u)
+(* (string_of_equality e) *)
+ )
+ equalities))));
+ debug_print (lazy "SIMPLYFYING EQUALITIES...");
+ let rec simpl e others others_simpl =
+ let (u, e) = e in
+ let active = List.map (fun (u, e) -> (Positive, e))
+ (others @ others_simpl) in
+ let tbl =
+ List.fold_left
+ (fun t (_, e) -> Indexing.index t e)
+ Indexing.empty active
in
- debug_print
- (lazy
- (Printf.sprintf "Time to retrieve equalities: %.9f\n" (t2 -. t1)))
+ let res = forward_simplify env (Positive, e) (active, tbl) in
+ match others with
+ | hd::tl -> (
+ match res with
+ | None -> simpl hd tl others_simpl
+ | Some e -> simpl hd tl ((u, (snd e))::others_simpl)
+ )
+ | [] -> (
+ match res with
+ | None -> others_simpl
+ | Some e -> (u, (snd e))::others_simpl
+ )
+ in
+ let _equalities =
+ match equalities with
+ | [] -> []
+ | hd::tl ->
+ let others = tl in (* List.map (fun e -> (Positive, e)) tl in *)
+ let res =
+ List.rev (simpl (*(Positive,*) hd others [])
+ in
+ debug_print
+ (lazy
+ (Printf.sprintf "\nequalities AFTER:\n%s\n"
+ (String.concat "\n"
+ (List.map
+ (fun (u, e) ->
+ Printf.sprintf "%s: %s"
+ (UriManager.string_of_uri u)
+ (string_of_equality e)
+ )
+ res))));
+ res in
+ debug_print
+ (lazy
+ (Printf.sprintf "Time to retrieve equalities: %.9f\n" (t2 -. t1)))
;;
ty
in
let env = (metasenv, context, ugraph) in
- let t1 = Unix.gettimeofday () in
(*try*)
let goal = Inference.BasicProof new_meta_goal, [], goal in
let equalities =
(List.map
(string_of_equality ~env) equalities));
print_endline "--------------------------------------------------";
- let start = Unix.gettimeofday () in
print_endline "GO!";
start_time := Unix.gettimeofday ();
if !time_limit < 1. then time_limit := 60.;
let ra, rp =
saturate_equations env goal (fun e -> true) passive active
in
- let finish = Unix.gettimeofday () in
let initial =
List.fold_left (fun s e -> EqualitySet.add e s)
EqualitySet.empty equalities
in
- let addfun s e = EqualitySet.add e s
- (*
+ let addfun s e =
if not (EqualitySet.mem e initial) then EqualitySet.add e s else s
- *)
in
let passive =
projects / helm.git / blobdiff