File ‹~~/src/Tools/Argo/argo_proof.ML›
signature ARGO_PROOF =
sig
type proof_id
datatype tautology =
Taut_And_1 of int | Taut_And_2 of int * int | Taut_Or_1 of int * int | Taut_Or_2 of int |
Taut_Iff_1 | Taut_Iff_2 | Taut_Iff_3 | Taut_Iff_4 | Taut_Ite_Then | Taut_Ite_Else
datatype side = Left | Right
datatype inequality = Le | Lt
datatype rewrite =
Rewr_Not_True | Rewr_Not_False | Rewr_Not_Not | Rewr_Not_And of int | Rewr_Not_Or of int |
Rewr_Not_Iff |
Rewr_And_False of int | Rewr_And_Dual of int * int | Rewr_And_Sort of int * int list list |
Rewr_Or_True of int | Rewr_Or_Dual of int * int | Rewr_Or_Sort of int * int list list |
Rewr_Iff_True | Rewr_Iff_False | Rewr_Iff_Not_Not | Rewr_Iff_Refl | Rewr_Iff_Symm |
Rewr_Iff_Dual |
Rewr_Imp | Rewr_Ite_Prop | Rewr_Ite_True | Rewr_Ite_False | Rewr_Ite_Eq |
Rewr_Eq_Refl | Rewr_Eq_Symm |
Rewr_Neg | Rewr_Add of (Rat.rat * int option) list * (Rat.rat * int option) list | Rewr_Sub |
Rewr_Mul_Nums of Rat.rat * Rat.rat | Rewr_Mul_Zero | Rewr_Mul_One | Rewr_Mul_Comm |
Rewr_Mul_Assoc of side | Rewr_Mul_Sum of side | Rewr_Mul_Div of side |
Rewr_Div_Zero | Rewr_Div_One | Rewr_Div_Nums of Rat.rat * Rat.rat |
Rewr_Div_Num of side * Rat.rat | Rewr_Div_Mul of side * Rat.rat | Rewr_Div_Div of side |
Rewr_Div_Sum | Rewr_Min_Eq | Rewr_Min_Lt | Rewr_Min_Gt | Rewr_Max_Eq | Rewr_Max_Lt |
Rewr_Max_Gt | Rewr_Abs | Rewr_Eq_Nums of bool | Rewr_Eq_Sub | Rewr_Eq_Le |
Rewr_Ineq_Nums of inequality * bool | Rewr_Ineq_Add of inequality * Rat.rat |
Rewr_Ineq_Sub of inequality | Rewr_Ineq_Mul of inequality * Rat.rat |
Rewr_Not_Ineq of inequality
datatype conv =
Keep_Conv | Then_Conv of conv * conv | Args_Conv of Argo_Expr.kind * conv list |
Rewr_Conv of rewrite
datatype rule =
Axiom of int | Taut of tautology * Argo_Expr.expr | Conjunct of int * int | Rewrite of conv |
Hyp of int * Argo_Expr.expr | Clause of int list | Lemma of int list | Unit_Res of int |
Refl of Argo_Expr.expr | Symm | Trans | Cong | Subst | Linear_Comb
type proof
val eq_proof_id: proof_id * proof_id -> bool
val proof_id_ord: proof_id ord
val keep_conv: conv
val mk_then_conv: conv -> conv -> conv
val mk_args_conv: Argo_Expr.kind -> conv list -> conv
val mk_rewr_conv: rewrite -> conv
type context
val cdcl_context: context
val cc_context: context
val simplex_context: context
val solver_context: context
val mk_axiom: int -> context -> proof * context
val mk_taut: tautology -> Argo_Expr.expr -> context -> proof * context
val mk_conj: int -> int -> proof -> context -> proof * context
val mk_rewrite: conv -> proof -> context -> proof * context
val mk_hyp: Argo_Lit.literal -> context -> proof * context
val mk_clause: Argo_Lit.literal list -> proof -> context -> proof * context
val mk_lemma: Argo_Lit.literal list -> proof -> context -> proof * context
val mk_unit_res: Argo_Lit.literal -> proof -> proof -> context -> proof * context
val mk_refl: Argo_Term.term -> context -> proof * context
val mk_symm: proof -> context -> proof * context
val mk_trans: proof -> proof -> context -> proof * context
val mk_cong: proof -> proof -> context -> proof * context
val mk_subst: proof -> proof -> proof -> context -> proof * context
val mk_linear_comb: proof list -> context -> proof * context
val id_of: proof -> proof_id
val dest: proof -> proof_id * rule * proof list
val string_of_proof_id: proof_id -> string
val string_of_taut: tautology -> string
val string_of_rule: rule -> string
exception UNSAT of proof
val unsat: proof -> 'a
end
structure Argo_Proof: ARGO_PROOF =
struct
datatype tautology =
Taut_And_1 of int | Taut_And_2 of int * int | Taut_Or_1 of int * int | Taut_Or_2 of int |
Taut_Iff_1 | Taut_Iff_2 | Taut_Iff_3 | Taut_Iff_4 | Taut_Ite_Then | Taut_Ite_Else
datatype side = Left | Right
datatype inequality = Le | Lt
datatype rewrite =
Rewr_Not_True | Rewr_Not_False | Rewr_Not_Not | Rewr_Not_And of int | Rewr_Not_Or of int |
Rewr_Not_Iff |
Rewr_And_False of int | Rewr_And_Dual of int * int | Rewr_And_Sort of int * int list list |
Rewr_Or_True of int | Rewr_Or_Dual of int * int | Rewr_Or_Sort of int * int list list |
Rewr_Iff_True | Rewr_Iff_False | Rewr_Iff_Not_Not | Rewr_Iff_Refl | Rewr_Iff_Symm |
Rewr_Iff_Dual |
Rewr_Imp | Rewr_Ite_Prop | Rewr_Ite_True | Rewr_Ite_False | Rewr_Ite_Eq |
Rewr_Eq_Refl | Rewr_Eq_Symm |
Rewr_Neg | Rewr_Add of (Rat.rat * int option) list * (Rat.rat * int option) list | Rewr_Sub |
Rewr_Mul_Nums of Rat.rat * Rat.rat | Rewr_Mul_Zero | Rewr_Mul_One | Rewr_Mul_Comm |
Rewr_Mul_Assoc of side | Rewr_Mul_Sum of side | Rewr_Mul_Div of side |
Rewr_Div_Zero | Rewr_Div_One | Rewr_Div_Nums of Rat.rat * Rat.rat |
Rewr_Div_Num of side * Rat.rat | Rewr_Div_Mul of side * Rat.rat | Rewr_Div_Div of side |
Rewr_Div_Sum | Rewr_Min_Eq | Rewr_Min_Lt | Rewr_Min_Gt | Rewr_Max_Eq | Rewr_Max_Lt |
Rewr_Max_Gt | Rewr_Abs | Rewr_Eq_Nums of bool | Rewr_Eq_Sub | Rewr_Eq_Le |
Rewr_Ineq_Nums of inequality * bool | Rewr_Ineq_Add of inequality * Rat.rat |
Rewr_Ineq_Sub of inequality | Rewr_Ineq_Mul of inequality * Rat.rat |
Rewr_Not_Ineq of inequality
datatype conv =
Keep_Conv | Then_Conv of conv * conv | Args_Conv of Argo_Expr.kind * conv list |
Rewr_Conv of rewrite
datatype rule =
Axiom of int | Taut of tautology * Argo_Expr.expr | Conjunct of int * int | Rewrite of conv |
Hyp of int * Argo_Expr.expr | Clause of int list | Lemma of int list | Unit_Res of int |
Refl of Argo_Expr.expr | Symm | Trans | Cong | Subst | Linear_Comb
datatype proof_id = Cdcl of int | Cc of int | Simplex of int | Solver of int
datatype proof = Proof of proof_id * rule * proof list
val proof_id_card = 4
fun raw_proof_id (Cdcl i) = i
| raw_proof_id (Cc i) = i
| raw_proof_id (Simplex i) = i
| raw_proof_id (Solver i) = i
fun int_of_proof_id (Cdcl _) = 0
| int_of_proof_id (Cc _) = 1
| int_of_proof_id (Simplex _) = 2
| int_of_proof_id (Solver _) = 3
fun eq_proof_id (Cdcl i1, Cdcl i2) = (i1 = i2)
| eq_proof_id (Cc i1, Cc i2) = (i1 = i2)
| eq_proof_id (Simplex i1, Simplex i2) = (i1 = i2)
| eq_proof_id (Solver i1, Solver i2) = (i1 = i2)
| eq_proof_id _ = false
fun proof_id_ord (Cdcl i1, Cdcl i2) = int_ord (i1, i2)
| proof_id_ord (Cc i1, Cc i2) = int_ord (i1, i2)
| proof_id_ord (Simplex i1, Simplex i2) = int_ord (i1, i2)
| proof_id_ord (Solver i1, Solver i2) = int_ord (i1, i2)
| proof_id_ord (id1, id2) = int_ord (int_of_proof_id id1, int_of_proof_id id2)
val keep_conv = Keep_Conv
fun mk_then_conv Keep_Conv c = c
| mk_then_conv c Keep_Conv = c
| mk_then_conv c1 c2 = Then_Conv (c1, c2)
fun mk_args_conv k cs =
if forall (fn Keep_Conv => true | _ => false) cs then Keep_Conv
else Args_Conv (k, cs)
fun mk_rewr_conv r = Rewr_Conv r
type context = proof_id
val cdcl_context = Cdcl 0
val cc_context = Cc 0
val simplex_context = Simplex 0
val solver_context = Solver 0
fun next_id (id as Cdcl i) = (id, Cdcl (i + 1))
| next_id (id as Cc i) = (id, Cc (i + 1))
| next_id (id as Simplex i) = (id, Simplex (i + 1))
| next_id (id as Solver i) = (id, Solver (i + 1))
fun id_of (Proof (id, _, _)) = id
fun dest (Proof p) = p
fun mk_proof r ps cx =
let val (id, cx) = next_id cx
in (Proof (id, r, ps), cx) end
fun mk_axiom i = mk_proof (Axiom i) []
fun mk_taut t e = mk_proof (Taut (t, e)) []
fun mk_conj i n p = mk_proof (Conjunct (i, n)) [p]
fun mk_rewrite Keep_Conv p cx = (p, cx)
| mk_rewrite c p cx = mk_proof (Rewrite c) [p] cx
fun mk_hyp lit = mk_proof (Hyp (Argo_Lit.signed_id_of lit, Argo_Lit.signed_expr_of lit)) []
fun mk_clause lits p cx = mk_proof (Clause (map Argo_Lit.signed_id_of lits)) [p] cx
fun mk_lemma lits p = mk_proof (Lemma (map Argo_Lit.signed_id_of lits)) [p]
fun check_clause (p as Proof (_, Clause _, _)) = p
| check_clause (p as Proof (_, Lemma _, _)) = p
| check_clause (p as Proof (_, Unit_Res _, _)) = p
| check_clause _ = raise Fail "bad clause proof"
fun mk_unit t p1 p2 = mk_proof (Unit_Res (Argo_Term.id_of t)) (map check_clause [p1, p2])
fun mk_unit_res (Argo_Lit.Pos t) p1 p2 = mk_unit t p1 p2
| mk_unit_res (Argo_Lit.Neg t) p1 p2 = mk_unit t p2 p1
fun mk_refl t = mk_proof (Refl (Argo_Term.expr_of t)) []
fun mk_symm p = mk_proof Symm [p]
fun mk_trans (Proof (_, Refl _, _)) p2 = pair p2
| mk_trans p1 (Proof (_, Refl _, _)) = pair p1
| mk_trans p1 p2 = mk_proof Trans [p1, p2]
fun mk_cong p1 p2 = mk_proof Cong [p1, p2]
fun mk_subst p1 (Proof (_, Refl _, _)) (Proof (_, Refl _, _)) = pair p1
| mk_subst p1 p2 p3 = mk_proof Subst [p1, p2, p3]
fun mk_linear_comb ps = mk_proof Linear_Comb ps
fun string_of_proof_id id = string_of_int (proof_id_card * raw_proof_id id + int_of_proof_id id)
fun string_of_list l r f xs = enclose l r (space_implode ", " (map f xs))
fun parens f xs = string_of_list "(" ")" f xs
fun brackets f xs = string_of_list "[" "]" f xs
fun string_of_taut (Taut_And_1 n) = "and " ^ string_of_int n
| string_of_taut (Taut_And_2 (i, n)) = "and " ^ parens string_of_int [i, n]
| string_of_taut (Taut_Or_1 (i, n)) = "or " ^ parens string_of_int [i, n]
| string_of_taut (Taut_Or_2 n) = "or " ^ string_of_int n
| string_of_taut Taut_Iff_1 = "(p1 == p2) | p1 | p2"
| string_of_taut Taut_Iff_2 = "(p1 == p2) | ~p1 | ~p2"
| string_of_taut Taut_Iff_3 = "~(p1 == p2) | ~p1 | p2"
| string_of_taut Taut_Iff_4 = "~(p1 == p2) | p1 | ~p2"
| string_of_taut Taut_Ite_Then = "~p | (ite p t1 t2) = t1"
| string_of_taut Taut_Ite_Else = "p | (ite p t1 t2) = t2"
fun string_of_rewr Rewr_Not_True = "~T = F"
| string_of_rewr Rewr_Not_False = "~F = T"
| string_of_rewr Rewr_Not_Not = "~~p = p"
| string_of_rewr (Rewr_Not_And n) =
"~(and [" ^ string_of_int n ^ "]) = (or [" ^ string_of_int n ^ "])"
| string_of_rewr (Rewr_Not_Or n) =
"~(or [" ^ string_of_int n ^ "]) = (and [" ^ string_of_int n ^ "])"
| string_of_rewr Rewr_Not_Iff = "~(p1 == p2) = (~p1 == ~p2)"
| string_of_rewr (Rewr_And_False i) = "(and ... F(" ^ string_of_int i ^ ") ...) = F"
| string_of_rewr (Rewr_And_Dual (i1, i2)) =
"(and ... p(" ^ string_of_int i1 ^ ") ... ~p(" ^ string_of_int i2 ^ ") ...) = F"
| string_of_rewr (Rewr_And_Sort (n, iss)) =
"(and [" ^ string_of_int n ^ "]) = " ^
"(and " ^ brackets (brackets string_of_int) iss ^ ")"
| string_of_rewr (Rewr_Or_True i) = "(or ... T(" ^ string_of_int i ^ ") ...) = T"
| string_of_rewr (Rewr_Or_Dual (i1, i2)) =
"(or ... p(" ^ string_of_int i1 ^ ") ... ~p(" ^ string_of_int i2 ^ ") ...) = T"
| string_of_rewr (Rewr_Or_Sort (n, iss)) =
"(or [" ^ string_of_int n ^ "]) = " ^
"(or " ^ brackets (brackets string_of_int) iss ^ ")"
| string_of_rewr Rewr_Iff_True = "(p == T) = p"
| string_of_rewr Rewr_Iff_False = "(p == F) = ~p"
| string_of_rewr Rewr_Iff_Not_Not = "(~p1 == ~p2) = (p1 == p2)"
| string_of_rewr Rewr_Iff_Refl = "(p == p) = T"
| string_of_rewr Rewr_Iff_Symm = "(p1 == p2) = (p2 == p1)"
| string_of_rewr Rewr_Iff_Dual = "(p == ~p) = F"
| string_of_rewr Rewr_Imp = "(p1 --> p2) = (~p1 | p2)"
| string_of_rewr Rewr_Ite_Prop = "(if p1 p2 p2) = ((~p1 | p2) & (p1 | p3) & (p2 | p3))"
| string_of_rewr Rewr_Ite_True = "(if T t1 t2) = t1"
| string_of_rewr Rewr_Ite_False = "(if F t1 t2) = t2"
| string_of_rewr Rewr_Ite_Eq = "(if p t t) = t"
| string_of_rewr Rewr_Eq_Refl = "(e = e) = T"
| string_of_rewr Rewr_Eq_Symm = "(e1 = e2) = (e2 = e1)"
| string_of_rewr Rewr_Neg = "-e = -1 * e"
| string_of_rewr (Rewr_Add (p1, p2)) =
let
fun string_of_monom (n, NONE) = Rat.string_of_rat n
| string_of_monom (n, SOME i) =
(if n = @1 then "" else Rat.string_of_rat n ^ " * ") ^ "e" ^ string_of_int i
fun string_of_polynom ms = space_implode " + " (map string_of_monom ms)
in string_of_polynom p1 ^ " = " ^ string_of_polynom p2 end
| string_of_rewr Rewr_Sub = "e1 - e2 = e1 + -1 * e2"
| string_of_rewr (Rewr_Mul_Nums (n1, n2)) =
Rat.string_of_rat n1 ^ " * " ^ Rat.string_of_rat n2 ^ " = " ^ Rat.string_of_rat (n1 * n2)
| string_of_rewr Rewr_Mul_Zero = "0 * e = 0"
| string_of_rewr Rewr_Mul_One = "1 * e = e"
| string_of_rewr Rewr_Mul_Comm = "e1 * e2 = e2 * e1"
| string_of_rewr (Rewr_Mul_Assoc Left) = "(e1 * e2) * e3 = e1 * (e2 * e3)"
| string_of_rewr (Rewr_Mul_Assoc Right) = "e1 * (n * e2) = (e1 * n) * e2"
| string_of_rewr (Rewr_Mul_Sum Left) = "(e1 + ... + em) * e = e1 * e + ... em * e"
| string_of_rewr (Rewr_Mul_Sum Right) = "e * (e1 + ... + em) = e * e1 + ... e * em"
| string_of_rewr (Rewr_Mul_Div Left) = "(e1 / e2) * e3 = (e1 * e3) / e2"
| string_of_rewr (Rewr_Mul_Div Right) = "e1 * (e2 / * e3) = (e1 * e2) / e3"
| string_of_rewr Rewr_Div_Zero = "0 / e = 0"
| string_of_rewr Rewr_Div_One = "e / 1 = e"
| string_of_rewr (Rewr_Div_Nums (n1, n2)) =
Rat.string_of_rat n1 ^ " / " ^ Rat.string_of_rat n2 ^ " = " ^ Rat.string_of_rat (n1 / n2)
| string_of_rewr (Rewr_Div_Num (Left, n)) =
Rat.string_of_rat n ^ " / e = " ^ Rat.string_of_rat n ^ " * (1 / e)"
| string_of_rewr (Rewr_Div_Num (Right, n)) =
"e / " ^ Rat.string_of_rat n ^ " = " ^ Rat.string_of_rat (Rat.inv n) ^ " * e"
| string_of_rewr (Rewr_Div_Mul (Left, n)) =
"(" ^ Rat.string_of_rat n ^ " * e1) / e2 = " ^ Rat.string_of_rat n ^ " * (e1 / e2)"
| string_of_rewr (Rewr_Div_Mul (Right, n)) =
"e1 / (" ^ Rat.string_of_rat n ^ " * e2) = " ^ Rat.string_of_rat (Rat.inv n) ^ " * (e1 / e2)"
| string_of_rewr (Rewr_Div_Div Left) = "(e1 / e2) / e3 = e1 / (e2 * e3)"
| string_of_rewr (Rewr_Div_Div Right) = "e1 / (e2 / e3) = (e1 * e3) / e2"
| string_of_rewr Rewr_Div_Sum = "(e1 + ... + em) / e = e1 / e + ... + em / e"
| string_of_rewr Rewr_Min_Eq = "min e e = e"
| string_of_rewr Rewr_Min_Lt = "min e1 e2 = (if e1 <= e2 then e1 else e2)"
| string_of_rewr Rewr_Min_Gt = "min e1 e2 = (if e2 <= e1 then e2 else e1)"
| string_of_rewr Rewr_Max_Eq = "max e e = e"
| string_of_rewr Rewr_Max_Lt = "max e1 e2 = (if e1 < e2 then e2 else e1)"
| string_of_rewr Rewr_Max_Gt = "max e1 e2 = (if e2 < e1 then e1 else e2)"
| string_of_rewr Rewr_Abs = "abs e = (if 0 <= e then e else -e)"
| string_of_rewr (Rewr_Eq_Nums true) = "(n1 = n2) = true"
| string_of_rewr (Rewr_Eq_Nums false) = "(n1 ~= n2) = false"
| string_of_rewr Rewr_Eq_Sub = "(e1 = e2) = (e1 - e2 = 0)"
| string_of_rewr Rewr_Eq_Le = "(e1 = e2) = (and (e1 <= e2) (e2 <= e1))"
| string_of_rewr (Rewr_Ineq_Nums (Le, true)) = "(n1 <= n2) = true"
| string_of_rewr (Rewr_Ineq_Nums (Le, false)) = "(n1 <= n2) = false"
| string_of_rewr (Rewr_Ineq_Nums (Lt, true)) = "(n1 < n2) = true"
| string_of_rewr (Rewr_Ineq_Nums (Lt, false)) = "(n1 < n2) = false"
| string_of_rewr (Rewr_Ineq_Add (Le, _)) = "(e1 <= e2) = (e1 + n <= e2 + n)"
| string_of_rewr (Rewr_Ineq_Add (Lt, _)) = "(e1 < e2) = (e1 + n < e2 + n)"
| string_of_rewr (Rewr_Ineq_Sub Le) = "(e1 <= e2) = (e1 - e2 <= 0)"
| string_of_rewr (Rewr_Ineq_Sub Lt) = "(e1 < e2) = (e1 - e2 < 0)"
| string_of_rewr (Rewr_Ineq_Mul (Le, _)) = "(e1 <= e2) = (n * e1 <= n * e2)"
| string_of_rewr (Rewr_Ineq_Mul (Lt, _)) = "(e1 < e2) = (n * e1 < n * e2)"
| string_of_rewr (Rewr_Not_Ineq Le) = "~(e1 <= e2) = (e2 < e1)"
| string_of_rewr (Rewr_Not_Ineq Lt) = "~(e1 < e2) = (e2 <= e1)"
fun flatten_then_conv (Then_Conv (c1, c2)) = flatten_then_conv c1 @ flatten_then_conv c2
| flatten_then_conv c = [c]
fun string_of_conv Keep_Conv = "_"
| string_of_conv (c as Then_Conv _) =
space_implode " then " (map (enclose "(" ")" o string_of_conv) (flatten_then_conv c))
| string_of_conv (Args_Conv (k, cs)) =
"args " ^ Argo_Expr.string_of_kind k ^ " " ^ brackets string_of_conv cs
| string_of_conv (Rewr_Conv r) = string_of_rewr r
fun string_of_rule (Axiom i) = "axiom " ^ string_of_int i
| string_of_rule (Taut (t, _)) = "tautology: " ^ string_of_taut t
| string_of_rule (Conjunct (i, n)) = "conjunct " ^ string_of_int i ^ " of " ^ string_of_int n
| string_of_rule (Rewrite c) = "rewrite: " ^ string_of_conv c
| string_of_rule (Hyp (i, _)) = "hypothesis " ^ string_of_int i
| string_of_rule (Clause is) = "clause " ^ brackets string_of_int is
| string_of_rule (Lemma is) = "lemma " ^ brackets string_of_int is
| string_of_rule (Unit_Res i) = "unit-resolution " ^ string_of_int i
| string_of_rule (Refl _) = "reflexivity"
| string_of_rule Symm = "symmetry"
| string_of_rule Trans = "transitivity"
| string_of_rule Cong = "congruence"
| string_of_rule Subst = "substitution"
| string_of_rule Linear_Comb = "linear-combination"
exception UNSAT of proof
fun unsat p = raise UNSAT p
end