Commit c9f1ab6b authored by Francois Bobot's avatar Francois Bobot

driver utilise maintenant en interne des context list Transform.t

dans les drivers il n'y a qu'une seul liste de transformations
parent 8874bce9
...@@ -128,7 +128,7 @@ PARSER_CMO := parser.cmo lexer.cmo typing.cmo ...@@ -128,7 +128,7 @@ PARSER_CMO := parser.cmo lexer.cmo typing.cmo
PARSER_CMO := $(addprefix src/parser/,$(PARSER_CMO)) PARSER_CMO := $(addprefix src/parser/,$(PARSER_CMO))
TRANSFORM_CMO := simplify_recursive_definition.cmo inlining.cmo\ TRANSFORM_CMO := simplify_recursive_definition.cmo inlining.cmo\
split_conjunction.cmo split_conjunction.cmo split_goals.cmo
TRANSFORM_CMO := $(addprefix src/transform/,$(TRANSFORM_CMO)) TRANSFORM_CMO := $(addprefix src/transform/,$(TRANSFORM_CMO))
DRIVER_CMO := call_provers.cmo driver_parser.cmo driver_lexer.cmo driver.cmo DRIVER_CMO := call_provers.cmo driver_parser.cmo driver_lexer.cmo driver.cmo
......
...@@ -4,6 +4,6 @@ printer "helloworld" ...@@ -4,6 +4,6 @@ printer "helloworld"
filename "%f-%t-%s.hw" filename "%f-%t-%s.hw"
apply_after_split_goals transformations
"helloworld" "helloworld"
end end
\ No newline at end of file
...@@ -2,8 +2,6 @@ open Term ...@@ -2,8 +2,6 @@ open Term
open Termlib open Termlib
open Theory open Theory
open Transform
let prelude = ["prelude"] let prelude = ["prelude"]
let array = "Array" let array = "Array"
let store = ["store"] let store = ["store"]
......
...@@ -13,11 +13,9 @@ unknown "I don't know" "Unknown" ...@@ -13,11 +13,9 @@ unknown "I don't know" "Unknown"
fail "typing error:\\(.*\\)$" "Failure : File generation error : \\1" fail "typing error:\\(.*\\)$" "Failure : File generation error : \\1"
(* À discuter *) (* À discuter *)
apply_before_split_goals transformations
"split_conjunction"
end
apply_after_split_goals
"simplify_recursive_definition" "simplify_recursive_definition"
"split_conjunction"
"inline_trivial" "inline_trivial"
end end
......
...@@ -2,7 +2,7 @@ printer "why3" ...@@ -2,7 +2,7 @@ printer "why3"
filename "%f-%t-%s.why" filename "%f-%t-%s.why"
(* À discuter *) (* À discuter *)
apply_before_split_goals transformations
"simplify_recursive_definition" "simplify_recursive_definition"
"inline_all" "inline_all"
end end
......
...@@ -2,7 +2,7 @@ printer "why3" ...@@ -2,7 +2,7 @@ printer "why3"
filename "%f-%t-%s.why" filename "%f-%t-%s.why"
(* À discuter *) (* À discuter *)
apply_before_split_goals transformations
"split_conjunction" "split_conjunction"
end end
......
...@@ -136,10 +136,9 @@ let transform env l = ...@@ -136,10 +136,9 @@ let transform env l =
let extract_goals = let extract_goals =
let split_goals = Transform.split_goals () in let split_goals = Split_goals.t () in
fun env drv acc th -> fun env drv acc th ->
let ctxt = Context.use_export (Context.init_context env) th in let ctxt = Context.use_export (Context.init_context env) th in
let ctxt = Driver.apply_before_split drv ctxt in
let l = Transform.apply split_goals ctxt in let l = Transform.apply split_goals ctxt in
let l = List.rev_map (fun ctxt -> (th,ctxt)) l in let l = List.rev_map (fun ctxt -> (th,ctxt)) l in
List.rev_append l acc List.rev_append l acc
...@@ -193,9 +192,11 @@ let do_file env drv filename_printer file = ...@@ -193,9 +192,11 @@ let do_file env drv filename_printer file =
| Dprop (_,pr',_) -> pr == pr' | Dprop (_,pr',_) -> pr == pr'
| _ -> assert false) goals in | _ -> assert false) goals in
(* Apply transformations *) (* Apply transformations *)
let goals = List.map let goals = List.fold_left
(fun (th,ctxt) -> (th,Driver.apply_after_split drv ctxt)) (fun acc (th,ctxt) ->
goals in List.rev_append
(List.map (fun e -> (th,e)) (Driver.apply_transforms drv ctxt)
) acc) [] goals in
(* Pretty-print the goals or call the prover *) (* Pretty-print the goals or call the prover *)
match !output with match !output with
| None (* we are in the call mode *) -> | None (* we are in the call mode *) ->
......
...@@ -126,8 +126,7 @@ and driver = { ...@@ -126,8 +126,7 @@ and driver = {
drv_prover : Call_provers.prover; drv_prover : Call_provers.prover;
drv_prelude : string option; drv_prelude : string option;
drv_filename : string option; drv_filename : string option;
drv_beforesplit : Transform.ctxt_t list; drv_transforms : Transform.ctxt_list_t;
drv_aftersplit : Transform.ctxt_t list;
drv_rules : theory_rules list; drv_rules : theory_rules list;
drv_thprelude : string Hid.t; drv_thprelude : string Hid.t;
(* the first is the translation only for this ident, the second is also for representant *) (* the first is the translation only for this ident, the second is also for representant *)
...@@ -145,10 +144,12 @@ let print_driver fmt driver = ...@@ -145,10 +144,12 @@ let print_driver fmt driver =
(** registering transformation *) (** registering transformation *)
let (transforms : (string, unit -> Transform.ctxt_t) Hashtbl.t) = Hashtbl.create 17 let (transforms : (string, unit -> Transform.ctxt_list_t) Hashtbl.t)
= Hashtbl.create 17
let register_transform name transform = Hashtbl.replace transforms name transform
let register_transform' name transform = Hashtbl.replace transforms name transform
let register_transform name t = register_transform' name
(fun () -> Transform.singleton (t ()))
let list_transforms () = Hashtbl.fold (fun k _ acc -> k::acc) transforms [] let list_transforms () = Hashtbl.fold (fun k _ acc -> k::acc) transforms []
(** registering printers *) (** registering printers *)
...@@ -283,8 +284,7 @@ let load_driver file env = ...@@ -283,8 +284,7 @@ let load_driver file env =
let call_stdin = ref None in let call_stdin = ref None in
let call_file = ref None in let call_file = ref None in
let filename = ref None in let filename = ref None in
let beforesplit = ref None in let ltransforms = ref None in
let aftersplit = ref None in
let regexps = ref [] in let regexps = ref [] in
let set_or_raise loc r v error = let set_or_raise loc r v error =
if !r <> None then errorm ~loc "duplicate %s" error if !r <> None then errorm ~loc "duplicate %s" error
...@@ -304,8 +304,7 @@ let load_driver file env = ...@@ -304,8 +304,7 @@ let load_driver file env =
| RegexpUnknown (s1,s2) -> regexps:=(s1,Unknown s2)::!regexps | RegexpUnknown (s1,s2) -> regexps:=(s1,Unknown s2)::!regexps
| RegexpFailure (s1,s2) -> regexps:=(s1,Failure s2)::!regexps | RegexpFailure (s1,s2) -> regexps:=(s1,Failure s2)::!regexps
| Filename s -> set_or_raise loc filename s "filename" | Filename s -> set_or_raise loc filename s "filename"
| Beforesplit s -> set_or_raise loc beforesplit s "beforesplit" | Transforms s -> set_or_raise loc ltransforms s "transform"
| Aftersplit s -> set_or_raise loc aftersplit s "aftersplit"
| Plugin files -> load_plugin (Filename.dirname file) files | Plugin files -> load_plugin (Filename.dirname file) files
in in
List.iter add f.f_global; List.iter add f.f_global;
...@@ -313,11 +312,15 @@ let load_driver file env = ...@@ -313,11 +312,15 @@ let load_driver file env =
let trans r = let trans r =
let transformations = match !r with let transformations = match !r with
| None -> [] | Some l -> l in | None -> [] | Some l -> l in
List.map (fun (loc,s) -> try (Hashtbl.find transforms s) () List.fold_left
with Not_found -> errorm ~loc "unknown transformation %s" s) (fun acc (loc,s) ->
transformations in let t =
let beforesplit = trans beforesplit in try (Hashtbl.find transforms s) ()
let aftersplit = trans aftersplit in with Not_found -> errorm ~loc "unknown transformation %s" s in
Transform.compose' acc t
)
Transform.identity' transformations in
let transforms = trans ltransforms in
{ drv_printer = !printer; { drv_printer = !printer;
drv_context = Context.init_context env; drv_context = Context.init_context env;
drv_prover = {Call_provers.pr_call_stdin = !call_stdin; drv_prover = {Call_provers.pr_call_stdin = !call_stdin;
...@@ -325,8 +328,7 @@ let load_driver file env = ...@@ -325,8 +328,7 @@ let load_driver file env =
pr_regexps = regexps}; pr_regexps = regexps};
drv_prelude = !prelude; drv_prelude = !prelude;
drv_filename = !filename; drv_filename = !filename;
drv_beforesplit = beforesplit; drv_transforms = transforms;
drv_aftersplit = aftersplit;
drv_rules = f.f_rules; drv_rules = f.f_rules;
drv_thprelude = Hid.create 1; drv_thprelude = Hid.create 1;
drv_theory = Hid.create 1; drv_theory = Hid.create 1;
...@@ -360,12 +362,7 @@ let syntax_arguments s print fmt l = ...@@ -360,12 +362,7 @@ let syntax_arguments s print fmt l =
(** using drivers *) (** using drivers *)
let transform_context list ctxt = let apply_transforms drv = Transform.apply drv.drv_transforms
List.fold_left (fun ctxt t -> Transform.apply t ctxt)
ctxt list
let apply_before_split drv = transform_context drv.drv_beforesplit
let apply_after_split drv = transform_context drv.drv_aftersplit
let print_context drv fmt ctxt = match drv.drv_printer with let print_context drv fmt ctxt = match drv.drv_printer with
| None -> errorm "no printer" | None -> errorm "no printer"
......
...@@ -45,6 +45,7 @@ type printer = driver -> formatter -> context -> unit ...@@ -45,6 +45,7 @@ type printer = driver -> formatter -> context -> unit
val register_printer : string -> printer -> unit val register_printer : string -> printer -> unit
val register_transform : string -> (unit -> Transform.ctxt_t) -> unit val register_transform : string -> (unit -> Transform.ctxt_t) -> unit
val register_transform' : string -> (unit -> Transform.ctxt_list_t) -> unit
val list_printers : unit -> string list val list_printers : unit -> string list
val list_transforms : unit -> string list val list_transforms : unit -> string list
...@@ -52,8 +53,7 @@ val list_transforms : unit -> string list ...@@ -52,8 +53,7 @@ val list_transforms : unit -> string list
(** using drivers *) (** using drivers *)
(** transform context *) (** transform context *)
val apply_before_split : driver -> context -> context val apply_transforms : driver -> context -> context list
val apply_after_split : driver -> context -> context
(** print_context *) (** print_context *)
val print_context : printer val print_context : printer
......
...@@ -47,8 +47,7 @@ type global = ...@@ -47,8 +47,7 @@ type global =
| RegexpUnknown of string * string | RegexpUnknown of string * string
| RegexpFailure of string * string | RegexpFailure of string * string
| Filename of string | Filename of string
| Beforesplit of (loc * string) list | Transforms of (loc * string) list
| Aftersplit of (loc * string) list
| Plugin of (string * string) | Plugin of (string * string)
type file = { type file = {
......
...@@ -45,8 +45,7 @@ ...@@ -45,8 +45,7 @@
"type", TYPE; "type", TYPE;
"prop", PROP; "prop", PROP;
"filename", FILENAME; "filename", FILENAME;
"apply_before_split_goals", BEFORE_SPLIT; "transformations", TRANSFORMS;
"apply_after_split_goals", AFTER_SPLIT;
"plugin", PLUGIN "plugin", PLUGIN
] ]
......
...@@ -32,7 +32,7 @@ ...@@ -32,7 +32,7 @@
%token THEORY END SYNTAX REMOVE TAG PRELUDE PRINTER CALL_ON_FILE CALL_ON_STDIN %token THEORY END SYNTAX REMOVE TAG PRELUDE PRINTER CALL_ON_FILE CALL_ON_STDIN
%token VALID INVALID UNKNOWN FAIL %token VALID INVALID UNKNOWN FAIL
%token UNDERSCORE LEFTPAR RIGHTPAR CLONED DOT EOF %token UNDERSCORE LEFTPAR RIGHTPAR CLONED DOT EOF
%token LOGIC TYPE PROP FILENAME BEFORE_SPLIT AFTER_SPLIT PLUGIN %token LOGIC TYPE PROP FILENAME TRANSFORMS PLUGIN
%type <Driver_ast.file> file %type <Driver_ast.file> file
%start file %start file
...@@ -59,8 +59,7 @@ global: ...@@ -59,8 +59,7 @@ global:
| UNKNOWN STRING STRING { RegexpUnknown ($2, $3) } | UNKNOWN STRING STRING { RegexpUnknown ($2, $3) }
| FAIL STRING STRING { RegexpFailure ($2, $3) } | FAIL STRING STRING { RegexpFailure ($2, $3) }
| FILENAME STRING { Filename $2 } | FILENAME STRING { Filename $2 }
| BEFORE_SPLIT list0_string END { Beforesplit $2 } | TRANSFORMS list0_string END { Transforms $2 }
| AFTER_SPLIT list0_string END { Aftersplit $2 }
| PLUGIN STRING STRING { Plugin ($2,$3) } | PLUGIN STRING STRING { Plugin ($2,$3) }
; ;
......
...@@ -26,7 +26,7 @@ end ...@@ -26,7 +26,7 @@ end
theory Test_conjunction theory Test_conjunction
use import prelude.Int use import prelude.Int
goal G : forall x:int. x*x=4 -> (x*x*x=8 or x*x*x=-8) and x*x*2 = 8 goal G : forall x:int. x*x=4 -> ((x*x*x=8 or x*x*x=-8) and x*x*2 = 8)
end end
......
open Ident
open Term open Term
open Theory open Theory
...@@ -6,11 +7,18 @@ let list_fold_product f acc l1 l2 = ...@@ -6,11 +7,18 @@ let list_fold_product f acc l1 l2 =
(fun acc e1 -> (fun acc e1 ->
List.fold_left List.fold_left
(fun acc e2 -> f acc e1 e2) (fun acc e2 -> f acc e1 e2)
l2 acc) acc l2)
acc l1 acc l1
let rec split_pos split_neg acc f = let rec split_pos split_neg acc f =
let split_pos = split_pos split_neg in let split_pos acc f =
let p = split_pos split_neg acc f in
(* Format.printf "@[<hov 2>f : %a@\n acc : %a :@\n %a@]@."
Pretty.print_fmla f
(Pp.print_list Pp.semi Pretty.print_fmla) acc
(Pp.print_list Pp.semi Pretty.print_fmla) p;*)
p in
match f.f_node with match f.f_node with
| Ftrue -> acc | Ftrue -> acc
| Ffalse -> f::acc | Ffalse -> f::acc
...@@ -79,14 +87,11 @@ let split_pos = split_pos (fun acc x -> x::acc) ...@@ -79,14 +87,11 @@ let split_pos = split_pos (fun acc x -> x::acc)
let elt d = let elt d =
match d.d_node with match d.d_node with
| Dprop (Pgoal,pr,f) -> | Dprop (Pgoal,pr,f) ->
begin let l = split_pos [] f in
try List.map (fun p -> [create_prop_decl Pgoal
let l = split_pos [] f in (create_prop (id_clone (pr_name pr))) p]) l
List.map (fun p -> create_prop_decl Pgoal pr p) l | _ -> [[d]]
with Exit -> [d]
end
| _ -> [d]
let t () = Transform.elt elt let t () = Transform.elt' elt
let () = Driver.register_transform "split_conjunction" t let () = Driver.register_transform' "split_conjunction" t
(**************************************************************************)
(* *)
(* 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 Theory
open Context
let t () =
let f ctxt0 (ctxt,l) =
let decl = ctxt0.ctxt_decl in
match decl.d_node with
| Dprop (Pgoal, _, _) -> (ctxt, add_decl ctxt decl :: l)
| Dprop (Plemma, pr, f) ->
let d1 = create_prop_decl Paxiom pr f in
let d2 = create_prop_decl Pgoal pr f in
(add_decl ctxt d1,
add_decl ctxt d2 :: l)
| _ -> (add_decl ctxt decl, l)
in
let g = Transform.fold f (fun env -> init_context env, []) in
Transform.conv_res g snd
(**************************************************************************)
(* *)
(* 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. *)
(* *)
(**************************************************************************)
val t : unit -> Transform.ctxt_list_t
...@@ -197,21 +197,6 @@ let elt_of_oelt ~ty ~logic ~ind ~prop ~use ~clone d = ...@@ -197,21 +197,6 @@ let elt_of_oelt ~ty ~logic ~ind ~prop ~use ~clone d =
let fold_context_of_decl f ctxt env ctxt_done d = let fold_context_of_decl f ctxt env ctxt_done d =
let env,decls = f ctxt env d in let env,decls = f ctxt env d in
env,List.fold_left add_decl ctxt_done decls env,List.fold_left add_decl ctxt_done decls
let split_goals () =
let f ctxt0 (ctxt,l) =
let decl = ctxt0.ctxt_decl in
match decl.d_node with
| Dprop (Pgoal, _, _) -> (ctxt, add_decl ctxt decl :: l)
| Dprop (Plemma, pr, f) ->
let d1 = create_prop_decl Paxiom pr f in
let d2 = create_prop_decl Pgoal pr f in
(add_decl ctxt d1,
add_decl ctxt d2 :: l)
| _ -> (add_decl ctxt decl, l)
in
let g = fold f (fun env -> init_context env, []) in
conv_res g snd
let remove_lemma = let remove_lemma =
let f d = let f d =
...@@ -235,6 +220,8 @@ let identity = ...@@ -235,6 +220,8 @@ let identity =
{ all = (fun x -> x); { all = (fun x -> x);
clear = (fun () -> ()); } clear = (fun () -> ()); }
let identity' = singleton identity
let rewrite_elt rt rf d = let rewrite_elt rt rf d =
match d.d_node with match d.d_node with
| Dtype _ -> [d] | Dtype _ -> [d]
......
...@@ -37,6 +37,9 @@ val compose' : context list t -> 'a list t -> 'a list t ...@@ -37,6 +37,9 @@ val compose' : context list t -> 'a list t -> 'a list t
val singleton : 'a t -> 'a list t val singleton : 'a t -> 'a list t
val conv_res : 'a t -> ('a -> 'b) -> 'b t
(* There is no memoisation is this only for constant
modification of the result *)
(* apply a transformation and memoise *) (* apply a transformation and memoise *)
val apply : 'a t -> context -> 'a val apply : 'a t -> context -> 'a
...@@ -87,14 +90,13 @@ val elt_env' : (env -> (decl -> decl list list)) -> context list t ...@@ -87,14 +90,13 @@ val elt_env' : (env -> (decl -> decl list list)) -> context list t
(* Utils *) (* Utils *)
val split_goals : unit -> context list t
exception NotGoalContext exception NotGoalContext
val goal_of_ctxt : context -> prop val goal_of_ctxt : context -> prop
(* goal_of_ctxt ctxts return the goal of a goal context (* goal_of_ctxt ctxts return the goal of a goal context
the ctxt must end with a goal.*) the ctxt must end with a goal.*)
val identity : context t val identity : context t
val identity' : context list t
val rewrite_elt : val rewrite_elt :
......
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