summaryrefslogtreecommitdiff
path: root/testsuite/tests/misc-kb/kbmain.ml
blob: d39d709bdb90534e4360b65cd3a364b9d229ffde (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
(* TEST
 modules = "terms.ml equations.ml orderings.ml kb.ml";
*)

open Terms
open Equations
open Orderings
open Kb

(****
let group_rules = [
  { number = 1; numvars = 1;
    lhs = Term("*", [Term("U",[]); Var 1]); rhs = Var 1 };
  { number = 2; numvars = 1;
    lhs = Term("*", [Term("I",[Var 1]); Var 1]); rhs = Term("U",[]) };
  { number = 3; numvars = 3;
    lhs = Term("*", [Term("*", [Var 1; Var 2]); Var 3]);
    rhs = Term("*", [Var 1; Term("*", [Var 2; Var 3])]) }
]
****)

let geom_rules = [
  { number = 1; numvars = 1;
    lhs = Term ("*",[(Term ("U",[])); (Var 1)]);
    rhs = Var 1 };
  { number = 2; numvars = 1;
    lhs = Term ("*",[(Term ("I",[(Var 1)])); (Var 1)]);
    rhs = Term ("U",[]) };
  { number = 3; numvars = 3;
    lhs = Term ("*",[(Term ("*",[(Var 1); (Var 2)])); (Var 3)]);
    rhs = Term ("*",[(Var 1); (Term ("*",[(Var 2); (Var 3)]))]) };
  { number = 4; numvars = 0;
    lhs = Term ("*",[(Term ("A",[])); (Term ("B",[]))]);
    rhs = Term ("*",[(Term ("B",[])); (Term ("A",[]))]) };
  { number = 5; numvars = 0;
    lhs = Term ("*",[(Term ("C",[])); (Term ("C",[]))]);
    rhs = Term ("U",[]) };
  { number = 6; numvars = 0;
    lhs = Term("*",
            [(Term ("C",[]));
             (Term ("*",[(Term ("A",[])); (Term ("I",[(Term ("C",[]))]))]))]);
    rhs = Term ("I",[(Term ("A",[]))]) };
  { number = 7; numvars = 0;
    lhs = Term("*",
            [(Term ("C",[]));
             (Term ("*",[(Term ("B",[])); (Term ("I",[(Term ("C",[]))]))]))]);
    rhs = Term ("B",[]) }
]

let group_rank = function
    "U" -> 0
  | "*" -> 1
  | "I" -> 2
  | "B" -> 3
  | "C" -> 4
  | "A" -> 5
  | _ -> assert false

let group_precedence op1 op2 =
  let r1 = group_rank op1
  and r2 = group_rank op2 in
    if r1 = r2 then Equal else
    if r1 > r2 then Greater else NotGE

let group_order = rpo group_precedence lex_ext

let greater pair =
  match group_order pair with Greater -> true | _ -> false

let _ =
  kb_complete greater [] geom_rules