Attention une mise à jour du service Gitlab va être effectuée le mardi 18 janvier (et non lundi 17 comme annoncé précédemment) entre 18h00 et 18h30. Cette mise à jour va générer une interruption du service dont nous ne maîtrisons pas complètement la durée mais qui ne devrait pas excéder quelques minutes.

Commit 9e1f0bda authored by Andrei Paskevich's avatar Andrei Paskevich
Browse files

- removal of "let" was already implemented by Francois,

  move this implementation to eliminate_let.
- initial commit of eliminate_definition : the goal is
  to translate definitions by match into series of axioms.
parent 17f75f4d
......@@ -134,7 +134,7 @@ TRANSFORM_CMO := simplify_recursive_definition.cmo inlining.cmo\
split_conjunction.cmo encoding_decorate.cmo\
remove_logic_definition.cmo eliminate_inductive.cmo\
compile_match.cmo eliminate_algebraic.cmo\
eliminate_let.cmo
eliminate_definition.cmo eliminate_let.cmo
TRANSFORM_CMO := $(addprefix src/transform/,$(TRANSFORM_CMO))
DRIVER_CMO := call_provers.cmo dynlink_compat.cmo driver_parser.cmo\
......
......@@ -15,7 +15,7 @@ fail "typing error:\\(.*\\)$" "Failure : File generation error : \\1"
(* À discuter *)
transformations
"simplify_recursive_definition"
"inline_let"
"eliminate_let"
"inline_trivial"
(*"split_goal_pos_neg_goal"*) "split_goal_pos_neg_all"
end
......
......@@ -2,8 +2,9 @@ printer "why3"
filename "%f-%t-%s.why"
transformations
"eliminate_inductive"
"compile_match"
"eliminate_definition"
"eliminate_inductive"
"eliminate_algebraic"
"eliminate_let"
end
......
(**************************************************************************)
(* *)
(* Copyright (C) 2010- *)
(* Francois Bobot *)
(* Jean-Christophe Filliatre *)
(* Johannes Kanig *)
(* 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. *)
(* *)
(**************************************************************************)
open Ident
open Term
open Decl
let add_ls acc (ls,_) = create_logic_decl [ls,None] :: acc
let add_ld acc ls ld =
let id = ls.ls_name.id_long ^ "_def" in
let pr = create_prsymbol (id_derive id ls.ls_name) in
create_prop_decl Paxiom pr (ls_defn_axiom ld) :: acc
let add_ld acc (ls,ld) = match ld with
| None -> acc
| Some ld -> add_ld acc ls ld
let elim d = match d.d_node with
| Dlogic ll ->
let dl = List.fold_left add_ls [] ll in
let dl = List.fold_left add_ld dl ll in
List.rev dl
| _ -> [d]
let elim = Register.store (fun () -> Trans.decl elim None)
let () = Driver.register_transform "eliminate_definition" elim
......@@ -19,19 +19,31 @@
open Term
let rec rewriteT t = match t.t_node with
| Tlet (t,tb) ->
let v,e = t_open_bound tb in
rewriteT (t_subst_single v t e)
| _ -> t_map rewriteT rewriteF t
let rec rewrite_t map t =
match t.t_node with
| Tlet (t1,tb) ->
let t1 = rewrite_t map t1 in
let vs,t2 = t_open_bound tb in
rewrite_t (Mvs.add vs t1 map) t2
| Tvar vs ->
begin try
Mvs.find vs map
with Not_found -> t end
| _ -> t_map (rewrite_t map) (rewrite_f map) t
and rewriteF f = match f.f_node with
| Flet (t,fb) ->
let v,e = f_open_bound fb in
rewriteF (f_subst_single v t e)
| _ -> f_map rewriteT rewriteF f
and rewrite_f map f =
match f.f_node with
| Flet (t1,fb) ->
let t1 = rewrite_t map t1 in
let vs,f2 = f_open_bound fb in
rewrite_f (Mvs.add vs t1 map) f2
| _ -> f_map (rewrite_t map) (rewrite_f map) f
let comp = Register.store (fun () -> Trans.rewrite rewriteT rewriteF None)
let remove_let_t = rewrite_t Mvs.empty
let remove_let_f = rewrite_f Mvs.empty
let () = Driver.register_transform "eliminate_let" comp
let eliminate_let =
Register.store (fun () -> Trans.rewrite remove_let_t remove_let_f None)
let () = Driver.register_transform "eliminate_let" eliminate_let
......@@ -17,3 +17,8 @@
(* *)
(**************************************************************************)
val remove_let_t : Term.term -> Term.term
val remove_let_f : Term.fmla -> Term.fmla
val eliminate_let : Task.task Register.trans_reg
......@@ -134,33 +134,3 @@ let () =
Driver.register_transform "inline_all" all;
Driver.register_transform "inline_trivial" trivial
(* Let inlining *)
let rec rewrite_t map t =
match t.t_node with
| Tlet (t1,tb) ->
let t1 = rewrite_t map t1 in
let vs,t2 = t_open_bound tb in
rewrite_t (Mvs.add vs t1 map) t2
| Tvar vs ->
begin try
Mvs.find vs map
with Not_found -> t end
| _ -> t_map (rewrite_t map) (rewrite_f map) t
and rewrite_f map f =
match f.f_node with
| Flet (t1,fb) ->
let t1 = rewrite_t map t1 in
let vs,f2 = f_open_bound fb in
rewrite_f (Mvs.add vs t1 map) f2
| _ -> f_map (rewrite_t map) (rewrite_f map) f
let remove_let_t = rewrite_t Mvs.empty
let remove_let_f = rewrite_f Mvs.empty
let inline_let =
Register.store (fun () -> Trans.rewrite remove_let_t remove_let_f None)
let () = Driver.register_transform "inline_let" inline_let
......@@ -36,11 +36,6 @@ val all : Task.task Register.trans_reg
val trivial : Task.task Register.trans_reg
(* Inline let *)
val remove_let_t : Term.term -> Term.term
val remove_let_f : Term.fmla -> Term.fmla
val inline_let : Task.task Register.trans_reg
(* Function to use in other transformations if inlining is needed *)
type env
......
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