HOLMS/k_decid.ml at main · HOLMS-lib/HOLMS · GitHub

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
(* ========================================================================= *)
(* Decision procedure for the provability logic K.                           *)
(*                                                                           *)
(* (c) Copyright, Marco Maggesi, Cosimo Perini Brogi 2020-2022.              *)
(* (c) Copyright, Antonella Bilotta, Marco Maggesi,                          *)
(*                Cosimo Perini Brogi, Leonardo Quartini 2024.               *)
(* (c) Copyright, Antonella Bilotta, Marco Maggesi,                          *)
(*                Cosimo Perini Brogi 2025-2026.                             *)
(* ========================================================================= *)

needs "HOLMS/k_completeness.ml";;
needs "HOLMS/gen_countermodel.ml";;

(* ------------------------------------------------------------------------- *)
(* Lemmata.                                                                  *)
(* ------------------------------------------------------------------------- *)

let IN_FINITE_FRAME_CLAUSES = prove
 (`!W:W->bool R.
     (W,R) IN FINITE_FRAME
     ==> (!w w'. R w w'
                 ==> !p. holds (W,R) V (Box p) w ==> holds (W,R) V p w') /\
         (!w p. holds (W,R) V (Box p) w
                 ==> !w'. R w w' ==> holds (W,R) V p w')`,
  REWRITE_TAC[IN_FINITE_FRAME] THEN MESON_TAC[HOLDS_LEFT_BOX]);;

let K_COMPLETENESS_NUM =
 let K_COMPLETENESS_THEOREM_NUM =
   REWRITE_RULE[num_INFINITE]
     (INST_TYPE [`:num`,`:A`] K_COMPLETENESS_THM_GEN) in
 prove
 (`!p. (!W:num->bool R.
          (W,R) IN FINITE_FRAME
          ==> !V w. w IN W ==> holds (W,R) V p w)
       ==> [{} . {} |~ p]`,
  GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC K_COMPLETENESS_THEOREM_NUM THEN
  REWRITE_TAC[valid; FORALL_PAIR_THM; holds_in] THEN ASM_MESON_TAC[]);;

(* ------------------------------------------------------------------------- *)
(* Top-level invocation.                                                     *)
(* ------------------------------------------------------------------------- *)

let K_TAC : tactic =
  let tm = `(W:num->bool,R) IN FINITE_FRAME` in
  let th = MATCH_MP IN_FINITE_FRAME_CLAUSES (ASSUME tm) in
  let rules = CONJUNCTS th in
  GEN_HOLMS_TAC MATCH_BOX_RIGHT_TAC K_COMPLETENESS_NUM rules;;

holms_register_tactic `{}:form->bool` K_TAC;;

(* ------------------------------------------------------------------------- *)
(* Countermodels.                                                            *)
(* ------------------------------------------------------------------------- *)

let K_HOLMS_CERTIFY_COUNTERMODEL : term -> term -> thm =
  let ltm = `FINITE_FRAME:(num->bool)#(num->num->bool)->bool` in
  fun ctm tm ->
    let fm = rand (snd (strip_forall tm))
    and eth = mk_countermodel_existence_thm ctm in
    prove (mk_not_valid_ptm ltm fm,
           CERTIFY_COUNTERMODEL_TAC eth);;

(* ------------------------------------------------------------------------- *)
(* Non-axiom examples.                                                       *)
(* ------------------------------------------------------------------------- *)

(* T_AX *)
let tm = `!a. [{} . {} |~ Box a --> a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

(* K4_AX *)
let tm = `!a. [{} . {} |~ Box a --> Box Box a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

(* B_AX *)
let tm = `!a. [{} . {} |~ a --> Box Diam a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

(* K_AX *)
let tm = `!a. [{} . {} |~ Diam a --> Box Diam  a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

(* GL_AX *)
let tm = `!a. [{} . {} |~ Box (Box a --> a) --> Box a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

(* ------------------------------------------------------------------------- *)
(* Furter examples.                                                          *)
(* ------------------------------------------------------------------------- *)

let tm = `!a. [{} . {} |~ a --> Box a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

let tm = `!a. [{} . {} |~ a --> Box Box a]`;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
K_HOLMS_CERTIFY_COUNTERMODEL ctm tm;;

needs "Library/iter.ml";;

let tm = `!a. [{} . {} |~ a --> ITER 8 (Box) a]`;;
let tm = run_conv (TOP_SWEEP_CONV num_CONV THENC REWRITE_CONV [ITER]) tm;;
let ctm = HOLMS_BUILD_COUNTERMODEL tm;;
time (K_HOLMS_CERTIFY_COUNTERMODEL ctm) tm;;   (* CPU time (user): 0.335567 *)