whyml: specification calculation

TODO

+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,10 +24,10 @@ syntaxe
        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.
 
   - should split_goal provide a "right-hand side only split"?
@@ -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
 ---------------
@@ -60,4 +71,4 @@ tools
    than reported in the configuration
   - Maybe : make something generic for the dialog box with memory.
   - autodetection can be modified now that only name/version/altern
-   are taken into account in session.
\ No newline at end of file
+   are taken into account in session.

src/whyml/mlw_expr.ml

@@ -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
 

src/whyml/mlw_expr.mli

@@ -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

src/whyml/mlw_pretty.ml

@@ -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