Commit cd251cd9 authored by Andrei Paskevich's avatar Andrei Paskevich

rewrite Encoding_decorate to use Libencoding

parent 7955d8e4
This diff is collapsed.
......@@ -17,9 +17,3 @@
(* *)
(**************************************************************************)
(** A transformation between polymorphic logic and multi-sorted logic*)
(** {{: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
......@@ -114,28 +114,15 @@ module Transform = struct
in
[Decl.create_logic_decl (List.map helper decls)]
(** transforms a closed formula *)
let sentence_transform fmla =
let type_vars = f_ty_freevars Stv.empty fmla in
let varM = Stv.fold (* create a vsymbol for each type var *)
(fun x m -> Mtv.add x (create_vsymbol (id_fresh "t") ty_type) m)
type_vars Mtv.empty in
(* Debug.print_mtv Pretty.print_vs Format.err_formatter varM;
Format.eprintf "-----------@."; *)
(*universal quantification over ty vars*)
let new_fmla = fmla_transform varM fmla in
let vars = Mtv.fold (fun _ value acc -> value::acc) varM [] in
f_forall_close vars [] new_fmla
(** transform an inductive declaration *)
let ind_transform idl =
let iconv (pr,f) = pr, sentence_transform f in
let iconv (pr,f) = pr, Libencoding.f_type_close fmla_transform f in
let conv (ls,il) = findL ls, List.map iconv il in
[Decl.create_ind_decl (List.map conv idl)]
(** transforms a proposition into another (mostly a substitution) *)
let prop_transform (prop_kind, prop_name, fmla) =
let quantified_fmla = sentence_transform fmla in
let prop_transform (prop_kind, prop_name, f) =
let quantified_fmla = Libencoding.f_type_close fmla_transform f in
[Decl.create_prop_decl prop_kind prop_name quantified_fmla]
end
......
......@@ -126,8 +126,6 @@ let print_env fmt menv =
type tvar = ty Mtv.t
let why_filename = Encoding_decorate.why_filename
let rec projty menv tvar ty =
let rec aux ty =
match ty.ty_node with
......
......@@ -49,6 +49,14 @@ let rec term_of_ty tvmap ty = match ty.ty_node with
| Tyapp (ts,tl) ->
t_app (ls_of_ts ts) (List.map (term_of_ty tvmap) tl) ty_type
(* rewrite a closed formula modulo its free typevars *)
let f_type_close fn f =
let tvs = f_ty_freevars Stv.empty f in
let get_vs tv = create_vsymbol (id_clone tv.tv_name) ty_type in
let tvm = Stv.fold (fun v m -> Mtv.add v (get_vs v) m) tvs Mtv.empty in
let vl = Mtv.fold (fun _ vs acc -> vs::acc) tvm [] in
f_forall_close_simp vl [] (fn tvm f)
(* convert a type declaration to a list of lsymbol declarations *)
let lsdecl_of_tydecl tdl =
let add td acc = match td with
......
......@@ -39,6 +39,9 @@ val is_ls_of_ts : lsymbol -> bool
(* convert a type to a term of type ty_type *)
val term_of_ty : vsymbol Mtv.t -> ty -> term
(* rewrite a closed formula modulo its free typevars *)
val f_type_close : (vsymbol Mtv.t -> fmla -> fmla) -> fmla -> fmla
(* convert a type declaration to a list of lsymbol declarations *)
val lsdecl_of_tydecl : ty_decl list -> decl list
......
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