Commit 8e207729 authored by François Bobot's avatar François Bobot
Browse files

native syntax for yices

Warning since 7efae3f8 yices doesn't
work with real since in assoc_mul_div a variable is the denominator.
Yices refuse that.
parent fe469a24
......@@ -134,7 +134,7 @@ LIB_TRANSFORM = simplify_recursive_definition simplify_formula \
eval_match
LIB_PRINTER = print_real alt_ergo why3printer smtv1 smtv2 \
coq tptp simplify gappa cvc3
coq tptp simplify gappa cvc3 yices
LIBMODULES = src/config \
$(addprefix src/util/, $(LIB_UTIL)) \
......
......@@ -2,8 +2,8 @@
prelude ";;; this is a prelude for Yices "
printer "smtv1"
filename "%f-%t-%g.smt"
printer "yices"
filename "%f-%t-%g.ycs"
valid "\\bunsat\\b"
unknown "\\bunknown\\b\\|\\bsat\\b\\|feature not supported: non linear problem" "Unknown"
......@@ -23,11 +23,10 @@ transformation "simplify_formula"
transformation "discriminate"
transformation "encoding_smt"
transformation "encoding_sort"
theory BuiltIn
syntax type int "Int"
syntax type real "Real"
syntax type int "int"
syntax type real "real"
syntax predicate (=) "(= %1 %2)"
meta "encoding : kept" type int
......@@ -115,13 +114,12 @@ theory bool.Bool
syntax function False "false"
syntax function andb "(and %1 %2)"
syntax function orb "(or %1 %2)"
syntax function xorb "(xor %1 %2)"
syntax function notb "(not %1)"
meta cloned "encoding_decorate : kept" type bool
end
*)
(*
theory int.EuclideanDivision
syntax function div "(div %1 %2)"
syntax function mod "(mod %1 %2)"
......@@ -130,7 +128,20 @@ theory int.EuclideanDivision
remove prop Mod_1
remove prop Div_1
end
*)
theory map.Map
syntax type map "(-> %1 %2)"
meta "encoding : lskept" function get
meta "encoding : lskept" function set
meta "encoding : lskept" function const
syntax function get "(%1 %2)"
syntax function set "(update %1 (%2) %3)"
end
(*
Local Variables:
mode: why
......
......@@ -48,7 +48,7 @@ version_regexp = "[Yices ]*\\([^ \n]+\\)"
version_ok = "1.0.27"
version_old = "1.0.17"
version_old = "1.0.24"
command = "@LOCALBIN@why3-cpulimit %t %m -s %e -smt"
command = "@LOCALBIN@why3-cpulimit %t %m -s %e"
driver = "drivers/yices.drv"
[ATP eprover]
......
......@@ -27,10 +27,11 @@ open Rc
- 2
- 5 cvc3 native
- 6 driver renaming
- 7 yices native
If a configuration doesn't contain the actual magic number we don't use it.*)
let magicnumber = 6
let magicnumber = 7
exception WrongMagicNumber
......
(**************************************************************************)
(* *)
(* Copyright (C) 2010-2011 *)
(* François Bobot *)
(* Jean-Christophe Filliâtre *)
(* Claude Marché *)
(* Andrei Paskevich *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
(** SMT v1 printer with some extensions *)
open Format
open Pp
open Ident
open Ty
open Term
open Decl
open Theory
open Task
open Printer
(** Options of this printer *)
let use_builtin_array = Theory.register_meta_excl "Smt : builtin array" []
(** *)
let ident_printer =
let bls = (*["and";" benchmark";" distinct";"exists";"false";"flet";"forall";
"if then else";"iff";"implies";"ite";"let";"logic";"not";"or";
"sat";"theory";"true";"unknown";"unsat";"xor";
"assumption";"axioms";"defintion";"extensions";"formula";
"funs";"extrafuns";"extrasorts";"extrapreds";"language";
"notes";"preds";"sorts";"status";"theory";"Int";"Real";"Bool";
"Array";"U";"select";"store"]*)
(** smtlib2 V2 p71 *)
[(** General: *)
"!";"_"; "as"; "DECIMAL"; "exists"; "forall"; "let"; "NUMERAL";
"par"; "STRING"; "if"; "ite";
(**Command names:*)
"define";
"define-type";"exit";"get-assertions";"get-assignment"; "get-info";
"get-option"; "get-proof"; "get-unsat-core"; "get-value"; "pop"; "push";
"set-logic"; "set-info"; "set-option";
(** for security *)
"bool";"unsat";"sat";"true";"false";
"true";"check";"assert";"TYPE";"SUBTYPE";
"scalar";"select";"update";"int";"real";"subtype";"subrange";"mk-bv";
"bv-concat";"bv-extract";"bv-shift-right0";
]
in
let san = sanitizer char_to_alpha char_to_alnumus in
create_ident_printer bls ~sanitizer:san
let print_ident fmt id =
fprintf fmt "%s" (id_unique ident_printer id)
(** type *)
type info = {
info_syn : string Mid.t;
info_rem : Sid.t;
complex_type : ty Hty.t;
}
let rec print_type info fmt ty = match ty.ty_node with
| Tyvar _ -> unsupported "yices : you must encode the polymorphism"
| Tyapp (ts, []) -> begin match query_syntax info.info_syn ts.ts_name with
| Some s -> syntax_arguments s (print_type info) fmt []
| None -> fprintf fmt "%a" print_ident ts.ts_name
end
| Tyapp (ts, l) ->
begin match query_syntax info.info_syn ts.ts_name with
| Some s -> syntax_arguments s (print_type info) fmt l
| None -> print_type info fmt (Hty.find info.complex_type ty)
end
(* and print_tyapp info fmt = function *)
(* | [] -> () *)
(* | [ty] -> fprintf fmt "%a " (print_type info) ty *)
(* | tl -> fprintf fmt "(%a) " (print_list comma (print_type info)) tl *)
let rec iter_complex_type info fmt () ty = match ty.ty_node with
| Tyvar _ -> unsupported "cvc3 : you must encode the polymorphism"
| Tyapp (_, []) -> ()
| Tyapp (ts, l) ->
begin match query_syntax info.info_syn ts.ts_name with
| Some _ -> List.iter (iter_complex_type info fmt ()) l
| None when not (Hty.mem info.complex_type ty) ->
let id = id_fresh (Pp.string_of_wnl Pretty.print_ty ty) in
let ts = create_tysymbol id [] None in
let cty = ty_app ts [] in
fprintf fmt "(define-type %a)@."
print_ident ts.ts_name;
Hty.add info.complex_type ty cty
| None -> ()
end
let find_complex_type info fmt f =
t_ty_fold (iter_complex_type info fmt) () f
let find_complex_type_expr info fmt f =
TermTF.t_selecti
(t_ty_fold (iter_complex_type info fmt))
(t_ty_fold (iter_complex_type info fmt))
() f
let print_type info fmt =
catch_unsupportedType (print_type info fmt)
let print_type_value info fmt = function
| None -> fprintf fmt "bool"
| Some ty -> print_type info fmt ty
(** var *)
let forget_var v = forget_id ident_printer v.vs_name
let print_var fmt {vs_name = id} =
let n = id_unique ident_printer id in
fprintf fmt "%s" n
let print_typed_var info fmt vs =
fprintf fmt "%a::%a" print_var vs
(print_type info) vs.vs_ty
let print_var_list info fmt vsl =
print_list space (print_typed_var info) fmt vsl
(** expr *)
let rec print_term info fmt t = match t.t_node with
| Tconst (ConstInt n) -> fprintf fmt "%s" n
| Tconst (ConstReal c) ->
Print_real.print_with_integers
"%s" "(* %s %s)" "(/ %s %s)" fmt c
| Tvar v -> print_var fmt v
| Tapp (ls, tl) -> begin match query_syntax info.info_syn ls.ls_name with
| Some s -> syntax_arguments_typed s (print_term info)
(print_type info) (Some t) fmt tl
| None -> begin match tl with (* for cvc3 wich doesn't accept (toto ) *)
| [] -> fprintf fmt "%a" print_ident ls.ls_name
| _ -> fprintf fmt "@,(%a %a)"
print_ident ls.ls_name (print_list space (print_term info)) tl
end end
| Tlet (t1, tb) ->
let v, t2 = t_open_bound tb in
fprintf fmt "@[(let ((%a %a)) %a)@]" print_var v
(print_term info) t1 (print_term info) t2;
forget_var v
| Tif (f1,t1,t2) ->
fprintf fmt "@[(if %a@ %a@ %a)@]"
(print_fmla info) f1 (print_term info) t1 (print_term info) t2
| Tcase _ -> unsupportedTerm t
"yices : you must eliminate match"
| Teps _ -> unsupportedTerm t
"yices : you must eliminate epsilon"
| Tquant _ | Tbinop _ | Tnot _ | Ttrue | Tfalse -> raise (TermExpected t)
and print_fmla info fmt f = match f.t_node with
| Tapp ({ ls_name = id }, []) ->
print_ident fmt id
| Tapp (ls, tl) -> begin match query_syntax info.info_syn ls.ls_name with
| Some s -> syntax_arguments_typed s (print_term info)
(print_type info) None fmt tl
| None -> begin match tl with
| [] -> fprintf fmt "%a" print_ident ls.ls_name
| _ -> fprintf fmt "(%a %a)"
print_ident ls.ls_name (print_list space (print_term info)) tl
end end
| Tquant (q, fq) ->
let q = match q with Tforall -> "forall" | Texists -> "exists" in
let vl, tl, f = t_open_quant fq in
(* TODO trigger dépend des capacités du prover : 2 printers?
smtwithtriggers/smtstrict *)
if true (*tl = []*) then
fprintf fmt "@[(%s@ (%a)@ %a)@]"
q
(print_var_list info) vl
(print_fmla info) f
else
fprintf fmt "@[(%s@ (%a)%a@ %a)@]"
q
(print_var_list info) vl
(print_triggers info) tl
(print_fmla info) f;
List.iter forget_var vl
| Tbinop (Tand, f1, f2) ->
fprintf fmt "@[(and %a@ %a)@]" (print_fmla info) f1 (print_fmla info) f2
| Tbinop (Tor, f1, f2) ->
fprintf fmt "@[(and %a@ %a)@]" (print_fmla info) f1 (print_fmla info) f2
| Tbinop (Timplies, f1, f2) ->
fprintf fmt "@[(=> %a@ %a)@]"
(print_fmla info) f1 (print_fmla info) f2
| Tbinop (Tiff, f1, f2) ->
fprintf fmt "@[(and (=> %a@ %a) (=> %a@ %a@))]"
(print_fmla info) f1 (print_fmla info) f2
(print_fmla info) f2 (print_fmla info) f1
| Tnot f ->
fprintf fmt "@[(not@ %a)@]" (print_fmla info) f
| Ttrue ->
fprintf fmt "true"
| Tfalse ->
fprintf fmt "false"
| Tif (f1, f2, f3) ->
fprintf fmt "@[(if %a@ %a@ %a)@]"
(print_fmla info) f1 (print_fmla info) f2 (print_fmla info) f3
| Tlet (t1, tb) ->
let v, f2 = t_open_bound tb in
fprintf fmt "@[(let ((%a %a)) %a)@]" print_var v
(print_term info) t1 (print_fmla info) f2;
forget_var v
| Tcase _ -> unsupportedTerm f
"yices : you must eliminate match"
| Tvar _ | Tconst _ | Teps _ -> raise (FmlaExpected f)
and print_expr info fmt =
TermTF.t_select (print_term info fmt) (print_fmla info fmt)
(** I don't know how to print trigger for yices *)
and print_triggers info fmt = function
| [] -> ()
| a::l -> fprintf fmt "PATTERN (%a):@ %a"
(print_list space (print_expr info)) a
(print_triggers info) l
let print_logic_binder info fmt v =
fprintf fmt "%a: %a" print_ident v.vs_name
(print_type info) v.vs_ty
let print_type_decl info fmt = function
| ts, Tabstract when Sid.mem ts.ts_name info.info_rem -> false
| ts, Tabstract when ts.ts_args = [] ->
fprintf fmt "(define-type %a)" print_ident ts.ts_name; true
| _, Tabstract -> false
| _, Talgebraic _ -> unsupported
"yices : algebraic type are not supported"
let print_logic_decl info fmt (ls,ld) =
if not (Mid.mem ls.ls_name info.info_syn) then
List.iter (iter_complex_type info fmt ()) ls.ls_args;
Util.option_iter (iter_complex_type info fmt ()) ls.ls_value;
match ld, ls.ls_args with
| None,[] ->
fprintf fmt "@[<hov 2>(define %a::%a)@]@\n"
print_ident ls.ls_name
(print_type_value info) ls.ls_value
| None,_ ->
fprintf fmt "@[<hov 2>(define %a::(-> %a %a))@]@\n"
print_ident ls.ls_name
(print_list space (print_type info)) ls.ls_args
(print_type_value info) ls.ls_value
| Some _,_ ->
unsupported "yices : function and predicate definitions are not supported"
let print_logic_decl info fmt d =
if Sid.mem (fst d).ls_name info.info_rem then
false else (print_logic_decl info fmt d; true)
let print_decl info fmt d = match d.d_node with
| Dtype dl ->
print_list_opt newline (print_type_decl info) fmt dl
| Dlogic dl ->
print_list_opt newline (print_logic_decl info) fmt dl
| Dind _ -> unsupportedDecl d
"yices : inductive definition are not supported"
| Dprop (Paxiom, pr, _) when Sid.mem pr.pr_name info.info_rem -> false
| Dprop (Paxiom, pr, f) ->
find_complex_type info fmt f;
fprintf fmt "@[<hov 2>;; %s@\n(assert@ %a);@]@\n"
pr.pr_name.id_string
(print_fmla info) f; true
| Dprop (Pgoal, pr, f) ->
find_complex_type info fmt f;
fprintf fmt "@[(assert@\n";
fprintf fmt "@[;; %a@]@\n" print_ident pr.pr_name;
(match pr.pr_name.id_loc with
| None -> ()
| Some loc -> fprintf fmt " @[;; %a@]@\n"
Loc.gen_report_position loc);
fprintf fmt " @[(not %a)@])@]@\n(check)" (print_fmla info) f;
true
| Dprop ((Plemma|Pskip), _, _) -> assert false
let print_decl info fmt = catch_unsupportedDecl (print_decl info fmt)
let distingued =
let dist_syntax mls = function
| [MAls ls;MAstr s] -> Mls.add ls s mls
| _ -> assert false in
let dist_dist syntax mls = function
| [MAls ls;MAls lsdis] ->
begin try
Mid.add lsdis.ls_name (Mls.find ls syntax) mls
with Not_found -> mls end
| _ -> assert false in
Trans.on_meta meta_syntax_logic (fun syntax ->
let syntax = List.fold_left dist_syntax Mls.empty syntax in
Trans.on_meta Discriminate.meta_lsinst (fun dis ->
let dis2 = List.fold_left (dist_dist syntax) Mid.empty dis in
Trans.return dis2))
let print_task pr thpr fmt task =
print_prelude fmt pr;
print_th_prelude task fmt thpr;
let info = {
info_syn = Mid.union (fun _ _ s -> Some s)
(get_syntax_map task) (Trans.apply distingued task);
info_rem = get_remove_set task;
complex_type = Hty.create 5;
}
in
let decls = Task.task_decls task in
ignore (print_list_opt (add_flush newline2) (print_decl info) fmt decls)
let () = register_printer "yices"
(fun _env pr thpr ?old:_ fmt task ->
forget_all ident_printer;
print_task pr thpr fmt task)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment