Commit d0fdf426 authored by Martin Clochard's avatar Martin Clochard

(WIP) Formalisation de la logique de Why3/API: refonte en cours

parent e88d56f8
module Ctx
(* Variable contexts. *)
use import support.HO
type context 'p 'l
function c_ldom (context 'p 'l) : 'l -> bool
function c_pdom (context 'p 'l) : 'p -> bool
function c_ltp (context 'p 'l) : 'l -> 'p
function c_ptl (context 'p 'l) : 'p -> 'l
axiom context_inv : forall c:context 'p 'l.
maps_to c.c_ldom c.c_ltp c.c_pdom /\
maps_to c.c_pdom c.c_ptl c.c_ldom /\
(forall x. c.c_ldom x -> c.c_ptl (c.c_ltp x) = x) /\
(forall x. c.c_pdom x -> c.c_ltp (c.c_ptl x) = x)
predicate context_inj (c1:context 'p 'l1) (f:'l1 -> 'l2) (c2:context 'p 'l2) =
forall x. c1.c_pdom x -> c2.c_pdom x /\ c2.c_ptl x = f (c1.c_ptl x)
end
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<file name="../context.mlw" expanded="true">
<theory name="Ctx" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
module Not_found
exception Not_found
end
module FMap
use import support.HO
use import support.Finite
use import Not_found
use import option.Option
use mach.peano.Peano as P
(* Program representation of a key. *)
type key
(* Logic representation of a key. The model projection need to be known
here to recover the right modelisation as the assocation maps
depends only on that part of the key. *)
type key_l
function k_m key : key_l
(* Finite associaton table. *)
type t 'a
function domain (t 'a) : key_l -> bool
function bindings (t 'a) : key_l -> 'a
axiom t_inv : forall m:t 'a. finite m.domain
(* Immediate implementation of sets on top of fmap. *)
type s = t unit
val empty () : t 'a
ensures { result.domain = none }
val is_empty (m:t 'a) : bool
ensures { result -> m.domain = none }
ensures { forall x. m.domain x -> not result }
val mem (x:key) (m:t 'a) : bool
ensures { result <-> m.domain (k_m x) }
val add (x:key) (b:'a) (m:t 'a) : t 'a
ensures { result.domain = update m.domain x.k_m true }
ensures { result.bindings = update m.bindings x.k_m b }
val singleton (x:key) (b:'a) : t 'a
ensures { result.domain = update none x.k_m true }
ensures { result.bindings x.k_m = b }
val remove (x:key) (m:t 'a) : t 'a
ensures { result.domain = update m.domain x.k_m false }
ensures { result.bindings = m.bindings }
val cardinal (m:t 'a) : P.t
ensures { finite m.domain }
ensures { result.P.v = cardinal m.domain }
val find (x:key) (m:t 'a) : 'a
ensures { m.domain x.k_m /\ m.bindings x.k_m = result }
raises { Not_found -> not m.domain x.k_m }
val set_union (m1 m2:t 'a) : t 'a
ensures { forall x. result.domain x <-> m1.domain x \/ m2.domain x }
ensures { result.bindings = ho_ite m1.domain m1.bindings m2.bindings }
val set_inter (m1 m2:t 'a) : t 'a
ensures { forall x. result.domain x <-> m1.domain x /\ m2.domain x }
ensures { result.bindings = m1.bindings }
val set_diff (m1 m2:t 'a) : t 'a
ensures { forall x. result.domain x <-> m1.domain x /\ not m2.domain x }
ensures { result.bindings = m1.bindings }
val set_submap (m1 m2:t 'a) : bool
ensures { result <-> subset m1.domain m2.domain }
val set_disjoint (m1 m2:t 'a) : bool
ensures { result <-> forall x. not (m1.domain x /\ m2.domain x) }
val set_equal (m1 m2:t 'a) : bool
ensures { result -> m1.domain = m2.domain }
ensures { forall x. m1.domain x <> m2.domain x -> not result }
val find_def (d:'a) (x:key) (m:t 'a) : 'a
ensures { m.domain x.k_m -> result = m.bindings x.k_m }
ensures { not m.domain x.k_m -> result = d }
val find_opt (x:key) (m:t 'a) : option 'a
ensures { m.domain x.k_m -> result = Some (m.bindings x.k_m) }
ensures { not m.domain x.k_m -> result = None }
ensures { match result with
| None -> not m.domain x.k_m
| Some u -> u = m.bindings x.k_m
end }
val domain (m:t 'a) : s
ensures { result.domain = m.domain }
val is_num_elt (n:P.t) (m:t 'a) : bool
ensures { finite m.domain }
ensures { result <-> cardinal m.domain = n.P.v }
type enumeration 'a
function e_domain (enumeration 'a) : key_l -> bool
function e_bindings (enumeration 'a) : key_l -> 'a
function e_first (enumeration 'a) : key_l
axiom e_inv : forall e:enumeration 'a.
not e.e_domain e.e_first -> e.e_domain = none
val val_enum (e:enumeration 'a) : option (key,'a)
ensures { match result with
| None -> e.e_domain = none
| Some (k0,v) -> k0.k_m = e.e_first /\ v = e.e_bindings k0.k_m /\
e.e_domain k0.k_m
end }
val start_enum (m:t 'a) : enumeration 'a
ensures { result.e_domain = m.domain }
ensures { result.e_bindings = m.bindings }
end
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<file name="../extmap.mlw" expanded="true">
<theory name="Not_found" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="FMap" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
(* Very, very abstract views of strings & Why3 locations:
they are. *)
module String
type string
end
module Loc
type position
end
module Label
use import String
use import Loc
type label model { lab_string : string }
val lab_equal (l1 l2:label) : bool
ensures { result -> l1 = l2 }
ensures { l1.lab_string = l2.lab_string -> result }
val create_label (s:string) : label
ensures { result.lab_string = s }
val lab_string (l:label) : string
ensures { result = l.lab_string }
clone extmap.FMap as Mlab with
type key = label,
type key_l = string,
function k_m = lab_string
end
module Ident
use import int.Int
use import String
use import Loc
use import Label
use import option.Option
use import list.List
use import support.HO
(* Abstract name type. *)
type ident_name
(* Not present in Why3: ghost information allowing to know the
identifier class.
Justification: Why3 library make use of the fact that the same identifier
may be used for only one class of variable: variable symbol,
type symbol, function/predicate symbol, proposition symbol, and
maybe others. This fact is used to build maps that are the reunion of
disjoint maps over those categories. *)
type id_class model { id_class_name : ident_name }
(* Type of set of all classes build yet, and of snapshots
of such classes. Correctness of such specification can be
justified via the use of history invariants (this trick is a mere coding
of it)
Important note about this trick: any mean of countourning the fact
that program values of type id_class are build using this interface
would break its safety. In practice, this impose limitation about
calls to logic function in (ghost) code, (axiomatized default/choice break
this property when applied to non-pure logic type such as id_class).
In this setup, the safe logic functions calls in (ghost) code are:
- any call that instantiate polymorphic variables using
pure logic types only (does not interfere with the program world).
- any call to a logic function defined on top of safe logic functions
(can be lifted to the program world).
- projections & constructors (present in the program world).
*)
type id_class_set model { mutable id_classes : id_class -> bool }
type id_class_snapshot model { id_classes_s : id_class -> bool }
val ghost idcls : id_class_set
val ghost id_class_snapshot () : id_class_snapshot
ensures { result.id_classes_s = idcls.id_classes }
val ghost id_classes_growth (id0:id_class_snapshot) : unit
ensures { subset id0.id_classes_s idcls.id_classes }
val ghost id_class_inv (idc:id_class) : unit
ensures { idcls.id_classes idc }
val ghost fresh_id_class () : id_class
writes { idcls }
ensures { not (old idcls).id_classes result }
ensures { subset (old idcls).id_classes idcls.id_classes }
ensures { idcls.id_classes result }
(* Projection. *)
function idn_string ident_name : string
type ident model {
id_name : ident_name;
id_label : string -> bool;
id_loc : option position;
(* Not present in Why3 (because ghost): classes to which the identifier
belong, ordered. This allow to build hierarchies of disjoint name
generators on top of identifiers, while being able to easily recover the
disjointness property. *)
id_class : list id_class;
}
function id_string (i:ident) : string = i.id_name.idn_string
val id_string (i:ident) : string
ensures { result = i.id_string }
val id_label (i:ident) : Mlab.s
ensures { result.Mlab.domain = i.id_label }
val id_loc (i:ident) : option position
ensures { result = i.id_loc }
type preid = {
pre_name : string;
pre_label : Mlab.s;
pre_loc : option position;
}
(* Similar mechanism for identifier generation. *)
type id_set model { mutable ids : ident_name -> bool }
type id_set_snapshot model { ids_s : ident_name -> bool }
val ghost ids : id_set
val ghost id_set_snapshot () : id_set_snapshot
ensures { result.ids_s = ids.ids }
val ghost id_set_growth (id0:id_set_snapshot) : unit
ensures { subset id0.ids_s ids.ids }
val ghost id_inv (i:ident) : unit
ensures { ids.ids i.id_name }
val id_equal (i1 i2:ident) : bool
ensures { result -> i1 = i2 }
ensures { i1.id_name = i2.id_name -> result }
val id_register (ghost idc:list id_class) (p:preid) : ident
writes { ids }
ensures { result.id_string = p.pre_name }
ensures { result.id_label = p.pre_label.Mlab.domain }
ensures { result.id_loc = p.pre_loc }
ensures { result.id_class = idc }
ensures { not (old ids).ids result.id_name }
ensures { subset (old ids).ids ids.ids }
ensures { ids.ids result.id_name }
clone extmap.FMap as Mid with
type key = ident,
type key_l = ident_name,
function k_m = id_name
end
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<file name="../ident.mlw" expanded="true">
<theory name="String" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Loc" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Label" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Ident" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
This diff is collapsed.
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<prover id="0" name="Alt-Ergo" version="0.99.1" timelimit="5" memlimit="1000"/>
<file name="../logic_impl.mlw" expanded="true">
<theory name="Ident" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
<theory name="Ty" sum="e6b1a0dadb3900c32ea41aeb7e9bfa0c" expanded="true">
<goal name="WP_parameter sig_world_inv" expl="VC for sig_world_inv" expanded="true">
<proof prover="0"><result status="valid" time="0.08" steps="102"/></proof>
</goal>
<goal name="WP_parameter tyl_inv" expl="VC for tyl_inv">
<proof prover="0"><result status="valid" time="0.19" steps="300"/></proof>
</goal>
</theory>
<theory name="Term" sum="b19687c0bc7def2d6a9d5eca04977811">
<goal name="WP_parameter vl_ty_len_nth" expl="VC for vl_ty_len_nth">
<transf name="split_goal_wp">
<goal name="WP_parameter vl_ty_len_nth.1" expl="1. variant decrease">
<proof prover="0"><result status="valid" time="0.06" steps="24"/></proof>
</goal>
<goal name="WP_parameter vl_ty_len_nth.2" expl="2. postcondition">
<proof prover="0"><result status="valid" time="0.05" steps="15"/></proof>
</goal>
<goal name="WP_parameter vl_ty_len_nth.3" expl="3. postcondition">
<proof prover="0"><result status="valid" time="0.06" steps="128"/></proof>
</goal>
<goal name="WP_parameter vl_ty_len_nth.4" expl="4. postcondition">
<proof prover="0"><result status="valid" time="0.05" steps="8"/></proof>
</goal>
<goal name="WP_parameter vl_ty_len_nth.5" expl="5. postcondition">
<proof prover="0"><result status="valid" time="0.07" steps="29"/></proof>
</goal>
</transf>
</goal>
</theory>
</file>
</why3session>
This diff is collapsed.
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<file name="../logic_theory.mlw" expanded="true">
<theory name="Decl" sum="d41d8cd98f00b204e9800998ecf8427e" expanded="true">
</theory>
</file>
</why3session>
module Sig
use import int.Int
use import logic_syntax.Defs
use import logic_syntax.VarsIn
use import logic_typing.Sig as S
use import support.HO
use import support.Finite
(* Global extensible signature.
With respect to typing signatures,
a new field has been added: the field giving the
number of constructors for a type symbol.
The reason is that Why3 cache a ls_constr field inside logic symbols
that corresponds to the total number of constructors,
so it must be known from the signature modelisation.
*)
type signature model {
mutable sig_m : S.signature;
mutable tsc_n : ty_symbol -> int;
} invariant { sig_wf self.sig_m /\
forall tys. self.sig_m.tys_belong tys ->
let s = self.sig_m.tys_constr tys in
let n0 = self.tsc_n tys in
finite s /\ n0 >= cardinal s /\
(n0 = cardinal s -> self.sig_m.tys_constr_complete tys) }
type signature_s model {
sig_m_s : S.signature;
tsc_n_s : ty_symbol -> int;
} invariant { sig_wf self.sig_m_s /\
forall tys. self.sig_m_s.tys_belong tys ->
let s = self.sig_m_s.tys_constr tys in
let n0 = self.tsc_n_s tys in
finite s /\ n0 >= cardinal s /\
(n0 = cardinal s -> self.sig_m_s.tys_constr_complete tys) }
(* global signature declaration. *)
val ghost global_sig : signature
val ghost global_sig_snapshot () : signature_s
ensures { result.sig_m_s = global_sig.sig_m }
ensures { result.tsc_n_s = global_sig.tsc_n }
val ghost global_sig_growth (s:signature_s) : unit
ensures { let so = s.sig_m_s in let sc = global_sig.sig_m in
sig_inclusion so sc /\
equalizer (tys_alg so) s.tsc_n_s global_sig.tsc_n }
(* Allowed symbols domain, e.g symbol contexts. *)
type sym_context
function d_tys sym_context : ty_symbol -> bool
function d_ls sym_context : lsymbol -> bool
function d_constr sym_context : lsymbol -> bool
axiom sym_context_inv : forall sc ls. sc.d_constr ls -> sc.d_ls ls
predicate sub_sym_context (s1 s2:sym_context) =
subset s1.d_tys s2.d_tys /\
subset s1.d_ls s2.d_ls /\
subset s1.d_constr s2.d_constr
predicate sym_ctx_wf (sig:S.signature) (s:sym_context) =
subset s.d_tys sig.tys_belong /\
subset s.d_ls sig.ls_belong /\
subset s.d_constr sig.ls_constr /\
(forall ls. s.d_ls ls -> ty_vars_in all s.d_tys (sig.ls_ret ls) /\
tyl_vars_in all s.d_tys (sig.ls_args ls))
val ghost sym_bounds (sym_c:sym_context) : unit
ensures { sym_ctx_wf global_sig.sig_m sym_c }
end
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">
<why3session shape_version="4">
<prover id="0" name="Alt-Ergo" version="0.99.1" timelimit="5" memlimit="1000"/>
<file name="../signature.mlw">
<theory name="Sig" sum="c089b6032ff37aa2b364017323261821">
<goal name="WP_parameter sym_closed_inv" expl="VC for sym_closed_inv">
<proof prover="0"><result status="valid" time="0.05" steps="5"/></proof>
</goal>
</theory>
</file>
</why3session>
This diff is collapsed.
module Tv
use import support.HO
use import ident.String
use import ident.Ident
use import ident.Label
use import list.List
use import option.Option
(* Toplevel declaration: ident class of type variables. *)
constant tv_id_class_name : ident_name
val ghost tv_id_class () : id_class
ensures { result.id_class_name = tv_id_class_name }
(* Contexts for type variables. Represents the type variables allowed at
a given location and the correspondance with their models.
TODO: implements a type for general variable contexts, which is
basically a bijection between two domains on different types:
ident_name & int for type variable context,
ident_name & 'a for term variable context. *)
type tv_context
(*function ctv_m tv_context : context *)
function tv_dom tv_context : ident_name -> bool
function tv_fun tv_context : ident_name -> int
function tv_rfun tv_context : int -> ident_name
axiom tv_context_inv : forall ctv id.
ctv.tv_dom id -> ctv.tv_rfun (ctv.tv_fun id) = id
val ghost tv_bounds (ctv:tv_context) : unit
ensures { subset ctv.tv_dom ids.ids }
val ghost tv_make_context (dm:ident_name -> bool)
(fn:ident_name -> int) (rfn:int -> ident_name) : tv_context
requires { forall x. dm x -> rfn (fn x) = x }
ensures { result.tv_dom = dm }
ensures { result.tv_fun = fn }
ensures { result.tv_rfun = rfn }
(* Context injection in another. *)
predicate tv_ctx_inj (tv1:tv_context) (f:int -> int) (tv2:tv_context) =
forall i. tv1.tv_dom i -> tv2.tv_dom i /\ tv2.tv_fun i = f (tv1.tv_fun i)
type tvsymbol
function tv_name tvsymbol : ident
function tv_idn (vty:tvsymbol) : ident_name = vty.tv_name.id_name
axiom tv_inv : forall x. exists y z.
x.tv_name.id_class = Cons y z /\ y.id_class_name = tv_id_class_name
val tv_name (vty:tvsymbol) : ident
ensures { result = vty.tv_name }
val tv_equal (vty1 vty2:tvsymbol) : bool
ensures { vty1.tv_name.id_name = vty2.tv_name.id_name -> result }
ensures { result -> vty1 = vty2 }
val create_tv_symbol (ghost idc:list id_class) (p:preid) : tvsymbol
writes { ids }
ensures { result.tv_name.id_string = p.pre_name }
ensures { result.tv_name.id_label = p.pre_label.Mlab.domain }
ensures { result.tv_name.id_loc = p.pre_loc }
ensures { exists y. result.tv_name.id_class = Cons y idc /\
y.id_class_name = tv_id_class_name }
ensures { not (old ids).ids result.tv_name.id_name }
ensures { subset (old ids).ids ids.ids }
ensures { ids.ids result.tv_name.id_name }
val tv_of_string (s:string) : tvsymbol
writes { ids }
ensures { result.tv_name.id_string = s }
ensures { result.tv_name.id_label = none }
ensures { result.tv_name.id_loc = None }
ensures { exists y. result.tv_name.id_class = Cons y Nil /\
y.id_class_name = tv_id_class_name }
ensures { subset (old ids).ids ids.ids }
ensures { ids.ids result.tv_name.id_name }
end
module Ty
use import logic_syntax.Defs as D
use import logic_syntax.Maps
use import list.List
use import list.Length
use import support.HO
use import support.HOList
use import ident.Ident
use import signature.Sig
use import Tv
constant ts_id_class_name : ident_name
axiom ts_id_class_name_distinct : ts_id_class_name <> tv_id_class_name
val ghost ts_id_class () : id_class
ensures { result.id_class_name = ts_id_class_name }
(* Type symbol may be defined or abstract (expanded alias). *)
type tysymbol
function ts_name tysymbol : ident
function ts_arity tysymbol : int
function ts_abs tysymbol : bool
function ts_m tysymbol : D.ty_symbol
function ts_def tysymbol : D.ty
axiom tv_inv : forall x. exists y z.
x.ts_name.id_class = Cons y z /\ y.id_class_name = ts_id_class_name
function ts_idn (tys:tysymbol) : ident_name = tys.ts_name.id_name
val ts_name (tys:tysymbol) : ident
ensures { result = tys.ts_name }
(* Correspondance from type symbols to identifiers.
FIXME ? using a logical function imply that all identifiers
can be pulled back to a type symbols, e.g that the cardinality
of the ident_name type is lower than the cardinality of the
type symbol type, which is a priori not evident.
(otherwise, type symbol generation simply cannot be implemented)
The other technique is to use a growing map, but this is much
more convoluted. *)
function tys_idn (tys:D.ty_symbol) : ident_name
(* TODO: type symbol generation: function from global signature ty_symbols to
identifiers & reciprocal. *)
(* Context mechanism: a type has sense only in a context. *)
type ty
(* Type context: allowed type variables/symbols and
variable name -> integer correspondance.
From the point of view of types, corresponds to a domain and
an interpretation. *)
type ty_ctx model {
cty_tv : tv_context;
cty_sym : sym_context;
cty_d : ty -> bool;
cty_m : ty -> D.ty;
}
type ty_node =
| Tyvar tvsymbol
| Tyapp tysymbol (list ty)
val ty_var (ghost cty:ty_ctx) (vty:tvsymbol) : ty
requires { cty.cty_tv.tv_dom vty.tv_idn }
ensures { cty.cty_m result = D.TyVar (cty.cty_tv.tv_fun vty.tv_idn) }
ensures { cty.cty_d result }
val ty_app (ghost cty:ty_ctx) (tys:tysymbol) (tyl:list ty) : ty
requires { for_all cty.cty_d tyl /\ length tyl = tys.ts_arity }
requires { if tys.ts_abs
then cty.cty_sym.d_tys tys.ts_m
else false (* TODO: enable application to defined type symbols. *) }
ensures { cty.cty_d result }
ensures { if tys.ts_abs
then cty.cty_m result = D.TyApp tys.ts_m (map cty.cty_m tyl)
else false (* TODO. *) }
(* context creation. *)
val ghost make_ty_ctx (ctv:tv_context) (cts:sym_context) : ty_ctx
ensures { result.cty_tv = ctv /\ result.cty_sym = cts }
(* Context injection in another and effect on model. *)
val ghost ty_ctx_inj (cty1:ty_ctx) (f:int -> int) (cty2:ty_ctx) : ty_ctx
requires { tv_ctx_inj cty1.cty_tv f cty2.cty_tv }
requires { sub_sym_context cty1.cty_sym cty2.cty_sym }
ensures { subset cty1.cty_d cty2.cty_d }
ensures { forall ty. cty1.cty_d ty ->
cty2.cty_m ty = ty_map f id (cty1.cty_m ty) }
val ghost ty_node (ghost cty:ty_ctx) (ty:ty) : ty_node
requires { cty.cty_d ty }
returns { Tyvar vty -> cty.cty_m ty = D.TyVar (cty.cty_tv.tv_fun vty.tv_idn)
| Tyapp tys tyl -> tys.ts_abs /\
cty.cty_m ty = D.TyApp tys.ts_m (map cty.cty_m tyl) /\
for_all cty.cty_d tyl }
end
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE why3session PUBLIC "-//Why3//proof session v5//EN"
"http://why3.lri.fr/why3session.dtd">