Commit 2bfa53fe authored by Andrei Paskevich's avatar Andrei Paskevich

whyml: specification calculation

parent 13edc745
WhyML
-----
- should the API ensure that every psymbol resets the new regions?
Should they be always reset at the last arrow? What if they are
already reset at some earlier arrows, should we reset them again?
- in "val" and "any", when a region rho is written into, but some
subregion rho' of rho is not, should we reset rho' under rho?
In Mlw_typing or in Mlw_expr?
syntaxe
-------
......@@ -13,7 +24,7 @@ syntaxe
match ... with 0 :: r -> ... | ...
sémantique
sémantique
----------
- env should not contain theories under the null path.
......@@ -28,16 +39,16 @@ s
is not changed by a transformation, it will stay in the hash table forever,
since the key is the value. Should we use generation numbers in arguments
and results of transformations?
François -- I don't get that point the weak Hashtbl that we use
François -- I don't get that point the weak Hashtbl that we use
are designed to work on this case, even with the identity function.
What we should do is a way to remove the task from a session when
they are not needed anymore.
- uses : pour l'instant, l'ordre des théories dans le fichier est important
i.e. les théories mentionnées par uses doivent être définies précédemment
- uses : pour l'instant, l'ordre des théories dans le fichier est important
i.e. les théories mentionnées par uses doivent être définies précédemment
- open (et échouer si "open A" et "open B" avec A et B déclarant un symbole
de même nom)
- open (et échouer si "open A" et "open B" avec A et B déclarant un symbole
de même nom)
error reporting
---------------
......
......@@ -214,7 +214,11 @@ let spec_vars varm variant pre post xpost eff result =
raise (UnboundException (Sexn.choose badex));
Mvs.fold (fun vs _ m -> add_vs_vars vs m) vsset varm
exception DuplicateArg of pvsymbol
let spec_arrow pvl effect vty =
let add pv s = Spv.add_new (DuplicateArg pv) pv s in
ignore (List.fold_right add pvl Spv.empty);
let arg,argl = match List.rev pvl with
| [] -> Loc.errorm "Empty argument list"
| arg::argl -> arg, argl in
......@@ -460,6 +464,7 @@ type expr = {
e_vars : varset Mid.t;
e_label : Slab.t;
e_loc : Loc.position option;
e_tag : Hashweak.tag;
}
and expr_node =
......@@ -502,6 +507,16 @@ and lambda = {
l_xpost : xpost;
}
module WSexpr = WeakStructMake (struct
type t = expr
let tag expr = expr.e_tag
end)
module Sexpr = WSexpr.S
module Mexpr = WSexpr.M
module Hexpr = WSexpr.H
module Wexpr = WSexpr.W
(* smart constructors *)
let e_label ?loc l e = { e with e_label = l; e_loc = loc }
......@@ -516,15 +531,24 @@ let e_label_copy { e_label = lab; e_loc = loc } e =
exception GhostWrite of expr * region
exception GhostRaise of expr * xsymbol
let mk_expr node vty eff vars = {
let mk_expr node vty eff vars c = {
e_node = node;
e_vty = vty;
e_effect = if vty_ghost vty then eff_ghostify eff else eff;
e_vars = vars;
e_label = Slab.empty;
e_loc = None;
e_tag = Hashweak.create_tag c;
}
let mk_expr =
let c = ref 0 in fun node vty eff vars ->
incr c; mk_expr node vty eff vars !c
(* FIXME? e_label calls do not refresh the tag. This is safe
as long as we only use tags for "semantical things" such as
extended specification storage in WPs. *)
let add_t_vars t m = Mvs.fold (fun vs _ m -> add_vs_vars vs m) t.t_vars m
let add_e_vars e m = varmap_union e.e_vars m
......
......@@ -133,6 +133,7 @@ type val_decl = private {
val create_val : Ident.preid -> type_v -> val_decl
exception DuplicateArg of pvsymbol
exception UnboundException of xsymbol
(** patterns *)
......@@ -177,6 +178,7 @@ type expr = private {
e_vars : varset Mid.t;
e_label : Slab.t;
e_loc : Loc.position option;
e_tag : Hashweak.tag;
}
and expr_node = private
......@@ -224,6 +226,11 @@ and variant = {
v_rel : lsymbol option; (* tau tau : prop *)
}
module Mexpr : Map.S with type key = expr
module Sexpr : Mexpr.Set
module Hexpr : Hashtbl.S with type key = expr
module Wexpr : Hashweak.S with type key = expr
val e_label : ?loc:Loc.position -> Slab.t -> expr -> expr
val e_label_add : label -> expr -> expr
val e_label_copy : expr -> expr -> expr
......
......@@ -470,5 +470,7 @@ let () = Exn_printer.register
| Mlw_expr.UnboundException xs ->
fprintf fmt "This function raises %a but does not \
specify a post-condition for it" print_xs xs
| Mlw_expr.DuplicateArg pv ->
fprintf fmt "Argument %a is used twice" print_pv pv
| _ -> raise exn
end
This diff is collapsed.
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