renamed Mexn -> Mxs

src/mlw/dexpr.ml

@@ -375,7 +375,7 @@ type 'a later = pvsymbol Mstr.t -> register_old -> 'a
 type dspec_final = {
   ds_pre     : term list;
   ds_post    : (pvsymbol * term) list;
-  ds_xpost   : (pvsymbol * term) list Mexn.t;
+  ds_xpost   : (pvsymbol * term) list Mxs.t;
   ds_reads   : pvsymbol list;
   ds_writes  : term list;
   ds_diverge : bool;
@@ -775,7 +775,7 @@ let create_invariant pl = List.map to_fmla pl
 let create_post ity ql = List.map (fun (v,f) ->
   ity_equal_check ity v.pv_ity; Ity.create_post v.pv_vs (to_fmla f)) ql
 
-let create_xpost xql = Mexn.mapi (fun xs ql -> create_post xs.xs_ity ql) xql
+let create_xpost xql = Mxs.mapi (fun xs ql -> create_post xs.xs_ity ql) xql
 
 (** User effects *)
 
@@ -815,7 +815,7 @@ let effect_of_dspec dsp =
     | _ ->
         Loc.errorm ?loc:t.t_loc "mutable expression expected" in
   let wl, eff = List.fold_left add_write ([], eff_read pvs) dsp.ds_writes in
-  let eff = Mexn.fold (fun xs _ eff -> eff_raise eff xs) dsp.ds_xpost eff in
+  let eff = Mxs.fold (fun xs _ eff -> eff_raise eff xs) dsp.ds_xpost eff in
   let eff = if dsp.ds_diverge then eff_diverge eff else eff in
   wl, eff
 
@@ -824,8 +824,8 @@ let effect_of_dspec dsp =
 let check_spec inr dsp ecty ({e_loc = loc} as e) =
   let bad_read  reff eff = not (Spv.subset  reff.eff_reads  eff.eff_reads) in
   let bad_write weff eff = not (Mreg.submap (fun _ s1 s2 -> Spv.subset s1 s2)
-                                            weff.eff_writes eff.eff_writes) in
-  let bad_raise xeff eff = not (Sexn.subset xeff.eff_raises eff.eff_raises) in
+                                           weff.eff_writes eff.eff_writes) in
+  let bad_raise xeff eff = not (Sxs.subset xeff.eff_raises eff.eff_raises) in
   (* computed effect vs user effect *)
   let uwrl, ue = effect_of_dspec dsp in
   let ucty = create_cty ecty.cty_args ecty.cty_pre ecty.cty_post
@@ -847,7 +847,7 @@ let check_spec inr dsp ecty ({e_loc = loc} as e) =
       "this@ write@ effect@ does@ not@ happen@ in@ the@ expression") uwrl;
   if check_ue && bad_raise ueff eeff then Loc.errorm ?loc
     "this@ expression@ does@ not@ raise@ exception@ %a"
-    print_xs (Sexn.choose (Sexn.diff ueff.eff_raises eeff.eff_raises));
+    print_xs (Sxs.choose (Sxs.diff ueff.eff_raises eeff.eff_raises));
   if check_ue && ueff.eff_oneway && not eeff.eff_oneway then Loc.errorm ?loc
       "this@ expression@ does@ not@ diverge";
   (* check that every computed effect is listed *)
@@ -858,10 +858,10 @@ let check_spec inr dsp ecty ({e_loc = loc} as e) =
   if check_rw && bad_write eeff ueff then
     Loc.errorm ?loc:(e_locate_effect (fun eff -> bad_write eff ueff) e)
       "this@ expression@ produces@ an@ unlisted@ write@ effect";
-  if ecty.cty_args <> [] && bad_raise eeff ueff then Sexn.iter (fun xs ->
-    Loc.errorm ?loc:(e_locate_effect (fun eff -> Sexn.mem xs eff.eff_raises) e)
+  if ecty.cty_args <> [] && bad_raise eeff ueff then Sxs.iter (fun xs ->
+    Loc.errorm ?loc:(e_locate_effect (fun eff -> Sxs.mem xs eff.eff_raises) e)
       "this@ expression@ raises@ unlisted@ exception@ %a"
-      print_xs xs) (Sexn.diff eeff.eff_raises ueff.eff_raises);
+      print_xs xs) (Sxs.diff eeff.eff_raises ueff.eff_raises);
   if eeff.eff_oneway && not ueff.eff_oneway then
     Loc.errorm ?loc:(e_locate_effect (fun eff -> eff.eff_oneway) e)
       "this@ expression@ may@ diverge,@ but@ this@ is@ not@ \
@@ -1210,8 +1210,8 @@ and try_expr uloc env ({de_dvty = argl,res} as de0) =
         let vm, pat = create_prog_pattern dp.dp_pat xs.xs_ity mask in
         let e = expr uloc (add_pv_map env vm) de in
         Mstr.iter (fun _ v -> check_used_pv e v) vm;
-        Mexn.add xs ((pat, e) :: Mexn.find_def [] xs m) m in
-      let xsm = List.fold_left add_branch Mexn.empty bl in
+        Mxs.add xs ((pat, e) :: Mxs.find_def [] xs m) m in
+      let xsm = List.fold_left add_branch Mxs.empty bl in
       let is_simple p = match p.pat_node with
         | Papp (fs,[]) -> is_fs_tuple fs
         | Pvar _ | Pwild -> true | _ -> false in
@@ -1259,7 +1259,7 @@ and try_expr uloc env ({de_dvty = argl,res} as de0) =
               let _,pp = create_prog_pattern PPwild xs.xs_ity mask in
               (pp, e_raise xs e (ity_of_dity res)) :: bl in
             vl, e_case e (List.rev bl) in
-      e_try e1 (Mexn.mapi mk_branch xsm)
+      e_try e1 (Mxs.mapi mk_branch xsm)
   | DEraise (xs,de) ->
       e_raise xs (expr uloc env de) (ity_of_dity res)
   | DEghost de ->
@@ -1301,7 +1301,7 @@ and rec_defn uloc ({inr = inr} as env) {fds = dfdl} =
     let ghost = env.ghs || gh || kind = RKlemma in
     let pvl = binders ghost bl in
     let ity = Loc.try1 ?loc:de.de_loc ity_of_dity (dity_of_dvty dvty) in
-    let cty = create_cty ~mask pvl [] [] Mexn.empty Mpv.empty eff_empty ity in
+    let cty = create_cty ~mask pvl [] [] Mxs.empty Mpv.empty eff_empty ity in
     let rs = create_rsymbol id ~ghost ~kind:RKnone cty in
     add_rsymbol env rs, (rs, kind, mask, dsp, dvl, de) in
   let env, fdl = Lists.map_fold_left step1 {env with inr = true} dfdl in
@@ -1374,7 +1374,7 @@ let let_defn ?(keep_loc=true) (id, ghost, kind, de) =
       let e = expr uloc env_empty de in
       if mask_ghost e.e_mask && not ghost then Loc.errorm ?loc
         "Function %s must be explicitly marked ghost" nm;
-      let c = c_fun [] [] [] Mexn.empty Mpv.empty e in
+      let c = c_fun [] [] [] Mxs.empty Mpv.empty e in
       (* the rsymbol will carry a single postcondition "the result
          is equal to the logical constant". Any user-written spec
          will be checked once, in-place, under Eexec. Since kind

src/mlw/dexpr.mli

@@ -64,7 +64,7 @@ type 'a later = pvsymbol Mstr.t -> register_old -> 'a
 type dspec_final = {
   ds_pre     : term list;
   ds_post    : (pvsymbol * term) list;
-  ds_xpost   : (pvsymbol * term) list Mexn.t;
+  ds_xpost   : (pvsymbol * term) list Mxs.t;
   ds_reads   : pvsymbol list;
   ds_writes  : term list;
   ds_diverge : bool;

src/mlw/expr.ml

@@ -171,7 +171,7 @@ let create_projection s v =
   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
   let q = make_post (fs_app ls [t_var arg.pv_vs] v.pv_vs.vs_ty) in
-  let c = create_cty [arg] [] [q] Mexn.empty Mpv.empty eff v.pv_ity in
+  let c = create_cty [arg] [] [q] Mxs.empty Mpv.empty eff v.pv_ity in
   mk_rs ls.ls_name c (RLls ls) (Some v)
 
 exception FieldExpected of rsymbol
@@ -198,7 +198,7 @@ let create_constructor ~constr id s fl =
   let eff = match ity.ity_node with
     | Ityreg r -> eff_reset eff_empty (Sreg.singleton r)
     | _ -> eff_empty in
-  let c = create_cty fl [] [q] Mexn.empty Mpv.empty eff ity in
+  let c = create_cty fl [] [q] Mxs.empty Mpv.empty eff ity in
   mk_rs ls.ls_name c (RLls ls) None
 
 let rs_of_ls ls =
@@ -207,7 +207,7 @@ let rs_of_ls ls =
   let t_args = List.map (fun v -> t_var v.pv_vs) v_args in
   let q = make_post (t_app ls t_args ls.ls_value) in
   let ity = ity_of_ty (t_type q) in
-  let c = create_cty v_args [] [q] Mexn.empty Mpv.empty eff_empty ity in
+  let c = create_cty v_args [] [q] Mxs.empty Mpv.empty eff_empty ity in
   mk_rs ls.ls_name c (RLls ls) None
 
 (** {2 Program patterns} *)
@@ -310,7 +310,7 @@ and expr_node =
   | Ecase   of expr * (prog_pattern * expr) list
   | Ewhile  of expr * invariant list * variant list * expr
   | Efor    of pvsymbol * for_bounds * invariant list * expr
-  | Etry    of expr * (pvsymbol list * expr) Mexn.t
+  | Etry    of expr * (pvsymbol list * expr) Mxs.t
   | Eraise  of xsymbol * expr
   | Eassert of assertion_kind * term
   | Eghost  of expr
@@ -375,7 +375,7 @@ let e_fold fn acc e = match e.e_node with
   | Elet (LDvar (_,d), e) | Ewhile (d,_,_,e) -> fn (fn acc d) e
   | Eif (c,d,e) -> fn (fn (fn acc c) d) e
   | Ecase (d,bl) -> List.fold_left (fun acc (_,e) -> fn acc e) (fn acc d) bl
-  | Etry (d,xl) -> Mexn.fold (fun _ (_,e) acc -> fn acc e) xl (fn acc d)
+  | Etry (d,xl) -> Mxs.fold (fun _ (_,e) acc -> fn acc e) xl (fn acc d)
 
 exception FoundExpr of Loc.position option * expr
 
@@ -732,7 +732,7 @@ let c_pur s vl ityl ity =
   let res = Opt.map (fun _ -> ty_of_ity ity) s.ls_value in
   let q = make_post (t_app s t_args res) in
   let eff = eff_ghostify true eff_empty in
-  let cty = create_cty v_args [] [q] Mexn.empty Mpv.empty eff ity in
+  let cty = create_cty v_args [] [q] Mxs.empty Mpv.empty eff ity in
   mk_cexp (Cpur (s,vl)) cty
 
 let mk_proxy ghost e hd = match e.e_node with
@@ -806,7 +806,7 @@ let rs_func_app = rs_of_ls fs_func_app
 let ld_func_app =
   let v_args = rs_func_app.rs_cty.cty_args in
   let ity = rs_func_app.rs_cty.cty_result in
-  let c = create_cty v_args [] [] Mexn.empty Mpv.empty eff_empty ity in
+  let c = create_cty v_args [] [] Mxs.empty Mpv.empty eff_empty ity in
   LDsym (rs_func_app, c_any c)
 
 let e_func_app fn e =
@@ -906,19 +906,19 @@ let e_try e xl =
     | [v] -> v.pv_ity, mask_of_pv v
     | vl -> ity_tuple (List.map (fun v -> v.pv_ity) vl),
             MaskTuple (List.map mask_of_pv vl) in
-  Mexn.iter (fun xs (vl,d) ->
+  Mxs.iter (fun xs (vl,d) ->
     let ity, mask = get_mask vl in
     if mask_spill xs.xs_mask mask then
       Loc.errorm "Non-ghost pattern in a ghost position";
     ity_equal_check ity xs.xs_ity;
     ity_equal_check d.e_ity e.e_ity) xl;
   let ghost = e.e_effect.eff_ghost in
-  let eeff = Mexn.fold (fun xs _ eff ->
+  let eeff = Mxs.fold (fun xs _ eff ->
     eff_catch eff xs) xl e.e_effect in
-  let dl = Mexn.fold (fun _ (_,d) l -> d::l) xl [] in
+  let dl = Mxs.fold (fun _ (_,d) l -> d::l) xl [] in
   let add_mask mask d = mask_union mask d.e_mask in
   let mask = List.fold_left add_mask e.e_mask dl in
-  let xeff = Mexn.fold (fun _ (vl,d) eff ->
+  let xeff = Mxs.fold (fun _ (vl,d) eff ->
     let add s v = Spv.add_new (Invalid_argument "Expr.e_try") v s in
     let deff = eff_bind (List.fold_left add Spv.empty vl) d.e_effect in
     try_effect dl eff_union_par eff deff) xl eff_empty in
@@ -984,7 +984,7 @@ let rec e_rs_subst sm e = e_label_copy e (match e.e_node with
   | Ecase (d,bl) -> e_case (e_rs_subst sm d)
       (List.map (fun (pp,e) -> pp, e_rs_subst sm e) bl)
   | Etry (d,xl) -> e_try (e_rs_subst sm d)
-      (Mexn.map (fun (v,e) -> v, e_rs_subst sm e) xl))
+      (Mxs.map (fun (v,e) -> v, e_rs_subst sm e) xl))
 
 and c_rs_subst sm ({c_node = n; c_cty = c} as d) = match n with
   | Cany | Cpur _ -> d
@@ -1311,7 +1311,7 @@ and print_enode pri fmt e = match e.e_node with
   | Eraise (xs,e) ->
       fprintf fmt "raise (%a %a)" print_xs xs print_expr e
   | Etry (e,bl) ->
-      let bl = Mexn.bindings bl in
+      let bl = Mxs.bindings bl in
       fprintf fmt "try %a with@\n@[<hov>%a@]@\nend"
         print_expr e (Pp.print_list Pp.newline print_xbranch) bl
   | Eabsurd ->

src/mlw/expr.mli

@@ -124,7 +124,7 @@ and expr_node = private
   | Ecase   of expr * (prog_pattern * expr) list
   | Ewhile  of expr * invariant list * variant list * expr
   | Efor    of pvsymbol * for_bounds * invariant list * expr
-  | Etry    of expr * (pvsymbol list * expr) Mexn.t
+  | Etry    of expr * (pvsymbol list * expr) Mxs.t
   | Eraise  of xsymbol * expr
   | Eassert of assertion_kind * term
   | Eghost  of expr
@@ -182,7 +182,7 @@ val c_app : rsymbol -> pvsymbol list -> ity list -> ity -> cexp
 val c_pur : lsymbol -> pvsymbol list -> ity list -> ity -> cexp
 
 val c_fun : ?mask:mask -> pvsymbol list ->
-  pre list -> post list -> post list Mexn.t -> pvsymbol Mpv.t -> expr -> cexp
+  pre list -> post list -> post list Mxs.t -> pvsymbol Mpv.t -> expr -> cexp
 
 val c_any : cty -> cexp
 
@@ -218,7 +218,7 @@ val is_e_false : expr -> bool
 
 val e_raise : xsymbol -> expr -> ity -> expr
 
-val e_try : expr -> (pvsymbol list * expr) Mexn.t -> expr
+val e_try : expr -> (pvsymbol list * expr) Mxs.t -> expr
 
 val e_case : expr -> (prog_pattern * expr) list -> expr
 

src/mlw/ity.ml

@@ -862,8 +862,8 @@ module Exn = MakeMSH (struct
   let tag xs = Weakhtbl.tag_hash xs.xs_name.id_tag
 end)
 
-module Sexn = Exn.S
-module Mexn = Exn.M
+module Sxs = Exn.S
+module Mxs = Exn.M
 
 (* effects *)
 
@@ -883,7 +883,7 @@ type effect = {
   eff_taints : Sreg.t;        (* ghost code writes *)
   eff_covers : Sreg.t;        (* surviving writes *)
   eff_resets : Sreg.t;        (* locked by covers *)
-  eff_raises : Sexn.t;        (* raised exceptions *)
+  eff_raises : Sxs.t;         (* raised exceptions *)
   eff_oneway : bool;          (* non-termination *)
   eff_ghost  : bool;          (* ghost status *)
 }
@@ -894,7 +894,7 @@ let eff_empty = {
   eff_taints = Sreg.empty;
   eff_covers = Sreg.empty;
   eff_resets = Sreg.empty;
-  eff_raises = Sexn.empty;
+  eff_raises = Sxs.empty;
   eff_oneway = false;
   eff_ghost  = false;
 }
@@ -905,13 +905,13 @@ let eff_equal e1 e2 =
   Sreg.equal e1.eff_taints e2.eff_taints &&
   Sreg.equal e1.eff_covers e2.eff_covers &&
   Sreg.equal e1.eff_resets e2.eff_resets &&
-  Sexn.equal e1.eff_raises e2.eff_raises &&
+  Sxs.equal e1.eff_raises e2.eff_raises &&
   e1.eff_oneway = e2.eff_oneway &&
   e1.eff_ghost = e2.eff_ghost
 
 let eff_pure e =
   Mreg.is_empty e.eff_writes &&
-  Sexn.is_empty e.eff_raises &&
+  Sxs.is_empty e.eff_raises &&
   not e.eff_oneway
 
 let check_writes {eff_writes = wrt} pvs =
@@ -951,7 +951,7 @@ let eff_ghostify gh e =
 
 let eff_ghostify_weak gh e =
   if not gh || e.eff_ghost then e else
-  if e.eff_oneway || not (Sexn.is_empty e.eff_raises) then e else
+  if e.eff_oneway || not (Sxs.is_empty e.eff_raises) then e else
   if not (Sreg.equal e.eff_taints (visible_writes e)) then e else
   (* it is not enough to catch BadGhostWrite from eff_ghostify below,
      because e may not have in eff_reads the needed visible variables
@@ -1083,7 +1083,7 @@ let eff_assign asl =
     eff_taints = taint;
     eff_covers = Mreg.domain (Mreg.set_diff writes resets);
     eff_resets = resets;
-    eff_raises = Sexn.empty;
+    eff_raises = Sxs.empty;
     eff_oneway = false;
     eff_ghost  = ghost } in
   (* verify that we can rebuild every value *)
@@ -1108,8 +1108,8 @@ let eff_reset_overwritten ({eff_writes = wr} as e) =
   let svv, rst = Mreg.fold add_write wr (Sreg.empty,Sreg.empty) in
   { e with eff_resets = Sreg.diff rst svv }
 
-let eff_raise e x = { e with eff_raises = Sexn.add x e.eff_raises }
-let eff_catch e x = { e with eff_raises = Sexn.remove x e.eff_raises }
+let eff_raise e x = { e with eff_raises = Sxs.add x e.eff_raises }
+let eff_catch e x = { e with eff_raises = Sxs.remove x e.eff_raises }
 
 let merge_fields _ f1 f2 = Some (Spv.union f1 f2)
 
@@ -1123,7 +1123,7 @@ let eff_union e1 e2 = {
   eff_covers = Sreg.union (remove_stale e2 e1.eff_covers)
                           (remove_stale e1 e2.eff_covers);
   eff_resets = Sreg.union e1.eff_resets e2.eff_resets;
-  eff_raises = Sexn.union e1.eff_raises e2.eff_raises;
+  eff_raises = Sxs.union e1.eff_raises e2.eff_raises;
   eff_oneway = e1.eff_oneway || e2.eff_oneway;
   eff_ghost  = e1.eff_ghost && e2.eff_ghost }
 
@@ -1142,12 +1142,12 @@ let eff_union e1 e2 =
 
 let eff_contaminate e1 e2 =
   if not e1.eff_ghost then e2 else
-  if Sexn.is_empty e1.eff_raises then e2 else
+  if Sxs.is_empty e1.eff_raises then e2 else
   eff_ghostify true e2
 
 let eff_contaminate_weak e1 e2 =
   if not e1.eff_ghost then e2 else
-  if Sexn.is_empty e1.eff_raises then eff_ghostify_weak true e2 else
+  if Sxs.is_empty e1.eff_raises then eff_ghostify_weak true e2 else
   eff_ghostify true e2
 
 let eff_union_par e1 e2 =
@@ -1221,7 +1221,7 @@ type cty = {
   cty_args   : pvsymbol list;
   cty_pre    : pre list;
   cty_post   : post list;
-  cty_xpost  : post list Mexn.t;
+  cty_xpost  : post list Mxs.t;
   cty_oldies : pvsymbol Mpv.t;
   cty_effect : effect;
   cty_result : ity;
@@ -1256,7 +1256,7 @@ let cty_ghostify gh ({cty_effect = eff} as c) =
 let spec_t_fold fn_t acc pre post xpost =
   let fn_l a fl = List.fold_left fn_t a fl in
   let acc = fn_l (fn_l acc pre) post in
-  Mexn.fold (fun _ l a -> fn_l a l) xpost acc
+  Mxs.fold (fun _ l a -> fn_l a l) xpost acc
 
 let check_tvs reads result pre post xpost =
   (* every type variable in spec comes either from a known vsymbol
@@ -1284,7 +1284,7 @@ let create_cty ?(mask=MaskVisible) args pre post xpost oldies effect result =
   let exn = Invalid_argument "Ity.create_cty" in
   (* pre, post, and xpost are well-typed *)
   check_pre pre; check_post exn result post;
-  Mexn.iter (fun xs xq -> check_post exn xs.xs_ity xq) xpost;
+  Mxs.iter (fun xs xq -> check_post exn xs.xs_ity xq) xpost;
   (* mask is consistent with result *)
   mask_check exn result mask;
   let mask = mask_reduce mask in
@@ -1295,7 +1295,7 @@ let create_cty ?(mask=MaskVisible) args pre post xpost oldies effect result =
      reads are forbidden, to simplify instantiation later. *)
   Mpv.iter (fun {pv_ghost = gh; pv_ity = o} {pv_ity = t} ->
     if not (gh && o == ity_purify t) then raise exn) oldies;
-  let preads = spec_t_fold t_freepvs sarg pre [] Mexn.empty in
+  let preads = spec_t_fold t_freepvs sarg pre [] Mxs.empty in
   let qreads = spec_t_fold t_freepvs Spv.empty [] post xpost in
   let effect = eff_read_post effect qreads in
   let oldies = Mpv.set_inter oldies effect.eff_reads in
@@ -1311,7 +1311,7 @@ let create_cty ?(mask=MaskVisible) args pre post xpost oldies effect result =
     | _, {t_node = Tfalse} -> true | _ -> false in
   let filter _ () = function
     | [q] when is_false q -> None | _ -> Some () in
-  let raises = Mexn.diff filter effect.eff_raises xpost in
+  let raises = Mxs.diff filter effect.eff_raises xpost in
   let effect = { effect with eff_raises = raises } in
   (* remove effects on unknown regions. We reset eff_taints
      instead of simply filtering the existing set in order
@@ -1388,7 +1388,7 @@ let cty_apply c vl args res =
                       (fun t -> t_ty_subst tsb vsb t) in
   let subst_l l = List.map subst_t l in
   cty_unsafe (List.rev rargs) (subst_l c.cty_pre)
-    (subst_l c.cty_post) (Mexn.map subst_l c.cty_xpost)
+    (subst_l c.cty_post) (Mxs.map subst_l c.cty_xpost)
     oldies eff res c.cty_mask freeze
 
 let cty_tuple args =
@@ -1401,7 +1401,7 @@ let cty_tuple args =
   let eff = eff_read (Spv.of_list args) in
   let eff = eff_ghostify (mask = MaskGhost) eff in
   let frz = List.fold_right freeze_pv args isb_empty in