Commit 4ec2b2e9 authored by Andrei Paskevich's avatar Andrei Paskevich

Vc: Eif, Ecase, Eraise

parent 4e3b4673
......@@ -1227,9 +1227,10 @@ let create_cty ?(mask=MaskVisible) args pre post xpost oldies effect result =
let mask = mask_reduce mask in
(* the arguments are pairwise distinct *)
let sarg = List.fold_right (Spv.add_new exn) args Spv.empty in
(* drop unused or empty exceptional postconditions *)
let xpost = Mexn.set_inter xpost effect.eff_raises in
let xpost = Mexn.filter (fun _ l -> l <> []) xpost in
(* add empty and drop unused exceptional postconditions *)
let xpost = Mexn.merge (fun _ x q -> match x, q with
| Some (), Some _ -> q | Some (), None -> Some []
| None, _ -> None) effect.eff_raises xpost in
(* complete the reads and freeze the external context.
oldies must be fresh: collisions with args and external
reads are forbidden, to simplify instantiation later. *)
......@@ -1246,13 +1247,7 @@ let create_cty ?(mask=MaskVisible) args pre post xpost oldies effect result =
let xreads = Spv.diff effect.eff_reads sarg in
let freeze = Spv.fold freeze_pv xreads isb_empty in
check_tvs effect.eff_reads result pre post xpost;
(* remove exceptions whose postcondition is False.
For a given function definition, we ensure both
cty.eff_raises and cty.xpost are in e.eff_raises,
where every postcondition missing in cty.xpost
is handled in a VC-specific way (e.g. as true),
and every exception missing in cty.eff_raises
has a false postcondition in cty.xpost. *)
(* remove exceptions whose postcondition is False *)
let is_false q = match open_post q with
| _, {t_node = Tfalse} -> true | _ -> false in
let filter _ () = function
......
This diff is collapsed.
......@@ -827,13 +827,12 @@ ensures:
raises:
| uqualid ARROW term
{ $1, mk_pat (Ptuple []) $startpos($1) $endpos($1), $3 }
{ $1, Some (mk_pat (Ptuple []) $startpos($1) $endpos($1), $3) }
| uqualid pat_arg ARROW term
{ $1, $2, $4 }
{ $1, Some ($2, $4) }
xsymbol:
| uqualid
{ $1, mk_pat Pwild $startpos $endpos, mk_term Ttrue $startpos $endpos }
| uqualid { $1, None }
invariant:
| INVARIANT LEFTBRC term RIGHTBRC { $3 }
......
......@@ -93,7 +93,7 @@ type variant = (term * qualid option) list
type pre = term
type post = Loc.position * (pattern * term) list
type xpost = Loc.position * (qualid * pattern * term) list
type xpost = Loc.position * (qualid * (pattern * term) option) list
type spec = {
sp_pre : pre list;
......
......@@ -475,12 +475,15 @@ let dpost muc ql lvm old ity =
List.map dpost ql
let dxpost muc ql lvm old =
let add_exn (q,pat,f) m =
let add_exn (q,pf) m =
let xs = find_xsymbol muc q in
Mexn.change (function
| Some l -> Some ((pat,f) :: l)
| None -> Some ((pat,f) :: [])) xs m in
Mexn.change (fun l -> match pf, l with
| Some pf, Some l -> Some (pf :: l)
| Some pf, None -> Some (pf :: [])
| None, None -> Some []
| None, Some _ -> l) xs m in
let mk_xpost loc xs pfl =
if pfl = [] then [] else
dpost muc [loc,pfl] lvm old xs.xs_ity in
let exn_map (loc,xpfl) =
let m = List.fold_right add_exn xpfl Mexn.empty in
......
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