Commit 5ffac0d8 authored by Andrei Paskevich's avatar Andrei Paskevich

whyml: type pre- and post-conditions

parent ff97702a
......@@ -36,9 +36,8 @@ type ident = Ptree.ident
type ghost = bool
type dpre = Ptree.pre
type dpost_fmla = Ptree.lexpr
type dexn_post_fmla = Ptree.lexpr
type dpost = dpost_fmla * (Term.lsymbol * dexn_post_fmla) list
type dpost = Ptree.pre
type dxpost = (xsymbol * dpost) list
type deffect = {
deff_reads : Ptree.lexpr list;
......@@ -79,7 +78,7 @@ and dexpr_desc =
| DEglobal_pl of plsymbol
| DEglobal_ls of Term.lsymbol
| DEapply of dexpr * dexpr list
| DEfun of dbinder list * dtriple
| DEfun of dlambda
| DElet of ident * dexpr * dexpr
| DEletrec of drecfun list * dexpr
| DEassign of dexpr * dexpr
......@@ -97,6 +96,6 @@ and dexpr_desc =
| DEmark of string * dexpr
(* | DEany of dutype_c *)
and drecfun = ident * dity * dbinder list * dvariant list * dtriple
and drecfun = ident * dity * dlambda
and dtriple = dpre * dexpr * dpost
and dlambda = dbinder list * dvariant list * dpre * dexpr * dpost * dxpost
......@@ -192,12 +192,8 @@ and unify_reg r1 r2 =
| Rreg (reg1,_), Rreg (reg2,_) when reg_equal reg1 reg2 -> ()
| _ -> raise Exit
let unify_weak d1 d2 =
try unify ~weak:true d1 d2
with Exit -> raise (TypeMismatch (ity_of_dity d1, ity_of_dity d2))
let unify d1 d2 =
try unify ~weak:false d1 d2
let unify ?(weak=false) d1 d2 =
try unify ~weak d1 d2
with Exit -> raise (TypeMismatch (ity_of_dity d1, ity_of_dity d2))
let ts_arrow =
......
......@@ -43,11 +43,8 @@ val ts_app: tysymbol -> dity list -> dity
val make_arrow_type: dity list -> dity -> dity
val unify: dity -> dity -> unit
(** destructive unification *)
val unify_weak: dity -> dity -> unit
(** destructive unification, ignores regions *)
val unify: ?weak:bool -> dity -> dity -> unit
(** destructive unification, with or without region unification *)
val ity_of_dity: dity -> ity
val vty_of_dity: dity -> vty
......
......@@ -286,6 +286,11 @@ type xpost = post Mexn.t (* exceptional postconditions *)
type assertion_kind = Aassert | Aassume | Acheck
type variant = {
v_term : term; (* : tau *)
v_rel : lsymbol option; (* tau tau : prop *)
}
type expr = {
e_node : expr_node;
e_vty : vty;
......@@ -336,11 +341,6 @@ and lambda = {
l_xpost : xpost;
}
and variant = {
v_term : term; (* : tau *)
v_rel : lsymbol option; (* tau tau : prop *)
}
and any_effect = {
aeff_reads : expr list;
aeff_writes : expr list;
......@@ -489,10 +489,12 @@ let create_fun_defn id lam =
Mexn.iter (fun xs t -> check_post xs.xs_ity t) lam.l_xpost;
(* compute rec_vars and ps.ps_vars *)
let add_term t s = Mvs.set_union t.t_vars s in
let add_variant { v_term = t; v_rel = ps } s =
ignore (Util.option_map (fun ps -> ps_app ps [t;t]) ps);
add_term t s in
let vsset = add_term lam.l_post (add_term lam.l_pre Mvs.empty) in
let vsset = Mexn.fold (fun _ -> add_term) lam.l_xpost vsset in
let vsset =
List.fold_right (fun v -> add_term v.v_term) lam.l_variant vsset in
let vsset = List.fold_right add_variant lam.l_variant vsset in
let add_vs vs _ m = add_vs_vars vs m in
let del_pv m pv = Mid.remove pv.pv_vs.vs_name m in
let recvars = Mvs.fold add_vs vsset lam.l_expr.e_vars in
......
......@@ -119,6 +119,11 @@ type xpost = post Mexn.t (* exceptional postconditions *)
val create_post : vsymbol -> term -> post
val open_post : post -> vsymbol * term
type variant = {
v_term : term; (* : tau *)
v_rel : lsymbol option; (* tau tau : prop *)
}
type expr = private {
e_node : expr_node;
e_vty : vty;
......@@ -169,11 +174,6 @@ and lambda = {
l_xpost : xpost;
}
and variant = {
v_term : term; (* : tau *)
v_rel : lsymbol option; (* tau tau : prop *)
}
(* TODO? Every top region in the type of Eany is reset.
This is enough for our current purposes, but we might
need to be more flexible later. *)
......
This diff is collapsed.
......@@ -31,7 +31,7 @@ module N
let create_dref i = {| dcontents = {| contents = i |} |}
let myfun r =
let myfun r = { r = r }
let rec on_tree t = match t with
| Node {| contents = v |} f -> v + on_forest f
| Leaf -> raise (Exit Leaf)
......@@ -46,6 +46,7 @@ module N
dr.dcontents <- nr;
assert { r = r };
try on_tree r with Exit -> 0 end
{ result = 0 }
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