Commit 1b291599 authored by Francois Bobot's avatar Francois Bobot

encoding_smt should work with the default option

parent 637c820f
......@@ -108,11 +108,11 @@ LIB_DRIVER = call_provers driver_ast driver_parser driver_lexer driver \
whyconf
LIB_TRANSFORM = simplify_recursive_definition simplify_formula inlining \
split_conjunction encoding_decorate encoding_decorate_mono \
encoding_bridge\
split_conjunction encoding_const \
eliminate_definition eliminate_algebraic \
encoding_enumeration \
eliminate_inductive eliminate_let eliminate_if \
encoding_enumeration encoding encoding_decorate_mono \
encoding_decorate encoding_bridge \
explicit_polymorphism encoding_simple encoding_instantiate \
simplify_array filter_trigger split_goal
......@@ -464,27 +464,6 @@ install::
mkdir -p $(BINDIR)
cp -f bin/why3-cpulimit $(BINDIR)
#########
# drivers
#########
#Only generated drivers
DIR_DRIVERS := drivers/
DRIVERS := z3_inst cvc3_inst z3_simple cvc3_simple
DRIVERS := $(addsuffix .drv, $(DRIVERS))
DRIVERS := $(addprefix $(DIR_DRIVERS), $(DRIVERS))
#Not great for -j
$(DRIVERS) : $(DIR_DRIVERS)z3.drv $(DIR_DRIVERS)cvc3.drv drivers/gen_drv.sh
drivers/gen_drv.sh
byte opt: $(DRIVERS)
clean::
rm -f $(DRIVERS)
########
# bench
########
......
......@@ -20,7 +20,7 @@ transformation "eliminate_algebraic"
transformation "simplify_formula"
transformation "simplify_trivial_quantification"
transformation "encoding_decorate"
transformation "encoding_smt"
theory BuiltIn
syntax type int "Int"
......@@ -56,6 +56,9 @@ theory int.Int
remove prop Trans
remove prop Antisymm
remove prop Total
meta "encoding : kept" type int
end
theory real.Real
......@@ -90,6 +93,8 @@ theory real.Real
remove prop Antisymm
remove prop Total
meta "encoding : kept" type real
end
(*
......
#!/bin/sh
DIR=drivers/
replace (){
prover=$1;
suffix=$2;
src=$3
dst=$4
cat ${DIR}${prover}.drv |sed -e "s/${src}/${dst}/" > ${DIR}${prover}_${suffix}.drv
}
for prover in z3 cvc3; do
replace $prover "inst" transformation\ \"encoding_decorate\" transformation\ \"encoding_instantiate\"
done
for prover in z3 cvc3; do
replace $prover "simple" transformation\ \"encoding_decorate\" \
"transformation \"encoding_enumeration\"\ntransformation \"explicit_polymorphism\"\ntransformation \"encoding_simple_kept\""
done
......@@ -8,7 +8,7 @@ transformation "eliminate_algebraic"
transformation "eliminate_if"
transformation "eliminate_let"
transformation "encoding_decorate"
transformation "encoding_smt"
theory BuiltIn
syntax type int "int"
......
......@@ -20,7 +20,7 @@ transformation "eliminate_algebraic"
transformation "simplify_formula"
transformation "simplify_trivial_quantification"
transformation "encoding_decorate"
transformation "encoding_smt"
(* transformation "encoding_decorate_every_simple" *)
theory BuiltIn
......@@ -33,7 +33,7 @@ end
theory int.Int
prelude ";;; this is a prelude for Z3, Arithmetic"
syntax logic zero "0"
syntax logic (+) "(+ %1 %2)"
......@@ -59,6 +59,8 @@ theory int.Int
remove prop Antisymm
remove prop Total
meta "encoding : kept" type int
end
......@@ -94,6 +96,8 @@ theory real.Real
remove prop Antisymm
remove prop Total
meta "encoding : kept" type real
end
(*
......
......@@ -443,6 +443,7 @@ end)
module Sterm = Term.S
module Mterm = Term.M
module Hterm = Term.H
module Wterm = Term.W
module Hsfmla = Hashcons.Make (struct
......
......@@ -173,6 +173,7 @@ and trigger = expr list
module Mterm : Map.S with type key = term
module Sterm : Set.S with type elt = term
module Wterm : Hashweak.S with type key = term
module Mfmla : Map.S with type key = fmla
module Sfmla : Set.S with type elt = fmla
......
......@@ -25,18 +25,17 @@ open Task
open Theory
open Task
open Decl
open Encoding
let why_filename = ["transform" ; "encoding_decorate"]
let meta_kept = Encoding_decorate.meta_kept
(* From Encoding Polymorphism CADE07*)
type lconv = {tb2t : lsymbol;
t2tb : lsymbol;
tb : ty}
type tenv = {kept : Sts.t option;
type tenv = {kept : Sts.t;
clone_builtin : tysymbol -> Theory.tdecl list;
specials : lconv Hty.t;
trans_lsymbol : lsymbol Hls.t;
......@@ -52,7 +51,6 @@ let load_prelude kept env =
let type_t = Theory.ns_find_ts builtin.th_export ["t"] in
let trans_tsymbol = Hts.create 17 in
let clone_builtin ts =
let task = None in
let name = ts.ts_name.id_string in
let th_uc = create_theory (id_fresh ("bridge_for_"^name)) in
let th_uc =
......@@ -66,7 +64,7 @@ let load_prelude kept env =
let t2tb = ns_find_ls th.th_export ["t2tb"] in
let tb = ns_find_ts th.th_export ["tb"] in
let lconv = { tb2t = tb2t; t2tb = t2tb; tb = ty_app tb []} in
let task = Task.use_export task th in
let task = Task.use_export None th in
Hts.add trans_tsymbol ts tb;
Hty.add specials (ty_app ts []) lconv;
task_tdecls task in
......@@ -91,13 +89,7 @@ let rec ty_of_ty tenv ty =
let ty_of_ty_specials tenv ty =
if Hty.mem tenv.specials ty then ty else ty_of_ty tenv ty
let is_kept tenv ts =
ts.ts_args = [] &&
begin
match tenv.kept with
| None -> true (* every_simple *)
| Some s -> Sts.mem ts s
end
let is_kept tenv ts = ts.ts_args = [] && Sts.mem ts tenv.kept
(* Convert a logic symbols to the encoded one *)
let conv_ls tenv ls =
......@@ -155,26 +147,15 @@ let rec rewrite_term tenv t =
let p = Hls.find tenv.trans_lsymbol p in
let tl = List.map2 (conv_arg tenv) tl p.ls_args in
conv_res_app tenv p tl t.t_ty
| Tconst _ | Tvar _ | Tif _ | Tlet _ -> t_map fnT fnF t
| Tcase _ | Teps _ | Tbvar _ ->
Printer.unsupportedTerm t
"Encoding decorate : I can't encode this term"
| _ -> t_map fnT fnF t
and rewrite_fmla tenv f =
(* Format.eprintf "@[<hov 2>Fmla : %a =>@\n@?" Pretty.print_fmla f; *)
let fnT = rewrite_term tenv in
let fnF = rewrite_fmla tenv in
match f.f_node with
| Fapp(p, tl) when ls_equal p ps_equ ->
let tl = List.map fnT tl in
begin
match tl with
| [a1;_] ->
let ty = a1.t_ty in
let tl = List.map2 (conv_arg tenv) tl [ty;ty] in
f_app p tl
| _ -> assert false
end
| Fapp(p, [t1;t2]) when ls_equal p ps_equ ->
f_equ (fnT t1) (fnT t2)
| Fapp(p, tl) ->
let tl = List.map fnT tl in
let p = Hls.find tenv.trans_lsymbol p in
......@@ -227,15 +208,8 @@ let decl tenv d =
let t env = Trans.on_meta meta_kept (fun tds ->
let s = Task.find_tagged_ts meta_kept tds Sts.empty in
let init_task,tenv = load_prelude (Some s) env in
let init_task,tenv = load_prelude s env in
Trans.tdecl (decl tenv) init_task)
let () = Trans.register_env_transform "encoding_bridge" t
let t_all env =
let init_task,tenv = load_prelude None env in
Trans.tdecl (decl tenv) init_task
let () = Trans.register_env_transform "encoding_bridge_every_simple" t_all
let () = register_enco_kept "bridge" t
......@@ -25,20 +25,14 @@ open Task
open Theory
open Task
open Decl
open Encoding
let why_filename = ["transform" ; "encoding_decorate"]
let meta_kept = register_meta "encoding_decorate : kept" [MTtysymbol]
(* From Encoding Polymorphism CADE07*)
type lconv = {d2t : lsymbol;
t2u : lsymbol;
tty : term}
type tenv = {kept : Sts.t option;
clone_builtin : tysymbol -> Theory.tdecl list;
specials : lconv Hty.t;
type tenv = {kept : Sts.t;
keptty : Sty.t;
deco : ty;
undeco : ty;
sort : lsymbol;
......@@ -58,42 +52,10 @@ let load_prelude kept env =
let task = None in
let task = Task.use_export task prelude in
let trans_tsymbol = Hts.create 17 in
let specials = Hty.create 17 in
let builtin = Env.find_theory env why_filename "Builtin" in
let type_t = Theory.ns_find_ts builtin.th_export ["t"] in
let logic_d2t = Theory.ns_find_ls builtin.th_export ["d2t"] in
let logic_t2u = Theory.ns_find_ls builtin.th_export ["t2u"] in
let logic_tty = Theory.ns_find_ls builtin.th_export ["tty"] in
let clone_builtin ts =
let task = None in
let name = ts.ts_name.id_string in
let th_uc = create_theory (id_fresh ("encoding_decorate_for_"^name)) in
let th_uc = Theory.use_export th_uc prelude in
let th_uc =
if ts_equal ts ts_int || ts_equal ts ts_real then th_uc
else Theory.add_ty_decl th_uc [ts,Tabstract] in
let ty = ty_app ts [] in
let add_fsymbol fs th_uc =
Theory.add_logic_decl th_uc [fs,None] in
let tty = create_fsymbol (id_clone ts.ts_name) [] tyty in
let d2ty = create_fsymbol (id_fresh ("d2"^name)) [deco] ty in
let ty2u = create_fsymbol (id_fresh (name^"2u")) [ty] undeco in
let th_uc = add_fsymbol d2ty (add_fsymbol ty2u (add_fsymbol tty th_uc)) in
let th_inst = create_inst
~ts:[type_t,ts]
~ls:[logic_d2t,d2ty;logic_t2u,ty2u;logic_tty,tty]
~lemma:[] ~goal:[] in
let lconv = { d2t = d2ty; t2u = ty2u; tty = t_app tty [] tyty} in
let th_uc = Theory.clone_export th_uc builtin th_inst in
let th = close_theory th_uc in
let task = Task.use_export task th in
Hts.add trans_tsymbol ts tty;
Hty.add specials (ty_app ts []) lconv;
task_tdecls task in
let kepty = Sts.fold (fun ts -> Sty.add (ty_app ts [])) kept Sty.empty in
task,
{ kept = kept;
clone_builtin = Wts.memoize 7 clone_builtin;
specials = specials;
keptty = kepty;
deco = deco;
undeco = undeco;
ty = tyty;
......@@ -102,13 +64,7 @@ let load_prelude kept env =
trans_tsymbol = trans_tsymbol}
let is_kept tenv ts =
ts.ts_args = [] &&
begin
ts_equal ts ts_int || ts_equal ts ts_real (* for the constant *)
|| match tenv.kept with
| None -> true (* every_simple *)
| Some s -> Sts.mem ts s
end
ts.ts_args = [] && Sts.mem ts tenv.kept
(* Translate a type to a term *)
let rec term_of_ty tenv tvar ty =
......@@ -131,14 +87,14 @@ let sort_app tenv tvar t ty =
(* Convert a type at the right of an arrow *)
let conv_ty_neg tenv ty =
if Hty.mem tenv.specials ty then
if Sty.mem ty tenv.keptty then
ty
else
tenv.deco
(* Convert a type at the left of an arrow *)
let conv_ty_pos tenv ty =
if Hty.mem tenv.specials ty then
if Sty.mem ty tenv.keptty then
ty
else
tenv.undeco
......@@ -163,31 +119,11 @@ let conv_ts tenv ts =
let tyl = List.map (fun _ -> tenv.ty) ts.ts_args in
create_fsymbol preid tyl tenv.ty
(* Convert the argument of a function from specials to deco or deco to
specials if needed*)
let conv_arg tenv tvar t ty =
let tty = t.t_ty in
if ty_equal tty ty then t else
if ty_equal ty tenv.deco then
let tylconv = Hty.find tenv.specials tty in
let t = (t_app tylconv.t2u [t] tenv.undeco) in
sort_app tenv tvar t tty
else (* tty is tenv.deco *)
begin
assert (ty_equal tty tenv.deco);
let tylconv = Hty.find tenv.specials ty in
t_app tylconv.d2t [t] ty
end
(* Convert to undeco or to a specials an application *)
let conv_res_app tenv tvar p tl ty =
let tty = Util.of_option p.ls_value in
if ty_equal tty ty then t_app p tl tty else
begin
assert (ty_equal tty tenv.undeco);
let t = t_app p tl tenv.undeco in
sort_app tenv tvar t ty
end
let conv_res_app tenv tvar t ty =
let tty = t.t_ty in
if Sty.mem tty tenv.keptty then t
else sort_app tenv tvar t ty
let conv_vs tenv tvar (vsvar,acc) vs =
let tres,vsres =
......@@ -214,7 +150,8 @@ let conv_vs_let vsvar vs ty_res =
let rec rewrite_term tenv tvar vsvar t =
(*Format.eprintf "@[<hov 2>Term : %a =>@\n@?" Pretty.print_term t;*)
(* Format.eprintf "@[<hov 3>Term : %a : %a =>@\n@?" *)
(* Pretty.print_term t Pretty.print_ty t.t_ty; *)
let fnT = rewrite_term tenv tvar in
let fnF = rewrite_fmla tenv tvar vsvar in
match t.t_node with
......@@ -223,8 +160,8 @@ let rec rewrite_term tenv tvar vsvar t =
| Tapp(p,tl) ->
let tl = List.map (fnT vsvar) tl in
let p = Hls.find tenv.trans_lsymbol p in
let tl = List.map2 (conv_arg tenv tvar) tl p.ls_args in
conv_res_app tenv tvar p tl t.t_ty
let t' = t_app_infer p tl in
conv_res_app tenv tvar t' t.t_ty
| Tif (f, t1, t2) ->
t_if (fnF f) (fnT vsvar t1) (fnT vsvar t2)
| Tlet (t1, b) ->
......@@ -238,27 +175,19 @@ let rec rewrite_term tenv tvar vsvar t =
"Encoding decorate : I can't encode this term"
and rewrite_fmla tenv tvar vsvar f =
(* Format.eprintf "@[<hov 2>Fmla : %a =>@\n@?" Pretty.print_fmla f; *)
(* Format.eprintf "@[<hov>Fmla : %a =>@]@." Pretty.print_fmla f; *)
let fnT = rewrite_term tenv tvar vsvar in
let fnF = rewrite_fmla tenv tvar in
match f.f_node with
| Fapp(p, tl) when ls_equal p ps_equ ->
let tl = List.map fnT tl in
begin
match tl with
| [a1;_] ->
let ty =
if Hty.mem tenv.specials a1.t_ty
then a1.t_ty
else tenv.deco in
let tl = List.map2 (conv_arg tenv tvar) tl [ty;ty] in
f_app p tl
| _ -> assert false
end
| Fapp(p, [a1;a2]) when ls_equal p ps_equ ->
let a1 = fnT a1 in let a2 = fnT a2 in
(* Format.eprintf "@[<hov>%a : %a = %a : %a@]@." *)
(* Pretty.print_term a1 Pretty.print_ty a1.t_ty *)
(* Pretty.print_term a2 Pretty.print_ty a2.t_ty; *)
f_equ a1 a2
| Fapp(p, tl) ->
let tl = List.map fnT tl in
let p = Hls.find tenv.trans_lsymbol p in
let tl = List.map2 (conv_arg tenv tvar) tl p.ls_args in
f_app p tl
| Fquant (q, b) ->
let vl, tl, f1, close = f_open_quant_cb b in
......@@ -281,8 +210,7 @@ let decl (tenv:tenv) d =
(* let fnT = rewrite_term tenv in *)
let fnF = rewrite_fmla tenv in
match d.d_node with
| Dtype [ts,Tabstract] when is_kept tenv ts ->
tenv.clone_builtin ts
| Dtype [ts,Tabstract] when is_kept tenv ts -> [create_decl d]
| Dtype [ts,Tabstract] ->
let tty =
try
......@@ -333,15 +261,7 @@ let decl tenv d =
let t env = Trans.on_meta meta_kept (fun tds ->
let s = Task.find_tagged_ts meta_kept tds Sts.empty in
let init_task,tenv = load_prelude (Some s) env in
let init_task,tenv = load_prelude s env in
Trans.tdecl (decl tenv) init_task)
let () = Trans.register_env_transform "encoding_decorate" t
let t_all env =
let init_task,tenv = load_prelude None env in
Trans.tdecl (decl tenv) init_task
let () = Trans.register_env_transform "encoding_decorate_every_simple" t_all
let () = register_enco_poly "decorate" t
......@@ -23,4 +23,3 @@
Jean-Francois Couchot et Stephane Lescuyer *)
val why_filename : string list
val meta_kept : Theory.meta
......@@ -79,12 +79,12 @@ let decl tenv d = match d.d_node with
| _ ->
[decl_map (rewrite_term tenv) (rewrite_fmla tenv) d]
let t =
let encoding_enumeration =
let projs = Hts.create 17 in
Trans.on_meta meta_enum (fun tds ->
let enum = Task.find_tagged_ts meta_enum tds Sts.empty in
let tenv = { enum = enum ; projs = projs } in
Trans.decl (decl tenv) None)
let () = Trans.register_transform "encoding_enumeration" t
let () = Trans.register_transform "encoding_enumeration" encoding_enumeration
......@@ -17,3 +17,4 @@
(* *)
(**************************************************************************)
val encoding_enumeration : Task.task Trans.trans
This diff is collapsed.
......@@ -209,4 +209,6 @@ let explicit_polymorphism =
let () = Trans.register_transform "explicit_polymorphism" explicit_polymorphism
let () =
Encoding.register_enco_poly "explicit" (fun _ -> explicit_polymorphism)
......@@ -17,31 +17,11 @@ name = "CVC3"
command = "why3-cpulimit 0 %m cvc3 -timeout %t -lang smt %f 2>&1"
driver = "drivers/cvc3.drv"
[prover cvc3_simple]
name = "CVC3_simple"
command = "why3-cpulimit 0 %m cvc3 -timeout %t -lang smt %f 2>&1"
driver = "drivers/cvc3_simple.drv"
[prover cvc3_inst]
name = "CVC3 (inst)"
command = "why3-cpulimit 0 %m cvc3 -timeout %t -lang smt %f 2>&1"
driver = "drivers/cvc3_inst.drv"
[prover z3]
name = "Z3"
command = "why3-cpulimit %t %m z3 -smt %f 2>&1"
driver = "drivers/z3.drv"
[prover z3_simple]
name = "Z3_simple"
command = "why3-cpulimit %t %m z3 -smt %f 2>&1"
driver = "drivers/z3_simple.drv"
[prover z3_inst]
name = "Z3 (inst)"
command = "why3-cpulimit %t %m z3 -smt %f 2>&1"
driver = "drivers/z3_inst.drv"
[prover spass]
name = "spass"
command = "why3-cpulimit 0 %m SPASS -TPTP -PGiven=0 -PProblem=0 -DocProof -TimeLimit=%t %f 2>&1"
......
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