let rec apply_subst subst = function
| (Terms.Leaf _) as t -> t
- | Terms.Var i -> lookup_subst i subst
+ | Terms.Var i ->
+ (match lookup_subst i subst with
+ | Terms.Node _ as t -> apply_subst subst t
+ | t -> t)
| (Terms.Node l) ->
Terms.Node (List.map (fun t -> apply_subst subst t) l)
;;
(* $Id: terms.ml 9836 2009-06-05 15:33:35Z denes $ *)
+let rec lexicograph f l1 l2 =
+ match l1, l2 with
+ | [], [] -> 0
+ | x::xs, y::ys ->
+ let c = f x y in
+ if c <> 0 then c else lexicograph f xs ys
+ | [],_ -> ~-1
+ | _,[] -> 1
+;;
module Utils (B : Terms.Blob) = struct
module Subst = FoSubst.Subst(B) ;;
| _ -> false
;;
- let rec lexicograph f l1 l2 =
- match l1, l2 with
- | [], [] -> 0
- | x::xs, y::ys ->
- let c = f x y in
- if c <> 0 then c else lexicograph f xs ys
- | [],_ -> ~-1
- | _,[] -> 1
- ;;
let rec compare_foterm x y =
match x, y with
fresh_unit_clause maxvar (mk_id (), lit, varlist, proof)
;;
- let add_to_bag =
- let id = ref 0 in
- fun bag (_,lit,vl,proof) ->
- incr id;
- let clause = (!id, lit, vl, proof) in
- let bag = Terms.M.add !id clause bag in
+ let add_to_bag bag (_,lit,vl,proof) =
+ let id = mk_id () in
+ let clause = (id, lit, vl, proof) in
+ let bag = Terms.M.add id clause bag in
bag, clause
;;
(* $Id: terms.ml 9836 2009-06-05 15:33:35Z denes $ *)
+val lexicograph : ('a -> 'b -> int) -> 'a list -> 'b list -> int
+
module Utils (B : Terms.Blob) :
sig
val eq_foterm : B.t Terms.foterm -> B.t Terms.foterm -> bool
let rec compare x y =
match x,y with
| NCic.Rel i, NCic.Rel j -> i-j
+ | NCic.Meta (i,_), NCic.Meta (j,_) -> i-j
| NCic.Const r1, NCic.Const r2 -> NReference.compare r1 r2
- | NCic.Appl l1, NCic.Appl l2 -> assert false (* TODO *)
+ | NCic.Appl l1, NCic.Appl l2 -> FoUtils.lexicograph compare l1 l2
+ | NCic.Rel _, ( NCic.Meta _ | NCic.Const _ | NCic.Appl _ ) -> ~-1
+ | ( NCic.Meta _ | NCic.Const _ | NCic.Appl _ ), NCic.Rel _ -> 1
+ | NCic.Const _, ( NCic.Meta _ | NCic.Appl _ ) -> ~-1
+ | ( NCic.Meta _ | NCic.Appl _ ), NCic.Const _ -> 1
+ | NCic.Appl _, NCic.Meta _ -> ~-1
+ | NCic.Meta _, NCic.Appl _ -> 1
| _ -> assert false
;;
+
+ let compare x y =
+ if NCicReduction.alpha_eq C.metasenv C.subst C.context x y then 0
+ else compare x y
+ ;;
let pp t =
NCicPp.ppterm ~context:C.context ~metasenv:C.metasenv ~subst:C.subst t;;
let nparamod metasenv subst context t table =
+ prerr_endline "========================================";
let module C = struct
let metasenv = metasenv
let subst = subst
let table =
List.fold_left IDX.index_unit_clause IDX.DT.empty active_clauses
in
+ prerr_endline "Active table:";
+ List.iter (fun uc -> prerr_endline (Pp.pp_unit_clause uc)) active_clauses;
let bag, maxvar, newclauses =
Sup.superposition_right_with_table bag maxvar clause table
in
prerr_endline "Output clauses :";
List.iter (fun c -> prerr_endline (Pp.pp_unit_clause c)) newclauses;
+ prerr_endline "========================================";
;;
module Subst = FoSubst.Subst(B)
module Order = Orderings.Orderings(B)
module Utils = FoUtils.Utils(B)
+ module Pp = Pp.Pp(B)
let all_positions pos ctx t f =
let rec aux pos ctx = function
let superposition_right table varlist subterm pos context =
let cands = IDX.DT.retrieve_unifiables table subterm in
HExtlib.filter_map
- (fun (dir, (id,lit,vl,_)) ->
+ (fun (dir, (id,lit,vl,_ (*as uc*))) ->
match lit with
| Terms.Predicate _ -> assert false
| Terms.Equation (l,r,_,o) ->
if o <> Terms.Lt && o <> Terms.Eq then
Some (context newside, subst, varlist, id, pos, dir)
else
- None
+ ((*prerr_endline ("Filtering: " ^
+ Pp.pp_foterm side ^ " =(< || =)" ^
+ Pp.pp_foterm newside ^ " coming from " ^
+ Pp.pp_unit_clause uc );*)None)
else
Some (context newside, subst, varlist, id, pos, dir)
with FoUnif.UnificationFailure _ -> None)
in
Some (bag, maxvar, uc)
else
- None
+ ((*prerr_endline ("Filtering: " ^ Pp.pp_foterm t);*)None)
;;
let fold_build_new_clause bag maxvar id filter res =
include "nat/plus.ma".
-ntheorem foo: \forall x, y. ((λz. x + x = z + z) ?).
-##[ #x; #y; nnormalize; nauto.
\ No newline at end of file
+ntheorem foo:
+ ((λx.x + 0 = x) ?) →
+ ((λx,y.x + S y = S (x + y)) ? ?) →
+ ((λx,y.y + x = x + y) ? ?) →
+ ∀x. ((λz. x + x = z + S z) ?).
+##[ #H; #H1; #H2; #x; nnormalize in H H1 H2 ⊢ %; nauto by H, H1, H2.
\ No newline at end of file