src/HOL/SMT/Tools/cvc3_solver.ML
author boehmes
Fri, 18 Sep 2009 18:13:19 +0200
changeset 32618 42865636d006
child 33006 39f73a59e855
permissions -rw-r--r--
added new method "smt": an oracle-based connection to external SMT solvers
boehmes@32618
     1
(*  Title:      HOL/SMT/Tools/cvc3_solver.ML
boehmes@32618
     2
    Author:     Sascha Boehme, TU Muenchen
boehmes@32618
     3
boehmes@32618
     4
Interface of the SMT solver CVC3.
boehmes@32618
     5
*)
boehmes@32618
     6
boehmes@32618
     7
signature CVC3_SOLVER =
boehmes@32618
     8
sig
boehmes@32618
     9
  val setup: theory -> theory
boehmes@32618
    10
end
boehmes@32618
    11
boehmes@32618
    12
structure CVC3_Solver: CVC3_SOLVER =
boehmes@32618
    13
struct
boehmes@32618
    14
boehmes@32618
    15
val solver_name = "cvc3"
boehmes@32618
    16
val env_var = "CVC3_SOLVER"
boehmes@32618
    17
boehmes@32618
    18
val options =
boehmes@32618
    19
  ["+counterexample", "-lang", "smtlib", "-output-lang", "presentation"]
boehmes@32618
    20
boehmes@32618
    21
val is_sat = String.isPrefix "Satisfiable."
boehmes@32618
    22
val is_unsat = String.isPrefix "Unsatisfiable."
boehmes@32618
    23
val is_unknown = String.isPrefix "Unknown."
boehmes@32618
    24
boehmes@32618
    25
fun cex_kind true = "Counterexample"
boehmes@32618
    26
  | cex_kind false = "Possible counterexample"
boehmes@32618
    27
boehmes@32618
    28
fun raise_cex real ctxt recon ls =
boehmes@32618
    29
  let
boehmes@32618
    30
    val start = String.isPrefix "%Satisfiable  Variable Assignment: %"
boehmes@32618
    31
    val index = find_index start ls
boehmes@32618
    32
    val ls = if index > 0 then Library.drop (index + 1, ls) else []
boehmes@32618
    33
    val p = Pretty.big_list (cex_kind real ^ " found:") (map Pretty.str ls)
boehmes@32618
    34
  in error (Pretty.string_of p) end
boehmes@32618
    35
boehmes@32618
    36
fun core_oracle (SMT_Solver.ProofData {context, output, recon, ...}) =
boehmes@32618
    37
  let
boehmes@32618
    38
    val empty_line = (fn "" => true | _ => false)
boehmes@32618
    39
    val split_first = (fn [] => ("", []) | l :: ls => (l, ls))
boehmes@32618
    40
    val (l, ls) = split_first (dropwhile empty_line output)
boehmes@32618
    41
  in
boehmes@32618
    42
    if is_unsat l then @{cprop False}
boehmes@32618
    43
    else if is_sat l then raise_cex true context recon ls
boehmes@32618
    44
    else if is_unknown l then raise_cex false context recon ls
boehmes@32618
    45
    else error (solver_name ^ " failed")
boehmes@32618
    46
  end
boehmes@32618
    47
boehmes@32618
    48
fun smtlib_solver oracle _ =
boehmes@32618
    49
  SMT_Solver.SolverConfig {
boehmes@32618
    50
    name = {env_var=env_var, remote_name=solver_name},
boehmes@32618
    51
    interface = SMTLIB_Interface.interface,
boehmes@32618
    52
    arguments = options,
boehmes@32618
    53
    reconstruct = oracle }
boehmes@32618
    54
boehmes@32618
    55
val setup =
boehmes@32618
    56
  Thm.add_oracle (Binding.name solver_name, core_oracle) #-> (fn (_, oracle) =>
boehmes@32618
    57
  SMT_Solver.add_solver (solver_name, smtlib_solver oracle))
boehmes@32618
    58
boehmes@32618
    59
end