summaryrefslogtreecommitdiff
path: root/lib/sequent_calculus/sequent_proof.ml
blob: 7d8c0f938b23eff5b95400350c3aeb2e4aee7522 (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
(* Sequent Calculus *)

open Types
open Headers
open Sequent_rules

(* returns true if arg is the basic tautological sequent *)
let rec is_basic_sequent (Seq(l1, l2)) =
  match l1 with
  | [] -> false
  | p :: ps -> List.mem p l2 || is_basic_sequent (Seq (ps, l2))

(* gives list of sequents that need to be proved for this to be true *)
let get_dependencies (s : seq) : seq list =
  let rec apply_each fns s = (* apply each fn to s and return first result *)
    match fns with
    | [] -> raise (NotProvable "Couldn't find proof")
    | fn :: fns ->
      try
        fn s
      with
      | RuleNotApplicable -> apply_each fns s
  in
  if is_basic_sequent s then
    []
  else
    apply_each rule_precedence_list s

(* generates a proof for a sequent in stree form or throws an exception *)
(* TODO: deal with <-> case *)
let rec prove_sequent (s : seq) : stree =
  let dependencies = get_dependencies s in
  let proofs = List.map prove_sequent dependencies in
  Concl(s, proofs)

(* Prove a proposition via the sequent calculus or return None if not provable *)
let prove (p : proposition): stree option =
  try
    Some (prove_sequent (Seq ([], [p])))
  with NotProvable _ ->
    None