Commit f202ddd0 authored by Andrei Paskevich's avatar Andrei Paskevich

Ity: remove restrictions from "strong updates"

parent 5ce1efa8
......@@ -778,7 +778,7 @@ let rec effect_of_term t =
| Some _ -> assert false
| None -> ity in
begin try match ity.ity_node, restore_ps fs with
| Ityreg _, ({ps_mfield = Some _} as ps) -> v, ity, Some ps
| Ityreg _, ({ps_field = Some _} as ps) -> v, ity, Some ps
| _, {ps_cty={cty_args=[arg]; cty_result=res; cty_freeze=frz}} ->
v, ity_full_inst (ity_match frz arg.pv_ity ity) res, None
| _ -> quit () with Not_found -> quit () end
......@@ -797,9 +797,9 @@ let effect_of_dspec dsp =
let add_write (s,l,e) t = match effect_of_term t with
| v, {ity_node = Ityreg reg}, fd ->
let fs = match fd with
| Some fd -> Spv.singleton (Opt.get fd.ps_mfield)
| Some fd -> Spv.singleton (Opt.get fd.ps_field)
| None -> Spv.of_list reg.reg_its.its_mfields in
let wr = eff_write eff_empty reg fs in
let wr = Loc.try3 ?loc:t.t_loc eff_write eff_empty reg fs in
Spv.add v s, (wr,t)::l, eff_union e wr
| _ ->
Loc.errorm ?loc:t.t_loc "mutable expression expected" in
......
......@@ -18,11 +18,11 @@ open Ity
(** {2 Program symbols} *)
type psymbol = {
ps_name : ident;
ps_cty : cty;
ps_ghost : bool;
ps_logic : ps_logic;
ps_mfield : pvsymbol option;
ps_name : ident;
ps_cty : cty;
ps_ghost : bool;
ps_logic : ps_logic;
ps_field : pvsymbol option;
}
and ps_logic =
......@@ -49,11 +49,11 @@ let mk_ps, restore_ps =
let ls_to_ps = Wls.create 17 in
(fun id cty gh lg mf ->
let ps = {
ps_name = id;
ps_cty = cty;
ps_ghost = gh;
ps_logic = lg;
ps_mfield = mf;
ps_name = id;
ps_cty = cty;
ps_ghost = gh;
ps_logic = lg;
ps_field = mf;
} in
match lg with
| PLls ls -> Wls.set ls_to_ps ls ps; ps
......@@ -142,9 +142,10 @@ let create_psymbol id ?(ghost=false) ?(kind=PKnone) c =
check_effects c;
mk_ps (id_register id) c ghost PLlemma None
let create_mutable_field id s v =
if not (List.exists (fun u -> pv_equal u v) s.its_mfields) then
invalid_arg "Expr.create_mutable_field";
let create_field id s v =
if not (List.exists (fun u -> pv_equal u v) s.its_mfields ||
List.exists (fun u -> pv_equal u v) s.its_ifields) then
invalid_arg "Expr.create_field";
let ity = ity_app s (List.map ity_var s.its_ts.ts_args) s.its_regions in
let arg = create_pvsymbol (id_fresh "arg") ity in
let ls = create_fsymbol id [arg.pv_vs.vs_ty] v.pv_vs.vs_ty in
......@@ -507,10 +508,10 @@ let e_app e el ityl ity =
let e_assign_raw al =
let ghost = List.for_all (fun (r,f,v) ->
r.pv_ghost || f.ps_ghost || v.pv_ghost) al in
let conv (r,f,v) = match r.pv_ity.ity_node, f.ps_mfield with
let conv (r,f,v) = match r.pv_ity.ity_node, f.ps_field with
| Ityreg r, Some f -> r, f, v.pv_ity
| Ityreg {reg_its = s}, None -> Loc.errorm
"Type constructor %a has no mutable fields named %s"
"Type constructor %a has no fields named %s"
Ity.print_its s f.ps_name.id_string
| _ -> Loc.errorm "Mutable expression expected" in
let eff = eff_assign eff_empty (List.map conv al) in
......
......@@ -17,11 +17,11 @@ open Ity
(** {2 Program symbols} *)
type psymbol = private {
ps_name : ident;
ps_cty : cty;
ps_ghost : bool;
ps_logic : ps_logic;
ps_mfield : pvsymbol option;
ps_name : ident;
ps_cty : cty;
ps_ghost : bool;
ps_logic : ps_logic;
ps_field : pvsymbol option;
}
and ps_logic =
......@@ -57,7 +57,7 @@ val create_psymbol : preid -> ?ghost:bool -> ?kind:ps_kind -> cty -> psymbol
type must be [ity_bool]. If [?kind] is [PKlemma] and the result
type is not [ity_unit], an existential premise is generated. *)
val create_mutable_field : preid -> itysymbol -> pvsymbol -> psymbol
val create_field : preid -> itysymbol -> pvsymbol -> psymbol
val restore_ps : lsymbol -> psymbol
(** raises [Not_found] if the argument is not a [ps_logic] *)
......
This diff is collapsed.
......@@ -19,11 +19,13 @@ type itysymbol = private {
its_ts : tysymbol; (** pure "snapshot" type symbol *)
its_private : bool; (** is a private/abstract type *)
its_mutable : bool; (** is a record with mutable fields *)
its_mfields : pvsymbol list; (** mutable fields *)
its_mfields : pvsymbol list; (** mutable fields of a mutable type *)
its_ifields : pvsymbol list; (** immutable fields of a mutable type *)
its_regions : region list; (** mutable shareable components *)
its_reg_vis : bool list; (** non-ghost shareable components *)
its_arg_vis : bool list; (** non-ghost type parameters *)
its_arg_upd : bool list; (** updatable type parameters *)
its_arg_exp : bool list; (** exposed type parameters *)
its_def : ity option; (** is a type alias *)
}
......@@ -96,9 +98,9 @@ exception UnboundRegion of region
(** creation of a symbol for type in programs *)
val create_itysymbol :
preid -> (tvsymbol * bool * bool) list ->
preid -> (tvsymbol * bool * bool * bool) list ->
bool -> bool -> (region * bool) list ->
Spv.t -> ity option -> itysymbol
bool Mpv.t -> ity option -> itysymbol
val restore_its : tysymbol -> itysymbol
(** raises [Not_found] if the argument is not a [its_ts] *)
......@@ -159,8 +161,10 @@ val reg_r_fold : ('a -> region -> 'a) -> 'a -> region -> 'a
(** {2 Miscellaneous type utilities} *)
val ity_freevars : Stv.t -> ity -> Stv.t
val reg_freevars : Stv.t -> region -> Stv.t
val ity_v_occurs : tvsymbol -> ity -> bool
val reg_v_occurs : tvsymbol -> region -> bool
val ity_r_occurs : region -> ity -> bool
val reg_r_occurs : region -> region -> bool
......@@ -266,6 +270,10 @@ val eff_union : effect -> effect -> effect
val eff_is_empty : effect -> bool
val eff_is_pure : effect -> bool
exception AssignPrivate of region
exception DuplicateField of region * pvsymbol
exception WriteImmutable of region * pvsymbol
val eff_write : effect -> region -> Spv.t -> effect
val eff_raise : effect -> xsymbol -> effect
val eff_catch : effect -> xsymbol -> effect
......
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