Commit ea1e5ebd authored by Francois Bobot's avatar Francois Bobot

Ajout de l'encodage utilisant l'instantiation

parent e44972a4
......@@ -93,7 +93,7 @@ LIBGENERATED = src/util/rc.ml \
src/driver/driver_parser.mli src/driver/driver_parser.ml \
src/driver/driver_parser.output src/driver/driver_lexer.ml
LIB_UTIL = pp loc print_tree hashweak util hashcons sysutil rc
LIB_UTIL = pp loc print_tree hashweak hashcons util sysutil rc
LIB_CORE = ident ty term pattern decl theory task pretty trans env
......@@ -106,7 +106,7 @@ LIB_TRANSFORM = simplify_recursive_definition simplify_formula inlining \
split_conjunction encoding_decorate \
eliminate_definition eliminate_algebraic \
eliminate_inductive eliminate_let eliminate_if \
explicit_polymorphism simple_types
explicit_polymorphism simple_types encoding_instantiate
LIB_PRINTER = print_real alt_ergo why3 smt coq tptp simplify gappa
......
......@@ -518,7 +518,8 @@ let f_app_unsafe = f_app
let fs_tuple n =
let tyl = ref [] in
for i = 1 to n do tyl := ty_var (create_tvsymbol (id_fresh "a")) :: !tyl done;
for i = 1 to n
do tyl := ty_var (create_tvsymbol (id_fresh "a")) :: !tyl done;
let ty = ty_tuple !tyl in
create_fsymbol (id_fresh ("Tuple" ^ string_of_int n)) !tyl ty
......@@ -616,16 +617,17 @@ let f_any_unsafe prT prF lvl f =
(* unsafe constructors with type checking *)
let t_app fs tl ty =
let t_app_inst fs tl ty =
let s = match fs.ls_value with
| Some vty -> ty_match Mtv.empty vty ty
| _ -> raise (FunctionSymbolExpected fs)
in
let mtch s ty t = ty_match s ty t.t_ty in
ignore (try List.fold_left2 mtch s fs.ls_args tl
with Invalid_argument _ -> raise (BadArity
(List.length fs.ls_args, List.length tl)));
t_app fs tl ty
try List.fold_left2 mtch s fs.ls_args tl
with Invalid_argument _ ->
raise (BadArity (List.length fs.ls_args, List.length tl))
let t_app fs tl ty = ignore (t_app_inst fs tl ty); t_app fs tl ty
let t_app_infer fs tl =
let mtch s ty t = ty_match s ty t.t_ty in
......@@ -640,16 +642,17 @@ let t_app_infer fs tl =
in
t_app_unsafe fs tl ty
let f_app ps tl =
let f_app_inst ps tl =
let s = match ps.ls_value with
| None -> Mtv.empty
| _ -> raise (PredicateSymbolExpected ps)
in
let mtch s ty t = ty_match s ty t.t_ty in
ignore (try List.fold_left2 mtch s ps.ls_args tl
with Invalid_argument _ -> raise (BadArity
(List.length ps.ls_args, List.length tl)));
f_app ps tl
try List.fold_left2 mtch s ps.ls_args tl
with Invalid_argument _ ->
raise (BadArity (List.length ps.ls_args, List.length tl))
let f_app ps tl = ignore (f_app_inst ps tl); f_app ps tl
let p_check t p =
check_ty_equal p.pat_ty t.t_ty
......
......@@ -191,6 +191,7 @@ val t_case : term list -> (pattern list * term) list -> ty -> term
val t_eps : vsymbol -> fmla -> term
val t_app_infer : lsymbol -> term list -> term
val t_app_inst : lsymbol -> term list -> ty -> ty Mtv.t
val t_label : label list -> term -> term
val t_label_add : label -> term -> term
......@@ -214,6 +215,8 @@ val f_if : fmla -> fmla -> fmla -> fmla
val f_let : vsymbol -> term -> fmla -> fmla
val f_case : term list -> (pattern list * fmla) list -> fmla
val f_app_inst : lsymbol -> term list -> ty Mtv.t
val f_label : label list -> fmla -> fmla
val f_label_add : label -> fmla -> fmla
val f_label_copy : fmla -> fmla -> fmla
......
......@@ -95,10 +95,12 @@ module Hsty = Hashcons.Make (struct
let tag n ty = { ty with ty_tag = n }
end)
module Ty = StructMake (struct
module Tty = struct
type t = ty
let tag ty = ty.ty_tag
end)
end
module Ty = StructMake (Tty)
module Sty = Ty.S
module Mty = Ty.M
......
......@@ -55,6 +55,8 @@ module Mts : Map.S with type key = tysymbol
module Hts : Hashtbl.S with type key = tysymbol
module Wts : Hashweak.S with type key = tysymbol
module Tty : Hashweak.Tagged with type t = ty
module Sty : Set.S with type elt = ty
module Mty : Map.S with type key = ty
module Hty : Hashtbl.S with type key = ty
......
......@@ -249,8 +249,8 @@ let rec rewrite_term tenv tvar vsvar t =
| Tif (f, t1, t2) ->
t_if (fnF f) (fnT vsvar t1) (fnT vsvar t2)
| Tlet (t1, b) -> let u,t2 = t_open_bound b in
let (vsvar,u) = conv_vs_let tenv vsvar u in
let t1' = fnT vsvar t1 in let t2' = fnT vsvar t2 in
let (vsvar',u) = conv_vs_let tenv vsvar u in
let t1' = fnT vsvar t1 in let t2' = fnT vsvar' t2 in
if t_equal t1' t1 && t_equal t2' t2 then t else t_let u t1' t2'
| Tcase _ | Teps _ | Tbvar _ ->
Register.unsupportedTerm t
......
......@@ -21,3 +21,5 @@
(** {{:http://www.lri.fr/~lescuyer/pdf/CADE-CL07.ps}
Handling Polymorphism in Automated Deduction}.
Jean-Francois Couchot et Stephane Lescuyer *)
val why_filename : string list
This diff is collapsed.
......@@ -90,6 +90,14 @@ module Mstr = Map.Make(String)
(* Set, Map, Hashtbl on structures with a unique tag *)
module type OrderedHash =
sig
type t
val hash : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
end
module OrderedHash (X : Hashweak.Tagged) =
struct
type t = X.t
......@@ -98,6 +106,22 @@ struct
let compare ts1 ts2 = Pervasives.compare (X.tag ts1) (X.tag ts2)
end
module OrderedHashList (X : Hashweak.Tagged) =
struct
type t = X.t list
let hash = Hashcons.combine_list X.tag 3
let equal tsl1 tsl2 =
try List.for_all2 (fun ts1 ts2 -> X.tag ts1 = X.tag ts2) tsl1 tsl2
with Invalid_argument _ -> false
let rec compare ts1 ts2 = match ts1,ts2 with
| [], [] -> 0
| [], _ -> -1
| _ , [] -> 1
| a1::l1, a2::l2 ->
let c = Pervasives.compare (X.tag a1) (X.tag a2) in
if c != 0 then c else compare l1 l2
end
module StructMake (X : Hashweak.Tagged) =
struct
module T = OrderedHash(X)
......@@ -107,6 +131,7 @@ struct
module W = Hashweak.Make(X)
end
(* memoization *)
let memo ?(size=17) f =
......
......@@ -78,14 +78,18 @@ module Mstr : Map.S with type key = string
(* Set, Map, Hashtbl on structures with a unique tag *)
open Hashweak
module OrderedHash (X : Tagged) :
module type OrderedHash =
sig
type t = X.t
type t
val hash : t -> int
val equal : t -> t -> bool
val compare : t -> t -> int
end
module OrderedHash (X : Tagged) : OrderedHash with type t = X.t
module OrderedHashList (X : Tagged) : OrderedHash with type t = X.t list
module StructMake (X : Tagged) :
sig
module S : Set.S with type elt = X.t
......
......@@ -22,6 +22,17 @@ name = "Z3"
command = "why3-cpulimit %t %m z3 -smt %f 2>&1"
driver = "drivers/z3.drv"
[prover cvc3_inst]
name = "CVC3"
command = "why3-cpulimit 0 %m cvc3 -timeout %t -lang smt %f 2>&1"
driver = "drivers/cvc3_inst.drv"
[prover z3_inst]
name = "Z3"
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