@@ -2025,7 +2025,7 @@ and transmod_body ~attop (env : EcEnv.env) x params (me:pmodule_expr) =
2025
2025
me
2026
2026
| Pm_struct ps ->
2027
2027
transstruct ~attop env x.pl_desc stparams (mk_loc me.pl_loc ps)
2028
- | Pm_update (m , vars , funs ) ->
2028
+ | Pm_update (m , delete_vars , vars , funs ) ->
2029
2029
let loc = me.pl_loc in
2030
2030
let (mp, sig_) = trans_msymbol env {pl_desc = m; pl_loc = loc} in
2031
2031
@@ -2046,6 +2046,8 @@ and transmod_body ~attop (env : EcEnv.env) x params (me:pmodule_expr) =
2046
2046
vars
2047
2047
in
2048
2048
2049
+ let delete_vars = List. map (fun v -> v.pl_desc) delete_vars in
2050
+
2049
2051
let me, _ = EcEnv.Mod. by_mpath mp env in
2050
2052
let p = match mp.m_top with | `Concrete (p , _ ) -> p | _ -> assert false in
2051
2053
let subst = EcSubst. add_moddef EcSubst. empty ~src: p ~dst: (EcEnv. mroot env) in
@@ -2084,32 +2086,39 @@ and transmod_body ~attop (env : EcEnv.env) x params (me:pmodule_expr) =
2084
2086
let memenv = ref memenv in
2085
2087
2086
2088
(* Semantics for stmt updating, `i` is the target of the update. *)
2087
- let eval_supdate env sup i =
2089
+ let eval_supdate env sup si =
2088
2090
match sup with
2089
2091
| Pups_add (s , after ) ->
2090
2092
let ue = UE. create (Some [] ) in
2091
2093
let s = transstmt env ue s in
2092
2094
let ts = Tuni. subst (UE. close ue) in
2093
2095
if after then
2094
- i :: (s_subst ts s).s_node
2096
+ si @ (s_subst ts s).s_node
2095
2097
else
2096
- (s_subst ts s).s_node @ [i]
2098
+ (s_subst ts s).s_node @ si
2097
2099
| Pups_del -> []
2098
2100
in
2099
2101
2100
2102
(* Semantics for condition updating *)
2101
- (* `i` is the target of the update, and `tl` is the instr suffix. *)
2102
- let eval_cupdate cp_loc env cup i tl =
2103
+ let eval_cupdate cp_loc env cup si =
2104
+ (* NOTE: There will always be a head element *)
2105
+ (* `i` is the target of the update, and `tl` is the instr suffix. *)
2106
+ let i, tl = List. takedrop 1 si in
2107
+ let i = List. hd i in
2108
+
2103
2109
match cup with
2104
2110
(* Insert an if with condition `e` with body `tl` *)
2105
- | Pupc_add e ->
2111
+ | Pupc_add ( e , after ) ->
2106
2112
let loc = e.pl_loc in
2107
2113
let ue = UE. create (Some [] ) in
2108
2114
let e, ty = transexp env `InProc ue e in
2109
2115
let ts = Tuni. subst (UE. close ue) in
2110
2116
let ty = ty_subst ts ty in
2111
2117
unify_or_fail env ue loc ~expct: tbool ty;
2112
- i :: [i_if (e_subst ts e, stmt tl, s_empty)]
2118
+ if after then
2119
+ i :: [i_if (e_subst ts e, stmt tl, s_empty)]
2120
+ else
2121
+ [i_if (e_subst ts e, stmt (i :: tl), s_empty)]
2113
2122
2114
2123
(* Change the condition expression to `e` for a conditional instr `i` *)
2115
2124
| Pupc_mod e -> begin
@@ -2191,23 +2200,19 @@ and transmod_body ~attop (env : EcEnv.env) x params (me:pmodule_expr) =
2191
2200
(* Apply each of updates in reverse *)
2192
2201
(* NOTE: This is with the expectation that the user entered them in chronological order. *)
2193
2202
let body =
2194
- List. fold_right (fun (cp , up ) bd ->
2195
- let {pl_desc = cp ; pl_loc = loc} = cp in
2196
- let cp = trans_codepos env cp in
2203
+ List. fold_right (fun (cpr , up ) bd ->
2204
+ let {pl_desc = cpr ; pl_loc = loc} = cpr in
2205
+ let cp = trans_codepos_range env cpr in
2197
2206
let change env si =
2198
- (* NOTE: There will always be a head element *)
2199
- let i, tl = List. takedrop 1 si in
2200
- let i = List. hd i in
2201
-
2202
2207
match up with
2203
2208
| Pup_stmt sup ->
2204
- eval_supdate env sup i @ tl
2209
+ eval_supdate env sup si
2205
2210
| Pup_cond cup ->
2206
- eval_cupdate loc env cup i tl
2211
+ eval_cupdate loc env cup si
2207
2212
in
2208
2213
let env = EcEnv.Memory. push_active ! memenv env in
2209
2214
try
2210
- EcMatching.Zipper. map_range env (cp, `Offset ( EcMatching.Zipper. cpos ( - 1 ))) change bd
2215
+ EcMatching.Zipper. map_range env cp change bd
2211
2216
with
2212
2217
| EcMatching.Zipper. InvalidCPos ->
2213
2218
tyerror loc env (InvalidModUpdate MUE_InvalidCodePos );
@@ -2250,7 +2255,7 @@ and transmod_body ~attop (env : EcEnv.env) x params (me:pmodule_expr) =
2250
2255
| ME_Structure mb ->
2251
2256
let doit (env , items ) mi =
2252
2257
match mi with
2253
- | MI_Variable v ->
2258
+ | MI_Variable v when not ( List. mem (v_name v) delete_vars) ->
2254
2259
let env = EcEnv.Var. bind_pvglob v.v_name v.v_type env in
2255
2260
env, items @ [mi]
2256
2261
| MI_Function f -> begin
@@ -2266,6 +2271,7 @@ and transmod_body ~attop (env : EcEnv.env) x params (me:pmodule_expr) =
2266
2271
| MI_Module me ->
2267
2272
let env = EcEnv. bind1 (me.me_name, `Module me) env in
2268
2273
env, items @ [mi]
2274
+ | _ -> env, items
2269
2275
in
2270
2276
List. fold_left doit (env, [] ) (items @ mb.ms_body)
2271
2277
@@ -3635,6 +3641,18 @@ and trans_codepos ?(memory : memory option) (env : EcEnv.env) ((nm, p) : pcodepo
3635
3641
let p = trans_codepos1 ?memory env p in
3636
3642
(nm, p)
3637
3643
3644
+ (* -------------------------------------------------------------------- *)
3645
+ and trans_codepos_range ?(memory : memory option ) (env : EcEnv.env ) ((cps , cpe ) : pcodepos_range ) : codepos_range =
3646
+ let cps = trans_codepos ?memory env cps in
3647
+ let cpe =
3648
+ match cpe with
3649
+ | `Base cp ->
3650
+ `Base (trans_codepos ?memory env cp)
3651
+ | `Offset cp ->
3652
+ `Offset (trans_codepos1 ?memory env cp)
3653
+ in
3654
+ (cps, cpe)
3655
+
3638
3656
(* -------------------------------------------------------------------- *)
3639
3657
and trans_dcodepos1 ?(memory : memory option ) (env : EcEnv.env ) (p : pcodepos1 doption ) : codepos1 doption =
3640
3658
DOption. map (trans_codepos1 ?memory env) p
0 commit comments