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 syntaxe
------- -------
...@@ -13,10 +24,10 @@ syntaxe ...@@ -13,10 +24,10 @@ syntaxe
match ... with 0 :: r -> ... | ... match ... with 0 :: r -> ... | ...
sémantique sémantique
---------- ----------
- env should not contain theories under the null path. - env should not contain theories under the null path.
The current implementation of Typing.find_theory is potentially broken. The current implementation of Typing.find_theory is potentially broken.
- should split_goal provide a "right-hand side only split"? - should split_goal provide a "right-hand side only split"?
...@@ -28,16 +39,16 @@ s ...@@ -28,16 +39,16 @@ s
is not changed by a transformation, it will stay in the hash table forever, 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 since the key is the value. Should we use generation numbers in arguments
and results of transformations? 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. 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 What we should do is a way to remove the task from a session when
they are not needed anymore. they are not needed anymore.
- uses : pour l'instant, l'ordre des théories dans le fichier est important - 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 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 - open (et échouer si "open A" et "open B" avec A et B déclarant un symbole
de même nom) de même nom)
error reporting error reporting
--------------- ---------------
...@@ -60,4 +71,4 @@ tools ...@@ -60,4 +71,4 @@ tools
than reported in the configuration than reported in the configuration
- Maybe : make something generic for the dialog box with memory. - Maybe : make something generic for the dialog box with memory.
- autodetection can be modified now that only name/version/altern - autodetection can be modified now that only name/version/altern
are taken into account in session. are taken into account in session.
\ No newline at end of file
...@@ -214,7 +214,11 @@ let spec_vars varm variant pre post xpost eff result = ...@@ -214,7 +214,11 @@ let spec_vars varm variant pre post xpost eff result =
raise (UnboundException (Sexn.choose badex)); raise (UnboundException (Sexn.choose badex));
Mvs.fold (fun vs _ m -> add_vs_vars vs m) vsset varm Mvs.fold (fun vs _ m -> add_vs_vars vs m) vsset varm
exception DuplicateArg of pvsymbol
let spec_arrow pvl effect vty = 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 let arg,argl = match List.rev pvl with
| [] -> Loc.errorm "Empty argument list" | [] -> Loc.errorm "Empty argument list"
| arg::argl -> arg, argl in | arg::argl -> arg, argl in
...@@ -460,6 +464,7 @@ type expr = { ...@@ -460,6 +464,7 @@ type expr = {
e_vars : varset Mid.t; e_vars : varset Mid.t;
e_label : Slab.t; e_label : Slab.t;
e_loc : Loc.position option; e_loc : Loc.position option;
e_tag : Hashweak.tag;
} }
and expr_node = and expr_node =
...@@ -502,6 +507,16 @@ and lambda = { ...@@ -502,6 +507,16 @@ and lambda = {
l_xpost : xpost; 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 *) (* smart constructors *)
let e_label ?loc l e = { e with e_label = l; e_loc = loc } 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 = ...@@ -516,15 +531,24 @@ let e_label_copy { e_label = lab; e_loc = loc } e =
exception GhostWrite of expr * region exception GhostWrite of expr * region
exception GhostRaise of expr * xsymbol exception GhostRaise of expr * xsymbol
let mk_expr node vty eff vars = { let mk_expr node vty eff vars c = {
e_node = node; e_node = node;
e_vty = vty; e_vty = vty;
e_effect = if vty_ghost vty then eff_ghostify eff else eff; e_effect = if vty_ghost vty then eff_ghostify eff else eff;
e_vars = vars; e_vars = vars;
e_label = Slab.empty; e_label = Slab.empty;
e_loc = None; 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_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 let add_e_vars e m = varmap_union e.e_vars m
......
...@@ -133,6 +133,7 @@ type val_decl = private { ...@@ -133,6 +133,7 @@ type val_decl = private {
val create_val : Ident.preid -> type_v -> val_decl val create_val : Ident.preid -> type_v -> val_decl
exception DuplicateArg of pvsymbol
exception UnboundException of xsymbol exception UnboundException of xsymbol
(** patterns *) (** patterns *)
...@@ -177,6 +178,7 @@ type expr = private { ...@@ -177,6 +178,7 @@ type expr = private {
e_vars : varset Mid.t; e_vars : varset Mid.t;
e_label : Slab.t; e_label : Slab.t;
e_loc : Loc.position option; e_loc : Loc.position option;
e_tag : Hashweak.tag;
} }
and expr_node = private and expr_node = private
...@@ -224,6 +226,11 @@ and variant = { ...@@ -224,6 +226,11 @@ and variant = {
v_rel : lsymbol option; (* tau tau : prop *) 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 : ?loc:Loc.position -> Slab.t -> expr -> expr
val e_label_add : label -> expr -> expr val e_label_add : label -> expr -> expr
val e_label_copy : expr -> expr -> expr val e_label_copy : expr -> expr -> expr
......
...@@ -470,5 +470,7 @@ let () = Exn_printer.register ...@@ -470,5 +470,7 @@ let () = Exn_printer.register
| Mlw_expr.UnboundException xs -> | Mlw_expr.UnboundException xs ->
fprintf fmt "This function raises %a but does not \ fprintf fmt "This function raises %a but does not \
specify a post-condition for it" print_xs xs 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 | _ -> raise exn
end 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