labels in programs

parent 86fb97c0
......@@ -228,7 +228,7 @@ let rec term env t = match t.dt_node with
let rec collect p ll e = match e.dt_node with
| Tnamed (Lstr l, e) -> collect p (l::ll) e
| Tnamed (Lpos p, e) -> collect (Some p) ll e
| _ -> t_label ?loc:p ll (term env e)
| _ -> t_label ?loc:p (List.rev ll) (term env e)
in
collect None [] t
| Teps (id, ty, e1) ->
......@@ -277,7 +277,7 @@ and fmla env = function
let rec collect p ll = function
| Fnamed (Lstr l, e) -> collect p (l::ll) e
| Fnamed (Lpos p, e) -> collect (Some p) ll e
| e -> t_label ?loc:p ll (fmla env e)
| e -> t_label ?loc:p (List.rev ll) (fmla env e)
in
collect None [] f
| Fvar f ->
......
......@@ -1123,6 +1123,8 @@ expr:
{ mk_expr (Etry ($2, $5)) }
| ANY simple_type_c
{ mk_expr (Eany $2) }
| label expr %prec prec_named
{ mk_expr (Enamed ($1, $2)) }
;
triple:
......
......@@ -230,6 +230,7 @@ and expr_desc =
| Elabel of ident * expr
| Ecast of expr * pty
| Eany of type_c
| Enamed of label * expr
(* TODO: ghost *)
......
......@@ -18,6 +18,7 @@
(**************************************************************************)
open Why3
open Ident
open Denv
open Ty
open Pgm_types
......@@ -38,32 +39,6 @@ type for_direction = Ptree.for_direction
(*****************************************************************************)
(* phase 1: introduction of destructive types *)
(***
type dregion = {
dr_tv : Denv.type_var;
dr_ty : Denv.dty;
}
type deffect = {
de_reads : dregion list;
de_writes : dregion list;
de_raises : esymbol list;
}
type dtype_v =
| DTpure of Denv.dty
| DTarrow of dbinder list * dtype_c
and dtype_c =
{ dc_result_type : dtype_v;
dc_effect : deffect;
dc_pre : Denv.dfmla;
dc_post : (Denv.dty * Denv.dfmla) *
(Term.lsymbol * (Denv.dty option * Denv.dfmla)) list; }
and dbinder = ident * Denv.dty * dtype_v
***)
(* user type_v *)
type dpre = Ptree.pre
......@@ -126,6 +101,7 @@ and dexpr_desc =
| DEassert of assertion_kind * Ptree.lexpr
| DElabel of string * dexpr
| DEany of dutype_c
| DEnamed of Ptree.label * dexpr
and drecfun = (ident * Denv.dty) * dubinder list * dvariant option * dtriple
......@@ -225,6 +201,7 @@ and iexpr_desc =
| IEassert of assertion_kind * Term.term
| IElabel of label * iexpr
| IEany of itype_c
| IEnamed of Ptree.label * iexpr
and irecfun = ivsymbol * ibinder list * irec_variant option * itriple
......@@ -257,6 +234,7 @@ type expr = {
expr_type : ty;
expr_type_v: type_v;
expr_effect: E.t;
expr_lab : Ident.label list;
expr_loc : loc;
}
......
This diff is collapsed.
......@@ -413,9 +413,11 @@ let well_founded_rel = function
(* Recursive computation of the weakest precondition *)
let wp_label ?loc f =
if List.mem "WP" f.t_label then f
else t_label ?loc ("WP"::f.t_label) f
let wp_label ?loc ?(lab=[]) f =
let loc = option_apply f.t_loc (fun x -> Some x) loc in
let lab = lab @ f.t_label in
let lab = if List.mem "WP" lab then lab else "WP" :: lab in
t_label ?loc lab f
let t_True env =
fs_app (find_ls ~pure:true env "True") []
......@@ -436,7 +438,7 @@ let rec wp_expr env rm e q =
let q = post_map (old_label lab) q in
let f = wp_desc env rm e q in
let f = erase_label lab f in
let f = wp_label ~loc:e.expr_loc f in
let f = wp_label ~loc:e.expr_loc ~lab:e.expr_lab f in
if Debug.test_flag debug then begin
eprintf "@[--------@\n@[<hov 2>e = %a@]@\n" Pgm_pretty.print_expr e;
eprintf "@[<hov 2>q = %a@]@\n" Pretty.print_term (snd (fst q));
......@@ -482,7 +484,6 @@ and wp_desc env rm e q = match e.expr_desc with
let q1 = (* if result=True then w2 else w3 *)
let res = v_result e1.expr_type in
let test = t_equ (t_var res) (t_True env) in
let test = wp_label ~loc:e1.expr_loc test in
let q1 = t_if test w2 w3 in
saturate_post e1.expr_effect (res, q1) q
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