Commit f6d5509e authored by Francois Bobot's avatar Francois Bobot

- Transformation pour remplacer une definition par un axiome

 - Transformation réalisant l'encodage de Stéphane
parent e3b916dc
......@@ -128,7 +128,8 @@ PARSER_CMO := parser.cmo lexer.cmo denv.cmo typing.cmo
PARSER_CMO := $(addprefix src/parser/,$(PARSER_CMO))
TRANSFORM_CMO := simplify_recursive_definition.cmo inlining.cmo\
split_conjunction.cmo encoding_decorate.cmo
split_conjunction.cmo encoding_decorate.cmo\
remove_logic_definition.cmo
TRANSFORM_CMO := $(addprefix src/transform/,$(TRANSFORM_CMO))
DRIVER_CMO := call_provers.cmo dynlink_compat.cmo driver_parser.cmo\
......
......@@ -2,6 +2,7 @@ printer "why3"
filename "%f-%t-%s.why"
transformations
"remove_logic_definition"
"encoding_decorate"
end
......
......@@ -42,6 +42,27 @@ theory Split_conj
end
theory TestEnco
use import prelude.Int
type 'a mytype
logic id(x: int) : int = x
logic id2(x: int) : int = id(x)
logic succ(x:int) : int = id(x+1)
logic even(x: int) = 2*(x/2) = x
clone ThA with type test = int, logic test = (-_)
goal G : (forall x:int. x=x) or
(forall x:int. x=x+1)
logic p('a ) : 'a mytype
logic p2('a mytype) : 'a
axiom A1 : forall x : 'a mytype. p(p2(x)) = x
goal G2 : forall x:int. p2(p(x)) = x
end
(*
Local Variables:
compile-command: "make -C .. test"
......
This diff is collapsed.
(**************************************************************************)
(* *)
(* 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 decl d =
match d.d_node with
| Dtype _ -> [d]
| Dlogic l ->
let f (accls,accdef) (ls,def) =
let accls =(create_logic_decl [ls,None])::accls in
match def with
| None -> accls,accdef
| Some ls_defn ->
let fmla = ls_defn_axiom ls_defn in
let prsymbol = create_prsymbol (id_clone ls.ls_name) in
accls,(create_prop_decl Paxiom prsymbol fmla)::accdef in
let accls,accdef = (List.fold_left f ([],[]) l) in
(List.rev_append accls) accdef
| Dind _ -> [d]
| Dprop _ -> [d]
let t = Register.store (fun () -> Trans.decl decl None)
let () = Driver.register_transform "remove_logic_definition" 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. *)
(* *)
(**************************************************************************)
val decl : Decl.decl -> Decl.decl list
val t : Task.task Register.trans_reg
......@@ -40,10 +40,22 @@ struct
let find h e = Hashtbl.find h.ht (S.tag e)
let mem h e = Hashtbl.mem h.ht (S.tag e)
exception AlreadyBounded
let add h e v =
let tag = S.tag e in
let mem = Hashtbl.mem h.ht tag in
Hashtbl.replace h.ht tag v;
if not mem then Gc.finalise h.final e
if Hashtbl.mem h.ht tag
then raise AlreadyBounded
else begin
Gc.finalise h.final e;
Hashtbl.replace h.ht tag v
end
end
......@@ -29,7 +29,13 @@ sig
(* find the value binded to a key.
raise Not_found if there is no binding *)
val mem : 'a t -> X.t -> bool
(* test if a key bind to something.*)
exception AlreadyBounded
val add : 'a t -> X.t -> 'a -> unit
(* bind the key with the value given.
It replace previous binding *)
It raises AlreadyBounded if a bound exists
*)
end
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