New selection strategy. De morgan: 253 s.
;;
let remove_index tree equality =
- let _, _, (_, l, r, ordering), _, _ = equality in
+ let _, _, (_, l, r, ordering), _ = equality in
match ordering with
| Utils.Gt -> remove_index tree l (Utils.Left, equality)
| Utils.Lt -> remove_index tree r (Utils.Right, equality)
remove_index tree l (Utils.Left, equality)
let index tree equality =
- let _, _, (_, l, r, ordering), _, _ = equality in
+ let _, _, (_, l, r, ordering), _ = equality in
match ordering with
| Utils.Gt -> index tree l (Utils.Left, equality)
| Utils.Lt -> index tree r (Utils.Right, equality)
let in_index tree equality =
- let _, _, (_, l, r, ordering), _, _ = equality in
+ let _, _, (_, l, r, ordering), _ = equality in
let meta_convertibility (pos,equality') =
Inference.meta_convertibility_eq equality equality'
in
;;
let remove_index tree equality =
- let _, _, (_, l, r, ordering), _, _ = equality in
+ let _, _, (_, l, r, ordering), _ = equality in
match ordering with
| Utils.Gt -> remove_index tree l (Utils.Left, equality)
| Utils.Lt -> remove_index tree r (Utils.Right, equality)
remove_index tree l (Utils.Left, equality)
let index tree equality =
- let _, _, (_, l, r, ordering), _, _ = equality in
+ let _, _, (_, l, r, ordering), _ = equality in
match ordering with
| Utils.Gt -> index tree l (Utils.Left, equality)
| Utils.Lt -> index tree r (Utils.Right, equality)
let in_index tree equality =
- let _, _, (_, l, r, ordering), _, _ = equality in
+ let _, _, (_, l, r, ordering), _ = equality in
let meta_convertibility (pos,equality') =
Inference.meta_convertibility_eq equality equality'
in
;;
let check_for_duplicates metas msg =
-let _ =
- try
- ignore(CicUtil.lookup_meta 190 metas);
- prerr_endline ("eccoci in " ^ msg);
- with
- CicUtil.Meta_not_found _ -> () in
-if List.length metas <>
+ if List.length metas <>
List.length (HExtlib.list_uniq (List.sort Pervasives.compare metas)) then
begin
prerr_endline ("DUPLICATI " ^ msg);
;;
let check_target context target msg =
- let w, proof, (eq_ty, left, right, order), metas, args = target in
+ let w, proof, (eq_ty, left, right, order), metas = target in
(* check that metas does not contains duplicates *)
let eqs = Inference.string_of_equality target in
let _ = check_for_duplicates metas (msg ^ "\nchecking " ^ eqs) in
function
| [] -> None
| candidate::tl ->
- let pos, (_, proof, (ty, left, right, o), metas, args) = candidate in
+ let pos, (_, proof, (ty, left, right, o), metas) = candidate in
if Utils.debug_metas then
ignore(check_target context (snd candidate) "find_matches");
if Utils.debug_res then
function
| [] -> []
| candidate::tl ->
- let pos, (_, _, (ty, left, right, o), metas, args) = candidate in
+ let pos, (_, _, (ty, left, right, o), metas) = candidate in
let do_match c eq_URI =
let subst', metasenv', ugraph' =
let t1 = Unix.gettimeofday () in
returns true if target is subsumed by some equality in table
*)
let subsumption env table target =
- let _, _, (ty, left, right, _), tmetas, _ = target in
+ let _, _, (ty, left, right, _), tmetas = target in
let metasenv, context, ugraph = env in
let metasenv = metasenv @ tmetas in
let samesubst subst subst' =
in
let rec ok what = function
| [] -> false, []
- | (_, subst, menv, ug, ((pos, (_, _, (_, l, r, o), m, _)), _))::tl ->
+ | (_, subst, menv, ug, ((pos, (_, _, (_, l, r, o), m)), _))::tl ->
try
let other = if pos = Utils.Left then r else l in
let subst', menv', ug' =
let module HL = HelmLibraryObjects in
let module U = Utils in
let metasenv, context, ugraph = env in
- let w, proof, (eq_ty, left, right, order), metas, args = target in
+ let w, proof, (eq_ty, left, right, order), metas = target in
(* first, we simplify *)
let right = U.guarded_simpl context right in
let left = U.guarded_simpl context left in
let order = !Utils.compare_terms left right in
let stat = (eq_ty, left, right, order) in
let w = Utils.compute_equality_weight stat in
- let target = w, proof, stat, metas, args in
+ let target = w, proof, stat, metas in
if Utils.debug_metas then
ignore(check_target context target "demod equalities input");
let metasenv' = (* metasenv @ *) metas in
let substs = CicMetaSubst.ppsubst subst in
ignore(check_target context (snd eq_found) ("input3" ^ substs))
end;
- let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let pos, (_, proof', (ty, what, other, _), menv') = eq_found in
let ty =
try fst (CicTypeChecker.type_of_aux' metasenv context what ugraph)
with CicUtil.Meta_not_found _ -> ty
let what, other =
if pos = Utils.Left then what, other else other, what
in
- pos, (0, proof', (ty, other, what, Utils.Incomparable),
- menv', args')
+ pos, (0, proof', (ty, other, what, Utils.Incomparable),menv')
in
let target_proof =
let pb =
build_newtarget_time := !build_newtarget_time +. (time2 -. time1);
let res =
let w = Utils.compute_equality_weight stat in
- (w, newproof, stat,newmenv,args) in
+ (w, newproof, stat,newmenv) in
if Utils.debug_metas then
ignore(check_target context res "buildnew_target output");
!maxmeta, res
let module HL = HelmLibraryObjects in
let module CR = CicReduction in
let module U = Utils in
- let weight, proof, (eq_ty, left, right, ordering), menv, _ = target in
+ let weight, proof, (eq_ty, left, right, ordering), menv = target in
if Utils.debug_metas then
ignore(check_target context target "superpositionleft");
let expansions, _ =
(* debug_print (lazy "\nSUPERPOSITION LEFT\n"); *)
let time1 = Unix.gettimeofday () in
- let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let pos, (_, proof', (ty, what, other, _), menv') = eq_found in
let what, other = if pos = Utils.Left then what, other else other, what in
let newgoal, newproof =
let bo' = U.guarded_simpl context (apply_subst s (S.subst other bo)) in
let what, other =
if pos = Utils.Left then what, other else other, what
in
- pos, (0, proof', (ty, other, what, Utils.Incomparable), menv', args')
+ pos, (0, proof', (ty, other, what, Utils.Incomparable), menv')
in
let target_proof =
let pb =
build_newtarget_time := !build_newtarget_time +. (time2 -. time1);
let w = Utils.compute_equality_weight stat in
- (w, newproof, stat, newmenv, [])
+ (w, newproof, stat, newmenv)
in
!maxmeta, List.map build_new expansions
let module HL = HelmLibraryObjects in
let module CR = CicReduction in
let module U = Utils in
- let w, eqproof, (eq_ty, left, right, ordering), newmetas, args = target in
+ let w, eqproof, (eq_ty, left, right, ordering), newmetas = target in
if Utils.debug_metas then
ignore (check_target context target "superpositionright");
let metasenv' = newmetas in
ignore (check_target context (snd eq_found) "buildnew1" );
let time1 = Unix.gettimeofday () in
- let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let pos, (_, proof', (ty, what, other, _), menv') = eq_found in
let what, other = if pos = Utils.Left then what, other else other, what in
let newgoal, newproof =
(* qua *)
else apply_subst s left, newgoal in
let neworder = !Utils.compare_terms left right in
let newmenv = (* Inference.filter s *) m in
- let newargs = args @ args' in
let stat = (eq_ty, left, right, neworder) in
let eq' =
let w = Utils.compute_equality_weight stat in
- (w, newproof, stat, newmenv, newargs) in
+ (w, newproof, stat, newmenv) in
if Utils.debug_metas then
ignore (check_target context eq' "buildnew3");
let newm, eq' = Inference.fix_metas !maxmeta eq' in
let metasenv' = metas in
let build_newgoal (t, subst, menv, ug, (eq_found, eq_URI)) =
- let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let pos, (_, proof', (ty, what, other, _), menv') = eq_found in
let what, other = if pos = Utils.Left then what, other else other, what in
let ty =
try fst (CicTypeChecker.type_of_aux' metasenv context what ugraph)
let what, other =
if pos = Utils.Left then what, other else other, what
in
- pos, (0, proof', (ty, other, what, Utils.Incomparable), menv', args')
+ pos, (0, proof', (ty, other, what, Utils.Incomparable), menv')
in
let goal_proof =
let pb =
let metasenv' = metas in
let build_newtheorem (t, subst, menv, ug, (eq_found, eq_URI)) =
- let pos, (_, proof', (ty, what, other, _), menv', args') = eq_found in
+ let pos, (_, proof', (ty, what, other, _), menv') = eq_found in
let what, other = if pos = Utils.Left then what, other else other, what in
let newterm, newty =
let bo = Utils.guarded_simpl context (apply_subst subst (S.subst other t)) in
val subsumption :
Cic.metasenv * Cic.context * CicUniv.universe_graph ->
Index.t ->
- 'a * 'b * ('c * Index.key * Index.key * 'd) * Cic.metasenv * 'e ->
+ Inference.equality ->
bool * Cic.substitution
val superposition_left :
int ->
Cic.term * (* left side *)
Cic.term * (* right side *)
Utils.comparison) * (* ordering *)
- Cic.metasenv * (* environment for metas *)
- Cic.term list (* arguments *)
+ Cic.metasenv (* environment for metas *)
and proof =
| NoProof (* term is the goal missing a proof *)
match env with
| None -> (
function
- | w, _, (ty, left, right, o), _, _ ->
+ | w, _, (ty, left, right, o), _ ->
Printf.sprintf "Weight: %d, {%s}: %s =(%s) %s" w (CicPp.ppterm ty)
(CicPp.ppterm left) (string_of_comparison o) (CicPp.ppterm right)
)
| Some (_, context, _) -> (
let names = names_of_context context in
function
- | w, _, (ty, left, right, o), _, _ ->
+ | w, _, (ty, left, right, o), _ ->
Printf.sprintf "Weight: %d, {%s}: %s =(%s) %s" w (CicPp.pp ty names)
(CicPp.pp left names) (string_of_comparison o)
(CicPp.pp right names)
| ProofBlock (subst, eq_URI, (name, ty), bo, (pos, eq), eqproof) ->
let t' = Cic.Lambda (name, ty, bo) in
let proof' =
- let _, proof', _, _, _ = eq in
+ let _, proof', _, _ = eq in
do_build_proof proof'
in
let eqproof = do_build_proof eqproof in
- let _, _, (ty, what, other, _), menv', args' = eq in
+ let _, _, (ty, what, other, _), menv' = eq in
let what, other =
if pos = Utils.Left then what, other else other, what
in
let meta_convertibility_eq eq1 eq2 =
- let _, _, (ty, left, right, _), _, _ = eq1
- and _, _, (ty', left', right', _), _, _ = eq2 in
+ let _, _, (ty, left, right, _), _ = eq1
+ and _, _, (ty', left', right', _), _ = eq2 in
if ty <> ty' then
false
else if (left = left') && (right = right') then
let matching = matching1;;
let check_eq context msg eq =
- let w, proof, (eq_ty, left, right, order), metas, args = eq in
+ let w, proof, (eq_ty, left, right, order), metas = eq in
if not (fst (CicReduction.are_convertible ~metasenv:metas context eq_ty
(fst (CicTypeChecker.type_of_aux' metas context left CicUniv.empty_ugraph))
CicUniv.empty_ugraph))
let stat = (ty,t1,t2,o) in
let w = compute_equality_weight stat in
let proof = BasicProof p in
- let e = (w, proof, stat, newmetas, args) in
+ let e = (w, proof, stat, newmetas) in
Some e, (newmeta+1)
| _ -> None, newmeta
)
let o = !Utils.compare_terms t1 t2 in
let stat = (ty,t1,t2,o) in
let w = compute_equality_weight stat in
- let e = (w, BasicProof (C.Rel index), stat, [], []) in
+ let e = (w, BasicProof (C.Rel index), stat, []) in
Some e, (newmeta+1)
| _ -> None, newmeta
in (
let stat = (ty,t1,t2,o) in
let w = compute_equality_weight stat in
let proof = BasicProof p in
- let e = (w, proof, stat, newmetas, args) in
+ let e = (w, proof, stat, newmetas) in
Some e, (newmeta+1)
| _ -> None, newmeta
)
let o = !Utils.compare_terms t1 t2 in
let stat = (ty,t1,t2,o) in
let w = compute_equality_weight stat in
- let e = (w, BasicProof term, stat, [], []) in
+ let e = (w, BasicProof term, stat, []) in
Some e, (newmeta+1)
| _ -> None, newmeta
in
subst, metasenv, newmeta
-let fix_metas newmeta (w, p, (ty, left, right, o), menv, args) =
+let fix_metas newmeta (w, p, (ty, left, right, o), menv) =
(*
let metas = (metas_of_term left)@(metas_of_term right)
@(metas_of_term ty)@(metas_of_proof p) in
let ty = CicMetaSubst.apply_subst subst ty in
let left = CicMetaSubst.apply_subst subst left in
let right = CicMetaSubst.apply_subst subst right in
- let args = List.map (CicMetaSubst.apply_subst subst) args in
let rec fix_proof = function
| NoProof -> NoProof
| BasicProof term -> BasicProof (CicMetaSubst.apply_subst subst term)
@(metas_of_term ty)@(metas_of_proof p) in
let metasenv = List.filter (fun (i, _, _) -> List.mem i metas) metasenv in
*)
- let eq = (w, p, (ty, left, right, o), metasenv, args) in
+ let eq = (w, p, (ty, left, right, o), metasenv) in
(* debug prerr_endline (string_of_equality eq); *)
newmeta+1, eq
let o = !Utils.compare_terms t1 t2 in
let stat = (ty,t1,t2,o) in
let w = compute_equality_weight stat in
- let e = (w, BasicProof proof, stat, [], []) in
+ let e = (w, BasicProof proof, stat, []) in
e
| _ ->
raise TermIsNotAnEquality
type environment = Cic.metasenv * Cic.context * CicUniv.universe_graph;;
let is_weak_identity (metasenv, context, ugraph) = function
- | (_, _, (ty, left, right, _), menv, _) ->
+ | (_, _, (ty, left, right, _), menv) ->
(left = right ||
(meta_convertibility left right))
(* the test below is not a good idea since it stops
;;
let is_identity (metasenv, context, ugraph) = function
- | (_, _, (ty, left, right, _), menv, _) ->
+ | (_, _, (ty, left, right, _), menv) ->
(left = right ||
(* (meta_convertibility left right)) *)
(fst (CicReduction.are_convertible
let term_of_equality equality =
- let _, _, (ty, left, right, _), menv, _ = equality in
+ let _, _, (ty, left, right, _), menv = equality in
let eq i = function Cic.Meta (j, _) -> i = j | _ -> false in
let argsno = List.length menv in
let t =
Cic.term * (* left side *)
Cic.term * (* right side *)
Utils.comparison) * (* ordering *)
- Cic.metasenv * (* environment for metas *)
- Cic.term list (* arguments *)
+ Cic.metasenv (* environment for metas *)
and proof =
| NoProof (* no proof *)
(*
for debugging
let check_equation env equation msg =
- let w, proof, (eq_ty, left, right, order), metas, args = equation in
+ let w, proof, (eq_ty, left, right, order), metas = equation in
let metasenv, context, ugraph = env in
let metasenv' = metasenv @ metas in
try
type theorem = Cic.term * Cic.term * Cic.metasenv;;
-let symbols_of_equality (_, _, (_, left, right, _), _, _) =
+let symbols_of_equality (_, _, (_, left, right, _), _) =
let m1 = symbols_of_term left in
let m =
TermMap.fold
m
;;
-module OrderedEquality = struct
+(* griggio *)
+module OrderedEquality = struct
type t = Inference.equality
let compare eq1 eq2 =
match meta_convertibility_eq eq1 eq2 with
| true -> 0
| false ->
- let w1, _, (ty, left, right, _), _, a = eq1
- and w2, _, (ty', left', right', _), _, a' = eq2 in
+ let w1, _, (ty, left, right, _), m1 = eq1
+ and w2, _, (ty', left', right', _), m2 = eq2 in
match Pervasives.compare w1 w2 with
+ | 0 ->
+ let res = (List.length m1) - (List.length m2) in
+ if res <> 0 then res else Pervasives.compare eq1 eq2
+ | res -> res
+end
+
+(*
+module OrderedEquality = struct
+ type t = Inference.equality
+
+ let minor eq =
+ let w, _, (ty, left, right, o), _ = eq in
+ match o with
+ | Lt -> Some left
+ | Le -> assert false
+ | Gt -> Some right
+ | Ge -> assert false
+ | Eq
+ | Incomparable -> None
+
+ let compare eq1 eq2 =
+ let w1, _, (ty, left, right, o1), m1 = eq1
+ and w2, _, (ty', left', right', o2), m2 = eq2 in
+ match Pervasives.compare w1 w2 with
| 0 ->
- let res = (List.length a) - (List.length a') in
- if res <> 0 then res else (
- try
- let res = Pervasives.compare (List.hd a) (List.hd a') in
- if res <> 0 then res else Pervasives.compare eq1 eq2
- with Failure "hd" -> Pervasives.compare eq1 eq2
- )
- | res -> res
+ (match minor eq1, minor eq2 with
+ | Some t1, Some t2 ->
+ fst (Utils.weight_of_term t1) - fst (Utils.weight_of_term t2)
+ | Some _, None -> -1
+ | None, Some _ -> 1
+ | _,_ ->
+ (List.length m2) - (List.length m1) )
+ | res -> res
+
+ let compare eq1 eq2 =
+ match compare eq1 eq2 with
+ 0 -> Pervasives.compare eq1 eq2
+ | res -> res
end
+*)
module EqualitySet = Set.Make(OrderedEquality);;
(Negative, hd),
((tl, EqualitySet.remove hd neg_set), (pos, pos_set), passive_table)
| [], (hd:EqualitySet.elt)::tl ->
- let w,_,_,_,_ = hd in
+ let w,_,_,_ = hd in
let passive_table =
Indexing.remove_index passive_table hd
in (Positive, hd),
| _ ->
symbols_counter := !symbols_ratio;
let set_selection set = EqualitySet.min_elt set in
- (* let set_selection l = min_elt (fun (w,_,_,_,_) -> w) l in *)
+ (* let set_selection l = min_elt (fun (w,_,_,_) -> w) l in *)
if EqualitySet.is_empty neg_set then
let current = set_selection pos_set in
let passive =
try
let found =
List.find
- (fun (w, proof, (ty, left, right, ordering), m, a) ->
+ (fun (w, proof, (ty, left, right, ordering), m) ->
fst (CicReduction.are_convertible context left right ugraph))
negative
in
let active_list, newa =
List.fold_right
(fun (s, equality) (res, newn) ->
- let ew, _, _, _, _ = equality in
+ let ew, _, _, _ = equality in
if ew < min_weight then
(s, equality)::res, newn
else
let backward_simplify_passive env new_pos new_table min_weight passive =
let (nl, ns), (pl, ps), passive_table = passive in
let f sign equality (resl, ress, newn) =
- let ew, _, _, _, _ = equality in
+ let ew, _, _, _ = equality in
if ew < min_weight then
equality::resl, ress, newn
else
let new_pos, new_table, min_weight =
List.fold_left
(fun (l, t, w) e ->
- let ew, _, _, _, _ = e in
+ let ew, _, _, _ = e in
(Positive, e)::l, Indexing.index t e, min ew w)
([], Indexing.empty, 1000000) (snd new')
in
let new_pos, new_table, min_weight =
List.fold_left
(fun (l, t, w) e ->
- let ew, _, _, _, _ = e in
+ let ew, _, _, _ = e in
(Positive, e)::l, Indexing.index t e, min ew w)
([], Indexing.empty, 1000000) (snd new')
in
;;
let is_commutative_law eq =
- let w, proof, (eq_ty, left, right, order), metas, args = snd eq in
+ let w, proof, (eq_ty, left, right, order), metas = snd eq in
match left,right with
Cic.Appl[f1;Cic.Meta _ as a1;Cic.Meta _ as b1],
Cic.Appl[f2;Cic.Meta _ as a2;Cic.Meta _ as b2] ->
let module HL = HelmLibraryObjects in
let module I = Inference in
let metasenv, context, ugraph = env in
- let _, proof, (ty, left, right, _), metas, args = equality in
+ let _, proof, (ty, left, right, _), metas = equality in
let eqterm =
C.Appl [C.MutInd (LibraryObjects.eq_URI (), 0, []); ty; left; right] in
let gproof, gmetas, gterm = goal in
debug_print
(lazy (Printf.sprintf "OK!!! %s %s" (string_of_sign sign)
(string_of_equality ~env current)));
- let _, proof, _, _, _ = current in
+ let _, proof, _, _ = current in
ParamodulationSuccess (Some proof, env)
) else (
debug_print
if res then
let proof =
match goal' with
- | Some goal -> let _, proof, _, _, _ = goal in Some proof
+ | Some goal -> let _, proof, _, _ = goal in Some proof
| None -> None
in
ParamodulationSuccess (proof, env)
let proof =
match goal with
| Some goal ->
- let _, proof, _, _, _ = goal in Some proof
+ let _, proof, _, _ = goal in Some proof
| None -> None
in
ParamodulationSuccess (proof, env)
| _ -> assert false
in
( prerr_endline "esco qui";
+ (*
let s = Printf.sprintf "actives:\n%s\n"
(String.concat "\n"
((List.map
(string_of_equality ~env)
(let x,y,_ = passive in (fst x)@(fst y)))) in
prerr_endline s;
- prerr_endline sp;
+ prerr_endline sp; *)
ParamodulationSuccess (proof, env))
else
given_clause_fullred_aux dbd env goals theorems passive active
" LOCALMAX: " ^ string_of_int !Indexing.local_max ^
" #ACTIVES: " ^ string_of_int (size_of_active active) ^
" #PASSIVES: " ^ string_of_int (size_of_passive passive));
+(*
if (size_of_active active) mod 50 = 0 then
(let s = Printf.sprintf "actives:\n%s\n"
(String.concat "\n"
(string_of_equality ~env)
(let x,y,_ = passive in (fst x)@(fst y)))) in
prerr_endline s;
- prerr_endline sp);
+ prerr_endline sp); *)
let time1 = Unix.gettimeofday () in
let (_,context,_) = env in
let selection_estimate = get_selection_estimate () in
debug_print
(lazy (Printf.sprintf "OK!!! %s %s" (string_of_sign sign)
(string_of_equality ~env current)));
- let _, proof, _, _, _ = current in
+ let _, proof, _, _ = current in
ParamodulationSuccess (Some proof, env)
) else (
debug_print
| true, goal ->
let proof =
match goal with
- | Some goal -> let _, proof, _, _, _ = goal in Some proof
+ | Some goal -> let _, proof, _, _ = goal in Some proof
| None -> None
in
ParamodulationSuccess (proof, env)
print_endline (PP.pp proof names);
let newmetasenv =
List.fold_left
- (fun m (_, _, _, menv, _) -> m @ menv) metasenv equalities
+ (fun m (_, _, _, menv) -> m @ menv) metasenv equalities
in
let _ =
(*try*)
-(* GENERATED FILE, DO NOT EDIT. STAMP:Tue Mar 21 17:18:22 CET 2006 *)
+(* GENERATED FILE, DO NOT EDIT. STAMP:Mon Mar 27 15:17:54 CEST 2006 *)
val absurd : term:Cic.term -> ProofEngineTypes.tactic
val apply : term:Cic.term -> ProofEngineTypes.tactic
val assumption : ProofEngineTypes.tactic