diff --git a/compiler/Makefile b/compiler/Makefile
index 492a59f247..4400466ab7 100644
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -54,6 +54,7 @@ check-ci:
 check-ec:
 	$(MAKE) -C examples/gimli/proofs
 	$(MAKE) -C examples/extraction-unit-tests
+	$(MAKE) -C examples/extraction-safety-unit-tests
 
 check-all: check
 	dune runtest -f
diff --git a/compiler/entry/commonCLI.ml b/compiler/entry/commonCLI.ml
index fac84353e6..513ab3fcba 100644
--- a/compiler/entry/commonCLI.ml
+++ b/compiler/entry/commonCLI.ml
@@ -57,7 +57,7 @@ let parse_and_compile (type reg regx xreg rflag cond asm_op extra_op)
        and type rflag = rflag
        and type cond = cond
        and type asm_op = asm_op
-       and type extra_op = extra_op) ~wi2i pass file idirs =
+       and type extra_op = extra_op) ~wi2i ~safety pass file idirs =
   let _env, pprog, _ast =
     try Compile.parse_file Arch.arch_info ~idirs file with
     | Annot.AnnotationError (loc, code) ->
@@ -76,6 +76,10 @@ let parse_and_compile (type reg regx xreg rflag cond asm_op extra_op)
 
   let prog =
     if not wi2i then prog else Compile.do_wint_int (module Arch) prog
+  in 
+
+  let prog =
+    if not safety then prog else Compile.create_safety_asserts (module Arch) prog
   in
 
   let prog =
diff --git a/compiler/entry/commonCLI.mli b/compiler/entry/commonCLI.mli
index 3a6facd316..3d35818791 100644
--- a/compiler/entry/commonCLI.mli
+++ b/compiler/entry/commonCLI.mli
@@ -18,6 +18,7 @@ val parse_and_compile :
       and type xreg = 'xreg) ->
   wi2i:bool ->
   (* true => start by replacing wint operation by int operation *)
+  safety:bool ->
   Compiler.compiler_step ->
   string ->
   (string * string) list ->
diff --git a/compiler/entry/jasmin2ec.ml b/compiler/entry/jasmin2ec.ml
index 46d83580e9..e91c8351ae 100644
--- a/compiler/entry/jasmin2ec.ml
+++ b/compiler/entry/jasmin2ec.ml
@@ -3,24 +3,29 @@ open Cmdliner
 open CommonCLI
 open Utils
 
-let extract_to_file prog arch pd msfsz asmOp model amodel fnames array_dir
-    outfile =
-  let array_dir =
-    if array_dir = None then Option.map Filename.dirname outfile else array_dir
-  in
+let get_outfile_name outfile =
+  match outfile with
+  | None -> ""
+  | Some f -> 
+        let basename = Filename.basename f in
+        let basename' =
+          try Filename.chop_extension basename with Invalid_argument _ -> basename in
+        String.capitalize_ascii basename'
+
+let format_to_file outfile action =
   let fmt, close =
     match outfile with
-    | None -> (Format.std_formatter, fun () -> ())
+    | None ->
+        Format.std_formatter, (fun () -> ())
     | Some f ->
         let out = open_out f in
         let fmt = Format.formatter_of_out_channel out in
-        (fmt, fun () -> close_out out)
+        fmt, (fun () -> close_out out)
   in
   try
     BatPervasives.finally
       (fun () -> close ())
-      (fun () ->
-        ToEC.extract prog arch pd msfsz asmOp model amodel fnames array_dir fmt)
+      (fun () -> action fmt)
       ()
   with e ->
     BatPervasives.ignore_exceptions
@@ -28,16 +33,37 @@ let extract_to_file prog arch pd msfsz asmOp model amodel fnames array_dir
       ();
     raise e
 
+let extract_to_file prog arch pd msfsz asmOp model amodel fnames array_dir outfile prooffile =
+  let array_dir =
+    if array_dir = None then Option.map Filename.dirname outfile else array_dir
+  in
+  let extract () =
+    format_to_file outfile (fun fmt ->
+      ToEC.extract prog arch pd msfsz asmOp model amodel fnames array_dir fmt) in
+  let extract_proof () =
+    format_to_file prooffile (fun fmt ->
+      ToEC.generate_safety_lemmas (get_outfile_name outfile) prog arch pd msfsz asmOp model amodel fnames array_dir fmt) in
+  match model, outfile, prooffile with
+  | SafetyAnnotations, None, Some _ -> extract_proof ()
+  | SafetyAnnotations, Some _, None -> extract ()
+  | SafetyAnnotations, _, _         -> extract (); extract_proof ()
+  | _ -> extract ()
+
 let parse_and_extract arch call_conv idirs =
   let module A = (val CoreArchFactory.get_arch_module arch call_conv) in
-  let extract model amodel functions array_dir output pass file =
-    let prog = parse_and_compile (module A) ~wi2i:true pass file idirs in
-    extract_to_file prog arch A.reg_size A.msf_size A.asmOp model amodel
-      functions array_dir output
+  let extract model amodel functions array_dir output output_proof pass file =
+    let safety =
+      match model with
+       | SafetyAnnotations -> true
+       | _ -> false
+    in
+    let prog = parse_and_compile (module A) ~wi2i:true ~safety:safety pass file idirs in
+    extract_to_file prog arch A.reg_size  A.msf_size A.asmOp model amodel functions
+      array_dir output output_proof
   in
-  fun model amodel functions array_dir output pass file warn ->
+  fun model amodel functions array_dir output output_proof pass file warn ->
     if not warn then nowarning ();
-    match extract model amodel functions array_dir output pass file with
+    match extract model amodel functions array_dir output output_proof pass file with
     | () -> ()
     | exception HiError e ->
         Format.eprintf "%a@." pp_hierror e;
@@ -45,14 +71,16 @@ let parse_and_extract arch call_conv idirs =
 
 let model =
   let alts =
-    [ ("normal", Normal); ("CT", ConstantTime); ("CTG", ConstantTimeGlobal) ]
+    [ ("normal", Normal); ("CT", ConstantTime); ("CTG", ConstantTimeGlobal); ("safety", SafetyAnnotations)]
   in
+  (* TODO : fix the documentation *)
   let doc =
     "Extraction model.
     $(b,normal): plain extraction.
     $(b,CT): Functions additionally return timing-observable leakage for
     'cryptographic constant time' (if/while conditions, memory access
     addresses, array indices, for loop bounds).
+    $(b,safety): extract for safety verification.
     (Deprecated) $(b,CTG): Cryptographic constant time leakage is added to a
     global variable."
   in
@@ -86,6 +114,13 @@ let output =
     & opt (some string) None
     & info [ "o"; "output" ] ~docv:"OUTPUT FILE" ~doc)
 
+let output_proof =
+ let doc = "Output proof file. If not given, output will be printed on stdout." in
+  Arg.(
+    value
+    & opt (some string) None
+    & info [ "output-proof" ] ~docv:"OUTPUT PROOF FILE" ~doc)
+
 let array_dir =
   let doc =
     "Directory for generation of easycrypt array theories. \
@@ -117,5 +152,5 @@ let () =
   Cmd.v info
     Term.(
       const parse_and_extract $ arch $ call_conv $ idirs $ model $ array_model
-      $ functions $ array_dir $ output $ after_pass $ file $ warn)
+      $ functions $ array_dir $ output $ output_proof $ after_pass $ file $ warn)
   |> Cmd.eval |> exit
diff --git a/compiler/entry/jasmin_ct.ml b/compiler/entry/jasmin_ct.ml
index 1408acea59..0a66fe1005 100644
--- a/compiler/entry/jasmin_ct.ml
+++ b/compiler/entry/jasmin_ct.ml
@@ -11,8 +11,7 @@ type printer =
 let parse_and_check arch call_conv idirs =
   let module A = (val CoreArchFactory.get_arch_module arch call_conv) in
   let check ~doit infer ct_list speculative pass file print =
-    let prog = parse_and_compile (module A) ~wi2i:false pass file idirs in
-
+    let prog = parse_and_compile (module A) ~wi2i:false ~safety:false pass file idirs in
     if speculative then
       let prog =
         (* Ensure there are no spill/unspill operations left *)
diff --git a/compiler/examples/extraction-safety-unit-tests/Makefile b/compiler/examples/extraction-safety-unit-tests/Makefile
new file mode 100644
index 0000000000..e655b2d0d7
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/Makefile
@@ -0,0 +1,19 @@
+ECARGS ?= -I Jasmin:../../../eclib
+
+JASMIN2EC := ../../jasmin2ec
+
+.SUFFIXES: .jazz .ec
+
+SOURCES := $(wildcard *.jazz)
+EXTRACTED := $(SOURCES:.jazz=.ec)
+
+all: proofs.ec $(EXTRACTED)
+	easycrypt runtest $(ECARGS) ec.config $@
+
+clean:
+	$(RM) $(EXTRACTED)
+
+%.ec: %.jazz $(JASMIN2EC)
+	$(JASMIN2EC) --model safety -o $@ $<
+
+.PHONY: all
diff --git a/compiler/examples/extraction-safety-unit-tests/ec.config b/compiler/examples/extraction-safety-unit-tests/ec.config
new file mode 100644
index 0000000000..f1f93c2dbd
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/ec.config
@@ -0,0 +1,6 @@
+[default]
+bin = easycrypt
+
+[test-all]
+okdirs = .
+
diff --git a/compiler/examples/extraction-safety-unit-tests/proofs.ec b/compiler/examples/extraction-safety-unit-tests/proofs.ec
new file mode 100644
index 0000000000..b0fbd1c389
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/proofs.ec
@@ -0,0 +1,109 @@
+
+require import AllCore IntDiv CoreMap List Distr.
+from Jasmin require import JWord Jcheck JSafety.
+
+(* ----------------------------------------------------------------------------*)
+require Test_arr_sum.
+
+lemma Test_arr_sum_ok _x _b_x : Test_arr_sum.test_spec _x _b_x.
+proof.
+  rewrite /Test_arr_sum.test_spec .
+  proc; auto .
+  while ((valid trace_test) /\ (0 <= i)).
+  + auto => &m.
+    rewrite /valid all_cat => /> _ /#.
+  auto.
+qed.
+
+(* ----------------------------------------------------------------------------*)
+require Test_array.
+
+lemma Test_array_ok : Test_array.test_spec.
+proof.
+  rewrite /Test_array.test_spec.
+  proc; auto.
+qed.
+
+(* ----------------------------------------------------------------------------*)
+require Test_glob_array.
+
+lemma Test_glob_array_ok : Test_glob_array.get_global_spec.
+proof.
+  rewrite /get_global_spec.
+  proc; auto.
+qed.
+
+(* ----------------------------------------------------------------------------*)
+require Test_glob_var.
+
+lemma Test_glob_var_ok : Test_glob_var.zero_spec.
+proof.
+  rewrite /Test_glob_var.zero_spec .
+  proc; auto.
+qed.
+
+(* ----------------------------------------------------------------------------*)
+require Test_init_arr_sum.
+
+lemma Test_init_arr_sum_ok _x _b_x _y _b_y _z _b_z :
+       Test_init_arr_sum.test_spec _x _b_x _y _b_y _z _b_z.
+proof.
+  rewrite /test_spec.
+  proc; auto.
+  while ((valid trace_test) /\ 0 <= i /\ BArray10.is_init b_z 0 (2 * i)).
+  + auto => &m.
+    rewrite /is_init /valid !all_cat => /> /#.
+  auto => &m.
+  rewrite /is_init /valid !all_cat => /> /#.
+qed.
+
+(* ----------------------------------------------------------------------------*)
+require Test_init_pos_func.
+
+lemma init_pos_proof _x _b_x _i : Test_init_pos_func.init_pos_spec _x _b_x _i.
+proof.
+  rewrite /Test_init_pos_func.init_pos_spec.
+  proc; auto.
+  move=> &hr.
+  rewrite !and_iota /= /is_init /valid /= /#.
+qed .
+
+lemma test2_proof _x _b_x : Test_init_pos_func.test2_spec _x _b_x.
+proof.
+  rewrite /Test_init_pos_func.test2_spec.
+  proc; auto.
+  have init_pos_proof_aux := init_pos_proof; rewrite /Test_init_pos_func.init_pos_spec in init_pos_proof_aux;
+  ecall (init_pos_proof_aux param_0 (BArray5.init_arr (W8.of_int 255)) param).
+  auto => &hr.
+  rewrite and_iota /is_init /valid /= => /> ? result.
+  rewrite and_iota /= all_cat /= => />.
+  by move => ->.
+qed .
+
+lemma test_proof _x _b_x : Test_init_pos_func.test_spec _x _b_x.
+proof.
+  rewrite /test_spec.
+  proc; auto.
+  while ((valid trace_test) /\  (((0 <= i) /\ (i <= 5)) /\
+                                (BArray5.is_init b_x 0 i))).
+  + auto.
+    have init_pos_proof_aux := init_pos_proof; rewrite /init_pos_spec in init_pos_proof_aux;
+     ecall (init_pos_proof_aux param_0 b_param param).
+    auto.
+    rewrite /is_init /valid /= => /> &hr 5? result.
+    rewrite !and_iota /= !all_cat /= => 2?.
+    smt().
+  auto => &m.
+  rewrite /is_init /valid => />; split; first smt().
+  move => *; rewrite all_cat /= /#.
+qed .
+
+(* ----------------------------------------------------------------------------*)
+require Test_mem.
+
+lemma Test_mem_ok _str : Test_mem.test_spec _str.
+proof.
+rewrite /test_spec.
+proc; auto => &m /> *.
+smt (all_cat).
+qed.
diff --git a/compiler/examples/extraction-safety-unit-tests/test_arr_sum.jazz b/compiler/examples/extraction-safety-unit-tests/test_arr_sum.jazz
new file mode 100644
index 0000000000..4fd43d72c5
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_arr_sum.jazz
@@ -0,0 +1,15 @@
+#[safety =
+   { requires = is_arr_init(x,0,5) }
+ ]
+fn test(reg ptr u8[5] x) -> reg u8
+{
+    reg u8 sum;
+    inline int i;
+    sum = 0;
+    for i = 0 to 5 {
+      sum += x[i];
+    }
+    return sum;
+}
+
+
diff --git a/compiler/examples/extraction-safety-unit-tests/test_array.jazz b/compiler/examples/extraction-safety-unit-tests/test_array.jazz
new file mode 100644
index 0000000000..554f958a7b
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_array.jazz
@@ -0,0 +1,11 @@
+u8[8] a =
+{0X0, 0X4, 0X1, 0X5, 0X2, 0X6, 0X3, 0X7};
+
+fn test() -> reg u8 {
+  reg ptr u8[8] b;
+  reg u8 c;
+  c = a[3];
+  b = a;
+  c = b[2];
+  return c;
+}
\ No newline at end of file
diff --git a/compiler/examples/extraction-safety-unit-tests/test_cast.jazz b/compiler/examples/extraction-safety-unit-tests/test_cast.jazz
new file mode 100644
index 0000000000..df455146e1
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_cast.jazz
@@ -0,0 +1,13 @@
+fn test(reg u64 x, reg u64 y) -> reg u32
+{
+    reg u32 sum;
+    sum = x +32u y;
+    return sum;
+}
+
+fn test1(reg u64 x, reg u64 y) -> reg u32
+{
+    reg u32 sum;
+    _,_,_,_,_,sum = #ADD_32(x, y);
+    return sum;
+}
diff --git a/compiler/examples/extraction-safety-unit-tests/test_glob_array.jazz b/compiler/examples/extraction-safety-unit-tests/test_glob_array.jazz
new file mode 100644
index 0000000000..e281013279
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_glob_array.jazz
@@ -0,0 +1,7 @@
+u32[2] t = {0, 1};
+
+export fn get_global() -> reg u32 {
+  reg u32 r;
+  r = t[0];
+  return r;
+}
diff --git a/compiler/examples/extraction-safety-unit-tests/test_glob_var.jazz b/compiler/examples/extraction-safety-unit-tests/test_glob_var.jazz
new file mode 100644
index 0000000000..2c6bc83655
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_glob_var.jazz
@@ -0,0 +1,7 @@
+u32 x = 0;
+
+export fn zero() -> reg u32 {
+  reg u32 r;
+  r = x;
+  return r;
+}
\ No newline at end of file
diff --git a/compiler/examples/extraction-safety-unit-tests/test_init_arr_sum.jazz b/compiler/examples/extraction-safety-unit-tests/test_init_arr_sum.jazz
new file mode 100644
index 0000000000..ad43a5a1a1
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_init_arr_sum.jazz
@@ -0,0 +1,12 @@
+#[safety =
+   { requires = is_arr_init(x,0,10) && is_arr_init(y,0,10)
+   , ensures = is_arr_init(z,0,10) }
+ ]
+fn test(reg ptr u16[5] x,reg ptr u16[5] y,reg ptr u16[5] z) -> reg ptr u16[5]
+{
+    inline int i;
+    for i = 0 to 5 {
+      z[i] = x[i] + y[i];
+    }
+    return z;
+}
\ No newline at end of file
diff --git a/compiler/examples/extraction-safety-unit-tests/test_init_pos_func.jazz b/compiler/examples/extraction-safety-unit-tests/test_init_pos_func.jazz
new file mode 100644
index 0000000000..de4b24f5a0
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_init_pos_func.jazz
@@ -0,0 +1,42 @@
+#[safety =
+   { args = {x0 , i }
+   , res = {x }
+
+   , requires = 0 <= i && i < 5
+   , ensures = \all (k \in 0:5) (is_arr_init(x,k,1) == (k==i || is_arr_init(x0,k,1))) }
+ ]
+fn init_pos(reg ptr u8[5] x, reg int i) -> reg ptr u8[5]
+{
+    x[i] = 0;
+    return x;
+}
+
+#[safety =
+   { requires = is_arr_init(x,0,5) }
+ ]
+fn test2(reg ptr u8[5] x) -> reg ptr u8[5]
+{
+    stack u8[5] y;
+    inline int i;
+    i = 2;
+    y = init_pos(x,i);
+    x[2] = y[3];
+    return x;
+}
+
+#[safety =
+   { ensures = is_arr_init(x,0,5) }
+ ]
+fn test(reg ptr u8[5] x) -> reg ptr u8[5]
+{
+    inline int i;
+    i = 0;
+    while (i < 5) {
+      assert("safety_inv", 0<=i && i<=5 && is_arr_init (x,0,i));
+      x = init_pos(x,i);
+      i += 1;
+    }
+    i = x[2];
+    return x;
+}
+
diff --git a/compiler/examples/extraction-safety-unit-tests/test_mem.jazz b/compiler/examples/extraction-safety-unit-tests/test_mem.jazz
new file mode 100644
index 0000000000..8dec0d4506
--- /dev/null
+++ b/compiler/examples/extraction-safety-unit-tests/test_mem.jazz
@@ -0,0 +1,10 @@
+#[safety =
+   { requires = is_mem_init((64u)str,8) }
+ ]
+fn test (reg ui64 str) -> reg u8
+{
+  reg u8 r;
+  r =  [:u8 (64u)(str + 1)];
+  [:u32 (64u)str] = [:u32 (64u)(str + 4)];
+  return r;
+}
\ No newline at end of file
diff --git a/compiler/linter/Checker/VariableInitialisation.ml b/compiler/linter/Checker/VariableInitialisation.ml
index a77e97ccaa..114269ebe6 100644
--- a/compiler/linter/Checker/VariableInitialisation.ml
+++ b/compiler/linter/Checker/VariableInitialisation.ml
@@ -37,6 +37,12 @@ let check_func fd =
     | Papp2 (_, e1, e2) -> check_es m [ e1; e2 ]
     | PappN (_, es) -> check_es m es
     | Pif (_, e1, e2, e3) -> check_es m [ e1; e2; e3 ]
+    | Pbig (e0, _op, x, start, len, body) ->
+      check_es m [e0; start; len];
+      let m = Annotation.map m (RDDomain.add (Sv.singleton (L.unloc x)) (L.of_loc x)) in
+      check_e m body
+    | Pis_var_init _ -> ()
+    | Pis_mem_init (e1, e2) -> check_es m [e1; e2]
   and check_es m = List.iter (check_e m) in
   let check_lv m = function
     | Lnone _ | Lvar _ -> ()
diff --git a/compiler/safetylib/safetyAbsExpr.ml b/compiler/safetylib/safetyAbsExpr.ml
index a79fd69a8e..a1858e0f97 100644
--- a/compiler/safetylib/safetyAbsExpr.ml
+++ b/compiler/safetylib/safetyAbsExpr.ml
@@ -389,6 +389,9 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
     | Parr_init _ | Pget _ | Psub _
     | Pload _ | PappN _ | Pif _ -> None
 
+    (* FIXME *)
+    | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> None
+
 
   (* Try to evaluate e to a constant expression (of type word) in abs.
      Superficial checks only. *)
@@ -470,7 +473,17 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
       | Pload _ -> raise Expr_contain_load
 
       | Pif (_,_,e1,e2) (* FIXME: why the condition is not added ? *)
-      | Papp2 (_, e1, e2) -> aux (aux acc e1) e2 in
+      | Papp2 (_, e1, e2) -> aux (aux acc e1) e2
+
+      | Pbig(e0, _op, x, start, len, body) ->
+        let x = mvar_of_scoped_var Slocal (L.unloc x) in
+        let xs = aux [] body in
+        let xs = List.filter (fun y -> x <> y) xs in
+        let acc = xs @ acc in
+        aux (aux (aux acc e0) start) len
+      | Pis_var_init x -> mvar_of_scoped_var Slocal (L.unloc x) :: acc
+      | Pis_mem_init (e1, e2) -> aux (aux acc e1) e2
+    in
 
     try PtVars (aux [] e) with Expr_contain_load -> PtTopExpr
 
@@ -718,12 +731,22 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
         | e :: r_es -> match remove_if_expr_aux e with
           | None -> f_expl (i + 1) r_es
           | Some _ as r -> (i,r) in
-
+      begin
       match f_expl 0 es with
       | _,None -> None
       | i,Some (ty, b, el, er) ->
         let repi ex = List.mapi (fun j x -> if j = i then ex else x) es in
         Some (ty, b, PappN (opn, repi el), PappN (opn, repi er))
+    end
+
+    | Pis_var_init _ -> None
+    | Pis_mem_init (e1, e2) ->
+      begin match remove_if_expr_aux e1 with
+      | Some _ as e_opt -> map_f (fun ex -> Pis_mem_init(ex, e2)) e_opt
+      | None -> remove_if_expr_aux e2
+                |> map_f (fun ex -> Pis_mem_init(e1, ex)) end
+    | Pbig _ -> None
+
 
 
   let rec remove_if_expr (e : 'a Prog.gexpr) = match remove_if_expr_aux e with
@@ -1120,7 +1143,8 @@ module AbsExpr (Arch : SafetyArch.SafetyArch) (AbsDom : AbsNumBoolType) = struct
             apply_offset_expr abs outv info y er
           else aeval_top_offset abs outv
 
-        | _ -> aeval_top_offset abs outv end
+        | _ -> aeval_top_offset abs outv
+        end
 
     | Some outv, _ -> aeval_top_offset abs outv
 
diff --git a/compiler/safetylib/safetyInterpreter.ml b/compiler/safetylib/safetyInterpreter.ml
index 477e2eb4ba..8a72d7b189 100644
--- a/compiler/safetylib/safetyInterpreter.ml
+++ b/compiler/safetylib/safetyInterpreter.ml
@@ -223,7 +223,6 @@ let v_compare (loc,c) (loc',c') =
   lex [(fun () -> vloc_compare loc loc');
        (fun () ->  Stdlib.compare c c')]
 
-
 type warnings = (Format.formatter -> unit) list
 
 type analyse_res =
@@ -373,6 +372,10 @@ let rec safe_e_rec safe = function
     (* We do not check "is_defined e1 && is_defined e2" since
         (safe_e_rec (safe_e_rec safe e1) e2) implies it *)
     safe_e_rec (safe_e_rec (safe_e_rec safe e1) e2) e3
+  (* Should we fix this ? This function should disapear anyway because this is done in extraction for safety *)
+  | Pbig _ -> assert false
+  | Pis_var_init _x -> safe
+  | Pis_mem_init (e1, e2) -> safe_e_rec (safe_e_rec safe e1) e2
 
 let safe_e = safe_e_rec []
 
@@ -419,7 +422,7 @@ let safe_opn pd asmOp safe opn es =
         ]
       | Wsize.InRangeMod32(sz, lo, hi, n) ->
          let n = List.nth es (Conv.int_of_nat n) in
-         let n = Papp1 (E.uint_of_word sz, n) in
+         let n = Papp1 (Expr.uint_of_word sz, n) in
          let n = Papp2 (Omod (Unsigned, Op_int), n, Pconst (Z.of_int 32)) in
          [ InRange(Pconst (Conv.z_of_cz lo), Pconst (Conv.z_of_cz hi), n) ]
       | Wsize.AllInit(ws, p, i) ->
@@ -432,20 +435,20 @@ let safe_opn pd asmOp safe opn es =
 
       | ULt (sz, n, z) ->
         let n = List.nth es (Conv.int_of_nat n) in
-        let n = Papp1 (E.uint_of_word sz, n) in
+        let n = Papp1 (Expr.uint_of_word sz, n) in
         [ InRange(Pconst Z.zero, Pconst (Z.pred (Conv.z_of_cz z)), n)] (* n ∈ [0; z-1] *)
 
       | UGe (sz, z, n) ->
         let n = List.nth es (Conv.int_of_nat n) in
-        let n = Papp1 (E.uint_of_word sz, n) in
+        let n = Papp1 (Expr.uint_of_word sz, n) in
         let z = Pconst (Conv.z_of_cz z) in
         [ InRange(Pconst Z.zero, n, z) ] (* z ∈ [0; n] *)
 
       | UaddLe(sz, n1, n2, z) ->
         let n1 = List.nth es (Conv.int_of_nat n1) in
-        let n1 = Papp1 (E.uint_of_word sz, n1) in
+        let n1 = Papp1 (Expr.uint_of_word sz, n1) in
         let n2 = List.nth es (Conv.int_of_nat n2) in
-        let n2 = Papp1 (E.uint_of_word sz, n2) in
+        let n2 = Papp1 (Expr.uint_of_word sz, n2) in
         let n12 = Papp2 (Oadd Op_int, n1, n2) in
         let z = Pconst (Conv.z_of_cz z) in
         [ InRange(Pconst Z.zero, z, n12) ] (* n1 + n2 ∈ [0; z] *)
@@ -1051,6 +1054,7 @@ end = struct
 
 
   (* -------------------------------------------------------------------- *)
+
   let opn_dflt n = List.init n (fun _ -> None)
 
   (* -------------------------------------------------------------------- *)
@@ -1062,8 +1066,8 @@ end = struct
                          w_no_carry,
                          pcast ws (Pconst (Z.of_int 1))) in
 
-    let eli = Papp1 (E.uint_of_word ws, el)    (* (int)el *)
-    and eri = Papp1 (E.uint_of_word ws, er) in (* (int)er *)
+    let eli = Papp1 (Expr.uint_of_word ws, el)    (* (int)el *)
+    and eri = Papp1 (Expr.uint_of_word ws, er) in (* (int)er *)
     let w_i =
       Papp2 (Oadd Op_int, eli, eri) in (* (int)el + (int)er *)
     let pow_ws = Pconst (Z.pow (Z.of_int 2) (int_of_ws ws)) in (* 2^ws *)
@@ -1100,8 +1104,8 @@ end = struct
                          w_no_carry,
                          pcast ws (Pconst (Z.of_int 1))) in
 
-    let eli = Papp1 (E.uint_of_word ws, el)    (* (int)el *)
-    and eri = Papp1 (E.uint_of_word ws, er) in (* (int)er *)
+    let eli = Papp1 (Expr.uint_of_word ws, el)    (* (int)el *)
+    and eri = Papp1 (Expr.uint_of_word ws, er) in (* (int)er *)
 
     (* cf_no_carry is true <=> el < er *)
     let cf_no_carry = Papp2 (Olt Cmp_int, eli, eri ) in
@@ -1285,6 +1289,11 @@ end = struct
       | Papp2 (_, e1, e2)  -> nm_es vs_for [e1; e2]
       | PappN (_,es)       -> nm_es vs_for es
       | Pif (_, e, el, er) -> nm_es vs_for [e; el; er]
+      (* FIXME *)
+      | Pbig (e0, _, _, start, len, body) ->
+          nm_es vs_for [e0; start; len; body]
+      | Pis_var_init _ -> true
+      | Pis_mem_init _ -> false
 
     and nm_es vs_for es = List.for_all (nm_e vs_for) es
 
@@ -1444,7 +1453,6 @@ end = struct
         let cr = { ginstr with i_desc = Cassgn (lv, tag, ty2, er) } in
         aeval_if ginstr c [cl] [cr] state
 
-
       | Cassgn (lv, _, _, Parr_init _) ->
         let abs = AbsExpr.abs_forget_array_contents state.abs ginstr.i_info lv in
         { state with abs }
@@ -1963,7 +1971,7 @@ end
 
 module type ExportWrap = sig
   type extended_op
-  
+
   (* main function, before any compilation pass *)
   val main_source : (unit, extended_op) Prog.func
 
diff --git a/compiler/safetylib/safetyPreanalysis.ml b/compiler/safetylib/safetyPreanalysis.ml
index 54227beb73..e38614d208 100644
--- a/compiler/safetylib/safetyPreanalysis.ml
+++ b/compiler/safetylib/safetyPreanalysis.ml
@@ -113,6 +113,11 @@ end = struct
     | PappN (op,es) -> PappN (op, List.map (mk_expr fn) es)
     | Pif (ty, e, el, er)  ->
       Pif (ty, mk_expr fn e, mk_expr fn el, mk_expr fn er)
+    (* FIXME *)
+    | Pbig(e0, op, x, start, len, body) ->
+      Pbig(mk_expr fn e0, op, mk_v_loc fn x, mk_expr fn start, mk_expr fn len, mk_expr fn body)
+    | Pis_var_init x -> Pis_var_init (mk_v_loc fn x)
+    | Pis_mem_init (e1, e2) -> Pis_mem_init (mk_expr fn e1, mk_expr fn e2)
 
   and mk_exprs fn exprs = List.map (mk_expr fn) exprs
 
@@ -212,6 +217,7 @@ end = struct
     | PappN (_,es) -> List.fold_left (fun dp e -> app_expr dp v e ct) dp es
     | Pif (_,b,e1,e2) ->
       app_expr (app_expr (app_expr dp v b ct) v e1 ct) v e2 ct
+    | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> dp
 
   and app_expr_load dp e ct =
     match decompose_address e with
@@ -254,7 +260,15 @@ end = struct
       | Papp1 (_,e1) -> aux (acc,st) e1
       | Papp2  (_,e1,e2) -> aux (aux (acc,st) e1) e2
       | PappN (_,es) -> List.fold_left aux (acc,st) es
-      | Pif (_,b,e1,e2) -> aux (aux (aux (acc,st) e1) e2) b in
+      | Pif (_,b,e1,e2) -> aux (aux (aux (acc,st) e1) e2) b
+      | Pis_var_init x ->
+         begin match (L.unloc x).v_ty with
+         | Bty _ -> (L.unloc x) :: acc, st
+         | Arr _ -> acc, st
+         end
+      | Pis_mem_init(e1, e2) -> assert false
+      | Pbig (e0, _, x, start, len, body) -> assert false
+    in
 
     aux ([],st) e
 
@@ -278,7 +292,10 @@ end = struct
       | Papp1 (_,e1) -> aux acc e1
       | Papp2  (_,e1,e2) -> aux (aux acc e1) e2
       | PappN (_,es) -> List.fold_left aux acc es
-      | Pif (_,b,e1,e2) -> aux (aux (aux acc e1) e2) b in
+      | Pif (_,b,e1,e2) -> aux (aux (aux acc e1) e2) b
+      (* FIXME *)
+      | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> assert false
+    in
 
     aux acc e
 
@@ -526,6 +543,9 @@ end = struct
     | Papp2 (_,e1,e2) -> collect_vars_es sv [e1;e2]
     | PappN (_, el)  -> collect_vars_es sv el
     | Pif (_, e1, e2, e3) -> collect_vars_es sv [e1;e2;e3]
+    (* FIXME *)
+    | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> assert false
+
   and collect_vars_es sv es = List.fold_left collect_vars_e sv es
 
   let collect_vars_lv sv = function
diff --git a/compiler/safetylib/x86_safety.ml b/compiler/safetylib/x86_safety.ml
index db100d4a42..6d203d1c89 100644
--- a/compiler/safetylib/x86_safety.ml
+++ b/compiler/safetylib/x86_safety.ml
@@ -41,7 +41,7 @@ module X86_safety
 
   (* Carry flag is true if [w] and [vu] are not equal. *)
   let cf_of_word sz w vu =
-    Some (Papp2 (Oneq (Op_int),
+    Some (Papp2 (Oneq Op_int,
                  Papp1(E.uint_of_word sz,w),
                  vu))
 
diff --git a/compiler/src/alias.ml b/compiler/src/alias.ml
index fe7c7e6836..a75276aae4 100644
--- a/compiler/src/alias.ml
+++ b/compiler/src/alias.ml
@@ -206,10 +206,13 @@ let slice_of_pexpr a =
   function
   | Parr_init _ -> None
   | Pvar x -> Some (normalize_gvar a x)
+  | Pis_var_init x -> Some (normalize_var a (L.unloc x))
   | Psub (aa, ws, len, x, i) -> Some (normalize_asub a aa ws len x i)
   | PappN (Oarray _, _) -> hierror_no_loc "stack literal arrays are not supported"
-  | (Pconst _ | Pbool _ | Pget _ | Pload _ | Papp1 _ | Papp2 _ | PappN _ ) -> assert false
+  | (Pconst _ | Pbool _ | Pget _ | Pload _ | Papp1 _ | Papp2 _ | PappN _
+  | Pis_mem_init _) -> assert false
   | Pif _ -> hierror_no_loc "conditional move of (ptr) arrays is not supported yet"
+  | Pbig _ -> None
 
 let slice_of_lval a =
   function
diff --git a/compiler/src/arch_full.ml b/compiler/src/arch_full.ml
index 887a2710fb..00364c11a0 100644
--- a/compiler/src/arch_full.ml
+++ b/compiler/src/arch_full.ml
@@ -54,6 +54,7 @@ module type Arch = sig
   val reg_size : Wsize.wsize
   val pointer_data : Wsize.wsize
   val msf_size : Wsize.wsize
+  val fcp: Flag_combination.coq_FlagCombinationParams
   val rip : var
 
   val asmOp      : extended_op Sopn.asmOp
@@ -100,6 +101,7 @@ module Arch_from_Core_arch (A : Core_arch) :
   let reg_size = arch_decl.reg_size
   let pointer_data = arch_pd A.asm_e._asm._arch_decl
   let msf_size = arch_msfsz A.asm_e._asm._arch_decl
+  let fcp = arch_decl.ad_fcp
 
   let atoI = A.asm_e._atoI
   (* not sure it is the best place to define [rip], but we need to know [reg_size] *)
diff --git a/compiler/src/arch_full.mli b/compiler/src/arch_full.mli
index 65417911cf..d33f44588d 100644
--- a/compiler/src/arch_full.mli
+++ b/compiler/src/arch_full.mli
@@ -56,6 +56,7 @@ module type Arch = sig
   val reg_size : Wsize.wsize
   val pointer_data : Wsize.wsize
   val msf_size : Wsize.wsize
+  val fcp : Flag_combination.coq_FlagCombinationParams
   val rip : var
 
   val asmOp      : extended_op Sopn.asmOp
diff --git a/compiler/src/compile.ml b/compiler/src/compile.ml
index 03443095ee..c4369e7ed0 100644
--- a/compiler/src/compile.ml
+++ b/compiler/src/compile.ml
@@ -62,6 +62,13 @@ let do_spill_unspill asmop ?(debug = false) cp =
   | Utils0.Error msg -> Error (Conv.error_of_cerror (Printer.pp_err ~debug) msg)
   | Utils0.Ok p -> Ok (Conv.prog_of_cuprog p)
 
+let catch_error cp =
+  match cp with
+  | Utils0.Ok cp -> cp
+  | Utils0.Error e ->
+    let e = Conv.error_of_cerror (Printer.pp_err ~debug:false) e in
+    raise (HiError e)
+
 let do_wint_int
    (type reg regx xreg rflag cond asm_op extra_op)
     (module Arch : Arch_full.Arch
@@ -73,9 +80,11 @@ let do_wint_int
        and type asm_op = asm_op
        and type extra_op = extra_op) prog =
   let fdsi = snd prog in
-  let fv = List.fold_left (fun fv fd -> Sv.union fv (vars_fc fd)) Sv.empty fdsi in
-  let m =
-    Sv.fold (fun x m ->
+  let get_info p =
+    let p = Conv.prog_of_cuprog p in
+    let fv = List.fold_left (fun fv fd -> Sv.union fv (vars_fc_contracts fd)) Sv.empty (snd p) in
+    let m =
+      Sv.fold (fun x m ->
           match x.v_ty with
           | Bty (U _) ->
             begin match Annotations.has_wint x.v_annot with
@@ -87,17 +96,14 @@ let do_wint_int
             end
           | _ -> m)
       fv Mv.empty in
+    let info x =
+      let x = Conv.var_of_cvar x in
+      Mv.find_opt x m in
+    Conv.csv_of_sv fv ,info
+  in
   let cp = Conv.cuprog_of_prog prog in
-  let info x =
-    let x = Conv.var_of_cvar x in
-     Mv.find_opt x m in
-  let cp = Wint_int.wi2i_prog Arch.asmOp Arch.pointer_data Arch.msf_size info cp in
-  let cp =
-    match cp with
-    | Utils0.Ok cp -> cp
-    | Utils0.Error e ->
-      let e = Conv.error_of_cerror (Printer.pp_err ~debug:false) e in
-      raise (HiError e) in
+  let cp = Wint_int.wi2i_prog Arch.asmOp Arch.pointer_data Arch.msf_size get_info cp in
+  let cp = catch_error cp in
   let (gd, fdso) = Conv.prog_of_cuprog cp in
   (* Restore type of array in the functions signature *)
   let restore_ty tyi tyo =
@@ -115,6 +121,85 @@ let do_wint_int
   (gd, fds)
 
 
+(*--------------------------------------------------------------------- *)
+
+let add_default_contract args args_ty ret ret_ty =
+  let aux (x,t) =
+    match t with
+    | Arr (ws, len) ->
+      let len = arr_size ws len in
+      let plen = Conv.pos_of_int len in
+      [("safety",PappN (Ois_arr_init plen, [ Pvar (gkvar x);  Pconst Z.zero; Pconst (Z.of_int len) ]))]
+    | _ -> []
+  in
+  let create_new_var x = L.mk_loc L._dummy (GV.mk x.v_name x.v_kind x.v_ty x.v_dloc x.v_annot) in
+
+  let f_iparams = List.map (create_new_var) args in
+  let f_pre = List.flatten (List.map aux (List.combine f_iparams args_ty)) in
+  let ret = List.map (L.unloc) ret in
+  let f_ires = List.map (create_new_var) ret in
+  let f_post = List.flatten (List.map aux (List.combine f_ires ret_ty)) in
+  {
+    f_iparams; f_ires; f_pre; f_post;
+  }
+
+let add_default_contracts prog : global_decl list * (int, 'a, 'b) gfunc list =
+  let add_default_contract fd =
+    let c = match fd.f_contra with
+    | Some c -> Some c
+    | None -> Some (add_default_contract fd.f_args fd.f_tyin fd.f_ret fd.f_tyout)
+    in
+    {fd with f_contra = c }
+  in
+  let globs,funcs = prog in
+  globs,List.map add_default_contract funcs
+
+let create_safety_asserts
+   (type reg regx xreg rflag cond asm_op extra_op)
+    (module Arch : Arch_full.Arch
+      with type reg = reg
+       and type regx = regx
+       and type xreg = xreg
+       and type rflag = rflag
+       and type cond = cond
+       and type asm_op = asm_op
+       and type extra_op = extra_op) prog =
+  let memo = Hashtbl.create 5 in
+  let b (cv:Var0.Var.var) =
+      match Hashtbl.find memo cv with
+      | x -> x
+      | exception Not_found ->
+          let v = Conv.var_of_cvar cv in
+          let t = match v.v_ty with
+            |Arr (ws, x) ->  Arr(U8, (size_of_ws ws) * x)
+            | _ ->  tbool
+          in
+          let bv = V.mk ("b_"^v.v_name) (Reg (Normal, Direct)) t v.v_dloc [] in
+          let cbv = Conv.cvar_of_var bv in
+          Hashtbl.add memo cv cbv;
+          cbv
+  in
+  let create_var vk name t l =  Conv.cvar_of_var (V.mk name vk (Conv.ty_of_cty t) l []) in
+
+  let print_uprog _s cp = cp
+    (*let p = Conv.prog_of_cuprog cp in
+    Format.printf "After %s@. %a@.@.@."
+      s
+      (Printer.pp_prog ~debug:false Arch.pointer_data Arch.msf_size Arch.asmOp) p;
+    cp *)
+  in
+
+  let prog = add_default_contracts prog in
+  let cuprog = Conv.cuprog_of_prog prog in
+
+  let cuprog =
+    Compiler_extraction.create_safety_asserts
+      Arch.asmOp Arch.pointer_data Arch.msf_size create_var b Arch.fcp Arch.aparams.ap_is_move_op print_uprog cuprog in
+  let cuprog = catch_error cuprog in
+  let prog =  Conv.prog_of_cuprog cuprog in
+  prog
+
+
 (*--------------------------------------------------------------------- *)
 
 let compile (type reg regx xreg rflag cond asm_op extra_op)
diff --git a/compiler/src/compile.mli b/compiler/src/compile.mli
index 7f2bd7c512..3ea8c1ec35 100644
--- a/compiler/src/compile.mli
+++ b/compiler/src/compile.mli
@@ -59,6 +59,22 @@ val do_wint_int :
     ('reg, 'regx, 'xreg, 'rflag, 'cond, 'asm_op, 'extra_op) Arch_extra.extended_op Sopn.asm_op_t)
    prog
 
+val create_safety_asserts :
+  (module Arch_full.Arch
+     with type reg = 'reg
+      and type regx = 'regx
+      and type xreg = 'xreg
+      and type rflag = 'rflag
+      and type cond = 'cond
+      and type asm_op = 'asm_op
+      and type extra_op = 'extra_op) ->
+  (unit,
+    ('reg, 'regx, 'xreg, 'rflag, 'cond, 'asm_op, 'extra_op) Arch_extra.extended_op Sopn.asm_op_t)
+   prog ->
+  (unit,
+    ('reg, 'regx, 'xreg, 'rflag, 'cond, 'asm_op, 'extra_op) Arch_extra.extended_op Sopn.asm_op_t)
+   prog
+
 val compile :
   (module Arch_full.Arch
      with type reg = 'reg
diff --git a/compiler/src/conv.ml b/compiler/src/conv.ml
index adc5fabdde..b9c967344d 100644
--- a/compiler/src/conv.ml
+++ b/compiler/src/conv.ml
@@ -97,7 +97,11 @@ let rec cexpr_of_expr = function
   | Pif   (ty, e, e1, e2) -> C.Pif(cty_of_ty ty, 
                                 cexpr_of_expr e,
                                 cexpr_of_expr e1,
-                                cexpr_of_expr e2)
+                                   cexpr_of_expr e2)
+  | Pbig(e, o, x, e1, e2, e0) ->
+    C.Pbig(cexpr_of_expr e, o, cvari_of_vari x, cexpr_of_expr e1, cexpr_of_expr e2, cexpr_of_expr e0)
+  | Pis_var_init x -> C.Pis_var_init (cvari_of_vari x)
+  | Pis_mem_init (e1,e2) -> C.Pis_mem_init (cexpr_of_expr e1,cexpr_of_expr e2)
 
 let rec expr_of_cexpr = function
   | C.Pconst z          -> Pconst (z_of_cz z)
@@ -112,7 +116,11 @@ let rec expr_of_cexpr = function
   | C.PappN (o, es) -> PappN (o, List.map (expr_of_cexpr) es)
   | C.Pif (ty, e, e1, e2) -> Pif(ty_of_cty ty, expr_of_cexpr e,
                                expr_of_cexpr e1,
-                               expr_of_cexpr e2)
+                                 expr_of_cexpr e2)
+  | C.Pbig(e, o, x, e1, e2, e0) ->
+    Pbig(expr_of_cexpr e, o, vari_of_cvari x, expr_of_cexpr e1, expr_of_cexpr e2, expr_of_cexpr e0)
+  | C.Pis_var_init x -> Pis_var_init (vari_of_cvari x)
+  | C.Pis_mem_init (e1,e2) -> Pis_mem_init (expr_of_cexpr e1,expr_of_cexpr e2)
 
 
 (* ------------------------------------------------------------------------ *)
@@ -231,6 +239,19 @@ and instr_r_of_cinstr_r = function
 and stmt_of_cstmt c =
   List.map instr_of_cinstr c
 
+(* ------------------------------------------------------------------------ *)
+
+let contra_of_ccontra c =
+  let aux =
+    List.map (fun (prover,clause) -> prover,cexpr_of_expr clause)
+  in
+  Some
+  {
+    C.f_iparams =  List.map cvari_of_vari c.f_iparams;
+    C.f_ires = List.map cvari_of_vari c.f_ires;
+    C.f_pre = aux c.f_pre;
+    C.f_post = aux c.f_post;
+  }
 
 (* ------------------------------------------------------------------------ *)
 let cufdef_of_fdef fd =
@@ -241,6 +262,7 @@ let cufdef_of_fdef fd =
   let f_body = cstmt_of_stmt fd.f_body in
   let f_res = List.map cvari_of_vari fd.f_ret in
   fn, { C.f_info   = f_info;
+        C.f_contra = Option.bind fd.f_contra contra_of_ccontra;
         C.f_tyin   = List.map cty_of_ty fd.f_tyin;
         C.f_params = f_params;
         C.f_body   = f_body;
@@ -249,11 +271,23 @@ let cufdef_of_fdef fd =
         C.f_extra  = ();
       }
 
+let ccontra_of_contra c =
+  let aux =
+    List.map (fun (prover,clause) -> prover,expr_of_cexpr clause)
+  in
+  Some
+  {
+    f_iparams = List.map vari_of_cvari C.(c.f_iparams);
+    f_ires = List.map vari_of_cvari C.(c.f_ires);
+    f_pre = aux C.(c.f_pre);
+    f_post = aux C.(c.f_post);
+  }
 
 let fdef_of_cufdef (fn, fd) =
   let f_loc, f_annot, f_cc, f_ret_info = fd.C.f_info in
   { f_loc;
     f_annot;
+    f_contra = Option.bind fd.f_contra ccontra_of_contra;
     f_cc;
     f_info = ();
     f_name = fn;
diff --git a/compiler/src/ct_checker_forward.ml b/compiler/src/ct_checker_forward.ml
index 1a88f832d5..f160707236 100644
--- a/compiler/src/ct_checker_forward.ml
+++ b/compiler/src/ct_checker_forward.ml
@@ -358,6 +358,8 @@ let rec ty_expr ~(public:bool) env (e:expr) =
     let public = public || not (is_ct_opN o) in
     ty_exprs_max ~public env es
   | Pif(_, e1, e2, e3) -> ty_exprs_max ~public env [e1; e2; e3]
+  (* This are used only for assertion, and should have been removed *)
+  | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> assert false
 
 and ty_exprs ~public env es =
   List.map_fold (ty_expr ~public) env es
diff --git a/compiler/src/evaluator.ml b/compiler/src/evaluator.ml
index 30b1df80cf..3ac1cf6fa6 100644
--- a/compiler/src/evaluator.ml
+++ b/compiler/src/evaluator.ml
@@ -23,6 +23,7 @@ let pp_error fmt err =
   | ErrType  -> "type error"
   | ErrArith -> "arithmetic error"
   | ErrSemUndef -> "undefined semantics"
+  | ErrUnknowFun -> "unknow function"
   | ErrAssert _ -> "assertion violation"
 
 let exn_exec (ii:instr_info) (r: 't exec) = 
@@ -36,6 +37,11 @@ let of_val_z ii v : coq_Z =
 let of_val_b ii v : bool = 
   Obj.magic (exn_exec ii (of_val Coq_cbool v))
 
+(* ----------------------------------------------------------------- *)
+
+let withAssert = false
+let withCatch = false
+
 (* ----------------------------------------------------------------- *)
 type 'asm stack = 
   | Sempty of instr_info * 'asm fundef
@@ -69,7 +75,7 @@ let return ep spp s =
     let vres = 
       exn_exec ii (mapM (fun (x:var_i) -> get_var nosubword true vm2 x.v_var) f.f_res) in
     let vres' = exn_exec ii (mapM2 ErrType truncate_val (List.map Type.eval_atype f.f_tyout) vres) in
-    let s1 = exn_exec ii (write_lvals nosubword ep spp true gd {escs = scs2; emem = m2; evm = vm1 } xs vres') in
+    let s1 = exn_exec ii (write_lvals withCatch nosubword ep spp withAssert true gd {escs = scs2; emem = m2; evm = vm1 } xs vres') in
     { s with 
       s_cmd = c;
       s_estate = s1;
@@ -94,36 +100,36 @@ let small_step1 ep spp sip s =
     match ir with
 
     | Cassgn(x,_,ty,e) ->
-      let v  = exn_exec ii (sem_pexpr nosubword ep spp true gd s1 e) in
+      let v  = exn_exec ii (sem_pexpr withCatch nosubword ep spp withAssert true gd s1 e) in
       let v' = exn_exec ii (truncate_val (eval_atype ty) v) in
-      let s2 = exn_exec ii (write_lval nosubword ep spp true gd x v' s1) in
+      let s2 = exn_exec ii (write_lval withCatch nosubword ep spp withAssert true gd x v' s1) in
       { s with s_cmd = c; s_estate = s2 }
 
     | Copn(xs,_,op,es) ->
-      let s2 = exn_exec ii (sem_sopn nosubword ep spp sip._asmop gd op s1 xs es) in
+      let s2 = exn_exec ii (sem_sopn withCatch nosubword ep spp withAssert sip._asmop gd  op s1 xs es) in
       { s with s_cmd = c; s_estate = s2 }
 
     | Csyscall(xs,o, es) ->
-      let ves = exn_exec ii (sem_pexprs nosubword ep spp true gd s1 es) in
+      let ves = exn_exec ii (sem_pexprs withCatch nosubword ep spp withAssert true gd s1 es) in
       let ((scs, m), vs) =
         exn_exec ii (syscall_sem__ sip._sc_sem ep._pd s1.escs s1.emem o ves) in
-      let s2 = exn_exec ii (write_lvals nosubword ep spp true gd {escs = scs; emem = m; evm = s1.evm} xs vs) in
+      let s2 = exn_exec ii (write_lvals withCatch nosubword ep spp withAssert true gd {escs = scs; emem = m; evm = s1.evm} xs vs) in
       { s with s_cmd = c; s_estate = s2 }
 
     | Cassert (p,a) ->
-      let v = exn_exec ii (sem_pexpr nosubword ep spp true gd s1 a) in
+      let v = exn_exec ii (sem_pexpr withCatch nosubword ep spp withAssert true gd s1 a) in
       let b = of_val_b ii v in
       if not b then raise (Eval_error(ii, ErrAssert p));
       { s with s_cmd = c }
 
     | Cif(e,c1,c2) ->
-      let b = of_val_b ii (exn_exec ii (sem_pexpr nosubword ep spp true gd s1 e)) in
+      let b = of_val_b ii (exn_exec ii (sem_pexpr withCatch nosubword ep spp withAssert true gd s1 e)) in
       let c = (if b then c1 else c2) @ c in
       { s with s_cmd = c }
 
     | Cfor (i,((d,lo),hi), body) ->
-      let vlo = of_val_z ii (exn_exec ii (sem_pexpr nosubword ep spp true gd s1 lo)) in
-      let vhi = of_val_z ii (exn_exec ii (sem_pexpr nosubword ep spp true gd s1 hi)) in
+      let vlo = of_val_z ii (exn_exec ii (sem_pexpr withCatch nosubword ep spp withAssert true gd s1 lo)) in
+      let vhi = of_val_z ii (exn_exec ii (sem_pexpr withCatch nosubword ep spp withAssert true gd s1 hi)) in
       let rng = wrange d vlo vhi in
       let s =
         {s with s_cmd = []; s_stk = Sfor(ii, i, rng, body, c, s.s_stk) } in
@@ -133,7 +139,7 @@ let small_step1 ep spp sip s =
       { s with s_cmd = c1 @ MkI(ii, Cif(e, c2@[i],[])) :: c }
 
     | Ccall(xs,fn,es) ->
-      let vargs' = exn_exec ii (sem_pexprs nosubword ep spp true gd s1 es) in
+      let vargs' = exn_exec ii (sem_pexprs withCatch nosubword ep spp withAssert true gd s1 es) in
       let f = 
         match get_fundef s.s_prog.p_funcs fn with
         | Some f -> f
@@ -142,7 +148,8 @@ let small_step1 ep spp sip s =
       let {escs; emem = m1; evm = vm1}  = s1 in
       let stk = Scall(ii,f, xs, vm1, c, s.s_stk) in
       let sf = 
-        exn_exec ii (write_vars nosubword ep true f.f_params vargs {escs; emem = m1; evm = Vm.init nosubword}) in
+        exn_exec ii (write_vars nosubword ep true f.f_params vargs {escs; emem = m1; evm = Vm.init nosubword})
+      in
       {s with s_cmd = f.f_body;
               s_estate = sf;
               s_stk = stk }
diff --git a/compiler/src/insert_copy_and_fix_length.ml b/compiler/src/insert_copy_and_fix_length.ml
index bcec21012a..7588c57009 100644
--- a/compiler/src/insert_copy_and_fix_length.ml
+++ b/compiler/src/insert_copy_and_fix_length.ml
@@ -32,11 +32,61 @@ let size_of_lval =
   | Lasub (_, ws, len, _, _) -> arr_size ws len
   | Lnone _ | Lmem _ | Laset _ -> assert false
 
+
+let rec fix_length_e e =
+  match e with
+  | Pconst _ | Pbool _ | Pvar _ | Parr_init _ | Pis_var_init _ -> e
+  | Papp1 (o, e) ->
+    let e = fix_length_e e in
+    Papp1 (o, e)
+  | Papp2 (o, e1, e2) ->
+    let e1 = fix_length_e e1 in
+    let e2 = fix_length_e e2 in
+    Papp2(o, e1, e2)
+  | PappN (o, es) ->
+    let es = List.map fix_length_e es in
+    begin match o, es with
+
+    | Ois_arr_init _, e::_ ->
+      let ty = Typing.type_of_expr e in
+      let len = size_of ty in
+      PappN (Ois_arr_init (Conv.pos_of_int len), es)
+    | Ois_arr_init _, _ -> assert false
+
+    | Ois_barr_init _,  e::_ ->
+      let ty = Typing.type_of_expr e in
+      let len = size_of ty in
+      PappN (Ois_barr_init (Conv.pos_of_int len), es)
+    | Ois_barr_init _, _ -> assert false
+
+    | Opack _, _ | Ocombine_flags _, _ | Oarray _, _ -> PappN (o, es)
+    end
+  | Pget (al, aa, ws, x, e) -> Pget (al, aa, ws, x, fix_length_e e)
+  | Psub (aa, ws, len, x, e) -> Psub (aa, ws, len, x, fix_length_e e)
+  | Pload (al, ws, e) -> Pload (al, ws, fix_length_e e)
+  | Pif (ty, e, e1, e2) -> Pif (ty, fix_length_e e, fix_length_e e1, fix_length_e e2)
+  | Pbig(e1, op, x, e2, e3, e4) -> Pbig(fix_length_e e1, op, x, fix_length_e e2, fix_length_e e3, fix_length_e e4)
+  | Pis_mem_init(e1, e2) -> Pis_mem_init(fix_length_e e1, fix_length_e e2)
+
+let fix_length_es = List.map fix_length_e
+
+let fix_length_lv lv =
+ match lv with
+ | Lnone _ | Lvar _ -> lv
+ | Lmem(al, ws, l, e) ->  Lmem(al, ws, l, fix_length_e e)
+ | Laset(al, aa, ws, x, e) -> Laset(al, aa, ws, x, fix_length_e e)
+ | Lasub(aa, ws, len, x, e) -> Lasub(aa, ws, len, x, fix_length_e e)
+
+let fix_length_lvs = List.map fix_length_lv
+
+let fix_length_assert (s,e) =  (s,fix_length_e e)
+
 let rec iac_stmt pd is = List.map (iac_instr pd) is
 and iac_instr pd i = { i with i_desc = iac_instr_r pd i.i_loc i.i_desc }
 and iac_instr_r pd loc ir =
   match ir with
   | Cassgn (x, t, _, e) ->
+    let x, e = fix_length_lv x, fix_length_e e in
     if !Glob_options.introduce_array_copy then
       match is_array_copy x e with
       | None -> ir
@@ -47,11 +97,14 @@ and iac_instr_r pd loc ir =
           let op = Pseudo_operator.Ocopy(ws, Conv.pos_of_int n) in
           Copn([x], t, Sopn.Opseudo_op op, [e])
     else ir
-  | Cif (b, th, el) -> Cif (b, iac_stmt pd th, iac_stmt pd el)
-  | Cfor (i, r, s) -> Cfor (i, r, iac_stmt pd s)
-  | Cwhile (a, c1, t, info, c2) -> Cwhile (a, iac_stmt pd c1, t, info, iac_stmt pd c2)
+  | Cif (b, th, el) -> Cif (fix_length_e b, iac_stmt pd th, iac_stmt pd el)
+  | Cfor (i, (d, e1, e2), s) ->
+    let e1, e2 = fix_length_e e1, fix_length_e e2 in
+    Cfor (i, (d, e1, e2), iac_stmt pd s)
+  | Cwhile (a, c1, t, info, c2) ->
+    Cwhile (a, iac_stmt pd c1, fix_length_e t, info, iac_stmt pd c2)
   | Copn (xs,t,o,es) ->
-
+    let xs, es = fix_length_lvs xs, fix_length_es es in
     begin match o, xs with
     | Sopn.Opseudo_op(Pseudo_operator.Ospill(o,_)), _ ->
       let tys = List.map (fun e -> Conv.cty_of_ty (Typing.ty_expr pd loc e)) es in
@@ -94,6 +147,7 @@ and iac_instr_r pd loc ir =
     end
 
   | Csyscall(xs, o, es) ->
+    let xs, es = fix_length_lvs xs, fix_length_es es in
     begin match o with
     | Syscall_t.RandomBytes _ ->
       (* Fix the size it is dummy for the moment *)
@@ -105,10 +159,23 @@ and iac_instr_r pd loc ir =
       Csyscall(xs, Syscall_t.RandomBytes (ws, Conv.pos_of_int len), es)
     end
 
-  | Ccall _ | Cassert _ -> ir
+  | Ccall (xs, f, es) ->
+    let xs, es = fix_length_lvs xs, fix_length_es es in
+    Ccall(xs, f, es)
+
+  | Cassert (s,e) -> Cassert(s,fix_length_e e)
+
+let fix_length_contra fc =
+  { fc with
+    f_pre = List.map fix_length_assert fc.f_pre;
+    f_post = List.map fix_length_assert fc.f_post
+  }
 
 let iac_func pd f =
-  { f with f_body = iac_stmt pd f.f_body }
+  { f with
+    f_body = iac_stmt pd f.f_body;
+    f_contra = Option.map fix_length_contra f.f_contra
+  }
 
 let doit pd (p:(unit, 'asm) Prog.prog) : (unit, 'asm) Prog.prog =
   (fst p, List.map (iac_func pd) (snd p))
diff --git a/compiler/src/latex_printer.ml b/compiler/src/latex_printer.ml
index b86179d3f3..4f7f97cfc7 100644
--- a/compiler/src/latex_printer.ml
+++ b/compiler/src/latex_printer.ml
@@ -107,6 +107,23 @@ let pp_aligned =
       F.fprintf fmt "%a%a " sharp () pannot (string_of_align al)
     )
 
+let pp_result fmt i = Format.fprintf fmt "result.%s" i
+
+let pp_ws fmt w =
+  F.fprintf fmt "%a" ptype (string_of_swsize_ty w)
+
+let pp_arr_access_gen fmt al aa ws pp_var x pp_expr e len =
+  let ws = Option.map L.unloc ws in
+  let pp_olen fmt len =
+    match len with
+    | None -> ()
+    | Some len -> Format.fprintf fmt " : %a" pp_expr len in
+  F.fprintf fmt "%a%s[%a%a%a%a%a]"
+    pp_var x
+    (if aa = Warray_.AAdirect then "." else "")
+    pp_aligned (Option.bind len (fun _ -> al))
+    (pp_opt pp_ws) ws (pp_opt pp_space) ws pp_expr e pp_olen len
+
 let rec pp_simple_attribute fmt a =
   match L.unloc a with
   | PAstring s -> pannot fmt (Format.asprintf "%a" pp_string s)
@@ -159,12 +176,24 @@ and pp_expr_rec prio fmt pe =
     optparent fmt prio p "(";
     F.fprintf fmt "%a ? %a : %a" (pp_expr_rec p) e1 (pp_expr_rec p) e2 (pp_expr_rec p) e3;
     optparent fmt prio p ")"
+  | PEbig(bop, x, body, start, len) ->
+    Format.fprintf fmt "@[<hov 2>%a@ (%a in %a : %a)@ (%a)@]"
+      pp_big bop pp_var x pp_expr start pp_expr len pp_expr body
+  | PEResult i -> pp_result fmt i
+  | PEResultGet (al, aa, ws, i, e, len) ->
+    pp_arr_access_gen fmt al aa ws pp_result i pp_expr e len
+
+and pp_big fmt bop =
+  match bop with
+  | PEBop(o, e0) -> Format.fprintf fmt "%a[%a/%a]" kw "big" pp_op2 o pp_expr e0
+  | PESum-> kw fmt "sum"
+  | PEAll -> kw fmt "all"
+  | PEExists -> kw fmt "exists"
 
 and pp_mem_access fmt (al, ty, e) =
   let pp_size fmt ws = Format.fprintf fmt ":%a " pp_ws ws in
   F.fprintf fmt "[%a%a%a]" pp_aligned al (pp_opt pp_size) (Option.map L.unloc ty)  pp_expr e
 
-
 and pp_type fmt ty =
   match L.unloc ty with
   | TBool -> F.fprintf fmt "%a" ptype "bool"
@@ -173,22 +202,9 @@ and pp_type fmt ty =
   | TArray (w, e) -> F.fprintf fmt "%a[%a]" ptype (Syntax.string_of_sizetype w) pp_expr e
   | TAlias id -> F.fprintf fmt "%a" ptype (L.unloc id)
 
-and pp_ws fmt w =
-  F.fprintf fmt "%a" ptype (string_of_swsize_ty w)
-
 and pp_expr fmt e = pp_expr_rec Pmin fmt e
 
-and pp_arr_access fmt al aa ws x e len=
- let ws = Option.map L.unloc ws in
- let pp_olen fmt len =
-   match len with
-   | None -> ()
-   | Some len -> Format.fprintf fmt " : %a" pp_expr len in
- F.fprintf fmt "%a%s[%a%a%a%a%a]"
-    pp_var x
-    (if aa = Warray_.AAdirect then "." else "")
-    pp_aligned (Option.bind len (fun _ -> al))
-    (pp_opt pp_ws) ws (pp_opt pp_space) ws pp_expr e pp_olen len
+and pp_arr_access fmt al aa ws x e len = pp_arr_access_gen fmt al aa ws pp_var x pp_expr e len
 
 let pp_storage fmt s =
   latex "storageclass" fmt (pp_storage s)
diff --git a/compiler/src/lexer.mll b/compiler/src/lexer.mll
index 130abbf2a7..ec2679406d 100644
--- a/compiler/src/lexer.mll
+++ b/compiler/src/lexer.mll
@@ -83,6 +83,16 @@
 
   let keywords = Hash.of_enum (List.enum _keywords)
 
+  let _big = [
+    "all"   , ALL    ;
+    "big"   , BIG    ;
+    "exists", EXISTS ;
+    "in"    , IN     ;
+    "sum"   , SUM    ;
+  ]
+
+  let big = Hash.of_enum (List.enum _big)
+
   let sign_of_char =
   function
   | 'u' -> `Unsigned
@@ -178,6 +188,9 @@ rule main = parse
   | ident as s
       { Option.default (NID s) (Hash.find_option keywords s) }
 
+  | "\\" (ident as s) 
+    { Option.get_exn (Hash.find_option big s) (S.ParseError (L.of_lexbuf lexbuf, Some "invalid big ops")) }  
+
   | (size as sw) (wsign as s)
       { SWSIZE(size_of_string sw, mkwsign s)  }
 
diff --git a/compiler/src/parser.mly b/compiler/src/parser.mly
index 911298f385..4b06121e7f 100644
--- a/compiler/src/parser.mly
+++ b/compiler/src/parser.mly
@@ -23,9 +23,11 @@
 %token ALIGNED
 %token AMP
 %token AMPAMP
+%token ALL
 %token ASSERT
 %token BANG
 %token BANGEQ
+%token BIG
 %token COLON
 %token COLONCOLON
 %token COMMA
@@ -36,6 +38,7 @@
 %token EQ
 %token EQEQ
 %token EXEC
+%token EXISTS
 %token FALSE
 %token FN
 %token FOR
@@ -47,6 +50,7 @@
 %token <Syntax.sign option>GTGT
 %token HAT
 %token IF
+%token IN
 %token INLINE
 %token <Syntax.sign option> LE
 %token <Syntax.sign option> LT
@@ -68,6 +72,7 @@
 %token ROR
 %token ROL
 %token SEMICOLON
+%token SUM
 %token <Syntax.swsize> SWSIZE
 %token <Syntax.svsize> SVSIZE
 %token <Syntax.sign option> SLASH
@@ -312,6 +317,20 @@ pexpr_noarr_r(parent):
 | e1=parent QUESTIONMARK e2=parent COLON e3=parent
     { PEIf(e1, e2, e3) }
 
+| bo= big LPAREN v=var IN e1=parent COLON e2=parent RPAREN LPAREN b=parent RPAREN
+    { PEbig (bo, v, b, e1, e2) }
+
+(* FIXME this syntax is horrible *)
+| v=var DOT i=INT
+    { if L.unloc v <> "result" then
+        Syntax.parse_error ~msg:"`result` expected" (L.loc v);
+      PEResult i }
+
+| v=var DOT index=INT i=arr_access
+    { if L.unloc v <> "result" then
+        Syntax.parse_error ~msg:"`result` expected" (L.loc v);
+      let aa, (ws, e, len, al) = i in PEResultGet (al, aa, ws, index, e, len) }
+
 pexpr_noarr:
 | e=loc(pexpr_noarr_r(pexpr_noarr)) { e }
 
@@ -321,6 +340,12 @@ pexpr_r:
 pexpr:
 | e=loc(pexpr_r) { e }
 
+%inline big:
+| BIG LBRACKET o=peop2 SLASH e0=pexpr RBRACKET   { PEBop(o,e0) }
+| SUM                                            { PESum }
+| ALL                                            { PEAll }
+| EXISTS                                         { PEExists }
+
 (* -------------------------------------------------------------------- *)
 peqop:
 |                EQ  { `Raw    }
@@ -475,6 +500,13 @@ call_conv :
 | EXPORT { `Export }
 | INLINE { `Inline }
 
+(*
+requires:
+| REQUIRES a=annotations LBRACE pe=pexpr RBRACE { (a,pe) }
+
+ensures:
+| ENSURES a=annotations LBRACE pe=pexpr RBRACE { (a,pe) }
+*)
 pfundef:
 |  pdf_annot = annotations
     cc=call_conv?
diff --git a/compiler/src/pretyping.ml b/compiler/src/pretyping.ml
index b6a4c4dfd6..601aa03f6c 100644
--- a/compiler/src/pretyping.ml
+++ b/compiler/src/pretyping.ml
@@ -25,6 +25,7 @@ type tyerror =
   | InvalidArrayType    of P.epty
   | TypeMismatch        of P.epty pair
   | NoOperator          of sop * P.epty list
+  | UnknownResult       of int
   | InvalidOperator     of sop
   | NoReturnStatement   of P.funname * int
   | InvalidReturnStatement of P.funname * int * int
@@ -95,7 +96,10 @@ let pp_tyerror fmt (code : tyerror) =
 
   | InvalidArrayType ty ->
     F.fprintf fmt "the expression has type %a instead of array"
-       pp_eptype ty
+      pp_eptype ty
+
+  | UnknownResult i ->
+      F.fprintf fmt "unknown result: `%i'" i
 
   | TypeMismatch (t1,t2) ->
     F.fprintf fmt
@@ -260,6 +264,9 @@ module Env : sig
   val add_reserved : 'asm env -> string -> 'asm env
   val is_reserved : 'asm env -> string -> bool
 
+  val add_f_result : 'asm env -> (P.pvar * P.epty) list -> 'asm env
+  val get_f_result : 'asm env -> int -> (P.pvar * P.epty)
+
   val set_known_implicits : 'asm env -> (string * string) list -> 'asm env
   val get_known_implicits : 'asm env -> (string * string) list
 
@@ -317,6 +324,7 @@ end  = struct
     e_reserved : Ss.t;     (* Set of string (variable name) declared by the user,
                               fresh variables introduced by the compiler
                               should be disjoint from this set *)
+    e_fresult : (P.pvar * P.epty) list;
     e_known_implicits : (string * string) list;  (* Association list for implicit flags *)
   }
 
@@ -336,6 +344,7 @@ end  = struct
     ; e_loader  = empty_loader
     ; e_declared = ref P.Spv.empty
     ; e_reserved = Ss.empty
+    ; e_fresult = []
     ; e_known_implicits = [];
     }
 
@@ -345,6 +354,12 @@ end  = struct
   let is_reserved env s =
     Ss.mem s env.e_reserved
 
+  let add_f_result env s =
+    {env with e_fresult = s}
+
+  let get_f_result env i =
+    List.at env.e_fresult i
+
   let set_known_implicits env known_implicits = { env with e_known_implicits = known_implicits }
   let get_known_implicits env = env.e_known_implicits
 
@@ -1232,6 +1247,94 @@ let array_of_string s =
   c |> Char.code |> Z.of_int |> fun z ->
   P.(Papp1 (op_word_of_int(Word, W.Unsigned, W.U8), Pconst z))
 
+let create_is_mem_init pd loc args =
+  if List.length args == 2 then
+    let (e1,t1), (e2,t2) = List.at args 0, List.at args 1 in
+    let _ = check_ty_eq ~loc ~from:t1 ~to_:(P.etw pd) in
+    let e2 = cast_int loc None e2 t2 in
+    P.Pis_mem_init (e1,e2), P.etbool
+  else
+    rs_tyerror ~loc (InvalidArgCount(2, List.length args))
+
+let create_is_arr_init _pd loc args =
+  if List.length args == 3 then
+    let (e1,t1), (e2,t2), (e3,t3) = List.at args 0, List.at args 1, List.at args 2 in
+    let _ = match t1 with
+      | P.ETarr _ -> ()
+      | _ -> rs_tyerror ~loc (InvalidArrayType (t1))
+    in
+    let e2 = cast_int loc None e2 t2 in
+    let e3 = cast_int loc None e3 t3 in
+    (* The size will be fixed later *)
+    P.PappN (Ois_arr_init (Conv.pos_of_int 1) , [ e1; e2; e3]), P.etbool
+  else
+    rs_tyerror ~loc (InvalidArgCount(3, List.length args))
+
+let create_is_var_init _pd loc args =
+  if List.length args == 1 then
+    let (e, _t) = List.at args 0 in
+    let var_e = match e with
+      | P.Pvar v -> v.gv
+      | _ -> rs_tyerror ~loc (string_error "is_var_init expects a variable as an argument")
+    in
+    P.Pis_var_init (var_e), P.etbool
+  else
+    rs_tyerror ~loc (InvalidArgCount(1, List.length args))
+
+let create_min_e _pd loc args =
+  if List.length args == 2 then
+    let (e1,t1), (e2,t2) = List.at args 0, List.at args 1 in
+    let e1 = cast_int loc None e1 t1 in
+    let e2 = cast_int loc None e2 t2 in
+    let c = P.Papp2 ((Olt Cmp_int), e1, e2) in
+    P.Pif (Bty Int,c, e1,e2), P.etint
+  else
+    rs_tyerror ~loc (InvalidArgCount(2, List.length args))
+
+let create_max_e _pd loc args =
+  if List.length args == 2 then
+    let (e1,t1), (e2,t2) = List.at args 0, List.at args 1 in
+    let e1 = cast_int loc None e1 t1 in
+    let e2 = cast_int loc None e2 t2 in
+    let c = P.Papp2 ((Olt Cmp_int), e2, e1) in
+    P.Pif (Bty Int,c, e1,e2), P.etint
+  else
+    rs_tyerror ~loc (InvalidArgCount(2, List.length args))
+
+let init_predicates_map = Map.of_seq @@ List.to_seq [
+  ("is_mem_init",create_is_mem_init);
+  ("is_arr_init",create_is_arr_init);
+  ("is_var_init",create_is_var_init);
+  ("min",create_min_e);
+  ("max",create_max_e);
+];;
+
+(* -------------------------------------------------------------------- *)
+let bigop_check_type pd ?(mode=`AllVar) (env : 'asm Env.env) op body_ty pe (tt_expr: W.wsize -> ?mode:tt_mode -> 'asm Env.env -> S.pexpr_r L.located -> P.pexpr_ P.gexpr * P.pexpr_ CoreIdent.gety) =
+  match op with
+  | S.PEBop(pop,pe0) ->
+    let e0, ty0 = tt_expr pd ~mode env pe0 in
+    let exn = tyerror ~loc:(L.loc pe) (NoOperator (`Op2 pop, [body_ty; body_ty])) in
+    let o = op2_of_pop2 exn body_ty pop in
+    let ty1, ty2, tyo = type_of_op2 o in
+    check_ty_eq ~loc:(L.loc pe) ~from:tyo ~to_:body_ty;
+    check_ty_eq ~loc:(L.loc pe) ~from:ty1 ~to_:body_ty;
+    check_ty_eq ~loc:(L.loc pe) ~from:ty2 ~to_:body_ty;
+    check_ty_eq ~loc:(L.loc pe) ~from:ty0 ~to_:body_ty;
+    o,e0
+  | S.PEAll ->
+    check_ty_eq ~loc:(L.loc pe) ~from:body_ty ~to_:P.etbool;
+    Oand, P.Pbool true
+  | S.PEExists ->
+    check_ty_eq ~loc:(L.loc pe) ~from:body_ty ~to_:P.etbool;
+    Oor, P.Pbool false
+  | S.PESum ->
+    begin match body_ty with
+    | ETint    -> Oadd Op_int, P.Pconst Z.zero
+    | ETword (_, w)  -> Oadd (Op_w w), P.Papp1 (Oword_of_int w, P.Pconst Z.zero)
+    | _ -> raise (tyerror ~loc:(L.loc pe) (StringError "the expression should have type int or uXX"))
+    end
+
 (* -------------------------------------------------------------------- *)
 let rec tt_expr pd ?(mode=`AllVar) (env : 'asm Env.env) pe =
   match L.unloc pe with
@@ -1348,8 +1451,13 @@ let rec tt_expr pd ?(mode=`AllVar) (env : 'asm Env.env) pe =
   | S.PECall (id, args) when is_combine_flags id ->
     tt_expr ~mode pd env (L.mk_loc (L.loc pe) (S.PECombF(id,args)))
 
-  | S.PECall _ ->
-    rs_tyerror ~loc:(L.loc pe) CallNotAllowed
+  | S.PECall (id,args) ->
+    let pa_name = L.unloc id in
+    let args = List.map (tt_expr ~mode pd env) args in
+    begin match Map.find pa_name init_predicates_map with
+    | create_pred -> create_pred pd (L.loc id) args
+    | exception Not_found -> rs_tyerror ~loc:(L.loc pe) CallNotAllowed
+    end
 
   | S.PEPrim _ ->
     rs_tyerror ~loc:(L.loc pe) PrimNotAllowed
@@ -1378,6 +1486,44 @@ let rec tt_expr pd ?(mode=`AllVar) (env : 'asm Env.env) pe =
     let ty = max_ty ty2 ty3 |> oget ~exn:(tyerror ~loc:(L.loc pe3) (TypeMismatch (ty3, ty2))) in
     P.Pif(P.gty_of_gety ty, e1, e2, e3), ty
 
+  | S.PEbig(op, px, body, start, len) ->
+    let e1, ty1 = tt_expr ~mode pd env start in
+    let e2, ty2 = tt_expr ~mode pd env len in
+    check_ty_eq ~loc:(L.loc start) ~from:ty1 ~to_:P.etint;
+    check_ty_eq ~loc:(L.loc len) ~from:ty2 ~to_:P.etint;
+    let x = (P.PV.mk (L.unloc px) Wsize.Inline P.tint (L.loc px) []) in
+    let env = Env.Vars.push_local env (x, P.etint) in
+    let body, ty = tt_expr ~mode pd env body in
+    let o, idx = bigop_check_type pd env op ty pe tt_expr in
+    P.Pbig(idx, o, L.mk_loc (L.loc px) x,body, e1, e2), ty
+  | S.PEResult i ->
+    let i =  Z.to_int ( S.parse_int i) in
+    let v,t =
+      try Env.get_f_result env i with
+      | _ -> rs_tyerror ~loc:(L.loc pe) (UnknownResult i)
+    in
+    let v = P.{gv = L.mk_loc (L.loc pe) v; gs = Slocal} in
+    P.Pvar (v), t
+
+  | S.PEResultGet (al, aa, ws, v, pi, olen) ->
+    let i =  Z.to_int ( S.parse_int v) in
+    let x,ty =
+      try Env.get_f_result env i with
+      | _ -> rs_tyerror ~loc:(L.loc pe) (UnknownResult i)
+    in
+    let x = P.{gv = L.mk_loc (L.loc pe) x; gs = Slocal} in
+    let ty, _ = tt_as_array (L.loc pe, ty) in
+    let ws = tt_mem_wsize (P.ws_of_ety ty) ws in
+    let ty = P.etw ws in
+    let e,ity  = tt_expr ~mode pd env pi in
+    check_ty_eq ~loc:(L.loc pi) ~from:ity ~to_:P.etint;
+    begin match olen with
+      | None ->
+        let al = tt_al aa al in
+        P.Pget (al,aa, ws, x, e), ty
+      | Some _ -> assert false
+    end
+
 and tt_expr_cast pd ?(mode=`AllVar) (env : 'asm Env.env) pe ty =
   let e, ety = tt_expr ~mode pd env pe in
   cast (L.loc pe) e ety ty
@@ -1744,6 +1890,31 @@ let cast_opn ~loc id ws =
   | Oasm (BaseOp (Some _, _)) -> assert false
   | _ -> invalid ()
 
+(* -------------------------------------------------------------------- *)
+let rec pannot_to_annotations (pannot : Syntax.pannotations) : Annotations.annotations =
+  List.map pannot_to_annotation pannot
+
+and pannot_to_annotation ((id, pattri) : Syntax.pannotation) : Annotations.annotation =
+  (id, Option.map pattri_to_attribute pattri)
+
+and pattri_to_attribute (pattri: Syntax.pattribute) : Annotations.attribute =
+  let loc = L.loc pattri in
+  L.mk_loc loc (pattri_to_simple_attribute (L.unloc pattri))
+
+and pattri_to_simple_attribute (pattri: Syntax.psimple_attribute) : Annotations.simple_attribute =
+  match pattri with
+  | PAstring s -> Astring s
+  | PAws ws -> Aws ws
+  | PAstruct s -> Astruct (pannot_to_annotations s)
+  | PAexpr e ->
+      match L.unloc e with
+      | PEVar id -> Aid (L.unloc id)
+      | PEInt ir -> Aint (Syntax.parse_int ir)
+      | PEOp1 (`Neg None, {L.pl_desc = PEInt ir}) -> Aint (Z.neg (Syntax.parse_int ir))
+      | _ ->
+        rs_tyerror ~loc:(L.loc e)
+          (string_error "complexe expression not allowed in annotation")
+
 (* -------------------------------------------------------------------- *)
 let pexpr_of_plvalue exn l =
   match L.unloc l with
@@ -1941,7 +2112,14 @@ let tt_annot_paramdecls dfl_writable pd env (annot, (ty,vs)) =
   let vars = List.map (fun v -> aty, v) vs in
   tt_vardecls_push dfl_writable pd env vars
 
+let tt_annot_vardecls dfl_writable pd env (annot, (ty,vs)) =
+  let aty = pannot_to_annotations annot, ty in
+  let vars = List.map (fun v -> aty, v) vs in
+  tt_vardecls_push dfl_writable pd env vars
+
+
 let rec tt_instr arch_info (env : 'asm Env.env) ((pannot,pi) : S.pinstr) : 'asm Env.env * (unit, 'asm) P.pinstr list  =
+
   let annot = pannot_to_annotations pannot in
   let mk_i ?(annot=annot) instr =
     { P.i_desc = instr; P.i_loc = L.of_loc pi; P.i_info = (); P.i_annot = annot} in
@@ -2183,7 +2361,7 @@ let tt_funbody arch_info env (pb : S.pfunbody) =
   let ret =
     let for1 x = L.mk_loc (L.loc x) (tt_var `AllVar env x) in
     List.map for1 (Option.default [] (L.unloc pb.pdb_ret)) in
-  (bdy, ret_loc, ret)
+  (bdy, ret_loc, ret, env)
 
 
 (* -------------------------------------------------------------------- *)
@@ -2283,6 +2461,120 @@ let warn_unused_variables env f =
      warning UnusedVar (L.i_loc0 x.v_dloc) "unused variable %a" pp_var x)
     env
 
+let tt_contra arch_info env0 f_ret dfl_mut pf =
+ let annot =
+    List.filter (fun (id, _) -> L.unloc id <> "safety") pf.S.pdf_annot in
+
+  let safety =
+    List.filter (fun (id, _s) -> L.unloc id = "safety") pf.pdf_annot in
+
+  let f_contra =
+    match safety with
+    | [] -> None
+    | _ :: (id, _) :: _ -> rs_tyerror ~loc:(L.loc id)(string_error "only one safety annotation is expected")
+    | [ id, pa] ->
+      let requires = ref [] in
+      let ensures = ref [] in
+      let input = ref None in
+      let output = ref None in
+
+      let add_cond loc s r pa =
+        match pa with
+        | None -> rs_tyerror ~loc (string_error "\"= expression\" is expected after %s" s)
+        | Some pa ->
+          match L.unloc pa with
+          | S.PAexpr e -> r := e :: !r
+          | _ -> rs_tyerror ~loc (string_error "an expression is expected after %s =" s)
+      in
+
+      let add_vars loc nvars s r pa =
+        match pa with
+        | None -> rs_tyerror ~loc (string_error "\"= { vars }\" is expected after %s" s)
+        | Some pa ->
+          match L.unloc pa with
+          | S.PAstruct str ->
+            if !r <> None then rs_tyerror ~loc:(L.loc pa) (string_error "%s already defined" s);
+            let process_var (id, pa) =
+              if pa <> None then rs_tyerror ~loc:(L.loc id) (string_error "no argument is expected");
+              id
+            in
+            let l = List.map process_var str in
+            let nl = List.length l in
+            if nl <> nvars then rs_tyerror ~loc:(L.loc pa) (string_error "got %i variables instead of %i" nl nvars);
+            r := Some (List.map process_var str)
+          | _ -> rs_tyerror ~loc:(L.loc pa) (string_error "\" { vars }\" is expected after %s =" s)
+      in
+
+      let error loc = rs_tyerror ~loc (string_error "the general syntax is : safety = { args = { IDENT*}, res = { IDENT* }, requires = EXPR, ensures = EXPR }") in
+      let pdf_args =
+        List.flatten (List.map (fun (a, (ty, ids)) -> List.map (fun id -> (a, (ty, [id]))) ids) pf.pdf_args) in
+      let pdf_rty = Option.map_default (fun l -> l) [] pf.pdf_rty in
+      let process_fields =
+        List.iter (fun (id, pa) ->
+          let loc = L.loc id in
+          let s = L.unloc id in
+          match s with
+          | "requires" -> add_cond loc s requires pa
+          | "ensures"  -> add_cond loc s ensures pa
+          | "args"     -> add_vars loc (List.length pdf_args) s input pa
+          | "res"      -> add_vars loc (List.length pdf_rty) s output pa
+          | _ ->  error loc )
+      in
+
+      begin match pa with
+      | Some pa ->
+        begin match L.unloc pa with
+        | S.PAstruct fields -> process_fields fields
+        | _ -> error (L.loc pa)
+        end
+      | None -> error (L.loc id)
+      end;
+
+      let pre, post = List.rev !requires, List.rev !ensures in
+
+      let aux_env = Env.Vars.clear_locals env0 in
+      let env_pre, f_iparams =
+        let args =
+          match !input with
+          | None -> pdf_args
+          | Some ids ->
+            List.map2 (fun (a, (s, _)) id -> a, (s, [id])) pdf_args ids
+        in
+        List.map_fold
+          (tt_annot_vardecls dfl_mut arch_info.pd)
+          aux_env args
+      in
+      let f_iparams = List.flatten f_iparams in
+      let f_iparams =
+        List.map (fun x -> L.mk_loc (L.loc x) (fst (L.unloc x))) f_iparams
+      in
+      let get_clause env l =
+        (List.map (fun e -> ("safety", tt_expr_bool arch_info.pd env e)) l) in
+      let f_pre = get_clause env_pre pre in
+
+      let env_post, f_ires =
+        let outputs =
+          match !output with
+          | None -> List.map (fun x -> L.mk_loc (L.loc x) (L.unloc x).P.v_name) f_ret
+          | Some ids -> ids in
+        let outputs =
+          List.map2 (fun (a, ty) id -> (a, (ty, [id]))) pdf_rty outputs in
+        List.map_fold
+          (tt_annot_vardecls dfl_mut arch_info.pd)
+          env_pre outputs
+      in
+      let f_ires = List.flatten f_ires in
+      let ret = List.map L.unloc f_ires in
+      let f_ires = List.map (fun x -> L.mk_loc (L.loc x) (fst (L.unloc x))) f_ires in
+
+      (* FIXME remove this once we don't need "result.i" *)
+      let env_post = Env.add_f_result env_post ret in
+      let f_post = get_clause env_post post in
+      Some {P.f_iparams; f_ires; f_pre; f_post}
+  in
+  annot, f_contra
+
+
 let tt_fundef arch_info (env0 : 'asm Env.env) loc (pf : S.pfundef) : 'asm Env.env =
   let env = Env.Vars.clear_locals env0 in
   if is_combine_flags pf.pdf_name then
@@ -2297,15 +2589,20 @@ let tt_fundef arch_info (env0 : 'asm Env.env) loc (pf : S.pfundef) : 'asm Env.en
   let fs_tout = Option.map_default (List.map (tt_type arch_info.pd env |- snd |- snd)) [] pf.pdf_rty in
   let ret_annot = Option.map_default (List.map fst) [] pf.pdf_rty in
   let ret_annot = List.map pannot_to_annotations ret_annot in
-  let body, ret_loc, xret = tt_funbody arch_info envb pf.pdf_body in
+  let body, ret_loc, xret, _env = tt_funbody arch_info envb pf.pdf_body in
   let f_args = List.map (fun x -> L.mk_loc (L.loc x) (fst (L.unloc x))) args in
   let fs_tin = List.map (fun x -> snd (L.unloc x)) args in
   let f_ret = List.map (fun x -> L.mk_loc (L.loc x) (fst (L.unloc x))) xret in
   let f_cc = tt_call_conv loc f_args f_ret pf.pdf_cc in
+
+  let annot, f_contra = tt_contra arch_info env0 f_ret dfl_mut pf in
+
   let name = L.unloc pf.pdf_name in
+
   let fdef =
     { P.f_loc   = loc;
-      P.f_annot = process_f_annot loc name f_cc pf.pdf_annot;
+      P.f_annot = process_f_annot loc name f_cc annot;
+      P.f_contra = f_contra;
       P.f_cc    = f_cc;
       P.f_info  = ();
       P.f_name  = P.F.mk name;
diff --git a/compiler/src/printCommon.ml b/compiler/src/printCommon.ml
index 0d5fbcf182..7908b7987d 100644
--- a/compiler/src/printCommon.ml
+++ b/compiler/src/printCommon.ml
@@ -1,8 +1,8 @@
 open Format
 open Utils
 open Prog
-open Wsize
 open Operators
+open Wsize
 
 (* -------------------------------------------------------------------- *)
 let escape = String.map (fun c -> if c = '.' || c = ':' || c = '#' then '_' else c)
diff --git a/compiler/src/printer.ml b/compiler/src/printer.ml
index 73eca10051..6b3fe91f3b 100644
--- a/compiler/src/printer.ml
+++ b/compiler/src/printer.ml
@@ -67,9 +67,23 @@ let pp_ge ~debug (pp_len: 'len pp) (pp_var: 'len gvar pp) : 'len gexpr pp =
      | exception Not_found ->
      F.fprintf fmt "/* %du8 */ @[{ %a }@]" (Conv.int_of_pos len) (pp_list ",@ " (pp_expr NoAssoc priority_min)) es
      end
+  | PappN (Ois_arr_init _len, es) ->
+    F.fprintf fmt "@[<hov 2>is_arr_init(%a)@]" (pp_list ",@ " (pp_expr NoAssoc priority_min)) es
+  | PappN(Ois_barr_init _len, es) ->
+    F.fprintf fmt "@[<hov 2>is_barr_init(%a)@]" (pp_list ",@ " (pp_expr NoAssoc priority_min)) es
   | Pif(_, e,e1,e2) ->
      let p = priority_ternary in
      optparent fmt prio side p "%a ? %a : %a" (pp_expr Left p) e (pp_expr NoAssoc p) e1 (pp_expr Right p) e2
+  | Pbig(idx, op, x, body, start, len) ->
+    F.fprintf fmt "@[(\\big[%s/%a]@ (%a \\in %a:%a)@ (%a))@]"
+      (string_of_op2 op)
+      (pp_expr NoAssoc priority_min) idx
+      pp_var_i x
+      (pp_expr NoAssoc priority_min) start
+      (pp_expr NoAssoc priority_min) len
+      (pp_expr NoAssoc priority_min) body
+  | Pis_var_init x -> F.fprintf fmt "is_var_init(%a)" pp_var_i x
+  | Pis_mem_init (e1,e2) -> F.fprintf fmt "is_mem_init(%a,%a)" (pp_expr NoAssoc priority_min) e1 (pp_expr NoAssoc priority_min) e2
   in
   pp_expr NoAssoc priority_min
 
@@ -77,7 +91,8 @@ let pp_ge ~debug (pp_len: 'len pp) (pp_var: 'len gvar pp) : 'len gexpr pp =
 let pp_glv ~debug pp_len pp_var fmt =
   let pp_ge = pp_ge ~debug in
   function
-  | Lnone (_, ty) -> F.fprintf fmt "_ /* %a */" (pp_gtype (fun fmt _ -> F.fprintf fmt "?")) ty
+  | Lnone (_, ty) ->
+    F.fprintf fmt "_ /* %a */" (pp_gtype (fun fmt _ -> F.fprintf fmt "?")) ty
   | Lvar x  -> pp_gvar_i pp_var fmt x
   | Lmem (al, ws, _, e) ->
     pp_mem_access (pp_ge pp_len pp_var) fmt al (Some ws) e
@@ -147,20 +162,17 @@ let rec pp_gi ~debug pp_info pp_len pp_opn pp_var fmt i =
   F.fprintf fmt "%a" pp_info (i.i_loc, i.i_info);
   F.fprintf fmt "%a" pp_annotations i.i_annot;
   match i.i_desc with
-  | Cassgn(x, tg, ty, Parr_init (ws, n)) ->
+  | Cassgn(x, tg, ty, Parr_init(ws, n)) ->
     F.fprintf fmt "@[<hov 2>ArrayInit(%a); /* length=%s*%a %a%s */@]"
       (pp_glv ~debug pp_len pp_var) x
       (string_of_ws ws) pp_len n
       (pp_gtype pp_len) ty
       (pp_tag tg)
-
   | Cassgn(x , tg, ty, e) ->
     F.fprintf fmt "@[<hov 2>%a =@ %a; /* %a%s */@]"
       (pp_glv ~debug pp_len pp_var) x
       (pp_ge ~debug pp_len pp_var) e
-      (pp_gtype pp_len) ty
-      (pp_tag tg)
-
+      (pp_gtype pp_len) ty (pp_tag tg)
   | Copn(x, t, o, e) ->
     let pp_cast fmt = function
       | Sopn.Oasm (Arch_extra.BaseOp(Some ws, _)) -> Format.fprintf fmt "(%du)" (int_of_ws ws)
@@ -253,6 +265,33 @@ let pp_return_type pp_size fmt =
   in
   F.fprintf fmt "%a" (pp_list ",@ " pp)
 
+let mk_clauses pp_var prepost = List.map (fun (_, f) -> (pp_var, prepost, f))
+
+let pp_clause ~debug pp_size fmt (pp_var, prepost, f) =
+  Format.fprintf fmt "@[<hov 2>%s =@ %a@]" prepost (pp_ge ~debug pp_size pp_var) f
+
+let pp_clauses ~debug pp_size fmt cs =
+  pp_list "@ , " (pp_clause ~debug pp_size) fmt cs
+
+let rec index_of_post x xs i =
+  match xs with
+  | [] -> None
+  | h::t -> if x.v_id = h.v_id then Some i else index_of_post x t (i+1)
+
+let pp_contra ~debug pp_size pp_var fmt fd =
+  match fd.f_contra with
+  | None -> ()
+  | Some  ct ->
+    let vars_res = List.map L.unloc ct.f_ires in
+    let pp_var_post fmt x =
+       match index_of_post x vars_res 0 with
+      | None -> pp_var fmt x
+      | Some i -> Format.fprintf fmt "result.%d" i
+    in
+    F.fprintf fmt "@[<v>#[safety =@   @[<v>{ %a }@]@]@ ]@ "
+      (pp_clauses ~debug pp_size) (mk_clauses pp_var      "requires" ct.f_pre @
+                                   mk_clauses pp_var_post "ensures"  ct.f_post)
+
 let pp_gfun ~debug (pp_size:F.formatter -> 'size -> unit) pp_opn pp_var fmt fd =
   let ds = ScopeTree.get_declaration_sites fd in
   let pp_vd =  pp_var_decl pp_var pp_size in
@@ -274,9 +313,9 @@ let pp_gfun ~debug (pp_size:F.formatter -> 'size -> unit) pp_opn pp_var fmt fd =
     F.fprintf fmt "return @[%a@];"
       (pp_list ",@ " pp_var) ret in
 
-
-  F.fprintf fmt "@[<v>%a%afn %s @[(%a)@] -> @[(%a)@] {@   @[<v>%a@ %a@]@ }@]"
+  F.fprintf fmt "@[<v>%a%a%afn %s @[(%a)@] -> @[(%a)@]@ {@   @[<v>%a@ %a@]@ }@]"
    pp_annotations fd.f_annot.f_user_annot
+   (pp_contra ~debug pp_size pp_var) fd
    pp_call_conv fd.f_cc
    fd.f_name.fn_name
    (pp_list ",@ " pp_vd) fd.f_args
@@ -351,9 +390,10 @@ let pp_fun_ ~debug ?pp_locals ?(pp_info=pp_noinfo) pp_opn pp_var fmt fd =
   let pp_ret fmt () =
     F.fprintf fmt "return @[(%a)@];"
       (pp_list ",@ " pp_var) ret in
-  F.fprintf fmt "@[<v>%a%a {@   @[<v>%a@ %a@ %a@]@ }@]"
+  F.fprintf fmt "@[<v>%a%a@ %a {@   @[<v>%a@ %a@ %a@]@ }@]"
    pp_call_conv fd.f_cc
    (pp_header_ pp_var) fd
+   (pp_contra ~debug pp_len pp_var) fd
    pp_locals locals
    (pp_gc ~debug pp_info pp_len pp_opn pp_var) fd.f_body
    pp_ret ()
diff --git a/compiler/src/prog.ml b/compiler/src/prog.ml
index 6ee7d115c8..0afd48e5a4 100644
--- a/compiler/src/prog.ml
+++ b/compiler/src/prog.ml
@@ -30,6 +30,9 @@ type 'len gexpr =
   | Papp2  of sop2 * 'len gexpr * 'len gexpr
   | PappN of opN * 'len gexpr list
   | Pif    of 'len gty * 'len gexpr * 'len gexpr * 'len gexpr
+  | Pbig   of 'len gexpr * sop2 * 'len gvar_i * 'len gexpr * 'len gexpr * 'len gexpr
+  | Pis_var_init of 'len gvar_i
+  | Pis_mem_init of 'len gexpr * 'len gexpr
 
 type 'len gexprs = 'len gexpr list
 
@@ -115,10 +118,18 @@ and ('len,'info,'asm) ginstr = {
 and ('len, 'info, 'asm) gstmt = ('len, 'info, 'asm) ginstr list
 
 (* ------------------------------------------------------------------------ *)
+type 'len gfcontract = {
+  f_iparams : 'len gvar_i list;
+  f_ires : 'len gvar_i list;
+  f_pre : 'len assertion list;
+  f_post : 'len assertion list;
+}
+
 type ('len, 'info, 'asm) gfunc = {
     f_loc  : L.t;
     f_annot: FInfo.f_annot;
     f_info : 'info;
+    f_contra: 'len gfcontract option;
     f_cc   : FInfo.call_conv;
     f_name : funname;
     f_tyin : 'len gty list;
@@ -263,6 +274,11 @@ let rec rvars_e f s = function
   | Papp2(_,e1,e2) -> rvars_e f (rvars_e f s e1) e2
   | PappN (_, es) -> rvars_es f s es
   | Pif(_,e,e1,e2)   -> rvars_e f (rvars_e f (rvars_e f s e) e1) e2
+  | Pbig(e, _, x, e1, e2, e0) -> 
+    let s = f (L.unloc x) s in
+    List.fold_left (rvars_e f) s [e; e1; e2; e0;]
+  | Pis_var_init x -> f (L.unloc x) s
+  | Pis_mem_init (e1,e2) -> rvars_e f (rvars_e f s e1) e2
 
 and rvars_es f s es = List.fold_left (rvars_e f) s es
 
@@ -312,6 +328,19 @@ let vars_fc fc =
   let s = List.fold_left (fun s v -> Sv.add (L.unloc v) s) s fc.f_ret in
   rvars_c Sv.add s fc.f_body
 
+let vars_contract f_contra =
+  match f_contra with
+  | None -> Sv.empty
+  | Some f_contra ->
+    let s = List.fold_left (fun s v -> Sv.add (L.unloc v) s) Sv.empty f_contra.f_iparams in
+    let s = List.fold_left (fun s v -> Sv.add (L.unloc v) s) s f_contra.f_ires in
+    let s = rvars_es Sv.add s (List.map snd f_contra.f_pre) in
+    rvars_es Sv.add s (List.map snd f_contra.f_post)
+
+let vars_fc_contracts fc =
+  let s = vars_fc fc in
+  Sv.union s (vars_contract fc.f_contra)
+
 let locals fc =
   let s1 = params fc in
   let s2 = Sv.diff (vars_fc fc) s1 in
diff --git a/compiler/src/prog.mli b/compiler/src/prog.mli
index 75ae4de85a..bb3e715f93 100644
--- a/compiler/src/prog.mli
+++ b/compiler/src/prog.mli
@@ -28,6 +28,9 @@ type 'len gexpr =
   | Papp2  of sop2 * 'len gexpr * 'len gexpr
   | PappN of opN * 'len gexpr list
   | Pif    of 'len gty * 'len gexpr * 'len gexpr * 'len gexpr
+  | Pbig   of 'len gexpr * sop2 * 'len gvar_i * 'len gexpr * 'len gexpr * 'len gexpr
+  | Pis_var_init of 'len gvar_i
+  | Pis_mem_init of 'len gexpr * 'len gexpr
 
 type 'len gexprs = 'len gexpr list
 
@@ -82,10 +85,18 @@ and ('len, 'info, 'asm) ginstr = {
 and ('len, 'info, 'asm) gstmt = ('len, 'info, 'asm) ginstr list
 
 (* ------------------------------------------------------------------------ *)
+type 'len gfcontract = {
+  f_iparams : 'len gvar_i list;
+  f_ires : 'len gvar_i list;
+  f_pre : 'len assertion list;
+  f_post : 'len assertion list;
+}
+
 type ('len, 'info, 'asm) gfunc = {
     f_loc  : L.t;
     f_annot: FInfo.f_annot;
     f_info : 'info;
+    f_contra: 'len gfcontract option;
     f_cc   : FInfo.call_conv;
     f_name : funname;
     f_tyin : 'len gty list;
@@ -224,6 +235,7 @@ val vars_i  : ('info, 'asm) instr -> Sv.t
 val vars_c  : ('info, 'asm) stmt  -> Sv.t
 val pvars_c : ('info, 'asm) pstmt  -> Spv.t
 val vars_fc : ('info, 'asm) func  -> Sv.t
+val vars_fc_contracts : ('info, 'asm) func  -> Sv.t
 
 val locals  : ('info, 'asm) func -> Sv.t
 
diff --git a/compiler/src/scopeTree.ml b/compiler/src/scopeTree.ml
index ca181e0cee..409b95bc9d 100644
--- a/compiler/src/scopeTree.ml
+++ b/compiler/src/scopeTree.ml
@@ -60,22 +60,29 @@ let find_common_ancestor (t : tree) (nodes : nodeset) : node =
 (* --------------------------------------------------------------- *)
 (* Compute variable occurrences in expressions and instructions *)
 
+let variables_in_gvar gv (acc : Spv.t) : Spv.t =
+  let x = L.unloc gv in
+  if x.v_kind <> Const then Spv.add x acc else acc
+
 let variables_in_ggvar { gs; gv } (acc : Spv.t) : Spv.t =
   match gs with
   | E.Sglob -> acc
-  | E.Slocal ->
-      let x = L.unloc gv in
-      if x.v_kind <> Const then Spv.add x acc else acc
+  | E.Slocal -> variables_in_gvar gv acc
 
 let rec variables_in_pexpr (acc : Spv.t) (e : pexpr) : Spv.t =
   match e with
   | Pconst _ | Pbool _ | Parr_init _ -> acc
   | Pvar x -> variables_in_ggvar x acc
+  | Pis_var_init x -> variables_in_gvar x acc
   | Pget (_, _, _, x, e) | Psub (_, _, _, x, e) ->
       variables_in_pexpr (variables_in_ggvar x acc) e
   | Pload (_, _, e) | Papp1 (_, e) -> variables_in_pexpr acc e
-  | Papp2 (_, e1, e2) | Pif (_, _, e1, e2) -> variables_in_pexprs acc [ e1; e2 ]
+  | Papp2 (_, e1, e2) | Pis_mem_init (e1, e2) | Pif (_, _, e1, e2) -> variables_in_pexprs acc [ e1; e2 ]
   | PappN (_, es) -> variables_in_pexprs acc es
+  | Pbig (idx, _op, x, e, start, len)  -> 
+      let acc1 = variables_in_pexpr Spv.empty e in 
+      let acc = Spv.union acc (Spv.remove (L.unloc x) acc1) in
+      variables_in_pexprs acc [ idx; start; len ]
 
 and variables_in_pexprs (acc : Spv.t) (es : pexpr list) : Spv.t =
   List.fold_left variables_in_pexpr acc es
diff --git a/compiler/src/sct_checker_forward.ml b/compiler/src/sct_checker_forward.ml
index c1dab7d636..557cdf97bc 100644
--- a/compiler/src/sct_checker_forward.ml
+++ b/compiler/src/sct_checker_forward.ml
@@ -659,9 +659,10 @@ let rec ty_expr env venv loc (e:expr) : vty =
     ty_exprs_max ~public env venv loc es
 
   | Pif(_, e1, e2, e3) ->
-      let ty1 = ty_expr env venv loc e1 in
-      let ty2 = ty_expr env venv loc e2 in
-      let ty3 = ty_expr env venv loc e3 in
+    let ty1 = ty_expr env venv loc e1 in
+    let ty2 = ty_expr env venv loc e2 in
+    let ty3 = ty_expr env venv loc e3 in
+    begin
       match ty1 with
       | Indirect _ -> assert false
       | Direct l1 ->
@@ -683,6 +684,8 @@ let rec ty_expr env venv loc (e:expr) : vty =
           do_indirect lp2 le2 (Env.public2 env) le3
         | Direct le2, Indirect (lp3, le3) ->
           do_indirect (Env.public2 env) le2 lp3 le3
+    end
+  | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> assert false
 
 and ensure_smaller env venv loc e l =
   let ety = ty_expr env venv loc e in
diff --git a/compiler/src/slicing.ml b/compiler/src/slicing.ml
index 2cf37c4b84..9811c26c40 100644
--- a/compiler/src/slicing.ml
+++ b/compiler/src/slicing.ml
@@ -17,6 +17,10 @@ let rec inspect_e k = function
   | Papp2 (_, e1, e2) -> inspect_e (inspect_e k e1) e2
   | PappN (_, es) -> inspect_es k es
   | Pif (_, e1, e2, e3) -> inspect_e (inspect_e (inspect_e k e1) e2) e3
+  | Pbig(e, _op2, _x, e1, e2, e0) ->
+    List.fold_left inspect_e k [e;e1;e2; e0]
+  | Pis_var_init _ -> k
+  | Pis_mem_init (e1,e2) -> inspect_e (inspect_e k e1) e2
 
 and inspect_es k es = List.fold_left inspect_e k es
 
diff --git a/compiler/src/subst.ml b/compiler/src/subst.ml
index 531af6ab3d..cb5d2ef79c 100644
--- a/compiler/src/subst.ml
+++ b/compiler/src/subst.ml
@@ -28,6 +28,15 @@ let rec gsubst_e (flen: ?loc:L.t -> 'len1 -> 'len2) (f: 'len1 ggvar -> 'len2 gex
   | Papp2 (o, e1, e2)-> Papp2 (o, gsubst_e flen f e1, gsubst_e flen f e2)
   | PappN (o, es) -> PappN (o, List.map (gsubst_e flen f) es)
   | Pif   (ty, e, e1, e2)-> Pif(gsubst_ty (flen ?loc:None) ty, gsubst_e flen f e, gsubst_e flen f e1, gsubst_e flen f e2)
+  | Pbig (e, o, x, e1, e2, e0) ->
+    Pbig(gsubst_e flen f e,
+         o,
+         gsubst_vdest f x,
+         gsubst_e flen f e1,
+         gsubst_e flen f e2,
+         gsubst_e flen f e0)
+  | Pis_var_init v -> Pis_var_init (gsubst_vdest f v)
+  | Pis_mem_init (e1,e2) -> Pis_mem_init (gsubst_e flen f e1,gsubst_e flen f e2)
 
 and gsubst_gvar f v =
   match f v with
@@ -71,10 +80,23 @@ let rec gsubst_i (flen: ?loc:L.t -> 'len1 -> 'len2) f i =
 
 and gsubst_c flen f c = List.map (gsubst_i flen f) c
 
+let gsubst_cf_cond flen f =
+  List.map (fun (prover,clause) -> prover, gsubst_e flen f clause)
+
+let gsubst_cf_contra flen f c =
+  Some
+  {
+    f_iparams = List.map (gsubst_vdest f) c.f_iparams;
+    f_ires = List.map (gsubst_vdest f) c.f_ires;
+    f_pre = gsubst_cf_cond flen f c.f_pre;
+    f_post = gsubst_cf_cond flen f c.f_post;
+  }
+
 let gsubst_func (flen: ?loc:L.t -> 'len1 -> 'len2) f fc =
   let dov v = L.unloc (gsubst_vdest f (L.mk_loc L._dummy v)) in
   { fc with
     f_tyin = List.map (gsubst_ty (flen ?loc:None)) fc.f_tyin;
+    f_contra = Option.bind fc.f_contra (gsubst_cf_contra flen f);
     f_args = List.map dov fc.f_args;
     f_body = gsubst_c flen f fc.f_body;
     f_tyout = List.map (gsubst_ty (flen ?loc:None)) fc.f_tyout;
@@ -153,9 +175,13 @@ let psubst_prog (prog:('info, 'asm) pprog) =
         let subst_ty = psubst_ty subst_v in
         let dov v =
           L.unloc (gsubst_vdest subst_v (L.mk_loc L._dummy v)) in
+        let aux =
+          gsubst_cf_contra (psubst_e_ subst_v) subst_v
+        in
         let fc = {
             fc with
             f_tyin = List.map subst_ty fc.f_tyin;
+            f_contra = Option.bind fc.f_contra aux;
             f_args = List.map dov fc.f_args;
             f_body = gsubst_c (psubst_e_ subst_v) subst_v fc.f_body;
             f_tyout = List.map subst_ty fc.f_tyout;
@@ -202,8 +228,8 @@ let rec int_of_expr ?loc e =
   | Papp2 (o, e1, e2) ->
       let op = int_of_op2 ?loc o in
       op (int_of_expr ?loc e1) (int_of_expr ?loc e2)
-  | Pbool _ | Parr_init _ | Pvar _
-  | Pget _ | Psub _ | Pload _ | PappN _ | Pif _ ->
+  | Pbool _ | Parr_init _ | Pvar _ | Pis_var_init _ | Pis_mem_init _
+  | Pget _ | Psub _ | Pload _ | PappN _ | Pif _ | Pbig _ ->
       hierror ?loc "expression %a not allowed in array size (only constant arithmetic expressions are allowed)" (Printer.pp_pexpr ~debug:false) e
 
 
@@ -274,6 +300,7 @@ let isubst_prog glob prog =
     let fc = {
         fc with
         f_tyin = List.map isubst_ty fc.f_tyin;
+        f_contra =  Option.bind fc.f_contra (gsubst_cf_contra isubst_len subst_v);
         f_args;
         f_body = gsubst_c isubst_len subst_v fc.f_body;
         f_tyout = List.map isubst_ty fc.f_tyout;
diff --git a/compiler/src/syntax.ml b/compiler/src/syntax.ml
index 04ed444721..1a3b62ef8a 100644
--- a/compiler/src/syntax.ml
+++ b/compiler/src/syntax.ml
@@ -181,11 +181,20 @@ type pexpr_r =
   | PEOp1    of peop1 * pexpr
   | PEOp2    of peop2 * (pexpr * pexpr)
   | PEIf of pexpr * pexpr * pexpr
+  | PEbig    of pbig * pident *pexpr * pexpr * pexpr
+  | PEResult of int_representation
+  | PEResultGet of [`Aligned|`Unaligned] option * arr_access * swsize L.located option * int_representation * pexpr * pexpr option
+
 
 and pexpr = pexpr_r L.located
 
 and mem_access = [ `Aligned | `Unaligned ] option * swsize L.located option * pexpr
 
+and pbig =
+  | PEAll
+  | PEExists
+  | PESum
+  | PEBop of peop2 * pexpr
 
 (* Printing of pexpr *)
 let string_of_align =
@@ -293,6 +302,18 @@ module SPrinter = struct
       optparent fmt prio p "(";
       F.fprintf fmt "%a ? %a : %a" (pp_expr_rec p) e1 (pp_expr_rec p) e2 (pp_expr_rec p) e3;
       optparent fmt prio p ")"
+    | PEbig(bop, x, body, start, len) ->
+       Format.fprintf fmt "@[<hov 2>%a@ (%a in %a : %a)@ (%a)@]"
+       pp_big bop pp_var x pp_expr start pp_expr len pp_expr body
+    | PEResult _ | PEResultGet _ -> assert false
+
+  and pp_big fmt bop =
+    match bop with
+    | PEBop(o, e0) -> Format.fprintf fmt "%s[%a/%a]" "big" pp_op2 o pp_expr e0
+    | PESum-> Format.fprintf fmt "sum"
+    | PEAll -> Format.fprintf fmt "all"
+    | PEExists -> Format.fprintf fmt "exists"
+
 
   and pp_mem_access fmt (al, ty, e) =
     let pp_size fmt ws = Format.fprintf fmt ":%a " pp_ws ws in
@@ -314,9 +335,6 @@ module SPrinter = struct
       (pp_opt pp_ws) ws (pp_opt pp_space) ws pp_expr e pp_olen len
 
 end
-
-
-
 (* -------------------------------------------------------------------- *)
 type psimple_attribute =
   | PAstring of string
@@ -377,6 +395,11 @@ type plvals = pannotations L.located option * plvalue list
 
 type vardecls = pstotype * pident list
 
+type assert_kind =
+  [ `Assert | `Assume | `Cut ]
+
+type assert_prover = pident
+
 type pinstr_r =
   | PIArrayInit of pident
       (** ArrayInit(x); *)
diff --git a/compiler/src/toEC.ml b/compiler/src/toEC.ml
index b8a41b6046..24d35a2d12 100644
--- a/compiler/src/toEC.ml
+++ b/compiler/src/toEC.ml
@@ -1,7 +1,8 @@
+open Annotations
+open Operators
 open Utils
 open Wsize
 open Prog
-open Operators
 open PrintCommon
 
 type amodel =
@@ -301,6 +302,9 @@ type ec_expr =
     | Eop3 of ec_op3 * ec_expr * ec_expr * ec_expr (* ternary operator *)
     | Elist of ec_expr list (* list litteral *)
     | Etuple of ec_expr list (* tuple litteral *)
+    | Equant  of string list * ec_expr
+    | Eproj  of ec_expr * int  (* projection of a tuple *)
+    | EHoare of ec_ident * ec_expr * ec_expr
 
 type ec_lvalue =
     | LvIdent of ec_ident
@@ -349,13 +353,38 @@ type ec_module = {
     funs: ec_fun list;
 }
 
+type ec_proposition =  string * string list * ec_expr
+
+type ec_tactic_args =
+  (* | Conti of ec_tactic *)
+  (* | Seq of ec_tactic *)
+  | Param of ec_tactic_args list
+  (* | Form of ec_proposition *)
+  (* | Ident of ec_ident *)
+  | Pattern of string
+  | Prop of string
+  | DProp of ec_expr
+  (* | Comment of string *)
+
+and ec_tactic =
+  { tname : string;
+    targs : ec_tactic_args list;
+  }
+
+type ec_proof = ec_tactic list
+
+
 type ec_item =
     | IrequireImport of string list
     | Iimport of string list
     | IfromRequireImport of string * (string list)
-    | Iabbrev of string * ec_expr
+    | Iabbrev of bool * string * ec_expr
     | ImoduleType of ec_module_type
     | Imodule of ec_module
+    | Icomment of string
+    (* | Axiom of  ec_proposition *)
+    | Lemma of ec_proposition * ec_proof
+    | FunSpec of string * string list * ec_expr
 
 type ec_prog = ec_item list
 
@@ -393,7 +422,18 @@ module type EnvT = sig
   val new_aux_range: t -> t
   val new_fun: t -> t
   val set_var: t -> var -> t
-  val aux_vars: t -> (string * string) list
+
+  val set_var_prefix : t -> var -> string -> t
+  val set_var_prefix_u : t -> var -> string -> t
+  val aux_vars: t -> (string * ec_ty) list
+
+  val get_args: t -> funname -> Ss.elt list
+  val add_args: t -> funname -> ec_modty list -> unit
+
+  val get_proofv: t -> funname -> Ss.elt
+  val add_proofv: t -> funname -> Ss.elt -> unit
+  val add_func: t -> funname -> t
+  val get_func: t -> funname
 end
 
 
@@ -424,6 +464,9 @@ module Env: EnvT = struct
       auxv: string BatVect.t Mpty.t ref;
       mutable count: int Mpty.t;
       randombytes: Sint.t ref;
+      args : (Ss.elt list) Mf.t ref;
+      proofv : Ss.elt Mf.t ref;
+      func : funname option;
     }
 
   let vars env = env.vars
@@ -500,6 +543,24 @@ module Env: EnvT = struct
       alls = ref (Ss.add s !(env.alls));
       vars = Mv.add x s env.vars }
 
+   let set_var_prefix env x s =
+    let s = mkname env s in
+    { env with
+      alls = ref (Ss.add s !(env.alls));
+      vars = Mv.add x s env.vars }
+
+  let normalize_name n =
+    n |> String.uncapitalize_ascii |> escape
+
+  let set_var_prefix_u env x s =
+    let s = String.uncapitalize_ascii s in
+    { env with vars = Mv.add x s env.vars }
+
+  let set_name_prefix env s =
+    let s = normalize_name s in
+    s , {env with alls = ref (Ss.add s !(env.alls))}
+
+
   let add_ty env = function
       | Bty _ -> ()
       | Arr (_ws, n) -> add_Array env n
@@ -516,14 +577,20 @@ module Env: EnvT = struct
       auxv  = ref Mpty.empty;
       count = Mpty.empty;
       randombytes = ref Sint.empty;
+      args = ref Mf.empty;
+      proofv = ref Mf.empty;
+      func = None;
     }
 
+
+
   let set_fun env fd =
     let s = mkname env fd.f_name.fn_name in
     let funs =
       Mf.add fd.f_name (s, (fd.f_tyout, fd.f_tyin)) env.funs in
     { env with funs; alls = ref (Ss.add s !(env.alls)) }
 
+
   let get_funtype env f = snd (Mf.find f env.funs)
 
   let get_funname env f = fst (Mf.find f env.funs)
@@ -569,6 +636,28 @@ module Env: EnvT = struct
   let aux_vars env  =
     let unpack_vars ((_, ty), vars) = List.map (fun v -> (v, ty)) (BatVect.to_list vars) in
     List.flatten (List.map unpack_vars (Mpty.bindings !(env.auxv)))
+
+  let get_proofv env f =
+    Mf.find f !(env.proofv)
+
+  let add_proofv env f s =
+    let p,env = set_name_prefix env s in
+    env.proofv := Mf.add f p !(env.proofv)
+
+
+
+  let get_args env f =
+    Mf.find f !(env.args)
+
+  let add_args env f args =
+    env.args := Mf.add f args !(env.args)
+
+  let get_func env =
+    Option.get env.func
+
+  let add_func env f =
+    { env with func = Some f}
+
 end
 
 let check_array env x =
@@ -668,6 +757,15 @@ let rec pp_ec_ast_expr fmt e = match e with
     | Eop3 (op, e1, e2, e3) -> pp_ec_op3 fmt (op, e1, e2, e3)
     | Elist es -> Format.fprintf fmt "@[[%a]@]" (pp_list ";@ " pp_ec_ast_expr) es
     | Etuple es -> Format.fprintf fmt "@[(%a)@]" (pp_list ",@ " pp_ec_ast_expr) es
+    | Equant (i, f) ->
+          Format.fprintf fmt "@[(fun %a =>@ %a)@]"
+            (pp_list " " pp_string) i pp_ec_ast_expr f
+    | Eproj (e,i) -> Format.fprintf fmt "@[%a.`%i@]" pp_ec_ast_expr e i
+    | EHoare (i,fpre,fpost) ->
+      Format.fprintf fmt "@[hoare [%a :@ @[%a ==>@ %a@]]@]"
+        pp_ec_ident i
+        (pp_ec_ast_expr) fpre
+        (pp_ec_ast_expr) fpost
 
 and pp_ec_op2 fmt (op2, e1, e2) =
     let f fmt = match op2 with
@@ -744,6 +842,40 @@ let pp_ec_fun fmt f =
         (pp_list "@ " pp_decl_s) f.locals
         pp_ec_ast_stmt  f.stmt
 
+let pp_ec_propostion fmt (n, b, e) =
+  Format.fprintf fmt "@[%s @[%a@] :@ @[%a@]@]"
+    n
+    (pp_list " " pp_string) b
+    pp_ec_ast_expr e
+  
+let pp_ec_funspec fmt (n, b, e) =
+  Format.fprintf fmt "@[%s @[%a@] =@ @[%a@]@]"
+    n
+    (pp_list " " pp_string) b
+    pp_ec_ast_expr e
+
+let rec pp_ec_tatic_args fmt args =
+  match args with
+    (*
+  | Conti t -> Format.fprintf fmt "@[%a@]" pp_ec_rtactic t
+  | Seq t -> Format.fprintf fmt "@[; %a@]" pp_ec_rtactic t
+  *)
+  | Param a -> Format.fprintf fmt "(@[%a@])" (pp_list " " pp_ec_tatic_args) a
+(*
+  | Form f -> Format.fprintf fmt "@[%a@]" pp_ec_propostion f
+  | Ident i -> Format.fprintf fmt "@[%a@]" pp_ec_ident i
+  *)
+  | Pattern s -> Format.fprintf fmt "@[%s@]" s
+  | Prop s -> Format.fprintf fmt "@[%s@]" s
+  | DProp e -> Format.fprintf fmt "@[%a@]" pp_ec_ast_expr e
+  (* | Comment s -> Format.fprintf fmt "@[(\* %s *\)@]" s *)
+
+and pp_ec_rtactic fmt t =
+  Format.fprintf fmt "@[%s @[%a@]@]" t.tname (pp_list " " pp_ec_tatic_args) t.targs
+
+let pp_ec_tactic fmt t =
+  Format.fprintf fmt "@[%a@]." pp_ec_rtactic t
+
 let pp_ec_item fmt it =
   let pp_option pp fmt = function
     | Some x -> pp fmt x
@@ -760,8 +892,9 @@ let pp_ec_item fmt it =
     Format.fprintf fmt "@[import@ @[%a@].@]" (pp_list "@ " pp_string) is
   | IfromRequireImport (m, is) ->
     Format.fprintf fmt "@[from %s require import@ @[%a@].@]" m (pp_list "@ " pp_string) is
-  | Iabbrev (a, e) ->
-    Format.fprintf fmt "@[abbrev %s =@ @[%a@].@]" a pp_ec_ast_expr e
+  | Iabbrev (p, a, e) ->
+    let printing = if p then "[-printing]" else "" in
+    Format.fprintf fmt "@[abbrev %s %s =@ @[%a@].@]" printing a pp_ec_ast_expr e
   | ImoduleType mt ->
     Format.fprintf fmt "@[<v>@[module type %s = {@]@   @[<v>%a@]@ }.@]"
       mt.name (pp_list "@ " pp_ec_fun_decl) mt.funs
@@ -774,8 +907,19 @@ let pp_ec_item fmt it =
       (pp_list "@ " (fun fmt (v, t) -> Format.fprintf fmt "@[var %s : %s@]" v t)) m.vars
       (fun fmt _ -> if m.vars = [] then (Format.fprintf fmt "") else (Format.fprintf fmt "@ ")) ()
       (pp_list "@ " pp_ec_fun) m.funs
+  | Icomment s -> Format.fprintf fmt "@[(* %s *)@]" s
+  (*
+  | Axiom p ->
+    Format.fprintf fmt "@[axiom @[%a@].@]" pp_ec_propostion p
+  *)
+  | Lemma (p, t) ->
+    Format.fprintf fmt "@[lemma @[%a@].@]@ @[proof.@]@ @[<v>%a@]"
+      pp_ec_propostion p
+      (pp_list "@ "pp_ec_tactic) t
+  | FunSpec (n, b, e) ->
+    Format.fprintf fmt "@[op @[%a@].@]" pp_ec_funspec (n, b, e)
 
-let pp_ec_prog fmt (prog:ec_prog) = Format.fprintf fmt "@[<v>%a@]" (pp_list "@ @ " pp_ec_item) prog
+let pp_ec_prog fmt (prog: ec_prog) = Format.fprintf fmt "@[<v>%a@]" (pp_list "@ @ " pp_ec_item) prog
 
 (* ------------------------------------------------------------------- *)
 (* Array theory cloning *)
@@ -928,8 +1072,19 @@ let ec_int x = Econst (Z.of_int x)
 let ec_vars (env: Env.t) (x: var) = Mv.find x (Env.vars env)
 let ec_vari env (x:var) = Eident [ec_vars env x]
 
+let ec_lvals env xs =
+  let ec_lval env = function
+    | Lnone _ | Lmem _ | Laset _ | Lasub _ -> assert false
+    | Lvar x  -> LvIdent [ec_vars env (L.unloc x)]
+  in
+  List.map (ec_lval env) xs
+
 let glob_mem = ["Glob"; "mem"]
+let glob_mem_v = ["Glob"; "mem_v"]
 let glob_memi = Eident glob_mem
+let glob_mem_vi = Eident glob_mem_v
+
+let ec_pd env = Eident [Format.sprintf "W%d" (int_of_ws (Env.pd env)); "to_uint"]
 
 let ec_apps1 s e = Eapp (ec_ident s, [e])
 
@@ -1299,6 +1454,9 @@ let ty_expr = function
   | Papp2 (op,_,_) -> Conv.ty_of_cty (snd (E.type_of_op2 op))
   | PappN (op, _)  -> Conv.ty_of_cty (snd (E.type_of_opN op))
   | Pif (ty,_,_,_) -> ty
+  | Pbig (_,op,_,_,_,_) ->  Conv.ty_of_cty (snd (E.type_of_op2 op))
+  | Pis_var_init _ | Pis_mem_init _ -> tbool
+
 
 let ty_sopn pd msfsz asmOp op es =
   match op with
@@ -1366,6 +1524,9 @@ module type EcExpression = sig
   val ec_cast: Env.t -> ty * ty -> ec_expr -> ec_expr
   val toec_cast: Env.t -> ty * expr -> ec_expr
   val toec_expr: Env.t -> expr -> ec_expr
+
+  val toec_lval1: Env.t -> int glval -> ec_expr -> ec_instr
+
 end
 
 let int_of_word ws e = Papp1 (Oint_of_word(Unsigned, ws), e)
@@ -1390,7 +1551,7 @@ module EcExpression(EA: EcArray): EcExpression = struct
               let wse, ne = array_kind ety in
               EA.ec_cast_array env (ws, n) (wse, ne) e
 
-  let rec ec_op1 op e = match op with
+  let rec ec_op1 env op e = match op with
     | Oword_of_int sz ->
       ec_apps1 (Format.sprintf "%s.of_int" (fmt_Wsz sz)) e
     | Oint_of_word(s, sz) ->
@@ -1401,7 +1562,7 @@ module EcExpression(EA: EcArray): EcExpression = struct
     | Onot     -> ec_apps1 "!" e
     | Olnot _  -> ec_apps1 "invw" e
     | Oneg _   -> ec_apps1 "-" e
-    | Owi1 (_, WIwint_of_int sz) -> ec_op1 (Oword_of_int sz) e
+    | Owi1 (_, WIwint_of_int sz) -> ec_op1 env (Oword_of_int sz) e
     | Owi1 _ -> assert false (* other wint operator should have been removed by wint_int or wint_word *)
 
   let rec toec_expr env (e: expr) =
@@ -1419,7 +1580,7 @@ module EcExpression(EA: EcArray): EcExpression = struct
               glob_memi; toec_expr env (int_of_ptr (Env.pd env) e)
           ])
       | Papp1 (op1, e) ->
-            ec_op1 op1 (toec_cast env (Conv.ty_of_cty (fst (E.type_of_op1 op1)), e))
+          ec_op1 env op1 (toec_cast env (Conv.ty_of_cty (fst (E.type_of_op1 op1)), e))
       | Papp2 (op2, e1, e2) ->
           let t1, t2 = fst (E.type_of_op2 op2) in
           let te1 = (Conv.ty_of_cty t1, e1) in
@@ -1453,10 +1614,21 @@ module EcExpression(EA: EcArray): EcExpression = struct
                   List.map (toec_expr env) es
               )
           | Oarray len ->
+             begin match es with
+             | e :: _ when List.for_all (( = ) e) es ->
+                Eapp (Eident [ec_BArray env (Conv.int_of_pos len); "init_arr" ],
+                    [ toec_expr env e ]
+                  )
+             | _ ->
               Eapp (
                   EA.of_list env U8 (Conv.int_of_pos len),
                   [Elist (List.map (toec_expr env) es)]
               )
+             end
+          | Ois_arr_init _ -> assert false
+          | Ois_barr_init len ->
+              Eapp (Eident [ec_BArray env (Conv.int_of_pos len); "is_init"],
+                    List.map (toec_expr env) es)
           end
       | Pif(_,e1,et,ef) ->
           let ty = ty_expr e in
@@ -1465,9 +1637,51 @@ module EcExpression(EA: EcArray): EcExpression = struct
               toec_expr env e1,
               toec_cast env (ty, et),
               toec_cast env (ty, ef)
-          )
+            )
+      | Pbig (i, op, v, e, a, b) ->
+        let v = L.unloc v in
+        let env = Env.set_var env v in
+        let op = Infix (Format.asprintf "%a" fmt_op2 op) in
+        let acc = "acc" and x = "x" in
+        let expr = Eop2 (op, Eident [x], Eident [acc]) in
+        let lambda1 = Equant ([acc], expr) in
+        let lambda1 = Equant ([x], lambda1) in
+        let i = toec_expr env i in
+        let a = toec_expr env a in
+        let b = toec_expr env b in
+        let e = toec_expr env e in
+        let lambda2 = Equant([ec_vars env v],e) in
+        let iota = Eapp (ec_ident "iota_", [a; b]) in
+        let map = Eapp (ec_ident "map", [lambda2;iota]) in
+        Eapp (ec_ident "foldr", [lambda1;i; map])
+      | Pis_var_init _ -> assert false
+      | Pis_mem_init (e1,e2) ->
+        let e1 = toec_expr env (int_of_ptr (Env.pd env) e1) in
+        let e2 = toec_expr env e2 in
+        Eapp (ec_ident "is_valid", [ Eident ["ptr_modulus"];glob_mem_vi;e1; e2])
 
   and toec_cast env (ty, e) = ec_cast env (ty, ty_expr e) (toec_expr env e)
+
+
+  let toec_lval1 env lv e =
+      match lv with
+      | Lnone _ -> assert false
+      | Lmem(_, ws,_, e1) ->
+        let storewi = ec_ident (Format.sprintf "storeW%i" (int_of_ws ws)) in
+        let addr = Eapp (ec_pd env, [toec_cast env (Prog.tu (Env.pd env),e1)]) in
+        ESasgn ([LvIdent glob_mem], Eapp (storewi, [glob_memi; addr; e]))
+      | Lvar x  ->
+        let lvid = [ec_vars env (L.unloc x)] in
+        ESasgn ([LvIdent lvid], e)
+      | Laset (_, aa, ws, x, e1) ->
+        let e1 = toec_expr env e1 in
+        EA.toec_laset env (aa, ws, L.unloc x, e1) e
+      | Lasub (aa, ws, len, x, e1) ->
+        ESasgn (
+          [LvIdent [ec_vars env (L.unloc x)]],
+          EA.toec_lasub env (aa, ws, len, x, toec_expr env e1) e
+          )
+
 end
 
 module type EcLeakage = sig
@@ -1508,13 +1722,14 @@ module EcLeakConstantTimeGlobal(EE: EcExpression): EcLeakage = struct
 
   let rec leaks_e_rec pd leaks e =
     match e with
-    | Pconst _ | Pbool _ | Parr_init _ |Pvar _ -> leaks
+    | Pconst _ | Pbool _ | Parr_init _ | Pvar _  -> leaks
     | Pload (_,_,e) -> leaks_e_rec pd (int_of_ptr pd e :: leaks) e
     | Pget (_,_,_,_, e) | Psub (_,_,_,_,e) -> leaks_e_rec pd (e::leaks) e
     | Papp1 (_, e) -> leaks_e_rec pd leaks e
     | Papp2 (_, e1, e2) -> leaks_e_rec pd (leaks_e_rec pd leaks e1) e2
     | PappN (_, es) -> leaks_es_rec pd leaks es
     | Pif  (_, e1, e2, e3) -> leaks_e_rec pd (leaks_e_rec pd (leaks_e_rec pd leaks e1) e2) e3
+    | Pbig _ | Pis_var_init _ | Pis_mem_init _ -> assert false
   and leaks_es_rec pd leaks es = List.fold_left (leaks_e_rec pd) leaks es
 
   let leaks_e pd e = leaks_e_rec pd [] e
@@ -1605,13 +1820,15 @@ module EcLeakConstantTime(EE: EcExpression): EcLeakage = struct
 
   let rec leaks_e_rec env leaks e =
     match e with
-    | Pconst _ | Pbool _ | Parr_init _ | Pvar _ -> leaks
+    | Pconst _ | Pbool _ | Parr_init _ | Pvar _ | Pis_var_init _ -> leaks
     | Pload (_,_,e) -> leaks_e_rec env ((leak_addr_mem env e) @ leaks) e
     | Pget (_,_,_,_, e) | Psub (_,_,_,_,e) -> leaks_e_rec env ([leak_addr (toec_expr env e)] @ leaks) e
     | Papp1 (_, e) -> leaks_e_rec env leaks e
     | Papp2 (_, e1, e2) -> leaks_es_rec env leaks [e1; e2]
     | PappN (_, es) -> leaks_es_rec env leaks es
     | Pif  (_, e1, e2, e3) -> leaks_es_rec env leaks [e1; e2; e3]
+    | Pbig _ | Pis_mem_init _ -> leaks
+
 
   and leaks_es_rec env leaks es = List.fold_left (leaks_e_rec env) leaks es
 
@@ -1724,23 +1941,405 @@ module EcLeakConstantTime(EE: EcExpression): EcLeakage = struct
     push_leak (leakacc env) (ec_ident (Env.reuse_aux env leak_ret_prefix leak_ret_ty))
 end
 
+module type EcSafety = sig
+
+  val ec_safety_rty: Env.t -> ec_ty list -> ec_ty list
+  val ec_safety_ret: Env.t -> funname -> ec_expr list -> ec_expr list
+
+  val ec_safety_assert:  Env.t -> int assertion -> ec_instr list
+
+  val ec_fun_safety_init: Env.t -> (int, 'a, 'b) gfunc -> ec_stmt * ec_stmt * (ec_modty * ec_ty) list * Env.t
+
+  val safety_imports: Env.t -> ec_item list
+  val global_safety_vars: Env.t -> (ec_modty * ec_ty) list
+
+  val ec_safety_call_lvs : Env.t -> funname -> ec_lvalues
+
+  val ec_safety_call_acc: Env.t -> int glval list -> funname -> exprs -> ec_instr list
+
+  val final: Env.t -> ((int, 'a, 'b) gfunc) list  -> int -> ec_item list
+  val generate_proofs: Env.t -> ((int, 'a, 'b) gfunc) list  -> string -> ec_item list
+end
+
+module EcSafetyNormal(EE: EcExpression) (EA: EcArray) : EcSafety = struct
+
+  let ec_safety_rty _env rtyps =  rtyps
+  let ec_safety_ret _env _name ret = ret
+
+  let ec_safety_assert _env _a = []
+
+  let ec_fun_safety_init env _f = [],[],[],env
+
+  let ec_safety_call_acc _env _lvs _f _es = []
+  let safety_imports _env = []
+  let global_safety_vars _env  = []
+
+  let ec_safety_call_lvs _env _ = []
+
+  let final _env _funcs _ = []
+
+  let generate_proofs _env _funcs _ = []
+end
+
+module EcSafetyAnnotations (EE: EcExpression) (EA: EcArray): EcSafety = struct
+
+  let ec_safety_rty _env rtyps =  rtyps @ ["trace"]
+
+  let ec_safety_ret env name ret =
+    let trace = Env.get_proofv env name in
+    [Etuple(ret @ [Eident [trace]])]
+
+
+  let ec_safety_call_lvs _env _f = [LvIdent ["tmp__trace"]]
+  let ec_trace env _k e =
+    let k =  ["Assert"] in
+    let f =  Env.get_func env in
+    let p = Env.get_proofv env f in
+    let e = EE.toec_expr env e in
+    let e1 = Eop2 (Infix "++", Eident [p], Elist [Etuple [Eident k;e]]) in
+    let i = ESasgn ([LvIdent ([p])],e1) in
+    [i]
+  let ec_safety_assert env (k,e) = ec_trace env k e
+
+
+  let proof_var_init env f =
+    let proofv = Env.get_proofv env f.f_name in
+    [ESasgn ([LvIdent [proofv]], Elist [])]
+
+
+  let init_trace env f =
+    let fname = Env.get_funname env f.f_name in
+
+    let proofv = ("trace_" ^ fname) in
+    Env.add_proofv env f.f_name proofv;
+    let env = Env.add_func env f.f_name in
+    let trace_ = Env.get_proofv env f.f_name in
+    let vars =
+      [trace_, "trace"]
+    in
+    env, vars
+
+  let ec_fun_safety_init env f =
+    let args = List.map (ec_vars env)  f.f_args in
+    let fn = f.f_name in
+    Env.add_args env fn args;
+    let env,proofv = init_trace env f in
+    let proofv_init = proof_var_init env f in
+    proofv_init,[],proofv,env
+
+
+  let ec_safety_call_acc env _lvs _f _es =
+    let f = Env.get_func env in
+    let p = Env.get_proofv env f in
+    let e1 =
+      Eop2 (Infix "++", Eident [p], Eident["tmp__trace"])
+    in
+    [ESasgn ([LvIdent ([p])],e1)]
+
+  let safety_imports _env = [IfromRequireImport ("Jasmin",["Jcheck"; "JSafety"])]
+  let global_safety_vars _env  = [("tmp__trace", "trace")]
+
+  let res = Eident ["res"]
+  let get_smt_lemmas (annot:annotations): string list option =
+    match (get "smt" annot) with
+    | Some (Some x )->
+      let x = L.unloc x in
+      begin match x with
+      | Astring x -> Some (String.split_on_char ',' x)
+      | _ -> None
+      end
+    | _ -> None
+
+
+  let get_smt_tactic (annot:annotations): ec_tactic =
+    let smt_lemmas = match get_smt_lemmas annot with
+      | Some s -> List.map (fun l -> Prop l) s
+      | None -> [ Prop "List.all_cat"]
+    in
+    {
+      tname = "smt";
+      targs = [Param smt_lemmas]
+    }
+
+  let get_invariant env c =
+    match c with
+     | {i_desc = Cassert ("safety_inv", e)}:: t ->
+       let e = EE.toec_expr env e in
+       Pattern "/\\ " :: [DProp e], t
+     | c -> [Pattern "/\\ ..."], c
+
+
+  let rec pp_valid_trace_instrs env f p instrs: ec_tactic list =
+    let auto_tactic = {
+      tname = "auto";
+      targs = []
+    } in
+    let rewrite_tactic =
+      {
+        tname = "rewrite";
+        targs = [Prop "/is_init"; Prop "/valid"; Pattern "/="]
+      }
+    in
+    let smt_tactic = get_smt_tactic f.f_annot.f_user_annot in
+    let fn = Env.get_funname env f.f_name in
+    let proofv = "trace_" ^ fn in
+    let valid_trace = DProp(Eapp(Eident ["valid"], [Eident [proofv]])) in
+    match instrs with
+    | [] -> p
+    | i::t -> begin match i.i_desc with
+      | Cassert ("safety_inv", e) ->
+        let pre = pp_valid_trace_instrs env f [auto_tactic] t in
+        let pre = if (List.last pre).tname = "auto" then
+            pre @ [rewrite_tactic;smt_tactic]
+        else pre in
+        let e = EE.toec_expr env e in
+        [{tname = "seq"; targs = [Pattern "x"; Pattern ":"; Param [valid_trace;Pattern "/\\ ";DProp e]]}] @ pre @ p
+      | Cfor (_,_,c) ->
+        let invariant,c = get_invariant env c in
+        let c = pp_valid_trace_instrs env f []  (List.rev c) in
+        let default = [auto_tactic;rewrite_tactic;smt_tactic] in
+        let c1 =
+          if c == [] then
+            default
+          else
+              if (List.last c).tname = "auto" then
+                auto_tactic :: c @ [rewrite_tactic;smt_tactic]
+              else
+                auto_tactic :: c
+        in
+        let p = p @ [{tname = "while"; targs = [Param (valid_trace::invariant)]}] @ c1 @ [auto_tactic] in
+        pp_valid_trace_instrs env f p t
+      | Cwhile(_,c1,_,_,c2) ->
+        let invariant,c2 = get_invariant env c2 in
+        let c1 = pp_valid_trace_instrs env f [] (List.rev c1) in
+        let c2 = pp_valid_trace_instrs env f []  (List.rev c2) in
+        let default = [auto_tactic;rewrite_tactic;smt_tactic] in
+        let c3 =
+          if c1 == [] && c2 == [] then
+            default
+          else
+            let c = c2 @ c1 in
+            if (List.last c).tname = "auto" then
+              auto_tactic :: c @ [rewrite_tactic; smt_tactic]
+            else
+              auto_tactic :: c
+        in
+        let p = p @ [{tname = "while"; targs = [Param (valid_trace::invariant)]}] @ c3 @ [auto_tactic] @ c1 in
+        pp_valid_trace_instrs env f p t
+      | Ccall(_lvs,fn,es) ->
+        let _otys, itys = Env.get_funtype env fn in
+        let args = List.map (EE.toec_cast env) (List.combine itys es) in
+        let params = List.map (fun e -> DProp e) args in
+        let lemma_name = Prop (Format.asprintf "%s_proof" (Env.get_funname env fn)) in
+        let p = p @ [{tname = "ecall"; targs = [Param (lemma_name::params)]};auto_tactic] in
+        pp_valid_trace_instrs env f p t
+      | Cif (_e, c1, c2) ->
+        let c1 = pp_valid_trace_instrs env f [] (List.rev c1) in
+        let c2 = pp_valid_trace_instrs env f [] (List.rev c2) in
+        let first_not_assert_safety t =
+          match t with
+          | {i_desc = Cassert ("safety_inv", _)}::_ -> true
+          | _ -> false in
+        if (c1 == [] && c2 == []) || (first_not_assert_safety t)then
+          pp_valid_trace_instrs env f p t
+        else
+          let c1 = p @ c1 in
+          let c2 = p @ c2 in
+          let c1 = if c1==[] then [auto_tactic;rewrite_tactic;smt_tactic]
+                   else if (List.last c1).tname == "auto" then c1@[rewrite_tactic;smt_tactic] else c1 in
+          let c2 = if c2==[] then [auto_tactic;rewrite_tactic;smt_tactic]
+                   else if (List.last c2).tname == "auto" then c2@[rewrite_tactic;smt_tactic] else c2 in
+          let c1 = if List.first c1 == auto_tactic then c1 else auto_tactic::c1 in
+          let c2 = if List.first c2 == auto_tactic then c2 else auto_tactic::c2 in
+          let p = [{tname = "if"; targs = []}] @ c1 @ c2 in
+          pp_valid_trace_instrs env f p t
+      | _ -> pp_valid_trace_instrs env f p t
+      end
+
+  let pp_valid_trace_t_t =
+    let tactic1 =
+      {
+        tname = "proc; inline *; auto";
+        targs = []
+      } in
+      let tactic2 =
+      {
+        tname = "qed";
+        targs = []
+      } in
+      [tactic1;tactic2]
+
+
+  let fand a b = Eop2 (Infix "/\\", a, b)
+
+    let get_pre = function
+    | None -> []
+    | Some f -> f.f_pre
+
+  let get_post = function
+    | None -> []
+    | Some f -> f.f_post
+
+  let get_iparams = function
+    | None -> []
+    | Some f -> f.f_iparams
+
+  let get_ires = function
+    | None -> []
+    | Some f -> f.f_ires
+
+  let contrat env c =
+    let c = List.map (fun (_,x) -> x) c in
+    if List.is_empty c then
+      Ebool true
+    else
+      let c = List.map (EE.toec_expr env) c in
+      List.fold_left (fun acc a -> Eop2 (Infix "/\\", a, acc) ) (List.hd c) (List.tl c)
+
+  let var_eq vars1 vars2 =
+    if List.length vars1 = 0 then
+      Ebool true
+    else
+      let vars = List.map2 (fun a b -> (a,b)) vars1 vars2 in
+      let eq (var1,var2) =
+        Eop2 (Infix "=", ec_ident var1, ec_ident var2)
+      in
+      List.fold_left
+        (fun acc a -> Eop2 (Infix "/\\", eq a, acc))
+        (eq (List.hd vars))
+        (List.tl vars)
+
+  let mk_old_param env params iparams =
+    if List.length iparams = 0 then
+      List.fold_left2 (fun (env,acc) v iv ->
+        let s = String.uncapitalize_ascii v.v_name in
+        let s = "_" ^ s in
+        let env = Env.set_var_prefix env iv s in
+        env, s :: acc
+      ) (env,[]) (List.rev params) (List.rev params)
+    else
+      List.fold_left2 (fun (env,acc) v iv ->
+          let s = String.uncapitalize_ascii v.v_name in
+          let s = "_" ^ s in
+          let env = Env.set_var_prefix env iv s in
+          env, s :: acc
+        ) (env,[]) (List.rev params) (List.rev iparams)
+
+
+  let update_res_env env _f ires =
+    List.fold_lefti
+      (fun env i res ->
+         let s ="res.`" ^ string_of_int (i+1) in
+         Env.set_var_prefix_u env res s)
+      env ires
+
+  let pp_specs env extra_ret f =
+    let fname = Env.get_funname env f.f_name in
+
+    let iparams = get_iparams f.f_contra in
+    let iparams = List.map L.unloc iparams in
+    let env,vars = mk_old_param env f.f_args iparams in
+
+    let args = Env.get_args env f.f_name in
+    let f1 = var_eq vars args in
+    let f2 = contrat env (get_pre f.f_contra) in
+    let pre = fand f1 f2 in
+
+    let ires = get_ires f.f_contra in
+    let ires = List.map L.unloc ires in
+    let env1 = update_res_env env f ires in
+
+    let post = contrat env1 (get_post f.f_contra) in
+
+    let trace = if List.length (f.f_ret) + extra_ret == 0 then res else  Eproj(res,(List.length (f.f_ret)) + extra_ret + 1) in
+    let valid_trace = Eapp(Eident ["valid"], [trace]) in
+
+    let post' = fand post valid_trace in
+
+    let name = Format.asprintf "%s_spec" fname in
+    let module_name =
+      if List.is_empty (Env.randombytes env) then "M"
+      else "M("^syscall_mod^")"
+    in
+    let form = EHoare ([module_name;fname], pre, post') in
+    FunSpec (name, vars, form)
+
+  let final env funcs extra_ret =
+    let p1 = List.map (pp_specs env extra_ret) funcs in
+    let c1 = Icomment "The post and trace are valid." in
+    (c1 :: p1)
+  
+
+  let pp_automatic_proofs env f =
+    let locals = Sv.elements (locals f) in
+    let env = List.fold_left Env.set_var env (f.f_args @ locals) in
+    let fname = Env.get_funname env f.f_name in
+    let iparams = get_iparams f.f_contra in
+    let iparams = List.map L.unloc iparams in
+    let env,vars = mk_old_param env f.f_args iparams in
+    let name = Format.asprintf "%s_proof" fname in
+    let spec_name = Format.asprintf "%s_spec" fname in
+    let args = List.map (fun v -> Eident [v]) vars in
+    let form = Eapp (Eident [spec_name],args) in
+    let prop = (name, vars, form) in
+    let smt_tactic = get_smt_tactic f.f_annot.f_user_annot in
+    let tactics =
+      if f.f_contra == None then
+        pp_valid_trace_t_t
+      else
+        let tactic0 = {
+          tname = "rewrite /"^spec_name;
+          targs = []
+        } in
+        let tactic1 = {
+          tname = "proc; auto";
+          targs = []
+        } in
+        let tactic2 = pp_valid_trace_instrs env f [] (List.rev f.f_body) in
+        let tactic2 =
+          if (tactic2 == [] ) then
+            [{tname = "rewrite /is_init /valid /="; targs = []}; smt_tactic]
+          else
+            let last_tactic = List.last tactic2 in
+            if last_tactic.tname = "auto" then
+              tactic2 @ [{tname = "rewrite /is_init /valid /="; targs = []};smt_tactic]
+            else
+              tactic2
+        in
+        let tactic3 =
+          {
+            tname = "qed";
+            targs = []
+        } in
+        tactic0 :: tactic1 ::  tactic2 @ [tactic3]
+      in
+    Lemma (prop, tactics)
+
+  let generate_proofs env funcs filename =
+    let p1 = List.map (pp_automatic_proofs env) funcs in
+    let imports = [
+          IrequireImport ["AllCore"; "IntDiv"; "CoreMap"; "List"; "Distr"];
+          IrequireImport [filename]
+      ] in
+    let c1 = Icomment "The post and trace are valid." in
+    (imports @ safety_imports env @ (c1 :: p1))
+  
+end
+
+
 
 module Extraction
   (EA: EcArray)
-  (EL: EcLeakage) =
+  (EL: EcLeakage)
+  (ES : EcSafety)
+   =
 struct
   open EcExpression(EA)
   open EL
+  open ES
   (* ------------------------------------------------------------------- *)
   (* Extraction of lvals *)
 
-  let ec_lvals env xs =
-    let ec_lval env = function
-      | Lnone _ | Lmem _ | Laset _ | Lasub _ -> assert false
-      | Lvar x  -> LvIdent [ec_vars env (L.unloc x)]
-    in
-    List.map (ec_lval env) xs
-
   let toec_lval1 env lv e =
       match lv with
       | Lnone _ -> assert false
@@ -1788,11 +2387,11 @@ struct
     in
     (ec_leaks_lvs env lvs) @ stmt
 
-  let ec_pcall env lvs leak_lvs otys f args =
+  let ec_pcall env lvs leak_lvs safety_lvs otys f args =
     if lvals_are_vars lvs && (List.map ty_lval lvs) = otys then
-      (ec_leaks_lvs env lvs) @ [EScall (leak_lvs @ ec_lvals env lvs, f, args)]
+      (ec_leaks_lvs env lvs) @ [EScall (leak_lvs @ ec_lvals env lvs @ safety_lvs,f,args)]
     else
-      ec_assgn_f env lvs otys otys (fun lvals -> EScall (leak_lvs @ lvals, f, args))
+      ec_assgn_f env lvs otys otys (fun lvals -> EScall (leak_lvs @ lvals @ safety_lvs, f, args))
 
   let ec_expr_assgn env lvs etyso etysi e =
     if lvals_are_vars lvs && (List.map ty_lval lvs) = etyso && etyso = etysi then
@@ -1841,17 +2440,20 @@ struct
           let otys, itys = Env.get_funtype env f in
           let args = List.map (toec_cast env) (List.combine itys es) in
           let leak_lvs = ec_leak_call_lvs env in
+          let safety_lvs = ec_safety_call_lvs env f in
           (ec_leaks_es env es) @
-          (ec_pcall env lvs leak_lvs otys [Env.get_funname env f] args) @
-          (ec_leak_call_acc env)
+          (ec_pcall env lvs leak_lvs safety_lvs otys [Env.get_funname env f] args) @
+          (ec_leak_call_acc env) @
+          (ec_safety_call_acc env lvs f es)
       | Csyscall (lvs, o, es) ->
           let s = Syscall.syscall_sig_u o in
           let otys = List.map Conv.ty_of_cty s.scs_tout in
           let itys =  List.map Conv.ty_of_cty s.scs_tin in
           let args = List.map (toec_cast env) (List.combine itys es) in
           (ec_leaks_es env es) @
-          (ec_pcall env lvs [] otys [ec_syscall env o] args)
-      | Cassert _a -> [(* TODO *)]
+          (ec_pcall env lvs [] [] otys [ec_syscall env o] args)
+      | Cassert a ->
+         ec_safety_assert env a
       | Cif (e, c1, c2) ->
           let c1 env = toec_cmd asmOp env c1 in
           let c2 env = toec_cmd asmOp env c2 in
@@ -1896,9 +2498,12 @@ struct
       let env = List.fold_left Env.set_var env (f.f_args @ locals) in
       (* Limit the scope of changes for aux variables to the current function. *)
       let env = Env.new_fun env in
-      let init = ec_fun_leak_init env in
-      let stmts = init @ (toec_cmd asmOp env f.f_body) in
+      let init_safety,final,safety_locals,env  = ec_fun_safety_init env f in
+      let init_leak = ec_fun_leak_init env in
+      let init = init_safety @ init_leak in
+      let stmts = init @ (toec_cmd asmOp env f.f_body) @ final in
       let ec_locals = (Env.aux_vars env) @ (List.map (var2ec_var env) locals) in
+      let ec_locals = ec_locals @ safety_locals in
       let aux_locals_init = locals
           |> List.filter (fun x -> match x.v_ty with Arr _ -> true | _ -> false)
           |> List.sort (fun x1 x2 -> compare x1.v_name x2.v_name)
@@ -1906,7 +2511,7 @@ struct
       in
       let ret =
           let ec_var x = ec_vari env (L.unloc x) in
-          match ec_leak_ret env (List.map ec_var f.f_ret) with
+          match ec_safety_ret env f.f_name (ec_leak_ret env (List.map ec_var f.f_ret)) with
           | [x] -> ESreturn x
           | xs -> ESreturn (Etuple xs)
       in
@@ -1916,7 +2521,7 @@ struct
           decl = {
               fname = (Env.get_funname env f.f_name);
               args = List.map (var2ec_var env) f.f_args;
-              rtys = ec_leak_rty env (List.map (toec_ty env) f.f_tyout);
+              rtys = ec_safety_rty env (ec_leak_rty env (List.map (toec_ty env) f.f_tyout));
           };
           locals = ec_locals;
           stmt = aux_locals_init @ stmts @ [ret];
@@ -1945,12 +2550,12 @@ struct
 
   let ec_glob_decl env (x,d) =
     let w_of_z ws z = Eapp (Eident [fmt_Wsz ws; "of_int"], [Econst z]) in
-    let mk_abbrev e = Iabbrev (ec_vars env x, e) in
+    let mk_abbrev p e = Iabbrev (p,ec_vars env x, e) in
     match d with
-    | Global.Gword(ws, w) -> mk_abbrev (w_of_z ws (Conv.z_of_word ws w))
+    | Global.Gword(ws, w) -> mk_abbrev true (w_of_z ws (Conv.z_of_word ws w))
     | Global.Garr(p,t) ->
       let ws, t = Conv.to_array x.v_ty p t in
-      mk_abbrev (Eapp (EA.of_list env ws (Array.length t),
+      mk_abbrev false (Eapp (EA.of_list env ws (Array.length t),
                        [Elist (List.map (w_of_z ws) (Array.to_list t))]))
 
   let ec_randombytes env =
@@ -1988,22 +2593,6 @@ struct
         ]
 
   let toec_prog env asmOp globs funcs =
-      let add_glob_env env (x, d) =
-        add_glob_arrsz env (x, d);
-        Env.set_var env x
-      in
-      let add_arrsz env f =
-        let add env x =
-          match x.v_ty with
-          | Arr(ws, n) -> EA.add_jarray env ws n
-          | _ -> ()
-        in
-        let vars = vars_fc f in
-        Sv.iter (add env) vars
-      in
-      let env = List.fold_left Env.set_fun env funcs in
-      let env = List.fold_left add_glob_env env globs in
-      List.iter (add_arrsz env) funcs;
 
       let funs = List.map (toec_fun asmOp env) funcs in
 
@@ -2024,15 +2613,17 @@ struct
           name = "M";
           params = mod_arg;
           ty = None;
-          vars = global_leakage_vars env;
+          vars = global_leakage_vars env @ global_safety_vars env;
           funs;
       } in
       glob_imports @
       (leakage_imports env) @
+      (safety_imports env) @
       pp_array_theories (Env.array_theories env) @
       (List.map (fun glob -> ec_glob_decl env glob) globs) @
       (ec_randombytes env) @
-      [top_mod]
+      [top_mod] @
+      final env funcs (if ec_leak_call_lvs env <> [] then 1 else 0)
 
   let pp_prog env asmOp fmt globs funcs =
     Format.fprintf fmt "%a@." pp_ec_prog (toec_prog env asmOp globs funcs)
@@ -2056,16 +2647,8 @@ and used_func_i used i =
   | Cwhile(_, c1, _, _, c2) -> used_func_c (used_func_c used c1) c2
   | Ccall (_,f,_)   -> Ss.add f.fn_name used
 
-let extract ((globs,funcs):('info, 'asm) prog) arch pd msfsz asmOp (model: model) amodel fnames array_dir fmt =
-  let save_array_theories array_theories =
-    match array_dir with
-    | Some prefix ->
-        begin
-          Sarraytheory.iter (save_array_theory ~prefix) array_theories
-    end
-    | None -> ()
-  in
-  let fnames =
+let extract_init_env ((globs,funcs):('info, 'asm) prog) arch pd msfsz _asmOp (model: model) amodel fnames _array_dir _fmt extract =
+ let fnames =
     match fnames with
     | [] -> List.map (fun { f_name ; _ } -> f_name.fn_name) funcs
     | fnames -> fnames
@@ -2092,8 +2675,79 @@ let extract ((globs,funcs):('info, 'asm) prog) arch pd msfsz asmOp (model: model
         warning Deprecated Location.i_dummy
           "EasyCrypt extraction for constant-time in CTG mode is deprecated. Use the CT mode instead.";
         (module EcLeakConstantTimeGlobal(EE): EcLeakage)
+    | SafetyAnnotations -> (module EcLeakNormal(EE): EcLeakage)
+  ) in
+  let module ES: EcSafety = (val match model with
+    | SafetyAnnotations -> (module EcSafetyAnnotations(EE)(EA): EcSafety)
+    | _ -> (module EcSafetyNormal(EE)(EA): EcSafety)
+  ) in
+  let module E = Extraction(EA)(EL)(ES) in
+  let add_glob_env env (x, d) =
+      E.add_glob_arrsz env (x, d);
+      Env.set_var env x
+    in
+    let add_arrsz env f =
+      let add env x =
+        match x.v_ty with
+        | Arr(ws, n) -> EA.add_jarray env ws n
+        | _ -> ()
+      in
+      let vars = vars_fc f in
+      Sv.iter (add env) vars
+    in
+    let env = List.fold_left Env.set_fun env funcs in
+    let env = List.fold_left add_glob_env env globs in
+    List.iter (add_arrsz env) funcs;
+    env, extract env funcs
+
+
+
+let generate_safety_lemmas fname ((globs,funcs):('info, 'asm) prog) arch pd msfsz asmOp (model: model) amodel fnames array_dir fmt =
+  let module EA: EcArray = (val match amodel with
+    | ArrayOld -> (module EcArrayOld: EcArray)
+    | WArray   -> (module EcWArray  : EcArray)
+    | BArray   -> (module EcBArray  : EcArray)
+  ) in
+  let module EE = EcExpression(EA) in
+  let module ES: EcSafety = (val match model with
+    | SafetyAnnotations -> (module EcSafetyAnnotations(EE)(EA): EcSafety)
+    | _ -> (module EcSafetyNormal(EE)(EA): EcSafety)
+  ) in
+  let _, prog = extract_init_env ((globs,funcs):('info, 'asm) prog) arch pd msfsz asmOp model amodel fnames array_dir fmt
+    (fun env funcs -> ES.generate_proofs env funcs fname ) in
+  Format.fprintf fmt "%a@." pp_ec_prog prog
+
+
+let extract ((globs,funcs):('info, 'asm) prog) arch pd msfsz asmOp (model: model) amodel fnames array_dir fmt =
+  let save_array_theories array_theories =
+    match array_dir with
+    | Some prefix ->
+        begin
+          Sarraytheory.iter (save_array_theory ~prefix) array_theories
+    end
+    | None -> ()
+  in
+   let module EA: EcArray = (val match amodel with
+    | ArrayOld -> (module EcArrayOld: EcArray)
+    | WArray   -> (module EcWArray  : EcArray)
+    | BArray   -> (module EcBArray  : EcArray)
+  ) in
+  let module EE = EcExpression(EA) in
+  let module EL: EcLeakage = (val match model with
+    | Normal -> (module EcLeakNormal(EE): EcLeakage)
+    | ConstantTime -> (module EcLeakConstantTime(EE): EcLeakage)
+    | ConstantTimeGlobal ->
+        warning Deprecated Location.i_dummy
+          "EasyCrypt extraction for constant-time in CTG mode is deprecated. Use the CT mode instead.";
+        (module EcLeakConstantTimeGlobal(EE): EcLeakage)
+    | SafetyAnnotations -> (module EcLeakNormal(EE): EcLeakage)
+  ) in
+  let module ES: EcSafety = (val match model with
+    | SafetyAnnotations -> (module EcSafetyAnnotations(EE)(EA): EcSafety)
+    | _ -> (module EcSafetyNormal(EE)(EA): EcSafety)
   ) in
-  let module E = Extraction(EA)(EL) in
-  let prog = E.pp_prog env asmOp fmt globs funcs in
+  let module E = Extraction(EA)(EL)(ES) in
+  let env,prog = extract_init_env ((globs,funcs):('info, 'asm) prog) arch pd msfsz asmOp model amodel fnames array_dir fmt
+    (fun env funcs -> E.pp_prog env asmOp fmt globs funcs ) in
   save_array_theories (Env.array_theories env);
   prog
diff --git a/compiler/src/toEC.mli b/compiler/src/toEC.mli
index 1ade6079d7..6e19215331 100644
--- a/compiler/src/toEC.mli
+++ b/compiler/src/toEC.mli
@@ -17,3 +17,16 @@ val extract :
   string option ->
   Format.formatter ->
   unit
+
+val generate_safety_lemmas : string -> 
+  ('info, ('reg, 'regx, 'xreg, 'rflag, 'cond, 'asm_op, 'extra_op) Arch_extra.extended_op) Prog.prog ->
+  Utils.architecture ->
+  Wsize.wsize ->
+  Wsize.wsize ->
+  ('reg, 'regx, 'xreg, 'rflag, 'cond, 'asm_op, 'extra_op) Arch_extra.extended_op Sopn.asmOp ->
+  Utils.model ->
+  amodel ->
+  string list ->
+  string option ->
+  Format.formatter ->
+  unit
\ No newline at end of file
diff --git a/compiler/src/typing.ml b/compiler/src/typing.ml
index 22bd39daab..4ce3fa1c91 100644
--- a/compiler/src/typing.ml
+++ b/compiler/src/typing.ml
@@ -82,6 +82,22 @@ let type_of_sopn loc pd msfsz asmOp op =
   List.map Conv.ty_of_cty (Sopn.sopn_tin pd msfsz asmOp op),
   List.map Conv.ty_of_cty (Sopn.sopn_tout pd msfsz asmOp op)
 
+(* Return the type of the expression but do not type check it *)
+let type_of_expr e =
+  match e with
+  | Pconst _    -> tint
+  | Pbool _  | Pis_var_init _ | Pis_mem_init _ -> tbool
+  | Parr_init (ws, len) -> Arr (ws, len)
+  | Pvar x      -> ty_gvar x
+  | Pget(_al, _aa,ws, _x, _e) -> tu ws
+  | Psub(_aa, ws, len, _x, _e) -> Arr(ws, len)
+  | Pload(_, ws, _e) -> tu ws
+  | Papp1(op, _e) -> snd (type_of_op1 op)
+  | Papp2(op, _e1, _e2) -> snd (type_of_op2 op)
+  | PappN(op, _es) -> snd (type_of_opN op)
+  | Pif(ty, _b, _e1, _e2) -> ty
+  | Pbig(_e, op, _x, _e1, _e2, _e0) -> snd (type_of_op2 op)
+
 (* -------------------------------------------------------------------- *)
 
 let rec ty_expr pd loc (e:expr) =
@@ -89,6 +105,11 @@ let rec ty_expr pd loc (e:expr) =
   | Pconst _    -> tint
   | Pbool _     -> tbool
   | Parr_init (ws, len) -> Arr (ws, len)
+  | Pis_var_init _ -> tbool
+  | Pis_mem_init (e1, e2) -> 
+    ignore (ty_load_store pd loc Wsize.U8 e1);
+    check_expr pd loc e2 tint;
+    tbool
   | Pvar x      -> ty_gvar x
   | Pget(_al, _aa,ws,x,e) ->
     ty_get_set pd loc ws x e
@@ -115,6 +136,16 @@ let rec ty_expr pd loc (e:expr) =
     check_expr pd loc e1 ty;
     check_expr pd loc e2 ty;
     ty
+  | Pbig(e, op, _x, e1, e2, e0) ->
+    let (tin1, tin2), tout = type_of_op2 op in
+    check_expr pd loc e  tout;
+    check_expr pd loc e1 tint;
+    check_expr pd loc e2 tint;
+    check_expr pd loc e0 tout;
+    (* FIXME *)
+    if not (subtype tin1 tout) && not (subtype tin2 tout) then
+      error loc "invalid big op type";
+    tout
 
 and check_expr pd loc e ty =
   let te = ty_expr pd loc e in
diff --git a/compiler/src/typing.mli b/compiler/src/typing.mli
index 9413a73ec7..fae62bb1ef 100644
--- a/compiler/src/typing.mli
+++ b/compiler/src/typing.mli
@@ -9,3 +9,7 @@ val error : Prog.L.i_loc -> ('a, Format.formatter, unit, 'b) format4 -> 'a
 
 val check_prog :
   Wsize.wsize -> Wsize.wsize -> 'asm Sopn.asmOp -> ('info, 'asm) prog -> unit
+
+(* Return the type of the expression but do not type check it *)
+val type_of_expr : expr -> ty
+
diff --git a/compiler/src/utils.ml b/compiler/src/utils.ml
index 5514d8ac2b..dfb947f6bb 100644
--- a/compiler/src/utils.ml
+++ b/compiler/src/utils.ml
@@ -206,6 +206,7 @@ type model =
   | ConstantTime
   | ConstantTimeGlobal
   | Normal
+  | SafetyAnnotations
 
 (* -------------------------------------------------------------------- *)
 (* Functions used to add colors to errors and warnings.                 *)
diff --git a/compiler/src/utils.mli b/compiler/src/utils.mli
index ce30972479..4c8d471cfc 100644
--- a/compiler/src/utils.mli
+++ b/compiler/src/utils.mli
@@ -116,6 +116,7 @@ type model =
   | ConstantTime
   | ConstantTimeGlobal
   | Normal
+  | SafetyAnnotations
 
 (* -------------------------------------------------------------------- *)
 (* Enables colors in errors and warnings.                               *)
diff --git a/compiler/src/varalloc.ml b/compiler/src/varalloc.ml
index c7943463c2..fc5ea8ae5c 100644
--- a/compiler/src/varalloc.ml
+++ b/compiler/src/varalloc.ml
@@ -170,7 +170,11 @@ let classes_alignment (onfun : funname -> param_info option list) (gtbl: alignme
     | Psub (_,_,_,_,e) | Pload (_, _, e) | Papp1 (_, e) -> add_e e
     | Papp2 (_, e1,e2) -> add_e e1; add_e e2
     | PappN (_, es) -> add_es es 
-    | Pif (_,e1,e2,e3) -> add_e e1; add_e e2; add_e e3 
+    | Pif (_,e1,e2,e3) -> add_e e1; add_e e2; add_e e3
+    | Pbig (e, _, _, e1, e2, e0) -> add_e e; add_e e1; add_e e2; add_e e0
+    | Pis_var_init _ -> ()
+    | Pis_mem_init (e1,e2) -> add_e e1; add_e e2
+
   and add_es es = List.iter add_e es in
 
   let add_lv = function
diff --git a/compiler/tests/printing.ml b/compiler/tests/printing.ml
index 224e79e2aa..ed561b9a05 100644
--- a/compiler/tests/printing.ml
+++ b/compiler/tests/printing.ml
@@ -100,9 +100,13 @@ and eq_pexpr x y =
   | Papp2 (a, b, c), Papp2 (d, e, f) -> a = d && eq_pexpr b e && eq_pexpr c f
   | PappN (a, b), PappN (c, d) -> a = c && eq_pexprs b d
   | Pif (a, b, c, d), Pif (e, f, g, h) ->
-      eq_pty a e && eq_pexpr b f && eq_pexpr c g && eq_pexpr d h
+    eq_pty a e && eq_pexpr b f && eq_pexpr c g && eq_pexpr d h
+  | Pbig _ , Pbig _ -> assert false
+  | Pis_var_init a , Pis_var_init b -> eq_pvar_i a b
+  | Pis_mem_init (a, b), Pis_mem_init (c, d) -> eq_pexpr a c && eq_pexpr b d
   | ( ( Pconst _ | Pbool _ | Parr_init _ | Pvar _ | Pget _ | Psub _ | Pload _
-      | Papp1 _ | Papp2 _ | PappN _ | Pif _ ),
+      | Papp1 _ | Papp2 _ | PappN _ | Pif _ | Pbig _ | Pis_var_init _
+      | Pis_mem_init _),
       _ ) ->
       false
 
diff --git a/compiler/tests/success/x86-64/requires_ensures.jazz b/compiler/tests/success/x86-64/requires_ensures.jazz
new file mode 100644
index 0000000000..202f58239d
--- /dev/null
+++ b/compiler/tests/success/x86-64/requires_ensures.jazz
@@ -0,0 +1,18 @@
+#[safety =
+   { requires = is_arr_init(t, 0, 10) && 0 <= i && i < 10
+   , ensures = true}
+ ]
+export fn read_arr (reg ptr u32[10] t, reg u64 i) -> reg u32 {
+  reg u32 r = t[i];
+  return r;
+}
+
+#[safety =
+   { requires = is_arr_init(t, 0, 10)
+   , requires  = 0 <= i && i < 10
+   , ensures = true}
+ ]
+export fn read_arr_ (reg ptr u32[10] t, reg u64 i) -> reg u32 {
+  reg u32 r = t[i];
+  return r;
+}
\ No newline at end of file
diff --git a/eclib/JByte_array.ec b/eclib/JByte_array.ec
index bf22d8a317..a0a33a12d3 100644
--- a/eclib/JByte_array.ec
+++ b/eclib/JByte_array.ec
@@ -23,6 +23,22 @@ abstract theory ByteArray.
 
   op is_init (t:t) (k l : int): bool = forall i, k <= i => i < k + l => is_init_cell t i.
 
+  lemma is_init_one (t:t) (k :int):
+    is_init t k 1 = is_init_cell t k.
+  proof.
+    smt().
+  qed.
+  hint simplify is_init_one.
+
+  lemma is_init_cellP (t:t) (i j: int) (v:W8.t):
+      is_init_cell t.[i<-v] j = if (i=j /\ 0<=i<ByteArray.size) then v = (W8.of_int 255) else is_init_cell t j.
+  proof.
+    smt(get_set_if).
+  qed.
+
+  hint simplify is_init_cellP.
+
+
   op init_arr (b : W8.t) : t =
     init (fun _ => b).
 
@@ -31,7 +47,7 @@ abstract theory ByteArray.
 
  lemma is_init_set_last t len :
    is_init t 0 len => is_init t.[len <- W8.of_int 255] 0 (len + 1).
- proof. move => h k k0 klen k_in_bounds; rewrite get_set_if /#. qed.
+ proof. move => h k k0 klen k_in_bounds /#. qed.
 
   abstract theory WSB.
     type B.
@@ -175,6 +191,7 @@ abstract theory ByteArray.
     op of_list'S (l:B list) =
       init (fun i => if i < List.size l * r then nth _zero l (i%/r) \bits8 (i%%r) else W8.zero).
 
+
     lemma get8_of_list'S l i :
       (of_list'S l).[i] =
          if (0 <= i < ByteArray.size) /\ i < List.size l * r then nth _zero l (i%/r) \bits8 (i%%r) else W8.zero.
diff --git a/eclib/JMemory.ec b/eclib/JMemory.ec
index 929a6c656a..82f455ed95 100644
--- a/eclib/JMemory.ec
+++ b/eclib/JMemory.ec
@@ -23,6 +23,20 @@ op valid1 : global_mem_v_t -> address -> bool.
 op is_valid (mod: int) (mem_v: global_mem_v_t) (p: address) (l: int) =
   (forall i, p <= i < p + l => valid1 mem_v i) /\ (0 <= p /\ p + l < mod).
 
+lemma is_validP (mod :int) (mem_v:global_mem_v_t) (a: address) (l : int):
+  is_valid mod mem_v a l <=> (forall a' l' , a <= a' =>  a' + l' <= a + l => is_valid mod mem_v a' l').
+proof. 
+  smt().
+qed.
+
+
+lemma is_valid_bound (mod :int) (mem_v:global_mem_v_t) : 
+  forall i l, is_valid mod mem_v i l => i + l <= mod. 
+proof. 
+  smt().
+qed.
+
+
 axiom mem_eq_ext (m1 m2:global_mem_t) : (forall j, m1.[j] = m2.[j]) => m1 = m2.
 
 axiom get_setE m x y w :
diff --git a/eclib/JSafety.ec b/eclib/JSafety.ec
new file mode 100644
index 0000000000..d043d30f60
--- /dev/null
+++ b/eclib/JSafety.ec
@@ -0,0 +1,19 @@
+
+require import AllCore IntDiv CoreMap List Distr StdBigop.
+import Bigbool.
+
+
+lemma BBAnd_big_foldr ['a] (F : 'a -> bool) (r : 'a list) :
+  foldr (fun x0 acc => x0 /\ acc) true (map F r) =
+  BBAnd.big predT F r.
+    proof.
+by rewrite /BBAnd.big filter_predT.    
+  qed.
+  
+lemma and_iota (F : int -> bool) i l :
+  foldr (fun x0 acc => x0 /\ acc) true (map F (iota_ i l)) <=>
+  forall k, i <= k < i + l => F k.
+    proof.
+      rewrite BBAnd_big_foldr BBAnd.bigP filter_predT List.allP.
+    smt( mem_iota).
+  qed.
\ No newline at end of file
diff --git a/eclib/Jcheck.ec b/eclib/Jcheck.ec
index bfe94df707..5c12d839c0 100644
--- a/eclib/Jcheck.ec
+++ b/eclib/Jcheck.ec
@@ -8,6 +8,27 @@ lemma valid_cat ['k] (x y : 'k trace_) :
   valid (x ++ y) <=> valid x /\ valid y.
 proof. exact: all_cat. qed.
 
+
+op trace ['k 'a] (x:'a * 'k trace_) = x.`2.
+
+op validk ['k] (k : 'k) (t : 'k trace_) =
+  with t = []       => true
+  with t = p :: t' => if p.`1 = k then p.`2 /\ validk k t' else (p.`2 => validk k t').
+
+lemma forall_validk_valid ['k] (t : 'k trace_) :
+  (forall k, validk k t) => valid t.
+proof.
+  elim: t => //= -[k' b] t hrec /#.
+qed.
+
+lemma validk_cat ['k] (k : 'k) t1 t2 :
+  validk k t1 =>
+  (valid t1 => validk k t2) =>
+  validk k (t1 ++ t2).
+proof.
+  elim t1 => //= -[k' b] t1 hrec /= /#.
+qed.
+
 type kind =
 [
   | Assert
@@ -15,3 +36,8 @@ type kind =
 ].
 
 type trace = kind trace_.
+
+lemma all_validk_valid t : validk Assert t => validk Assume t => valid t.
+proof.
+  by move=> *; apply forall_validk_valid => -[].
+qed.
diff --git a/proofs/_CoqProject b/proofs/_CoqProject
index b981988496..4ac0957229 100644
--- a/proofs/_CoqProject
+++ b/proofs/_CoqProject
@@ -18,6 +18,7 @@
 -R arch Jasmin
 -R compiler Jasmin
 -R lang Jasmin
+-R ec_extraction Jasmin
 -R ssrmisc Jasmin
 -R itrees Jasmin
 
@@ -129,6 +130,7 @@ compiler/unionfind_proof.v
 compiler/unrolling.v
 compiler/unrolling_proof.v
 compiler/wint_int.v
+compiler/wint_int_proof.v
 compiler/wint_word.v
 compiler/wint_word_proof.v
 compiler/x86_decl.v
@@ -141,6 +143,13 @@ compiler/x86_params_proof.v
 compiler/x86_stack_zeroization.v
 compiler/x86_stack_zeroization_proof.v
 compiler/x86.v
+ec_extraction/compiler_extraction.v
+ec_extraction/constant_prop_extraction.v
+ec_extraction/contracts_asserts.v
+ec_extraction/extra_vars_call.v
+ec_extraction/insert_cast.v
+ec_extraction/insert_cast_proof.v
+ec_extraction/remove_init_preds.v
 itrees/it_exec.v
 itrees/rec_facts.v
 itrees/rutt_extras.v
@@ -175,6 +184,10 @@ lang/psem_of_sem_proof.v
 lang/pseudo_operator.v
 lang/psem_facts.v
 lang/relational_logic.v
+lang/safety.v
+lang/safety_proof.v
+lang/safety_shared.v
+lang/safety_shared_proof.v
 lang/sem_one_varmap.v
 lang/sem_op_typed.v
 lang/sem_one_varmap_facts.v
diff --git a/proofs/arch/arch_decl.v b/proofs/arch/arch_decl.v
index 708e50ae13..73429e13e4 100644
--- a/proofs/arch/arch_decl.v
+++ b/proofs/arch/arch_decl.v
@@ -17,7 +17,8 @@ Require Import
   syscall
   utils
   expr
-  word.
+  word
+  operators.
 
 Require Import
   sopn
@@ -409,6 +410,7 @@ Record instr_desc_t := {
   id_str_jas    : unit -> string;
   id_check_dest : all2 check_arg_dest id_out id_tout;
   id_safe       : seq safe_cond;
+  id_init       : seq init_cond;
   id_pp_asm     : asm_args -> pp_asm_op;
   (* Extra properties ensuring that previous information are consistent *)
   id_safe_wf    : all (fun sc => values.sc_needed_args sc <= size id_tin) id_safe;
@@ -558,6 +560,7 @@ Definition instr_desc (o:asm_op_msb_t) : instr_desc_t :=
        id_str_jas    := d.(id_str_jas);
        id_check_dest := instr_desc_aux2 ws d.(id_check_dest);
        id_safe       := d.(id_safe);
+       id_init       := d.(id_init);
        id_pp_asm     := d.(id_pp_asm);
        id_safe_wf    := d.(id_safe_wf);
        id_semi_errty := fun h => extend_sem_errty ws (d.(id_semi_errty) h);
diff --git a/proofs/arch/arch_extra.v b/proofs/arch/arch_extra.v
index 88f8818301..36a518125c 100644
--- a/proofs/arch/arch_extra.v
+++ b/proofs/arch/arch_extra.v
@@ -387,6 +387,7 @@ Definition get_instr_desc (o: extended_op) : instruction_desc :=
     ; semi     := semi_to_atype id.(id_semi)
     ; semu     := @vuincl_app_sopn_v _ _ _ (is_not_carr_ltype _)
     ; i_safe   := id.(id_safe)
+    ; i_init   := id.(id_init)
     ; i_valid  := id.(id_valid)
     ; i_safe_wf := semi_to_atype_safe_wf id.(id_safe_wf)
     ; i_semi_errty := fun h => semi_to_atype_errty (id.(id_semi_errty) h)
diff --git a/proofs/arch/arch_utils.v b/proofs/arch/arch_utils.v
index f14cbf46c9..99b0cdb174 100644
--- a/proofs/arch/arch_utils.v
+++ b/proofs/arch/arch_utils.v
@@ -273,15 +273,15 @@ Context
   {reg regx xreg rflag cond : Type}
   {ad : arch_decl reg regx xreg rflag cond}.
 
-Notation idt_dropn semi_dropn semi_errtyp semi_safe :=
+Notation idt_dropn n semi_dropn semi_errtyp semi_safe :=
   (fun idt =>
      {|
        id_valid := id_valid idt;
        id_msb_flag := id_msb_flag idt;
        id_tin := id_tin idt;
        id_in := id_in idt;
-       id_tout := beheadn _ (id_tout idt);
-       id_out := beheadn _ (id_out idt);
+       id_tout := beheadn n (id_tout idt);
+       id_out := beheadn n (id_out idt);
        id_semi := semi_dropn (id_semi idt);
        id_nargs := id_nargs idt;
        id_args_kinds := id_args_kinds idt;
@@ -289,6 +289,7 @@ Notation idt_dropn semi_dropn semi_errtyp semi_safe :=
        id_check_dest := all2_beheadn (id_check_dest idt);
        id_str_jas := id_str_jas idt;
        id_safe := id_safe idt;
+       id_init := beheadn n (id_init idt);
        id_pp_asm := id_pp_asm idt;
        id_safe_wf := id_safe_wf idt;
        id_semi_errty := fun (h : id_valid idt) =>
@@ -297,10 +298,10 @@ Notation idt_dropn semi_dropn semi_errtyp semi_safe :=
           semi_safe (id_tin idt) (id_tout idt) (id_safe idt) (id_semi idt) (id_semi_safe (i:=idt) h);
      |}).
 
-Definition idt_drop1 : instr_desc_t -> instr_desc_t := idt_dropn semi_drop1 semi_drop1_errty semi_drop1_sem_safe.
-Definition idt_drop2 : instr_desc_t -> instr_desc_t := idt_dropn semi_drop2 semi_drop2_errty semi_drop2_sem_safe.
-Definition idt_drop3 : instr_desc_t -> instr_desc_t := idt_dropn semi_drop3 semi_drop3_errty semi_drop3_sem_safe.
-Definition idt_drop4 : instr_desc_t -> instr_desc_t := idt_dropn semi_drop4 semi_drop4_errty semi_drop4_sem_safe.
+Definition idt_drop1 : instr_desc_t -> instr_desc_t := idt_dropn 1 semi_drop1 semi_drop1_errty semi_drop1_sem_safe.
+Definition idt_drop2 : instr_desc_t -> instr_desc_t := idt_dropn 2 semi_drop2 semi_drop2_errty semi_drop2_sem_safe.
+Definition idt_drop3 : instr_desc_t -> instr_desc_t := idt_dropn 3 semi_drop3 semi_drop3_errty semi_drop3_sem_safe.
+Definition idt_drop4 : instr_desc_t -> instr_desc_t := idt_dropn 4 semi_drop4 semi_drop4_errty semi_drop4_sem_safe.
 
 Definition rtuple_drop5th
   {t0 t1 t2 t3 t4 : ctype}
diff --git a/proofs/arch/asm_gen_proof.v b/proofs/arch/asm_gen_proof.v
index 271d40ed35..3e41203bf6 100644
--- a/proofs/arch/asm_gen_proof.v
+++ b/proofs/arch/asm_gen_proof.v
@@ -660,7 +660,7 @@ Lemma compile_asm_opn_aux (condspec : assemble_cond_spec) rip ii (loargs : seq a
   -> lom_eqv rip m s
   -> exists2 s', exec_instr_op id loargs s = ok s' & lom_eqv rip m' s'.
 Proof.
-  move=> id ; rewrite /exec_sopn /sopn_sem.
+  move=> id; rewrite /exec_sopn /sopn_sem /=.
   t_xrbindP => Hxs _ hval <- vt Hvt <-{ys} Hm' Hargs Hdest Hid Hlomeqv.
   rewrite /exec_instr_op /eval_instr_op Hid /=.
   move: hval => /=; rewrite -/id => -> /=.
@@ -670,7 +670,7 @@ Proof.
   rewrite <- e1, <- e2; clear e1 e2.
   case: id Hargs Hdest => /= id_valid msb_flag id_tin
    id_in id_tout id_out id_semi id_args_kinds id_nargs /andP[] /eqP hsin /eqP hsout
-   id_str_jas id_check_dest id_safe id_pp _ _ _ Hargs Hdest vt happ Hm'.
+   id_str_jas id_check_dest id_safe id_init id_pp _ _ _ Hargs Hdest vt happ Hm'.
   elim: id_in id_tin hsin id_semi args xs Hargs happ Hxs; rewrite /sem_prod.
   + move=> [] //= _ id_semi [|a1 args] [|v1 vs] //= _ -> _ /=.
     exact: (compile_lvals _ hsout Hm' Hlomeqv Hdest).
diff --git a/proofs/compiler/allocation.v b/proofs/compiler/allocation.v
index 775110c989..a429700eb5 100644
--- a/proofs/compiler/allocation.v
+++ b/proofs/compiler/allocation.v
@@ -604,6 +604,10 @@ Fixpoint check_i (i1 i2:instr_r) r :=
         ok (re, r') in
       Let r := loop2 check_c Loop.nb r in
       ok r
+    | Cassert a1, Cassert a2 =>
+      Let _ := assert (a1.1 == a2.1) (alloc_error "annotation_kind not equals") in
+      Let re := check_e a1.2 a2.2 r in
+      ok (re)
 
     | _, _ => Error (alloc_error "instructions not equals")
     end
diff --git a/proofs/compiler/allocation_proof.v b/proofs/compiler/allocation_proof.v
index e2344059e4..29d90b281f 100644
--- a/proofs/compiler/allocation_proof.v
+++ b/proofs/compiler/allocation_proof.v
@@ -110,7 +110,7 @@ Section CHECK_EP.
   Lemma check_e_esP : (∀ e, P e) ∧ (∀ es, Q es).
   Proof.
   Local Opaque arr_size.
-    apply: pexprs_ind_pair; split; subst P Q => /=.
+    apply: pexprs_ind_pair; split; subst P Q => //=.
     - case => // r _ vm1 _ [<-] h; split => // scs m _ [<-] /=; eauto.
     - move => e1 he1 es1 hes1 [] // e2 es2 r re vm1 err; t_xrbindP => r' ok_r' ok_re h.
       move: he1 => /(_ e2 r r' vm1 ok_r' h) [] h' he1.
@@ -827,6 +827,11 @@ Section PROOF.
     + move=> xs o es ii dead_vars r1 r2 ii2 [] // xs2 o2 es2 /=.
       t_xrbindP => r1' /eqP <- hces hcxs.
       apply wequiv_syscall_rel_uincl with checker_alloc r1' => //.
+    (* Assert *)
+    + move=> a1 ii dead_vars r1 r2 ii2 [] //= a2.
+      t_xrbindP => /eqP heq r1' hce <-.
+      apply wequiv_assert_rel_uincl with checker_alloc => //=.
+      by rewrite /check_es_alloc /check_es /= hce.
     (* If *)
     + move=> e c1 c2 hc1 hc2 ii dead_vars r1 r2 ii2 [] // e2 c1' c2' /=.
       t_xrbindP => re hce r1' hcc1 r2' hcc2 <-.
diff --git a/proofs/compiler/arm_extra.v b/proofs/compiler/arm_extra.v
index 8b4937653c..f94559885c 100644
--- a/proofs/compiler/arm_extra.v
+++ b/proofs/compiler/arm_extra.v
@@ -52,6 +52,7 @@ Definition Oarm_add_large_imm_instr : instruction_desc :=
    ; semi   := sem_prod_ok ctin semi
    ; semu   := @values.vuincl_app_sopn_v ctin [:: cty] (sem_prod_ok ctin semi) refl_equal
    ; i_safe := [::]
+   ; i_init := [:: IBool true]
    ; i_valid := true
    ; i_safe_wf := refl_equal
    ; i_semi_errty :=  fun _ => sem_prod_ok_error (tin:=ctin) semi _
@@ -64,7 +65,7 @@ Definition smart_li_instr (ws : wsize) : instruction_desc :=
     [:: aword ws ] [:: E 0 ]
     [:: aword ws ] [:: E 1 ]
     (fun x => x)
-    true.
+    true [:: IBool true].
 
 Definition smart_li_instr_cc (ws : wsize) : instruction_desc :=
   mk_instr_desc_safe
@@ -72,7 +73,7 @@ Definition smart_li_instr_cc (ws : wsize) : instruction_desc :=
     [:: aword ws; abool; aword ws ] [:: E 0; E 2; E 1 ]
     [:: aword ws ] [:: E 1 ]
     (fun x b y => if b then x else y)
-    true.
+    true [:: IBool true].
 
 Definition get_instr_desc (o: arm_extra_op) : instruction_desc :=
   match o with
diff --git a/proofs/compiler/arm_instr_decl.v b/proofs/compiler/arm_instr_decl.v
index 6dd6ca76a1..2987297854 100644
--- a/proofs/compiler/arm_instr_decl.v
+++ b/proofs/compiler/arm_instr_decl.v
@@ -8,6 +8,7 @@ From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat seq eqtype fintype.
 From mathcomp Require Import ssralg word_ssrZ.
 
 Require Import
+  operators
   sem_type
   shift_kind
   strings
@@ -521,6 +522,7 @@ Definition mk_cond (idt : instr_desc_t) : instr_desc_t :=
     id_check_dest := id_check_dest idt;
     id_str_jas := id_str_jas idt;
     id_safe := id_safe idt;
+    id_init := id_init idt;
     id_pp_asm := id_pp_asm idt;
     id_valid := id_valid idt;
     id_safe_wf := safe_wf_cat _ (id_safe_wf idt);
@@ -619,6 +621,7 @@ Definition mk_shifted
     id_check_dest := id_check_dest idt;
     id_str_jas := id_str_jas idt;
     id_safe := id_safe idt;
+    id_init := id_init idt;
     id_pp_asm := id_pp_asm idt;
     id_valid := id_valid idt;
     id_safe_wf := safe_wf_cat _ (id_safe_wf idt);
@@ -728,6 +731,7 @@ Definition arm_ADD_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -773,6 +777,7 @@ Definition arm_ADC_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -821,6 +826,7 @@ Definition arm_MUL_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -851,6 +857,7 @@ Definition arm_MLA_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -877,6 +884,7 @@ Definition arm_MLS_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -905,6 +913,7 @@ Definition arm_SDIV_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [:: ];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -939,6 +948,7 @@ Definition arm_SUB_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -977,6 +987,7 @@ Definition arm_SBC_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [::IBool true; IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1015,6 +1026,7 @@ Definition arm_RSB_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1053,6 +1065,7 @@ Definition arm_UDIV_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [:: ];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1080,6 +1093,7 @@ Definition arm_UMULL_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true; IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1107,6 +1121,7 @@ Definition arm_UMAAL_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true; IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1134,6 +1149,7 @@ Definition arm_UMLAL_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true; IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1161,6 +1177,7 @@ Definition arm_SMULL_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true; IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1188,6 +1205,7 @@ Definition arm_SMLAL_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true; IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1214,6 +1232,7 @@ Definition arm_SMMUL_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1240,6 +1259,7 @@ Definition arm_SMMULR_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1275,6 +1295,7 @@ Definition arm_smul_hw_instr hwn hwm : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1306,6 +1327,7 @@ Definition arm_smla_hw_instr hwn hwm : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1336,6 +1358,7 @@ Definition arm_smulw_hw_instr hw : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1374,6 +1397,7 @@ Definition arm_AND_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool false; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1441,6 +1465,7 @@ Definition arm_BFC_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := arm_BFC_semi_sc;
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1497,6 +1522,7 @@ Definition arm_BFI_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := arm_BFI_semi_sc;
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1522,6 +1548,7 @@ Definition arm_BIC_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool false; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1558,6 +1585,7 @@ Definition arm_EOR_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool false; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1602,6 +1630,7 @@ Definition arm_MVN_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool false; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1638,6 +1667,7 @@ Definition arm_ORR_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool false; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1671,6 +1701,11 @@ Definition arm_shift_semi
       & res
      ).
 
+Definition arm_shift_semi_ic n :=
+  let x := IOp1 (Oint_of_word Unsigned U8) (IVar n) in
+  let c := IOp2 (Oneq (Op_int)) x (IConst 0) in
+  [:: c;c;c;IBool true].
+  
 Definition arm_ASR_C (wn : ty_r) (shift : Z) :=
   if (32 <=? shift)%Z then msb wn
   else wbit_n wn (Z.to_nat (shift - 1)).
@@ -1700,6 +1735,7 @@ Definition arm_ASR_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := arm_shift_semi_ic 1;
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1736,6 +1772,7 @@ Definition arm_LSL_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := arm_shift_semi_ic 1;
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1772,6 +1809,7 @@ Definition arm_LSR_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := arm_shift_semi_ic 1;
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1808,6 +1846,7 @@ Definition arm_ROR_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := arm_shift_semi_ic 1;
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1833,6 +1872,7 @@ Definition mk_rev_instr mn semi :=
    ; id_check_dest := refl_equal
    ; id_str_jas := pp_s (string_of_arm_mnemonic mn)
    ; id_safe := [::]
+   ; id_init := [:: IBool true]
    ; id_pp_asm := pp_arm_op mn opts
    ; id_valid := true
    ; id_safe_wf := refl_equal
@@ -1873,6 +1913,7 @@ Definition arm_ADR_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1901,6 +1942,7 @@ Definition arm_MOV_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool false; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -1934,6 +1976,7 @@ Definition arm_MOVT_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -1984,6 +2027,7 @@ Definition arm_UBFX_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := bit_field_extract_semi_sc;
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -2018,6 +2062,7 @@ Definition arm_UXTB_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -2043,6 +2088,7 @@ Definition arm_UXTH_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -2070,6 +2116,7 @@ Definition arm_SBFX_instr : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := bit_field_extract_semi_sc;
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -2102,6 +2149,7 @@ Definition arm_CMP_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -2140,6 +2188,7 @@ Definition arm_TST_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -2171,6 +2220,7 @@ Definition arm_CMN_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s (string_of_arm_mnemonic mn);
       id_safe := [::];
+      id_init := [:: IBool true; IBool true; IBool true; IBool true];
       id_pp_asm := pp_arm_op mn opts;
       id_valid := true;
       id_safe_wf := refl_equal;
@@ -2210,6 +2260,7 @@ Definition arm_load_instr mn : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -2240,6 +2291,7 @@ Definition arm_store_instr mn : instr_desc_t :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
@@ -2264,6 +2316,7 @@ Definition arm_CLZ_instr :=
     id_check_dest := refl_equal;
     id_str_jas := pp_s (string_of_arm_mnemonic mn);
     id_safe := [::];
+    id_init := [:: IBool true];
     id_pp_asm := pp_arm_op mn opts;
     id_valid := true;
     id_safe_wf := refl_equal;
diff --git a/proofs/compiler/arm_lowering_proof.v b/proofs/compiler/arm_lowering_proof.v
index 6998fae807..8c3c701e6a 100644
--- a/proofs/compiler/arm_lowering_proof.v
+++ b/proofs/compiler/arm_lowering_proof.v
@@ -531,7 +531,7 @@ Proof.
   case: e => // [ al aa ws x| al ws] e s ws' ws'' aop es w.
   all: rewrite /lower_pexpr_aux /lower_load.
   all: move=> /chk_ws_regP [? [??]] hws hfve; subst ws' aop es.
-  all: rewrite /sem_pexpr -/(sem_pexpr _ _ s e).
+  all: rewrite /sem_pexpr -/(sem_pexpr (wc:=nocatch) _ _ s e).
 
   - apply: on_arr_gvarP => n t hty ok_t.
     apply: rbindP => idx.
@@ -570,7 +570,7 @@ Proof.
   move=> s ws ws' op' es w.
   move=> h hws hfve.
 
-  rewrite /sem_pexpr -/(sem_pexpr _ _ s e).
+  rewrite /sem_pexpr -/(sem_pexpr (wc:=nocatch) _ _ s e).
   t_xrbindP=> v hseme hw.
 
   move: h.
@@ -817,7 +817,7 @@ Proof.
   move=> h hws hfve hseme.
 
   move: hseme.
-  rewrite /sem_pexpr -!/(sem_pexpr _ _ s _).
+  rewrite /sem_pexpr -!/(sem_pexpr (wc:=nocatch) (wa:=noassert) _ _ s _).
   t_xrbindP=> v0 hseme0 v1 hseme1 hsemop.
 
   move: hfve => /disj_fvars_read_e_Papp2 [hfve0 hfve1].
@@ -1042,8 +1042,7 @@ Lemma lower_pexpr_auxP e :
   Plower_pexpr_aux e.
 Proof.
   move=> s ws ws' aop es w.
-  case: e => [||| gx | al aa ws0 x e || al ws0 x e | op e | op e0 e1 ||] //.
-
+  case: e => [||| gx | al aa ws0 x e || al ws0 x e | op e | op e0 e1 |||||] //.
   - exact: lower_PvarP.
   - exact: (lower_loadP (Pget _ _ _ _ _)).
   - exact: (lower_loadP (Pload _ _ _)).
@@ -1104,7 +1103,7 @@ Proof.
 
   move: s0 ws' pre op es w h hs00 hws hfve hfvlv hseme hwrite.
   case: e =>
-    [||| gx | al aa ws0 x e || al ws0 e | op e | op e0 e1 || ty c e0 e1] //
+    [||| gx | al aa ws0 x e || al ws0 e | op e | op e0 e1 || ty c e0 e1|||] //
     s0 ws' pre aop es w h hs00 hws hfve hfvlv hseme hwrite.
 
   1-5: move: h => /no_preP [? h]; subst pre.
@@ -1211,7 +1210,7 @@ Proof.
   rewrite /lower_store.
   case hmn: store_mn_of_wsize => [mn|] //.
 
-  case: e hseme hfv => [||| gx ||||||| ty c e0 e1] // hseme hfv [? ?];
+  case: e hseme hfv => [||| gx ||||||| ty c e0 e1|||] // hseme hfv [? ?];
     subst aop es.
   all: rewrite /= /sem_sopn /=.
   all: have /= := eeq_exc_sem_pexpr hfv hs00 hseme.
@@ -1415,7 +1414,7 @@ Proof.
   move=> hwrite1.
 
   move: h.
-  case: e2 hseme2 => [| [] || gx |||||||] //= hseme2 [???];
+  case: e2 hseme2 => [| [] || gx ||||||||||] //= hseme2 [???];
     subst lvs' op' es'.
   all: rewrite /= hseme0 hseme1 /= {hseme0 hseme1}.
 
diff --git a/proofs/compiler/array_copy.v b/proofs/compiler/array_copy.v
index fcccc64b6b..149ed3648d 100644
--- a/proofs/compiler/array_copy.v
+++ b/proofs/compiler/array_copy.v
@@ -144,9 +144,9 @@ Fixpoint array_copy_i V (i:instr) : cexec cmd :=
 Context {pT: progT}.
 
 Definition array_copy_fd V (f:fundef) :=
-  let 'MkFun fi tyin params c tyout res ev := f in
+  let 'MkFun fi ci tyin params c tyout res ev := f in
   Let c := array_copy_c V array_copy_i c in
-  ok (MkFun fi tyin params c tyout res ev).
+  ok (MkFun fi ci tyin params c tyout res ev).
 
 Definition array_copy_prog (p:prog) :=
   let V := vars_p (p_funcs p) in
diff --git a/proofs/compiler/array_copy_proof.v b/proofs/compiler/array_copy_proof.v
index 7b77f331b6..4c11dd68a0 100644
--- a/proofs/compiler/array_copy_proof.v
+++ b/proofs/compiler/array_copy_proof.v
@@ -197,7 +197,7 @@ Opaque esem.
       + subst z; rewrite Vm.setP_eq.
         have [hxy hyl]: v_var (gv src) = x /\ is_lvar src.
         + by move: hz; rewrite /read_gvar; case: ifP => ?; first split => //; [clear -hz|clear]; SvD.fsetdec.
-        move: ok_t; rewrite /= /get_gvar hyl /get_gvar hxy /get_var; t_xrbindP => _ heq.
+        move: ok_t; rewrite /= /get_gvar hyl /get_gvar hxy /get_var /=; t_xrbindP => _ heq.
         rewrite heq /len hty eqxx; split => //.
         move: hvm1' => /(_ _ hz) /=; rewrite hx heq /= => hu k w8.
         case: (hu) => _ h /h hw8; rewrite (write_read8 hset) /=.
@@ -227,7 +227,7 @@ Transparent esem.
     { rewrite /= /sem_assgn /=.
       rewrite /= get_gvar_neq // -eq_globs.
       move: hv => /= => -> /=.
-      rewrite (@get_gvar_eq _ _ _ (mk_lvar i)) //= (WArray.uincl_get hty' hget) /=.
+      rewrite (@get_gvar_eq _ _ _ _ (mk_lvar i)) //= (WArray.uincl_get hty' hget) /=.
       rewrite /truncate_val /= truncate_word_u /= write_var_eq_type //.
       rewrite /mk_lvar /= /get_gvar get_var_eq /= cmp_le_refl orbT //.
       rewrite /truncate_val /= truncate_word_u /=.
@@ -292,7 +292,7 @@ Proof.
   move=> z1 hcast z2 hset hw ?; subst s.
   rewrite read_rvs_cons read_rvs_nil /= read_eE => hsub hvm ok_dst t't''.
   have [ z1' hcast' z1z1' ] := WArray.uincl_cast t't'' hcast.
-  have : get_gvar true gd (evm s1) (mk_lvar x) = ok (Varr a) := ok_a.
+  have : get_gvar true gd (evm s1) (mk_lvar x) = ok (Varr a) by apply ok_a.
   case/(get_gvar_uincl_at (vm2 := vm1)).
   - by apply: hvm => /=; clear -hsub dstX; SvD.fsetdec.
   case => // blen b; rewrite /get_gvar /= => ok_b hab.
@@ -499,7 +499,7 @@ Qed.
 
 Local Lemma Hproc : sem_Ind_proc p1 ev Pc Pfun.
 Proof.
-  move=> scs1 m1 scs2 m2 fn [fi tin params body tout res extra] /=.
+  move=> scs1 m1 scs2 m2 fn [fi ci tin params body tout res extra] /=.
   move=> vargs vargs' s0 s1 s2 vres vres' hget hca hi hw _ hc hres hcr hscs hfi vargs1 hva.
   have [fd2 hfd hget']:= all_checked hget.
   have hpex : p_extra p1 = p_extra p2.
diff --git a/proofs/compiler/array_expansion.v b/proofs/compiler/array_expansion.v
index 337df67384..bbdfdc60e8 100644
--- a/proofs/compiler/array_expansion.v
+++ b/proofs/compiler/array_expansion.v
@@ -159,7 +159,24 @@ Fixpoint expand_e (m : t) (e : pexpr) : cexec pexpr :=
     Let e2 := expand_e m e2 in
     Let e3 := expand_e m e3 in
     ok (Pif ty e1 e2 e3) 
+  | Pbig idx op x body s len =>
+    Let _ := assert (Sv.mem x m.(svars)) (reg_ierror x "Pbig binder not in svar") in
+    Let idx := expand_e m idx in
+    Let body := expand_e m body in
+    Let s := expand_e m s in
+    Let len := expand_e m len in
+    ok (Pbig idx op x body s len)
+
+  | Pis_var_init x =>
+    (* FIXME *)
+    Let _ := assert (Sv.mem x m.(svars))
+       (reg_error x "(the array cannot be manipulated alone, you need to access its cells instead)") in
+    ok e
 
+  | Pis_mem_init e1 e2 =>
+    Let e1 := expand_e m e1 in
+    Let e2 := expand_e m e2 in
+    ok (Pis_mem_init e1 e2)
   end.
 
 Definition expand_lv (m : t) (x : lval)  :=
@@ -320,30 +337,54 @@ Definition expand_tyv m b s ty v :=
     (reg_ierror v "there should be an invariant ensuring this never happens in array_expansion_proof") in
     ok ([:: ty], [:: v], None).
 
+Definition expand_ci m exp (insf: seq (seq atype * seq var_i * option (wsize * Z)))
+                           (ins: seq (option (wsize * Z)))
+                           (outsf: seq (seq atype * seq var_i * option (wsize * Z)))
+                           (outs: seq (option (wsize * Z)))
+ ityin ci :=
+  match ci with
+  | Some ci =>
+    Let iins := mapM2 length_mismatch (expand_tyv m exp "the parameters") ityin ci.(f_iparams) in
+    Let _ := assert ([seq x.1.1 | x <- insf] == [seq x.1.1 | x <- iins])
+                    (E.reg_ierror_no_var "ins.1.1 <> iins.1.1") in
+    Let _ := assert (ins == [seq i.2 | i <- iins]) (E.reg_ierror_no_var "ins <> map snd iins") in
+    let ci_params := flatten (map (fun x => snd (fst x)) iins) in
+    Let ires := mapM2 length_mismatch (expand_tyv m exp "the results") ityin ci.(f_ires) in
+    Let _ := assert ([seq x.1.1 | x <- outsf] == [seq x.1.1 | x <- ires])
+                    (E.reg_ierror_no_var "outsf.1.1 <> ires.1.1") in
+    Let _ := assert (outs == [seq i.2 | i <- ires]) (E.reg_ierror_no_var "outs <> map snd ires") in
+    let ci_res := flatten (map (fun x => snd (fst x)) ires) in
+    Let ci_pre := mapM (sndM (expand_e m)) ci.(f_pre) in
+    Let ci_post := mapM (sndM (expand_e m)) ci.(f_post) in
+    ok (Some (MkContra ci_params ci_res ci_pre ci_post))
+  | None => ok None
+  end.
+
 Definition expand_fsig fi (entries : seq funname) (fname: funname) (fd: ufundef) :=
   Let x := init_map (fi fname fd) in
   match fd with
-  | MkFun _ tyin params c tyout res ef =>
+  | MkFun _ ci ityin params c tyout res ef =>
     let '(m, fi) := x in
     let exp := ~~(fname \in entries) in
-    Let ins  := mapM2 length_mismatch (expand_tyv m exp "the parameters") tyin params in
-    let tyin   := map (fun x => fst (fst x)) ins in
-    let params := map (fun x => snd (fst x)) ins in
-    let ins    := map snd ins in
-    Let outs := mapM2 length_mismatch (expand_tyv m exp "the return type") tyout res in
-    let tyout  := map (fun x => fst (fst x)) outs in
-    let res    := map (fun x => snd (fst x)) outs in
-    let outs   := map snd outs in
-    ok (MkFun fi (flatten tyin) (flatten params) c (flatten tyout) (flatten res) ef,
+    Let insf  := mapM2 length_mismatch (expand_tyv m exp "the parameters") ityin params in
+    let tyin   := map (fun x => fst (fst x)) insf in
+    let params := map (fun x => snd (fst x)) insf in
+    let ins := map snd insf in
+    Let outsf := mapM2 length_mismatch (expand_tyv m exp "the return type") tyout res in
+    let tyout  := map (fun x => fst (fst x)) outsf in
+    let res    := map (fun x => snd (fst x)) outsf in
+    let outs   := map snd outsf in
+    Let ci := expand_ci m exp insf ins outsf outs ityin ci in
+    ok (MkFun fi ci (flatten tyin) (flatten params) c (flatten tyout) (flatten res) ef,
         m, (ins, outs))
   end.
 
 Definition expand_fbody (fname: funname) (fs: ufundef * t) :=
   let (fd, m) := fs in
   match fd with
-  | MkFun fi tyin params c tyout res ef =>
+  | MkFun fi ci tyin params c tyout res ef =>
     Let c := mapM (expand_i m) c in
-    ok (MkFun fi tyin params c tyout res ef)
+    ok (MkFun fi ci tyin params c tyout res ef)
   end.
 
 End FSIGS.
diff --git a/proofs/compiler/array_expansion_proof.v b/proofs/compiler/array_expansion_proof.v
index 05ce43f414..5b344837db 100644
--- a/proofs/compiler/array_expansion_proof.v
+++ b/proofs/compiler/array_expansion_proof.v
@@ -829,9 +829,9 @@ Proof.
   have [fd1 [fd2 [m [inout [Hget2 hsigs /=]]]] {Hget}]:= all_checked Hget.
   rewrite /expand_fsig; t_xrbindP => -[mt finf].
   case: f Hca Hw Hc Hres Hcr => /=.
-  move=> finfo ftyin fparams fbody ftyout fres fextra.
+  move=> finfo fci ftyin fparams fbody ftyout fres fextra.
   set fd := {| f_info := finfo |} => Hca Hw Hc Hres Hcr hinit.
-  t_xrbindP => ins hparams outs hres <- ??; subst mt inout.
+  t_xrbindP => ins hparams outs hres fci' _ <- ??; subst mt inout.
   t_xrbindP => c hc ?; subst fd1.
   move=> expdin expdout; rewrite hsigs => -[??] vargs1 hexvs; subst expdin expdout.
   set (sempty := {| escs := scs1; emem := m1; evm := Vm.init |}).
@@ -1006,9 +1006,9 @@ Proof.
   have [fd1 [fd2 [m [inout [hget2 hsigs /=]]]]]:= all_checked hget1.
   rewrite /expand_fsig; t_xrbindP => -[mt finf].
   case: fd hget1.
-  move=> finfo ftyin fparams fbody ftyout fres fextra hget1.
+  move=> finfo fcontract ftyin fparams fbody ftyout fres fextra hget1.
   set fd := {| f_info := finfo |} => hinit.
-  t_xrbindP => ins hparams outs hres <- ??; subst mt inout.
+  t_xrbindP => ins hparams outs hres fc' _ <- ??; subst mt inout.
   t_xrbindP => c hc ?; exists fd1; subst fd1 => // s1.
   rewrite /initialize_funcall /=; t_xrbindP; rewrite /estate0 => vs1 htr hw.
   rewrite -hscs -hmem hflat => {hflat}.
@@ -1085,7 +1085,7 @@ Proof.
   t_xrbindP=> > +?? /hrec{hrec}h ?; subst=> /=.
   case: eqP; last by move=> /nesym /eqP?; rewrite Mf.setP_neq //.
   move=> <- + ? [] <- /=.
-  rewrite Mf.setP_eq /expand_fsig b /=; t_xrbindP=> -[??] _; t_xrbindP=> ? hz ? hz1 <- /=.
+  rewrite Mf.setP_eq /expand_fsig b /=; t_xrbindP=> -[??] _; t_xrbindP => ? hz ? hz1 ?? <- /=.
   do 2 f_equal.
   + move/mapM2_Forall3: hz; elim => //= > + _ ->.
     by rewrite /expand_tyv; case: Mvar.get => //; t_xrbindP => _ <-.
@@ -1102,7 +1102,7 @@ Lemma it_expand_callP f :
   wiequiv_f p1 p2 ev ev (rpreF (eS:=eq_spec)) f f (rpostF (eS:=eq_spec)).
 Proof.
   apply: (rbindP _ Hcomp) => s1 /[dup]Hs1 /it_expand_callP_aux /(_ E E0 wE rE0 f) h _ hin.
-  apply wequiv_fun_get => fd hget.
+  apply wequiv_fun_get_wa => fd hget.
   have hgets : Mf.get (fsigs s1) f =
     Some (map (fun=> None) (f_tyin fd), map (fun=> None) (f_tyout fd)).
   + move: Hs1 fd hget {h}; rewrite {}/fsigs. elim: (p_funcs p1) s1
@@ -1110,14 +1110,14 @@ Proof.
     t_xrbindP=> > +?? /hrec{hrec}h ?; subst=> /=.
     case: eqP; last by move=> /nesym /eqP?; rewrite Mf.setP_neq //.
     move=> <- + ? [] <- /=.
-    rewrite Mf.setP_eq /expand_fsig hin /=; t_xrbindP=> -[??] _; t_xrbindP=> ? hz ? hz1 <- /=.
+    rewrite Mf.setP_eq /expand_fsig hin /=; t_xrbindP=> -[??] _; t_xrbindP=> ? hz ? hz1 ? _ <- /=.
     do 2 f_equal.
     + move/mapM2_Forall3: hz; elim => //= > + _ ->.
       by rewrite /expand_tyv; case: Mvar.get => //; t_xrbindP => _ <-.
     move/mapM2_Forall3: hz1; elim => //= > + _ ->.
     by rewrite /expand_tyv; case: Mvar.get => //; t_xrbindP => _ <-.
   apply wkequiv_io_weaken with (rpreF (eS:=exp_spec s1) f f) (rpostF (eS:=exp_spec s1) f f) => //.
-  + move=> fs1 fs2 [] [_ <-] [s]; rewrite /initialize_funcall; t_xrbindP.
+  + move=> fs1 fs2 [] [_ <-] _ [s]; rewrite /initialize_funcall; t_xrbindP.
     move=> vs htri _ _ _; split => //; split => //.
     eexists; first exact hgets.
     exists [seq [:: x] | x <- (fvals fs1)] => /=.
diff --git a/proofs/compiler/array_init.v b/proofs/compiler/array_init.v
index da50ab5ec4..3ff34383a7 100644
--- a/proofs/compiler/array_init.v
+++ b/proofs/compiler/array_init.v
@@ -20,13 +20,13 @@ Fixpoint remove_init_i i :=
   match i with
   | MkI ii ir =>
     match ir with
-    | Cassgn x _ _ e => 
-      if is_array_init e then 
-        let t := 
+    | Cassgn x _ _ e =>
+      if is_array_init e then
+        let t :=
           match x with
           | Lvar x => is_reg_array x
           | Lasub _ _ _ x _ => is_reg_array x
-          | _ => true 
+          | _ => true
           end in
         if t then [::] else [::i]
       else [::i]
@@ -54,6 +54,7 @@ Context {pT: progT}.
 
 Definition remove_init_fd (fd:fundef) :=
   {| f_info   := fd.(f_info);
+     f_contra := fd.(f_contra);
      f_tyin   := fd.(f_tyin);
      f_params := fd.(f_params);
      f_body   := remove_init_c fd.(f_body);
@@ -73,10 +74,10 @@ Section Section.
 
   Context (add_init_i : Sv.t -> instr -> cmd * Sv.t).
 
-  Fixpoint add_init_c I (c:cmd) := 
+  Fixpoint add_init_c I (c:cmd) :=
     match c with
-    | [::] => ([::], I) 
-    | i::c => 
+    | [::] => ([::], I)
+    | i::c =>
       let (i,I) := add_init_i I i in
       let (c,I) := add_init_c I c in
       (i ++ c, I)
@@ -94,10 +95,10 @@ Definition add_init_aux ii x c :=
   | _ => c
   end.
 
-Definition add_init ii I extra i := 
+Definition add_init ii I extra i :=
   Sv.fold (add_init_aux ii) (Sv.diff extra I) [::i].
 
-Fixpoint add_init_i I (i:instr) := 
+Fixpoint add_init_i I (i:instr) :=
   let (ii,ir) := i in
   match ir with
   | Cif e c1 c2 =>
@@ -119,6 +120,7 @@ Definition add_init_fd (fd:fundef) :=
   let I := vrvs [seq (Lvar i) | i <- f_params fd] in
   let f_body  := (add_init_c add_init_i I fd.(f_body)).1 in
   {| f_info   := fd.(f_info);
+     f_contra := fd.(f_contra);
      f_tyin   := fd.(f_tyin);
      f_params := fd.(f_params);
      f_body   := f_body;
diff --git a/proofs/compiler/compiler.v b/proofs/compiler/compiler.v
index c165118a6c..2db717ba3e 100644
--- a/proofs/compiler/compiler.v
+++ b/proofs/compiler/compiler.v
@@ -123,8 +123,8 @@ Variant compiler_step :=
 Definition compiler_step_list := [::
     Typing
   ; ParamsExpansion
-  ; InsertRenaming
   ; RemoveAssertion
+  ; InsertRenaming
   ; WintWord
   ; ArrayCopy
   ; AddArrInit
@@ -260,7 +260,7 @@ Definition inlining (to_keep: seq funname) (p: uprog) : cexec uprog :=
 
 Definition compiler_first_part (to_keep: seq funname) (p: uprog) : cexec uprog :=
 
-  let p := remove_assert_prog p in
+  Let p := remove_assert_prog p in
   let p := cparams.(print_uprog) RemoveAssertion p in
 
   Let p := wi2w_prog (wsw:=withsubword) cparams.(remove_wint_annot) cparams.(dead_vars_ufd) p in
diff --git a/proofs/compiler/compiler_proof.v b/proofs/compiler/compiler_proof.v
index 5dee5f4aa3..a94f3ec26a 100644
--- a/proofs/compiler/compiler_proof.v
+++ b/proofs/compiler/compiler_proof.v
@@ -62,6 +62,7 @@ Hypothesis print_uprogP : forall s p, cparams.(print_uprog) s p = p.
 Hypothesis print_sprogP : forall s p, cparams.(print_sprog) s p = p.
 Hypothesis print_linearP : forall s p, cparams.(print_linear) s p = p.
 
+
 #[local] Existing Instance progUnit.
 
 Lemma compiler_third_part_meta entries (p p' : sprog) :
@@ -316,7 +317,7 @@ Lemma compiler_first_partP entries (p: prog) (p': uprog) scs m fn va scs' m' vr
     List.Forall2 value_uincl vr vr' &
     sem_call (dc:=direct_c) p' tt scs m fn va scs' m' vr'.
 Proof.
-  rewrite /compiler_first_part; t_xrbindP => paw.
+  rewrite /compiler_first_part; t_xrbindP => pra ok_pra paw.
   rewrite print_uprogP => ok_paw pa0.
   rewrite !print_uprogP => ok_pa0 pb.
   rewrite print_uprogP => ok_pb pa ok_pa pc ok_pc ok_puc ok_puc'.
@@ -382,10 +383,10 @@ Proof.
   apply: compose_pass_uincl'.
   + by move=> vr'; apply: wi2w_progP; apply ok_paw.
   apply: compose_pass.
-  + move => vr'; exact: remove_assert_progP.
+  - move=> vr'; apply: (remove_assert_progP); apply ok_pra.
   apply: compose_pass; first by move => vr'; exact: psem_call_u.
   exists vr => //.
-  exact: values_uincl_refl.
+  exact: (List_Forall2_refl _ value_uincl_refl).
 Qed.
 
 Lemma compiler_third_partP returned_params (p p' : @sprog _pd _ _asmop) :
diff --git a/proofs/compiler/constant_prop.v b/proofs/compiler/constant_prop.v
index aaefd6d058..76dbc01d83 100644
--- a/proofs/compiler/constant_prop.v
+++ b/proofs/compiler/constant_prop.v
@@ -381,6 +381,27 @@ Fixpoint const_prop_e (m:cpm) e :=
   | Papp2 o e1 e2 => s_op2 o (const_prop_e m e1)  (const_prop_e m e2)
   | PappN op es   => s_opN op (map (const_prop_e m) es)
   | Pif t e e1 e2 => s_if t (const_prop_e m e) (const_prop_e m e1) (const_prop_e m e2)
+  | Pbig idx op x body s len =>
+    let s   := const_prop_e m s in
+    let len := const_prop_e m len in
+    let idx := const_prop_e m idx in
+    match is_const s, is_const len with
+    | Some s, Some len =>
+      foldl (fun acc i =>
+              let m := Mvar.set m x (Cint i) in
+              let b := const_prop_e m body in
+              Papp2 op acc b)
+            idx (ziota s len)
+    | _, _ =>
+      Pbig idx op x (const_prop_e (Mvar.remove m x) body) s len
+    end
+
+   | Pis_var_init _ => e
+
+   | Pis_mem_init e1 e2 =>
+     let e1 := const_prop_e m e1 in
+     let e2 := const_prop_e m e2 in
+     Pis_mem_init e1 e2
   end.
 
 End GLOBALS.
@@ -549,9 +570,9 @@ Section Section.
 Context {pT: progT}.
 
 Definition const_prop_fun (gd: glob_decls) (f: fundef) :=
-  let 'MkFun ii si p c so r ev := f in
+  let 'MkFun ii ci si p c so r ev := f in
   let (_, c) := const_prop (const_prop_i gd) empty_cpm c in
-  MkFun ii si p c so r ev.
+  MkFun ii ci si p c so r ev.
 
 Definition const_prop_prog (p:prog) : prog := map_prog (const_prop_fun p.(p_globs)) p.
 
diff --git a/proofs/compiler/constant_prop_proof.v b/proofs/compiler/constant_prop_proof.v
index 2b0e464f17..5440fa5692 100644
--- a/proofs/compiler/constant_prop_proof.v
+++ b/proofs/compiler/constant_prop_proof.v
@@ -491,18 +491,16 @@ Qed.
 Lemma s_opNP op s es :
   sem_pexpr wdb gd s (s_opN op es) = sem_pexpr wdb gd s (PappN op es).
 Proof.
-
 Opaque app_sopn values.app_sopn.
   rewrite /s_opN.
-  case: op => [ sz' pe | // | c ];
-  case h: app_sopn => [r | //].
+  case: op => [ sz' pe | // | c | | ] //=.
+  all: case h: app_sopn => [r | //].
   + rewrite /= /sem_sop1 /= wrepr_unsigned /sem_opN /=.
     by rewrite -Let_Let (app_sopnP _ h).
 
   rewrite /sem_opN /=.
   by rewrite -Let_Let (app_sopnP s h).
 Transparent app_sopn values.app_sopn.
-
 Qed.
 
 Definition vconst c :=
@@ -534,7 +532,7 @@ Section CONST_PROP_EP.
 
   Lemma const_prop_e_esP : (∀ e, P e) ∧ (∀ es, Q es).
   Proof.
-    apply: pexprs_ind_pair; subst P Q; rewrite /eqok; split => /=;
+    apply: pexprs_ind_pair; subst P Q; rewrite /eqok; split => //=;
     try (intros; clarify; eauto; fail).
     - by move => ? [<-]; exists [::].
     - move => e rec es ih ?; rewrite /sem_pexprs /=.
@@ -761,19 +759,25 @@ End GLOB_DEFS.
 Instance const_prop_e_m :
   Proper (eq ==> @Mvar_eq const_v ==> eq ==> eq) const_prop_e.
 Proof.
-  move=> g _ <- m1 m2 Hm e e' <- {e'}.
-  elim: e => //=.
-  + by case => ? [] //; rewrite Hm.
-  + by move=> ????? ->.
-  + by move=> ????? ->.
-  + by move=> ??? ->.
-  + by move=> ?? ->.
-  + by move=> ?? -> ? ->.
-  + move => op es h; f_equal.
+  move=> g _ <- m1 m2 hm e e' <- {e'}.
+  elim: e m1 m2 hm => //=.
+  + by case => ? [] // > ->.
+  1-4: by move=> > he > /he ->.
+  + by move=> > he1 > he2 > /[dup] /he1 -> /he2 ->.
+  + move => op es h m1 m2 hm; f_equal.
     elim: es h => // e es ih rec /=; f_equal.
-    - by apply: rec; left.
-    by apply: ih => e' he'; apply: rec; right.
-  by move=> ?? -> ? -> ? ->.
+    - by apply: rec => //; left.
+    by apply: ih => e' he'; apply: rec => //; right.
+  + by move=> > he > he1 > he2 > /[dup] /he -> /[dup] /he1 -> /he2 ->.
+  + move=> > hi op x b hb > hs > hl m1 m2 hm.
+    rewrite (hi _ _ hm) (hs _ _ hm) (hl _ _ hm).
+    rewrite (hb (Mvar.remove m1 x) (Mvar.remove m2 x)); last first.
+    + by move=> ?; rewrite !Mvar.removeP; case: ifP.
+    case: is_const => // ?; case: is_const => // ?.
+    elim: ziota (const_prop_e g m2 _) => //= j js hrec e.
+    rewrite (hb _ (Mvar.set m2 x (Cint j))); first by apply hrec.
+    by move=> ?; rewrite !Mvar.setP; case: ifP.
+  by move=> > he1 > he2 > /[dup] /he1 -> /he2 ->.
 Qed.
 
 #[local]
@@ -1263,7 +1267,7 @@ Section PROOF.
     have /(Hf _ Heqm) Hc'': valid_cpm (evm s2) m.
     + have -> := valid_cpm_m (refl_equal (evm s2)) Heqm.
       apply: valid_cpm_rm Hm'=> z Hz;apply: (writeP Hsemc);SvD.fsetdec.
-    have /(_ _ _ (value_uincl_refl _)) [vm1' hw hvm1'] := write_var_uincl hvm1 _ Hw.
+    have /(_ _ _ _ (value_uincl_refl _)) [vm1' hw hvm1'] := write_var_uincl hvm1 _ Hw.
     have [vm2 [hc' /Hc'' [vm3 [hfor U]]]]:= Hc' _ hvm1';exists vm3;split => //.
     by apply: EForOne hc' hfor.
   Qed.
@@ -1286,7 +1290,7 @@ Section PROOF.
   Local Lemma Hproc : sem_Ind_proc p ev Pc Pfun.
   Proof.
     move => scs1 m1 sc2 m2 fn f vargs vargs' s0 s1 s2 vres vres'.
-    case: f=> fi ftin fparams fc ftout fres fex /= Hget Hargs Hi Hw _ Hc Hres Hfull Hscs Hfi.
+    case: f=> fi fci ftin fparams fc ftout fres fex /= Hget Hargs Hi Hw _ Hc Hres Hfull Hscs Hfi.
     generalize (get_map_prog (const_prop_fun gd) p fn); rewrite Hget /=.
     have : valid_cpm (evm s1) empty_cpm by move=> x n;rewrite Mvar.get0.
     move=> /Hc [];case: const_prop => m c' /= hcpm hc' hget vargs1 hargs'.
@@ -1569,7 +1573,7 @@ Local Opaque opp_word.
           by case: Mvar.get => // a []; rewrite write_i_for;SvD.fsetdec.
         have -> := valid_cpm_m (refl_equal (evm s1')) Hmi.
         by apply: remove_cpm1P Hw hval.
-      have /(_ _ _ (value_uincl_refl _)) [vm1' -> hvm1'] := write_var_uincl hvm1 _ Hw.
+      have /(_ _ _ _ (value_uincl_refl _)) [vm1' -> hvm1'] := write_var_uincl hvm1 _ Hw.
       by eexists.
     apply: remove_cpm_write1 hc => //.
     by rewrite write_i_for; SvD.fsetdec.
diff --git a/proofs/compiler/dead_code.v b/proofs/compiler/dead_code.v
index b8e7079965..2d9024d587 100644
--- a/proofs/compiler/dead_code.v
+++ b/proofs/compiler/dead_code.v
@@ -171,12 +171,12 @@ Section Section.
 Context {pT: progT}.
 
 Definition dead_code_fd {eft} fn (fd: _fundef eft) : cexec (_fundef eft) :=
-  let 'MkFun ii tyi params c tyo res ef := fd in
+  let 'MkFun ii ci tyi params c tyo res ef := fd in
   let res := fn_keep_only fn res in
   let tyo := fn_keep_only fn tyo in
   let s := read_es (map Plvar res) in
   Let c := dead_code_c dead_code_i c s in
-  ok (MkFun ii tyi params c.2 tyo res ef).
+  ok (MkFun ii ci tyi params c.2 tyo res ef).
 
 Definition dead_code_prog_tokeep (p: prog) : cexec prog :=
   Let funcs := map_cfprog_name dead_code_fd (p_funcs p) in
diff --git a/proofs/compiler/dead_code_proof.v b/proofs/compiler/dead_code_proof.v
index 04cd7e2630..1c8c42ff0d 100644
--- a/proofs/compiler/dead_code_proof.v
+++ b/proofs/compiler/dead_code_proof.v
@@ -496,7 +496,7 @@ Section PROOF.
     have dcok : map_cfprog_name (dead_code_fd is_move_op do_nop onfun) (p_funcs p) = ok (p_funcs p').
     + by move: dead_code_ok; rewrite /dead_code_prog_tokeep; t_xrbindP => ? ? <-.
     have [f' Hf'1 Hf'2] := get_map_cfprog_name_gen dcok Hfun.
-    case: f Hf'1 Hfun htra Hi Hw Hsem Hc Hres Hfull Hscs Hfi => fi ft fp /= c f_tyout res fb
+    case: f Hf'1 Hfun htra Hi Hw Hsem Hc Hres Hfull Hscs Hfi => fi fci ft fp /= c f_tyout res fb
       Hf'1 Hfun htra Hi Hw Hsem Hc Hres Hfull Hscs Hfi.
     move: Hf'1; t_xrbindP => -[sv sc] Hd H; subst f'.
     move: Hw; rewrite (write_vars_lvals _ gd) => Hw.
@@ -530,6 +530,7 @@ Section PROOF.
     eexists vres2; split=> //=.
     apply EcallRun with  {|
            f_info := fi;
+           f_contra := fci;
            f_tyin := ft;
            f_params := fp;
            f_body := sc;
@@ -608,7 +609,7 @@ Section PROOF.
     + by move: dead_code_ok; rewrite /dead_code_prog_tokeep; t_xrbindP => ? ? <-.
     have [fd' hfd' hget'] := get_map_cfprog_name_gen dcok hget.
     exists fd' => // {hget}.
-    case: fd hfd' => fi ftyin fp /= c ftyout res fextra.
+    case: fd hfd' => fi fci ftyin fp /= c ftyout res fextra.
     set fd := {| f_info := _ |}.
     t_xrbindP; set O := read_es _; move=> [I c'] hc ?; subst fd'.
     set fd' := {| f_info := _ |}.
@@ -820,7 +821,7 @@ Lemma dead_code_fd_meta do_nop onfun fn (fd fd': sfundef) :
    fd'.(f_extra) = fd.(f_extra)
   ].
 Proof.
-  by case: fd => /= ; t_xrbindP => /= ????????? <-.
+  by case: fd => /= ; t_xrbindP => /= ?????????? <-.
 Qed.
 
 End IT.
diff --git a/proofs/compiler/inline.v b/proofs/compiler/inline.v
index 148ae67e66..d28d940a36 100644
--- a/proofs/compiler/inline.v
+++ b/proofs/compiler/inline.v
@@ -114,10 +114,10 @@ Fixpoint inline_i (p:ufun_decls) (i:instr) (X:Sv.t) : cexec (Sv.t * cmd) :=
 
 Definition inline_fd (p:ufun_decls) (fd:ufundef) :=
   match fd with
-  | MkFun ii tyin params c tyout res ef =>
+  | MkFun ii ci tyin params c tyout res ef =>
     let s := read_es (map Plvar res) in
     Let c := inline_c (inline_i p) c s in
-    ok (MkFun ii tyin params c.2 tyout res ef)
+    ok (MkFun ii ci tyin params c.2 tyout res ef)
   end.
 
 Definition inline_fd_cons (ffd:funname * ufundef) (p:cexec ufun_decls) :=
diff --git a/proofs/compiler/inline_proof.v b/proofs/compiler/inline_proof.v
index 929a20f3c6..121250c619 100644
--- a/proofs/compiler/inline_proof.v
+++ b/proofs/compiler/inline_proof.v
@@ -67,7 +67,7 @@ Section INCL.
     inline_fd' p  fd = ok fd' ->
     inline_fd' p' fd = ok fd'.
   Proof.
-    by case: fd => fi ftin fp fb ftout fr fe /=;apply: rbindP => -[??] /inline_c_incl -> [<-].
+    by case: fd => fi ci ftin fp fb ftout fr fe /=;apply: rbindP => -[??] /inline_c_incl -> [<-].
   Qed.
 
 End INCL.
@@ -521,7 +521,7 @@ Section PROOF.
   Proof.
     move=> scs1 m1 scs2 m2 fn fd vargs vargs' s0 s1 svm2 vres vres' Hget Htin Hi Hw Hsem Hc Hres Htout Hscs Hfi.
     have [fd' [Hfd']{Hget}] := inline_progP' uniq_funname Hp Hget.
-    case: fd Htin Hi Hw Hsem Hc Hres Htout Hfi => /= fi tin fx fc tout fxr fe
+    case: fd Htin Hi Hw Hsem Hc Hres Htout Hfi => /= fi ci tin fx fc tout fxr fe
              Htin Hi Hw Hsem Hc Hres Htout Hfi.
     apply: rbindP => -[X fc'] /Hc{}Hc [] ?;subst fd'.
     move=> vargs1 Hall;move: Hw; rewrite (write_vars_lvals _ gd) => Hw.
@@ -664,7 +664,7 @@ Proof.
   move=> fs1 fs2 hpre.
   rewrite (isem_call_inline p1 ev do_inline).
   move: fs1 fs2 hpre.
-  apply wequiv_fun_ind => fn1 _ fs1 fs2 [<- hu] fd1 hfd1.
+  apply wequiv_fun_ind_wa => fn1 _ fs1 fs2 [<- hu] fd1 hfd1.
   have : if fn1 == fn then fd1 = fd /\ get_fundef (p_funcs p2) fn1 = Some fd' else get_fundef (p_funcs p2) fn1 = Some fd1.
   + move: hfd1; rewrite /p1 /p2 /get_fundef /= !assoc_cat.
     move: (uniq_funname); rewrite /pfuncs map_cat cat_uniq => /and3P [_ hhas _].
@@ -674,7 +674,7 @@ Proof.
     by rewrite /=; case: eqP => // ? [->].
   case: eqP; last first.
   (* First we show that for fn1 <> fn the semantic does not change *)
-  + move=> hfn ->; exists fd1 => //.
+  + move=> hfn ->; exists fd1 => // _; split => //.
     move=> s1 hinit.
     have [s1' hinit' hus1] :=
       [elaborate fs_uincl_initialize (p:=p1) (p':=p2) (fs:= fs1) (fs':= fs2) erefl erefl erefl erefl hu hinit].
@@ -687,7 +687,7 @@ Proof.
                          (sem_fun (sem_Fun := sem_fun_rec E) p1 ev ii fn fs).
     + move=> ii fn2 fs /=; rewrite /do_inline; case: eqP => //= ?; reflexivity.
     rewrite (isem_cmd_ext h) => {h}.
-    by move: s t; apply it_sem_uincl_aux => // ?????; apply: wequiv_fun_rec.
+    move: s t; apply it_sem_uincl_aux_wa => // ?????; exact/wequiv_fun_rec.
   (* Second it works for fn1 *)
   move=> ? [? ->]; subst fn1 fd1; exists fd' => //.
   have : exists2 Xc,
@@ -697,7 +697,7 @@ Proof.
     by t_xrbindP => Xc h <-; exists Xc.
   move=> [[X1 c']].
   set X2 := read_es _.
-  move=> hc' -> /= s1 hinit.
+  move=> hc' -> /= _; split => // s1 hinit.
   have [s1' hinit' hus1] :=
       [elaborate fs_uincl_initialize (p:=p1) (p':=p2) (fd:=fd) (fd':= with_body fd c')
                  (fs:= fs1) (fs':= fs2) erefl erefl erefl erefl hu hinit].
@@ -771,6 +771,7 @@ Proof.
   + rewrite ITree.Eq.Eqit.bind_vis.
     apply xrutt.xrutt_CutL => //.
     by rewrite /core_logics.errcutoff /is_error /Subevent.subevent /CategoryOps.resum /fromErr mid12.
+  rewrite ITree.Eq.Eqit.bind_ret_l /isem_pre /sem_pre /isem_post /sem_post /=.
   rewrite ITree.Eq.Eqit.bind_ret_l ITree.Eq.Eqit.bind_bind /kget_fundef.
   have -> /= : get_fundef pfuncs f = Some ffd.
   + move: uniq_funname; rewrite /get_fundef /pfuncs map_cat cat_uniq assoc_cat => /and3P [_ /= hhas /andP [hnin _]].
@@ -780,7 +781,7 @@ Proof.
       by apply: assoc_mem_dom' ha1.
     case: eqP => // ?; subst f.
     by move: hnin; rewrite (assoc_mem_dom' hffd).
-  rewrite ITree.Eq.Eqit.bind_ret_l ITree.Eq.Eqit.bind_bind.
+  rewrite !ITree.Eq.Eqit.bind_ret_l ITree.Eq.Eqit.bind_bind.
   case hinit : initialize_funcall => [s1 /= | ?]; last first.
   + rewrite ITree.Eq.Eqit.bind_vis.
     apply xrutt.xrutt_CutL => //.
@@ -815,11 +816,13 @@ Proof.
     (fun s2 s3 : estate => evm (with_vm s1 vm2) =[\write_c (f_body ffd')] evm s3 /\ st_eq_alloc r2 s2 s3).
   + by apply h.
   move=> s' t' [heqex {}heqa].
+  rewrite ITree.Eq.Eqit.bind_bind.
   case hfinal : finalize_funcall => [fr /= | ?]; last first.
   + rewrite ITree.Eq.Eqit.bind_vis.
     apply xrutt.xrutt_CutL => //.
     by rewrite /core_logics.errcutoff /is_error /Subevent.subevent /CategoryOps.resum /fromErr mid12.
   rewrite ITree.Eq.Eqit.bind_ret_l.
+  rewrite ITree.Eq.Eqit.bind_bind !ITree.Eq.Eqit.bind_ret_l. 
   case hupd : upd_estate => [s1' /= | ?]; last first.
   + apply xrutt.xrutt_CutL => //.
     by rewrite /core_logics.errcutoff /is_error /Subevent.subevent /CategoryOps.resum /fromErr mid12.
@@ -899,7 +902,7 @@ Proof.
   rewrite /inline_prog_err; case: ifP => //; t_xrbindP => huniq pfuncs h <-.
   have /(_ [::]) /= := inline_fd_consP h.
   rewrite cats0 => /(_ huniq) [_ ]; apply => fn'; rewrite (surj_prog p).
-  apply it_sem_uincl_f.
+  by apply it_sem_uincl_f_wa.
 Qed.
 
 End IT.
diff --git a/proofs/compiler/insert_renaming_proof.v b/proofs/compiler/insert_renaming_proof.v
index 0f2df7f460..bd153bc9b1 100644
--- a/proofs/compiler/insert_renaming_proof.v
+++ b/proofs/compiler/insert_renaming_proof.v
@@ -398,6 +398,7 @@ Section WITH_PARAMS.
       apply wequiv_fun_ind' => {} fn _ fs ft [] <- hfsu fd hget.
       exists (insert_renaming_fd insert_renaming_p fd).
       - by rewrite get_map_prog hget.
+      move=> _; split => //.
       move => s hinit.
       have htyin := insert_renaming_fd_tyin insert_renaming_p fd.
       have hextra := insert_renaming_fd_extra insert_renaming_p fd.
@@ -411,7 +412,7 @@ Section WITH_PARAMS.
       exists
         (if do_insert then rename_vars (entry_info_of_fun_info (f_info fd)) (f_params fd) ++ f_body fd else f_body fd),
         (if do_insert then rename_vars (ret_info_of_fun_info (f_info fd)) (f_res fd)  else [::]).
-      split; cycle -1.
+      split => //; cycle -1.
       - by apply: fs_uincl_finalize; case: do_insert; eauto.
       - by red; eauto.
       - case: do_insert; last by rewrite cats0.
diff --git a/proofs/compiler/it_compiler_proof.v b/proofs/compiler/it_compiler_proof.v
index 3c7eeba746..51410a9262 100644
--- a/proofs/compiler/it_compiler_proof.v
+++ b/proofs/compiler/it_compiler_proof.v
@@ -165,12 +165,13 @@ Lemma it_compiler_first_part {entries p p' ev fn} :
   compiler_first_part aparams cparams entries p = ok p' ->
   fn \in entries ->
   wiequiv_f
-    (wa1 := withassert) (wa2 := noassert)
-    (wsw1 := nosubword) (wsw2 := withsubword)
-    (dc1 := indirect_c) (dc2 := direct_c)
+    (wc1  := nocatch)    (wc2  := nocatch)
+    (wa1  := withassert) (wa2  := noassert)
+    (wsw1 := nosubword)  (wsw2 := withsubword)
+    (dc1  := indirect_c) (dc2  := direct_c)
     p p' ev ev pre_eq fn fn post_incl.
 Proof.
-rewrite /compiler_first_part; t_xrbindP => paw.
+rewrite /compiler_first_part; t_xrbindP => pra ok_pra paw.
 rewrite print_uprogP => ok_paw pa0.
 rewrite !print_uprogP => ok_pa0 pb.
 rewrite print_uprogP => ok_pb pa ok_pa pc ok_pc ok_puc ok_puc'.
@@ -184,7 +185,7 @@ rewrite !print_uprogP => ok_fvars pj ok_pj pp.
 rewrite !print_uprogP => ok_pp <- {p'} ok_fn.
 
 apply: (wiequiv_f_trans_EE_EU (wsw2:=nosubword) (dc2:=indirect_c)).
-+ by apply: (it_remove_assert_progP (dc:=indirect_c) (sip:=sip_of_asm_e) (pT:=progUnit) (wsw:=nosubword) ev).
++ by apply: (it_remove_assert_progP (dc:=indirect_c) (sip:=sip_of_asm_e) (pT:=progUnit) (wsw:=nosubword) ev ok_pra).
 
 apply: (wiequiv_f_trans_EE_EU (wsw2:= withsubword) (dc2:=indirect_c)).
 + exact: it_psem_call_u.
@@ -306,7 +307,7 @@ apply: (
 - move=> s1 _ s3 r1 r3 [_ <-] _ [r2 [?? hvals2] [?? hvals3]].
   split; only 1,2: congruence.
   exact: values_uincl_trans hvals2 hvals3.
-exact: (it_sem_uincl_f (sCP := sCP_stack) p' ev (fn := fn)).
+by apply: (it_sem_uincl_f_wa (sip:=sip_of_asm_e) (p:=p')).
 Qed.
 
 End THIRD_PART.
@@ -378,7 +379,7 @@ rewrite /compiler_front_end; t_xrbindP=> p1 ok_p1 check_p1 p2 ok_p2 p3.
 rewrite print_sprogP => ok_p3 p4.
 set rp := fun (fn : funname) => _.
 rewrite print_sprogP => ok_sp ? ok_fn; subst p4.
-apply: (wequiv_fun_get (scP1 := sCP_unit) (scP2 := sCP_stack)) => /= fd get_fd.
+apply: (wequiv_fun_get_wa (scP1 := sCP_unit) (scP2 := sCP_stack)) => /= fd get_fd.
 
 have [mglob ok_mglob] := [elaborate alloc_prog_get_fundef ok_p2 ].
 have [_ p2_p3_extra] :=
@@ -405,7 +406,7 @@ apply: (
   apply: Forall2_trans hres; first exact: value_uincl_trans.
   exact: (Forall2_drop hval1).
 
-apply: (wequiv_fun_get (scP1 := sCP_unit) (scP2 := sCP_stack)) => /= fd1
+apply: (wequiv_fun_get_wa (scP1 := sCP_unit) (scP2 := sCP_stack)) => /= fd1
   get_fd1.
 move: h => /(_ _ _ get_fd1)[] fd2 /[dup] ok_fd2 h get_fd2.
 have [fd3 get_fd3 [_ _ _ _ _ fd2_fd3_extra]] :=
diff --git a/proofs/compiler/jasmin_compiler.v b/proofs/compiler/jasmin_compiler.v
index 55fcaf32f2..56d63eacef 100644
--- a/proofs/compiler/jasmin_compiler.v
+++ b/proofs/compiler/jasmin_compiler.v
@@ -1,5 +1,5 @@
 (** This module is meant as the minimal dependency of extracted code. *)
-Require compiler.
+Require compiler_extraction.
 Require psem_defs.
 Require arm_params.
 Require x86_params.
diff --git a/proofs/compiler/linearization_proof.v b/proofs/compiler/linearization_proof.v
index 731d5afecb..cbeb0156c6 100644
--- a/proofs/compiler/linearization_proof.v
+++ b/proofs/compiler/linearization_proof.v
@@ -1570,8 +1570,7 @@ Section PROOF.
 
     Lemma match_mem_gen_sem_pexpr_pair : (∀ e, P e) ∧ (∀ es, Q es).
     Proof.
-      apply: pexprs_ind_pair; split.
-      - by [].
+      apply: pexprs_ind_pair; split => //.
       - by move => e ihe es ihes vs /=; t_xrbindP => ? /ihe -> /= ? /ihes -> /= ->.
       1-4: by rewrite /P /=.
       - move => al aa sz x e ihe vs /=.
diff --git a/proofs/compiler/lower_spill.v b/proofs/compiler/lower_spill.v
index b73d8a3568..c6bb4e131a 100644
--- a/proofs/compiler/lower_spill.v
+++ b/proofs/compiler/lower_spill.v
@@ -210,7 +210,7 @@ Definition check_map (m:Mvar.t var) X :=
     (bX.1 && ~~Sv.mem sx bX.2, Sv.add sx bX.2)) m (true, X).
 
 Definition spill_fd {eft} (fn:funname) (fd: _fundef eft) : cexec (_fundef eft) :=
-  let 'MkFun ii tyi params c tyo res ef := fd in
+  let 'MkFun ii ci tyi params c tyo res ef := fd in
   let s := foldl to_spill_i (Sv.empty, false) c in
   if ~~s.2 then ok fd else
   let: (m, _) := init_map s.1 in
@@ -218,7 +218,7 @@ Definition spill_fd {eft} (fn:funname) (fd: _fundef eft) : cexec (_fundef eft) :
   let b := check_map m X in
   Let _ := assert b.1 (pp_internal_error E.pass (pp_s "invalid map")) in
   Let ec := spill_c (spill_i (get_spill m)) Sv.empty c in
-  ok (MkFun ii tyi params ec.2 tyo res ef).
+  ok (MkFun ii ci tyi params ec.2 tyo res ef).
 
 Definition spill_prog (p: prog) : cexec prog :=
   Let funcs := map_cfprog_name spill_fd (p_funcs p) in
diff --git a/proofs/compiler/lower_spill_proof.v b/proofs/compiler/lower_spill_proof.v
index 7490b6a968..87a732e02a 100644
--- a/proofs/compiler/lower_spill_proof.v
+++ b/proofs/compiler/lower_spill_proof.v
@@ -630,7 +630,7 @@ Proof.
   + by move: spill_prog_ok; rewrite /spill_prog; t_xrbindP => ? ? <-.
   have [f' hf'1 hf'2] := get_map_cfprog_name_gen spillok hfun.
   case: f hfun htra hinit hw hsc hc hres hfull hf'1 hf'2 =>
-    fi ft fp /= c f_tyout res fb hfun htra hinit hw hsc [hc_ hc] hres hfull hf'1 hf'2.
+    fi fci ft fp /= c f_tyout res fb hfun htra hinit hw hsc [hc_ hc] hres hfull hf'1 hf'2.
   case: ifP hf'1.
   + by move=> hX [?]; subst f'; econstructor; eauto => //=; rewrite -eq_p_extra.
   case ok_m: init_map => [ m _count ].
@@ -724,7 +724,7 @@ Proof.
   + by move: spill_prog_ok; rewrite /spill_prog; t_xrbindP => ? ? <-.
   have [fd' hfd'1 hfd'2] := get_map_cfprog_name_gen spillok hget.
   exists fd' => // {hget hfd'2}.
-  case: fd hfd'1 => fi ft fp /= c f_tyout res fb.
+  case: fd hfd'1 => fi fci ft fp /= c f_tyout res fb.
   case: ifP.
   + move=> _ [<-] /= s hinit.
     exists s.
diff --git a/proofs/compiler/makeReferenceArguments_proof.v b/proofs/compiler/makeReferenceArguments_proof.v
index ff914ebf5d..13112053e4 100644
--- a/proofs/compiler/makeReferenceArguments_proof.v
+++ b/proofs/compiler/makeReferenceArguments_proof.v
@@ -806,6 +806,8 @@ Context
     have [|]:= make_prologueP plE (@SvP.MP.subset_refl X) _ hes heqX; first by SvD.fsetdec.
     move=> vmx [/(esem_i_bodyP (sem_F := sem_fun_rec _)) sem_pl eval_args' eq_vm1_vmx].
     rewrite sem_pl /= Eqit.bind_ret_l.
+    rewrite /isem_pre /isem_post /sem_pre /sem_post /=.
+    repeat setoid_rewrite Eqit.bind_ret_l.
     rewrite /isem_pexprs eval_args' /= Eqit.bind_ret_l Eqit.bind_bind.
     set fs1 := mk_fstate ves s; set fs2 := mk_fstate ves (with_vm s vmx).
     apply xrutt_facts.xrutt_bind with (rpostF (eS:=mra_spec) f f fs1 fs2);
@@ -815,7 +817,7 @@ Context
     case h3 : write_lvals => [s' | e /=]; last first.
     + apply xrutt.xrutt_CutL => //.
       by rewrite /core_logics.errcutoff /is_error /Subevent.subevent /CategoryOps.resum /fromErr mid12.
-    have [|vm2 [s3] []] :=  make_epilogueP epE _ h3 htr (eq_onT heqX eq_vm1_vmx).
+    have [|vm2 [s3] []] := make_epilogueP epE _ h3 htr (eq_onT heqX eq_vm1_vmx).
     + by SvD.fsetdec.
     move=> /= -> /(esem_i_bodyP (sem_F := sem_fun_rec _)) hsem eq_s2_vm2 /=.
     rewrite Eqit.bind_ret_l hsem /=.
diff --git a/proofs/compiler/merge_varmaps_proof.v b/proofs/compiler/merge_varmaps_proof.v
index afc8283e7d..5f1d840535 100644
--- a/proofs/compiler/merge_varmaps_proof.v
+++ b/proofs/compiler/merge_varmaps_proof.v
@@ -258,7 +258,7 @@ Section LEMMA.
     }.
 
   Instance match_estate_m : Proper (Sv.Equal ==> eq ==> eq ==> iff) match_estate.
-  Proof. 
+  Proof.
     by move => x y x_eq_y s _ <- t _ <-; split => - [] ?; rewrite ?x_eq_y => ?; constructor => //; rewrite x_eq_y.
   Qed.
 
@@ -305,7 +305,7 @@ Section LEMMA.
       2: exact: (mvp_stack_aligned ok_W).
       by move: (mvp_not_written ok_W); rewrite write_c_cons; apply: disjoint_w;
         move: (write_I i) (write_c c) (* SvD.fsetdec faster *); SvD.fsetdec.
-    have [t2 [ki texec_i hki] sim2] := hi _ _ _ _ ok_i ok_W1 sim1. 
+    have [t2 [ki texec_i hki] sim2] := hi _ _ _ _ ok_i ok_W1 sim1.
     have ok_W2 : merged_vmap_precondition (write_c c) sz (emem s2) (evm t2).
     - have [ not_written_gd not_written_rsp ] := not_written_magic (mvp_not_written ok_W1).
       split.
@@ -586,7 +586,7 @@ Section LEMMA.
          List.Forall2 value_uincl res res'
         ].
 
-  Lemma all2_get_pvar args xs : 
+  Lemma all2_get_pvar args xs :
     all2
       (λ (e : pexpr) (a : var_i),
         match e with
@@ -601,8 +601,8 @@ Section LEMMA.
   Qed.
 
   Lemma all2_get_lvar xs res :
-    all2 
-     (λ (x : lval) (r : var_i), 
+    all2
+     (λ (x : lval) (r : var_i),
       match x with
       | Lvar v => v_var v == r
       | _ => false
@@ -663,7 +663,7 @@ Section LEMMA.
     case: d hxd => // d hxd /andP [] /= /eqP hxq hall2 s3 s4 w ws.
     move: hx; rewrite /= inE orbX; case/orP; last first.
     + by move => hx; exact: ih _ _ vs_vs' _ hx hxds hqs hall2 _ ws.
-    case/andP => /eqP hyq /negbTE x_not_in_ys. 
+    case/andP => /eqP hyq /negbTE x_not_in_ys.
     have <- := vrvsP ws; last by rewrite (vrvs_vars hxds) -Sv.mem_spec sv_of_listE /= x_not_in_ys.
     move/write_varP: w vv' => [-> ? /vm_truncate_value_uincl].
     rewrite hxq -hyq Vm.setP_eq; apply: value_uincl_trans.
diff --git a/proofs/compiler/propagate_inline.v b/proofs/compiler/propagate_inline.v
index 94a6614e70..48d33bb39c 100644
--- a/proofs/compiler/propagate_inline.v
+++ b/proofs/compiler/propagate_inline.v
@@ -91,10 +91,22 @@ Fixpoint pi_e (pi:pimap) (e:pexpr) :=
   | PappN o es         => 
     let es := (map (pi_e pi) es) in
     match o with
-    | Opack _ _ | Oarray _ => PappN o es
     | Ocombine_flags c => scfc c es
+    | Opack _ _ | Oarray _ | Ois_arr_init _ | Ois_barr_init _ => PappN o es
     end
   | Pif t e e1 e2      => Pif t (pi_e pi e) (pi_e pi e1) (pi_e pi e2)
+  | Pbig idx op x body start len =>
+    let idx   := pi_e pi idx in
+    let body  := pi_e (remove pi x) body in
+    let start := pi_e pi start in
+    let len   := pi_e pi len in
+    Pbig idx op x body start len
+  | Pis_var_init x =>
+    match Mvar.get pi x with
+    | Some c => c.(pi_def)
+    | None => e
+    end
+  | Pis_mem_init e1 e2 => Pis_mem_init (pi_e pi e1) (pi_e pi e2)
   end.
 
 Definition pi_es (pi:pimap) (es:pexprs) := 
@@ -206,9 +218,9 @@ Section Section.
 Context {pT:progT}.
 
 Definition pi_fun  (f:fundef) :=
-  let 'MkFun ii si p c so r ev := f in
+  let 'MkFun ii ci si p c so r ev := f in
   Let pic := pi_c pi_i piempty c in 
-  ok (MkFun ii si p pic.2 so r ev).
+  ok (MkFun ii ci si p pic.2 so r ev).
 
 Definition pi_prog (p:prog) := 
   Let funcs := map_cfprog pi_fun (p_funcs p) in
diff --git a/proofs/compiler/propagate_inline_proof.v b/proofs/compiler/propagate_inline_proof.v
index 88734ffe27..15ab0472e1 100644
--- a/proofs/compiler/propagate_inline_proof.v
+++ b/proofs/compiler/propagate_inline_proof.v
@@ -224,7 +224,7 @@ Let Q es : Prop :=
 
 Lemma pi_eP_and : (forall e, P e) /\ (forall es, Q es).
 Proof.
-  apply: pexprs_ind_pair; subst P Q; split => /=.
+  apply: pexprs_ind_pair; subst P Q; split => //=.
   + by move=> ? [<-]; exists [::].
   + move=> e hrec es hrecs vs; t_xrbindP => ? /hrec [v' -> hu] ? /hrecs [vs' -> hus] <- /=.
     by exists (v'::vs'); auto.
@@ -247,15 +247,17 @@ Proof.
   + move=> op e1 hrec1 e2 hrec2 v; t_xrbindP => ve1 /hrec1 [ve1' -> hu1] ve2 /hrec2 [ve2' -> hu2] /= hs.
     by rewrite (vuincl_sem_sop2 hu1 hu2 hs); eauto.
   + move=> o es hrec ?; t_xrbindP => ? /hrec [vs' hs' hu].
-    case: o => [wz pe | len | c] /=.
+    case: o => [wz pe | len | c | | ] //=.
     + move=> ho; rewrite -/(sem_pexprs wdb gd _ (pi_es pi es)) hs' /=.
       rewrite (vuincl_sem_opN hu ho).
       by eexists; first by reflexivity.
     + move => /(vuincl_sem_opN hu).
       rewrite -/(sem_pexprs wdb gd s) hs' /= => ->.
       by eexists; first reflexivity.
-    move=> ho; have ho' := vuincl_sem_opN hu ho.
-    by rewrite -/(pi_es pi es) (scfcP hs' ho'); eauto.
+    + move=> ho; have ho' := vuincl_sem_opN hu ho.
+      by rewrite -/(pi_es pi es) (scfcP hs' ho'); eauto.
+    + by move=> > /sem_opN_is_arr_init.
+    by move=> > /sem_opN_is_barr_init.
   move=> ?? hrec ? hrec1 ? hrec2 v; t_xrbindP.
   move=> ?? /hrec [? -> /of_value_uincl_te h] /(h cbool) /= ->.
   move=> ?? /hrec1 [? -> hu1] /= /(value_uincl_truncate hu1) [? -> hu1'].
@@ -709,7 +711,7 @@ Section PROOF.
 
   Local Lemma Hproc : sem_Ind_proc p1 ev Pc Pfun.
   Proof.
-    move=> scs1 m1 scs2 m2 fn [ii si p c so r ev0] /= vargs' vargs s0 s1 s2 vres vres'.
+    move=> scs1 m1 scs2 m2 fn [ii ci si p c so r ev0] /= vargs' vargs s0 s1 s2 vres vres'.
     move=> hget htr hinit hwr _ hc hres hrtr hscs hfin.
     have [fd2 /=]:= all_checked hget.
     t_xrbindP => -[pi2 c'] hc_ ? hget2 vargs1 hvargs1; subst fd2.
diff --git a/proofs/compiler/remove_assert.v b/proofs/compiler/remove_assert.v
index 7ebf19384c..df13eaef85 100644
--- a/proofs/compiler/remove_assert.v
+++ b/proofs/compiler/remove_assert.v
@@ -1,40 +1,89 @@
 From Coq Require Import ZArith.
+From mathcomp Require Import ssrbool.
 Require Import expr compiler_util.
 
+Module Import E.
+
+  Definition pass : string := "remove assert".
+
+  Definition error := pp_internal_error_s pass "bigop remains".
+
+End E.
+
 Section ASM_OP.
 
+Section Section.
+
 Context `{asmop : asmOp}.
 
-Definition remove_assert_c (remove_assert_i: instr -> cmd) c :  cmd :=
+Definition check_opN (op : opN) :=
+  match op with
+  | Opack _ _ | Oarray _ | Ocombine_flags _ => true
+  | Ois_arr_init _ | Ois_barr_init _ => false
+  end.
+
+Fixpoint check_e (e : pexpr) :=
+  match e with
+  | Pconst _ | Pbool _ | Parr_init _ _ | Pvar _ => true
+  | Pget _ _ _ _ e
+  | Psub _ _ _ _ e
+  | Pload _ _ e
+  | Papp1 _ e => check_e e
+  | Papp2 o e1 e2 => check_e e1 && check_e e2
+  | PappN op es => check_opN op && all check_e es
+  | Pif ty e1 e2 e3 => all check_e [::e1; e2; e3]
+  | Pbig _ _ _ _ _ _ | Pis_var_init _ | Pis_mem_init _ _ => false
+  end.
+
+Definition check_es := all check_e.
+
+Definition check_lval (lv:lval) :=
+  match lv with
+  | Lnone _ _ | Lvar _ => true
+  | Lmem _ _ _ e | Laset _ _ _ _ e | Lasub _ _ _ _ e => check_e e
+  end.
+
+Definition check_lvals := all check_lval.
+
+Definition remove_assert_c (remove_assert_i: instr -> cexec cmd) c :  cexec cmd :=
   foldr (fun i r =>
-    let i := remove_assert_i i in
-     i ++ r) [::] c.
+    Let r := r in
+    Let i := remove_assert_i i in
+    ok ( i ++ r)) (ok [::]) c.
 
-Fixpoint remove_assert_i (i: instr) : cmd :=
-  let 'MkI ii ir := i in
+Fixpoint remove_assert_i (i:instr) : cexec cmd :=
+  let (ii, ir) := i in
+  add_iinfo ii
   match ir with
-  | Cassert _ => [::]
-  | Cassgn _ _ _ _
-  | Copn _ _ _ _ | Csyscall _ _ _ | Ccall _ _ _ =>
-    [:: i]
+  | Cassert _ => ok ([::])
+  | Cassgn x _ _ e =>
+    Let _ := assert (check_lval x && check_e e) E.error in
+    ok [:: i]
+  | Copn xs _ _ es | Csyscall xs _ es | Ccall xs _ es =>
+    Let _ := assert (check_lvals xs && check_es es) E.error in
+    ok [:: i]
   | Cif e c1 c2 =>
-    let c1 := remove_assert_c remove_assert_i c1 in
-    let c2 := remove_assert_c remove_assert_i c2 in
-    [:: MkI ii (Cif e c1 c2)]
+    Let _ := assert (check_e e) E.error in
+    Let c1 := remove_assert_c remove_assert_i c1 in
+    Let c2 := remove_assert_c remove_assert_i c2 in
+    ok [:: MkI ii (Cif e c1 c2)]
   | Cwhile al c1 e ii' c2 =>
-    let c1 := remove_assert_c remove_assert_i c1 in
-    let c2 := remove_assert_c remove_assert_i c2 in
-    [:: MkI ii (Cwhile al c1 e ii' c2)]
+    Let _ := assert (check_e e) E.error in
+    Let c1 := remove_assert_c remove_assert_i c1 in
+    Let c2 := remove_assert_c remove_assert_i c2 in
+    ok [:: MkI ii (Cwhile al c1 e ii' c2)]
   | Cfor x (d, e1, e2) c =>
-    let c := remove_assert_c remove_assert_i c in
-    [:: MkI ii (Cfor x (d, e1, e2) c)]
+    Let _ := assert (check_e e1 && check_e e2) E.error in
+    Let c := remove_assert_c remove_assert_i c in
+    ok [:: MkI ii (Cfor x (d, e1, e2) c)]
   end.
 
 Context {pT:progT}.
 
-Definition remove_assert_fd (fd: fundef) :=
-  let c := remove_assert_c remove_assert_i fd.(f_body) in
-  {| f_info   := fd.(f_info);
+Definition remove_assert_fd (fd:fundef) :=
+  Let c := remove_assert_c remove_assert_i fd.(f_body) in
+  ok {| f_info   := fd.(f_info);
+     f_contra := None;
      f_tyin   := fd.(f_tyin);
      f_params := fd.(f_params);
      f_body   := c;
@@ -43,7 +92,10 @@ Definition remove_assert_fd (fd: fundef) :=
      f_extra  := fd.(f_extra);
   |}.
 
-Definition remove_assert_prog (p: prog) : prog :=
-  map_prog remove_assert_fd p.
+Definition remove_assert_prog (p: prog) : cexec prog :=
+  Let funcs := map_cfprog remove_assert_fd (p_funcs p) in
+  ok {| p_extra := p_extra p; p_globs := p_globs p; p_funcs := funcs |}.
+
+End Section.
 
 End ASM_OP.
diff --git a/proofs/compiler/remove_assert_proof.v b/proofs/compiler/remove_assert_proof.v
index 15b62e9fdc..0da569bcde 100644
--- a/proofs/compiler/remove_assert_proof.v
+++ b/proofs/compiler/remove_assert_proof.v
@@ -1,7 +1,8 @@
-From Coq Require Import ssreflect.
+(* ** Imports and settings *)
+From mathcomp Require Import all_ssreflect all_algebra.
 Require Import psem compiler_util.
 Require Export remove_assert.
-Import Utf8 ssrfun.
+Import Utf8.
 
 Section REMOVE_ASSERT.
 
@@ -15,42 +16,109 @@ Section REMOVE_ASSERT.
     {pT:progT} {sCP: semCallParams}.
 
   Context (p p' : prog) (ev: extra_val_t).
+  Notation gd := (p_globs p).
+
+  Hypothesis remove_assert_ok : remove_assert_prog p = ok p'.
+
+  Lemma eq_globs : p_globs p = p_globs p'.
+  Proof. by move: remove_assert_ok; rewrite /remove_assert_prog; t_xrbindP => ? _ <-. Qed.
+
+  Lemma eq_p_extra : p_extra p = p_extra p'.
+  Proof. by move: remove_assert_ok; rewrite /remove_assert_prog; t_xrbindP => ? _ <-. Qed.
+
+  Lemma eq_get_fundef fn fd :
+    get_fundef (p_funcs p) fn = Some fd ->
+    exists2 c,
+      remove_assert_c remove_assert_i fd.(f_body) = ok c &
+      get_fundef (p_funcs p') fn = Some ({| f_info   := fd.(f_info);
+                                            f_contra := None;
+                                            f_tyin   := fd.(f_tyin);
+                                            f_params := fd.(f_params);
+                                            f_body   := c;
+                                            f_tyout  := fd.(f_tyout);
+                                            f_res    := fd.(f_res);
+                                            f_extra  := fd.(f_extra);
+                                         |}).
+  Proof.
+    move: remove_assert_ok; rewrite /remove_assert_prog; t_xrbindP => funcs hfuncs <- /= hget.
+    have [fd'] := get_map_cfprog_gen hfuncs hget.
+    rewrite /remove_assert_fd; t_xrbindP => c ? <- ?; eauto.
+  Qed.
+
+  Section EXPR.
+
+  Context (wa: WithAssert) (s:estate) (wdb:bool).
+
+  Let P e : Prop :=
+    check_e e ->
+    sem_pexpr (wa:=wa) wdb gd s e = sem_pexpr (wa:=noassert) wdb (p_globs p') s e.
+
+  Let Q es : Prop :=
+    check_es es ->
+    sem_pexprs (wa:=wa) wdb gd s es = sem_pexprs (wa:=noassert) wdb (p_globs p') s es.
+
+  Lemma check_e_esP : (∀ e, P e) ∧ (∀ es, Q es).
+  Proof.
+    apply: pexprs_ind_pair; subst P Q; rewrite -eq_globs; split => //=.
+    + by move=> e he es hes /andP[] /he -> /hes ->.
+    1-4: by move=> > he /he ->.
+    + by move=> > he1 > he2 /andP[] /he1 -> /he2 ->.
+    + move=> op es ih /andP [hop /ih].
+      by rewrite /sem_pexprs => ->; case: mapM => //=; case: op hop.
+    by move=> > he > he1 > he2 /and4P[] /he -> /he1 -> /he2 ->.
+  Qed.
+
+  Lemma check_eP : ∀ e, P e.
+  Proof. by case: check_e_esP. Qed.
+
+  Lemma check_esP : ∀ es, Q es.
+  Proof. by case: check_e_esP. Qed.
 
-  Hypothesis remove_assert_ok : remove_assert_prog p = p'.
+  Lemma check_lvalP x v :
+    check_lval x ->
+    write_lval (wa:=wa) wdb gd x v s = write_lval (wa:=noassert) wdb (p_globs p') x v s.
+  Proof.
+    case: x => //=.
+    + by move=> > _ > /check_eP ->.
+    1-2: by move=> > /check_eP ->.
+  Qed.
 
-  Lemma eq_globs : p_globs p' = p_globs p.
-  Proof. by rewrite -remove_assert_ok. Qed.
+  End EXPR.
 
-  Lemma eq_p_extra : p_extra p' = p_extra p.
-  Proof. by rewrite -remove_assert_ok. Qed.
+  Lemma check_lvalsP {wa:WithAssert} wdb xs s vs :
+    check_lvals xs ->
+    write_lvals (wa:=wa) wdb gd s xs vs = write_lvals (wa:=noassert) wdb (p_globs p') s xs vs.
+  Proof.
+    elim: xs s vs => //= x xs hrec s [] // v vs /andP[] /check_lvalP -> /hrec{}hrec.
+    by case: write_lval => //=.
+  Qed.
 
   Section SEM.
 
-  Let Pi s1 (i: instr) s2 :=
-    forall c, remove_assert_i i = c ->
+  Let Pi s1 (i:instr) s2 :=
+    forall c, remove_assert_i i = ok c ->
     sem p' ev s1 c s2.
 
-  Let Pi_r s1 (i: instr_r) s2 := forall ii, Pi s1 (MkI ii i) s2.
+  Let Pi_r s1 (i:instr_r) s2 := forall ii, Pi s1 (MkI ii i) s2.
 
-  Let Pc s1 (c: cmd) s2 :=
-    forall c', remove_assert_c remove_assert_i c = c' ->
+  Let Pc s1 (c:cmd) s2 :=
+    forall c', remove_assert_c remove_assert_i c = ok c' ->
     sem p' ev s1 c' s2.
 
-  Let Pfor (i: var_i) vs s1 c s2 :=
-    forall c', remove_assert_c remove_assert_i c = c' ->
+  Let Pfor (i:var_i) vs s1 c s2 :=
+    forall c', remove_assert_c remove_assert_i c = ok c' ->
     sem_for p' ev i vs s1 c' s2.
 
   Let Pfun scs m fn vargs scs' m' vres :=
     sem_call p' ev scs m fn vargs scs' m' vres.
 
   Local Lemma Rnil : sem_Ind_nil Pc.
-  Proof. move=> s _ <-; constructor. Qed.
+  Proof. move=> s c' /= [<-]; constructor. Qed.
 
   Local Lemma Rcons : sem_Ind_cons p ev Pc Pi.
   Proof.
-    move=> s1 s2 s3 i c _ Hi _ Hc c' /= <-; apply: sem_app.
-    + exact: Hi.
-    exact: Hc.
+    move=> s1 s2 s3 i c _ Hi _ Hc c' /=; t_xrbindP => ? /Hc hc ? /Hi hi <-.
+    by apply: sem_app hc.
   Qed.
 
   Local Lemma RmkI : sem_Ind_mkI p ev Pi_r Pi.
@@ -58,58 +126,61 @@ Section REMOVE_ASSERT.
 
   Local Lemma Rasgn : sem_Ind_assgn p Pi_r.
   Proof.
-    move=> s1 s2 x tag ty e v v' he htr hw ii c' /= <-.
-    by apply: sem_seq1; constructor; econstructor; eauto; rewrite eq_globs.
+    move=> s1 s2 x tag ty e v v' he htr hw ii c' /=; t_xrbindP.
+    move=> /andP[] /check_lvalP hx /check_eP hse <-.
+    apply: sem_seq1; constructor;econstructor;eauto.
+    + by rewrite -hse. by rewrite -hx.
   Qed.
 
   Local Lemma Ropn : sem_Ind_opn p Pi_r.
   Proof.
-    move=> s1 s2 t o xs es; rewrite /sem_sopn; t_xrbindP => ?? he hex hw ii _ <-.
-    by apply: sem_seq1; constructor;econstructor;eauto; rewrite /sem_sopn eq_globs he /= hex.
+    move=> s1 s2 t o xs es; rewrite /sem_sopn; t_xrbindP => ?? he hex hw ii c' /=; t_xrbindP.
+    move=> /andP[] /check_lvalsP hx /check_esP hse <-.
+    by apply: sem_seq1; constructor;econstructor;eauto; rewrite /sem_sopn -hse he /= hex /= -hx.
   Qed.
 
   Local Lemma Rsyscall : sem_Ind_syscall p Pi_r.
   Proof.
-    move=> s1 scs m s2 o xs es ves vs he hex hw ii _ <-.
-    by apply: sem_seq1; constructor; econstructor; eauto; rewrite eq_globs.
+    move=> s1 scs m s2 o xs es ves vs he hex hw ii c' /=; t_xrbindP.
+    move=> /andP[] /check_lvalsP hx /check_esP hse <-.
+    apply: sem_seq1; constructor;econstructor;eauto.
+    + by rewrite -hse. by rewrite -hx.
   Qed.
 
   Local Lemma Rif_true : sem_Ind_if_true p ev Pc Pi_r.
   Proof.
-    move=> s1 s2 e c1 c2 he _ hc ii _ <-.
-    apply sem_seq1; constructor; apply Eif_true.
-    + by rewrite eq_globs.
-    exact: hc.
+    move=> s1 s2 e c1 c2 he _ hc ii c' /=; t_xrbindP => /check_eP hse c1' /hc ? c2' _ <-.
+    by apply sem_seq1;constructor;apply Eif_true => //; rewrite -hse.
   Qed.
 
   Local Lemma Rif_false : sem_Ind_if_false p ev Pc Pi_r.
   Proof.
-    move=> s1 s2 e c1 c2 he _ hc ii _ <-.
-    apply sem_seq1; constructor; apply Eif_false.
-    + by rewrite eq_globs.
-    exact: hc.
+    move=> s1 s2 e c1 c2 he _ hc ii c' /=; t_xrbindP => /check_eP hse c1' _ c2' /hc ? <-.
+    by apply sem_seq1;constructor;apply Eif_false => //; rewrite -hse.
   Qed.
 
   Local Lemma Rwhile_true : sem_Ind_while_true p ev Pc Pi_r.
   Proof.
-    move=> s1 s2 s3 s4 a c e ei c' _ Hc he _ Hc' _ hw ii _ <-.
-    apply sem_seq1; constructor; eapply Ewhile_true; eauto.
-    + by rewrite eq_globs.
-    have /sem_seq1_iff /sem_IE := hw ii _ erefl.
-    exact.
+    move=> s1 s2 s3 s4 a c e ei c' _ Hc he _ Hc' _ hw ii c_ /=; t_xrbindP => hse ? hc ? hc' <-.
+    apply sem_seq1;constructor;eapply Ewhile_true; eauto.
+    + by rewrite -(check_eP _ _ _ hse).
+    have /= := hw ii _.
+    by rewrite hse hc hc' /= => /(_ _ erefl) /sem_seq1_iff /sem_IE.
   Qed.
 
   Local Lemma Rwhile_false : sem_Ind_while_false p ev Pc Pi_r.
   Proof.
-    move=> s1 s2 a c e ei c' _ Hc he ii _ <-.
+    move=> s1 s2 a c e ei c' _ Hc he ii c_ /=; t_xrbindP => hse ? hc ? hc' <-.
     apply sem_seq1; constructor; eapply Ewhile_false; eauto.
-    by rewrite eq_globs.
+    by rewrite -(check_eP _ _ _ hse).
   Qed.
 
   Local Lemma Rfor : sem_Ind_for p ev Pi_r Pfor.
   Proof.
-    move=> s1 s2 i d lo hi c vlo vhi hlo hhi _ hfor ii _ <-.
-    by apply sem_seq1; constructor; econstructor; eauto; rewrite eq_globs.
+    move=> s1 s2 i d lo hi c vlo vhi hlo hhi _ hfor ii c_ /=; t_xrbindP.
+    move=> /andP[] /check_eP hslo /check_eP hshi c' hc' <-.
+    apply sem_seq1; constructor; econstructor; eauto.
+    + by rewrite -hslo. by rewrite -hshi.
   Qed.
 
   Local Lemma Rfor_nil : sem_Ind_for_nil Pfor.
@@ -122,17 +193,18 @@ Section REMOVE_ASSERT.
 
   Local Lemma Rcall : sem_Ind_call p ev Pi_r Pfun.
   Proof.
-    move=> s1 scs2 m2 s2 xs fn es vargs vres hargs _ hfun hw ii _ <-.
-    by apply: sem_seq1; constructor; econstructor; eauto; rewrite eq_globs.
+    move=> s1 scs2 m2 s2 xs fn es vargs vres hargs _ hfun hw ii c_ /=; t_xrbindP.
+    move=> /andP[] /check_lvalsP hsx /check_esP hse <-.
+    apply: sem_seq1;constructor; econstructor;eauto.
+    + by rewrite -hse. by rewrite -hsx.
   Qed.
 
   Local Lemma Rproc : sem_Ind_proc p ev Pc Pfun.
   Proof.
     move=> scs1 m1 scs2 m2 fn fd vargs vargs' s0 s1 s2 vres vres' hget htin hinit hw _ hbody hgetr htout -> ->.
-    econstructor.
-    - rewrite -remove_assert_ok get_map_prog hget /=; reflexivity.
-    all: eauto.
-    by rewrite eq_p_extra.
+    have [c' hc' hget'] := eq_get_fundef hget.
+    econstructor; eauto.
+    by rewrite -eq_p_extra.
   Qed.
 
   Lemma remove_assert_progP f scs mem scs' mem' va vr:
@@ -164,59 +236,89 @@ Section REMOVE_ASSERT.
 
   Context {E E0: Type -> Type} {wE : with_Error E E0} {rE : EventRels E0}.
 
-  #[local] Notation st_eq := (st_rel (λ _ : unit, eq) tt).
+  Definition check_es_ra_eq (_:unit) (es es': pexprs) (_:unit) :=
+    es' = es /\ check_es es.
+
+  Definition check_lvals_ra_eq (_:unit) (xs xs': lvals) (_:unit) :=
+    xs' = xs /\ check_lvals xs.
 
-  Lemma st_rel_eq d s1 s2 : st_rel (λ _ : unit, eq) d s1 s2 → s1 = s2.
-  Proof. by case: s1 s2 => ??? [] ??? [] /= <- <- <-. Qed.
+  Lemma check_esP_R_ra_eq d es1 es2 d':
+    check_es_ra_eq d es1 es2 d' →
+    ∀ s1 s2, st_rel (λ _ : unit, eq) d s1 s2 → st_rel (λ _ : unit, eq) d' s1 s2.
+  Proof. by move=> _ s1 s2 [*]; split. Qed.
 
-  Program Instance checker_ra_eq : Checker_e (st_rel (λ _ : unit, eq)) :=
-    {| check_es _ x y _ := x = y; check_lvals _ x y _ := x = y; |}.
+  Lemma st_rel_eq d s1 s2 : st_rel (λ _ : unit, eq) d s1 s2 -> s1 = s2.
+  Proof. by move=> /st_relP [-> /= <-]; rewrite with_vm_same. Qed.
 
-  Instance checker_ra_eqP : Checker_eq p p' checker_ra_eq.
+  Definition checker_ra_eq :=
+    {| relational_logic.check_es := check_es_ra_eq;
+       relational_logic.check_lvals := check_lvals_ra_eq;
+       relational_logic.check_esP_rel := check_esP_R_ra_eq
+    |}.
+
+  Lemma checker_ra_eqP : Checker_eq (wa1:=withassert) (wa2:=noassert) p p' checker_ra_eq.
   Proof.
-    rewrite -remove_assert_ok.
     constructor.
-    - by move => > /wdb_ok_eq <- <- > /st_rel_eq <-; eauto.
-    by move => > /wdb_ok_eq <- <- > /st_rel_eq <- -> /=; eexists; first reflexivity.
+    + move=> wdb ? d es1 es2 d' /wdb_ok_eq <- [->] h s1 s2 vs /st_rel_eq <-.
+      by rewrite (check_esP _ _ _ h); eauto.
+    move=> wdb ? d xs1 xs2 d' /wdb_ok_eq <- [->] h vs s1 s2 s1' /st_rel_eq <-.
+    by rewrite (check_lvalsP _ _ _ h); exists s1'.
   Qed.
   #[local] Hint Resolve checker_ra_eqP : core.
 
-  Let Pi (i: instr) :=
-      wequiv_rec (wa1:=withassert) (wa2:=noassert) p p' ev ev eq_spec st_eq [::i] (remove_assert_i i) st_eq.
+  #[local] Notation st_eq := (st_rel (λ _ : unit, eq) tt).
+
+  Let Pi (i:instr) :=
+    forall c',
+      remove_assert_i i = ok c' ->
+      wequiv_rec (wa1:=withassert) (wa2:=noassert) p p' ev ev eq_spec st_eq [::i] c' st_eq.
+
+  Let Pi_r (i:instr_r) := forall ii, Pi (MkI ii i).
+
+  Let Pc (c:cmd) :=
+    forall c',
+      remove_assert_c remove_assert_i c = ok c' ->
+      wequiv_rec (wa1:=withassert) (wa2:=noassert) p p' ev ev eq_spec st_eq c c' st_eq.
 
-  Let Pi_r (i: instr_r) := forall ii, Pi (MkI ii i).
+  Lemma check_e_es e : check_e e -> relational_logic.check_es (Checker_e := checker_ra_eq) tt [:: e] [:: e] tt.
+  Proof. by move=> he; split => //; rewrite /check_es /= he. Qed.
 
-  Let Pc (c: cmd) :=
-      wequiv_rec (wa1:=withassert) (wa2:=noassert) p p' ev ev eq_spec st_eq c (remove_assert_c remove_assert_i c) st_eq.
+  Lemma check_x_xs x : check_lval x -> relational_logic.check_lvals (Checker_e := checker_ra_eq) tt [:: x] [:: x] tt.
+  Proof. by move=> hx; split => //; rewrite /check_lvals /= hx. Qed.
 
   Lemma it_remove_assert_progP fn :
-    wiequiv_f (wa1 := withassert) (wa2 := noassert) p p' ev ev (rpreF (eS:= eq_spec)) fn fn (rpostF (eS:=eq_spec)).
+    wiequiv_f_wa nocatch nocatch withassert noassert p p' ev ev (rpreF (eS:= eq_spec)) fn fn (rpostF (eS:=eq_spec)).
   Proof.
-    apply wequiv_fun_ind => {fn}.
+    apply wequiv_fun_ind_wa => {fn}.
     move=> fn _ fs ft [<- <-] fd hget.
-    rewrite -{1 2}remove_assert_ok get_map_prog hget /=.
-    eexists; first reflexivity.
+    have [c' hcc' hget']:= eq_get_fundef hget.
+    eexists; first by eauto.
+    move=> _; split => //.
     move=> s1 hinit; exists s1 => //=.
-    exists st_eq, st_eq; split; cycle -1.
-    + by move => ? _ fr /st_rel_eq <- hfin; exists fr.
-    + done.
-    move: (f_body fd) => {hget hinit s1 fs ft fn fd}.
-    apply: (cmd_rect (Pr := Pi_r) (Pi := Pi) (Pc := Pc)) => //.
-    + by apply wequiv_nil.
-    + by move=> i c hi hc; rewrite -cat1s; apply wequiv_cat with st_eq.
-    + by move => >; apply wequiv_assgn_rel_eq with checker_ra_eq tt.
-    + by move => >; apply wequiv_opn_rel_eq with checker_ra_eq tt.
-    + move => >; apply wequiv_syscall_rel_eq_core with checker_ra_eq tt => //.
-      by move => > <- ->; eauto.
-    + by move => >; apply wequiv_assert_left.
-    + move=> > hc1 hc2 ii.
+    + by move: hinit; rewrite /initialize_funcall /= eq_p_extra.
+    exists (st_rel (λ _ : unit, eq) tt), (st_rel (λ _ : unit, eq) tt); split => //.
+    2: by move=> ?? fr /st_rel_eq <- hfin; exists fr.
+    move=> {hget hget' hinit s1 fs ft fn}.
+    move: (f_body fd) c' hcc' => {fd}.
+    apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => //; rewrite /Pi_r /Pi /Pc; clear Pi_r Pi Pc.
+    + by move=> ? /= [<-]; apply wequiv_nil.
+    + move=> i c hi hc c_ /=; t_xrbindP => c' /hc{}hc i' /hi{}hi <-.
+      by rewrite -cat1s; apply wequiv_cat with st_eq.
+    + move=> > /=; t_xrbindP => /andP [/check_x_xs ? /check_e_es ?] <-.
+      by apply wequiv_assgn_rel_eq with checker_ra_eq tt.
+    + by move=> > /=; t_xrbindP => /andP [hx he] <-; apply wequiv_opn_rel_eq with checker_ra_eq tt.
+    + move=> > /=; t_xrbindP => /andP [hx he] <-; apply wequiv_syscall_rel_eq_core with checker_ra_eq tt => //.
+      by move=> > <- ->; eauto.
+    + by move=> > /= [<-]; apply wequiv_assert_left.
+    + move=> > hc1 hc2 ii c_ /=; t_xrbindP => /check_e_es ? ? /hc1{}hc1 ? /hc2{}hc2 <-.
       by apply wequiv_if_rel_eq with checker_ra_eq tt tt tt.
-    + move=> > hc >.
-      by apply wequiv_for_rel_eq with checker_ra_eq tt tt.
-    + move=> > hc hc' >.
+    + move=> > hc > /=; t_xrbindP => /andP[hlo hhi] ? /hc{}hc <-.
+      apply wequiv_for_rel_eq with checker_ra_eq tt tt => //.
+      by split => //; rewrite /check_es /= hlo hhi.
+    + move=> > hc hc' > /=; t_xrbindP => /check_e_es ? ? /hc{}hc ? /hc'{}hc' <-.
       by apply wequiv_while_rel_eq with checker_ra_eq tt.
-    move=> >.
-    apply wequiv_call_rel_eq with checker_ra_eq tt => //.
+    move=> > /=; t_xrbindP => /andP [??] <-.
+    apply wequiv_call_rel_eq_wa with checker_ra_eq tt => //.
     move=> ?? <-; exact/wequiv_fun_rec.
   Qed.
 
diff --git a/proofs/compiler/remove_globals.v b/proofs/compiler/remove_globals.v
index 2086f595ac..a0a1d396f9 100644
--- a/proofs/compiler/remove_globals.v
+++ b/proofs/compiler/remove_globals.v
@@ -128,15 +128,15 @@ Section REMOVE.
   Section GD.
     Context (gd:glob_decls).
 
-    Definition get_var_ ii (env:venv) (xi:gvar) := 
+    Definition get_var_ ii (env:venv) (xi:gvar) :=
       if is_lvar xi then
-        let vi := xi.(gv) in 
+        let vi := xi.(gv) in
         let x := vi.(v_var) in
         if is_glob_var x then
           match Mvar.get env x with
           | Some g => ok (mk_gvar (VarI g vi.(v_info)))
           | None   => Error (rm_glob_error ii vi)
-          end 
+          end
         else ok xi
       else ok xi.
 
@@ -176,6 +176,20 @@ Section REMOVE.
         Let e1 := remove_glob_e ii env e1 in
         Let e2 := remove_glob_e ii env e2 in
         ok (Pif t e e1 e2)
+      | Pbig idx op x body start len =>
+        Let _     := assert (~~ is_glob_var x) (rm_glob_error ii x) in
+        Let idx   := remove_glob_e ii env idx in
+        Let start := remove_glob_e ii env start in
+        Let len   := remove_glob_e ii env len in
+        Let body  := remove_glob_e ii env body in
+        ok (Pbig idx op x body start len)
+
+      | Pis_var_init _ => ok e
+
+      | Pis_mem_init e1 e2 =>
+        Let e1 := remove_glob_e ii env e1 in
+        Let e2 := remove_glob_e ii env e2 in
+        ok (Pis_mem_init e1 e2)
       end.
 
     Definition remove_glob_lv ii (env:venv) (lv:lval) :=
@@ -351,6 +365,7 @@ Section REMOVE.
       Let envc := remove_glob remove_glob_i env f.(f_body) in
       ok
         {| f_info   := f.(f_info);
+           f_contra := f.(f_contra);
            f_tyin   := f.(f_tyin);
            f_params := f.(f_params);
            f_body   := envc.2;
diff --git a/proofs/compiler/riscv_extra.v b/proofs/compiler/riscv_extra.v
index 1f7d0b30aa..bd6b1671b7 100644
--- a/proofs/compiler/riscv_extra.v
+++ b/proofs/compiler/riscv_extra.v
@@ -46,6 +46,7 @@ Definition Oriscv_add_large_imm_instr : instruction_desc :=
    ; semi   := sem_prod_ok ctin semi
    ; semu   := @values.vuincl_app_sopn_v ctin [:: cty] (sem_prod_ok ctin semi) refl_equal
    ; i_safe := [::]
+   ; i_init := [:: IBool true]
    ; i_valid := true
    ; i_safe_wf := refl_equal
    ; i_semi_errty :=  fun _ => sem_prod_ok_error (tin:=ctin) semi _
diff --git a/proofs/compiler/riscv_instr_decl.v b/proofs/compiler/riscv_instr_decl.v
index d75bee3d48..f9346ca6e0 100644
--- a/proofs/compiler/riscv_instr_decl.v
+++ b/proofs/compiler/riscv_instr_decl.v
@@ -5,6 +5,7 @@ From mathcomp Require Import ssreflect ssrfun ssrbool seq eqtype ssralg.
 From mathcomp Require Import word_ssrZ.
 
 Require Import
+  operators
   sem_type
   shift_kind
   strings
@@ -57,6 +58,7 @@ Definition RTypeInstruction ws semi jazz_name asm_name: instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s jazz_name; (* how to print it in Jasmin *)
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name asm_name; (* how to print it in asm *)
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -80,6 +82,7 @@ Definition ITypeInstruction chk_imm ws semi jazz_name asm_name : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s jazz_name; (* how to print it in Jasmin *)
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name asm_name; (* how to print it in asm *)
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -280,6 +283,7 @@ Definition riscv_MV_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s "MV";
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name "mv";
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -309,6 +313,7 @@ Definition riscv_LA_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s "LA";
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name "la";
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -338,6 +343,7 @@ Definition riscv_LI_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s "LI";
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name "li";
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -368,6 +374,7 @@ Definition riscv_NOT_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s "NOT";
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name "not";
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -397,6 +404,7 @@ Definition riscv_NEG_instr : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_s "NEG";
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name "neg";
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -446,6 +454,7 @@ Definition riscv_LOAD_instr s ws : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_sign_sz "LOAD" s ws;
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name ("l" ++ string_of_size ws ++ string_of_sign s);
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
@@ -479,6 +488,7 @@ Definition riscv_STORE_instr ws : instr_desc_t :=
       id_check_dest := refl_equal;
       id_str_jas := pp_sz "STORE" ws;
       id_safe := [::];
+      id_init := [:: IBool true ];
       id_pp_asm := pp_name ("s" ++ string_of_size ws);
       id_safe_wf := refl_equal;
       id_semi_errty := fun _ => sem_lprod_ok_error tin semi;
diff --git a/proofs/compiler/slh_lowering.v b/proofs/compiler/slh_lowering.v
index 881c695e8e..efad8fdc0e 100644
--- a/proofs/compiler/slh_lowering.v
+++ b/proofs/compiler/slh_lowering.v
@@ -533,9 +533,9 @@ Definition lower_cmd (c : cmd) : cexec cmd := rec_cmd lower_i c.
 
 Definition lower_fd (fn:funname) (fd:fundef) :=
   Let _ := check_fd fn fd in
-  let 'MkFun ii si p c so r ev := fd in
+  let 'MkFun ii ci si p c so r ev := fd in
   Let c := lower_cmd c in
-  ok (MkFun ii si p c so r ev).
+  ok (MkFun ii ci si p c so r ev).
 
 Definition is_slh_none ty := if ty is Slh_None then true else false.
 
diff --git a/proofs/compiler/slh_lowering_proof.v b/proofs/compiler/slh_lowering_proof.v
index 802ca2d2e8..c0f0bb6307 100644
--- a/proofs/compiler/slh_lowering_proof.v
+++ b/proofs/compiler/slh_lowering_proof.v
@@ -47,7 +47,7 @@ Section CONST_PROP.
   #[local]
   Lemma use_mem_snot e :
     use_mem (snot e) = use_mem e.
-  Proof. elim: e => [||||||| [] | [] ||] //=; congruence. Qed.
+  Proof. elim: e => [||||||| [] | [] |||||] //=; try congruence. Qed.
 
   #[local]
   Lemma use_mem_sneg_int e :
@@ -125,38 +125,50 @@ Section CONST_PROP.
     ~~ use_mem e ->
     ~~ use_mem (const_prop_e None cpm e).
   Proof.
-    elim: e =>
+    elim: e cpm =>
       [||| x
       | al aa sz x e hinde
       ||| op1 e hinde
       | op2 e0 hinde0 e1 hinde1
       | opn es hindes
       | ty e hinde e0 hinde0 e1 hinde1
-      ] //= h.
+      | i hi op x b hb start hstart l hl
+      | |] //= cpm h.
 
     - by case: x => x [] //; case: Mvar.get => // - [].
 
     - by case: x =>  - x [] /=; auto.
 
-    - rewrite use_mem_s_op1. exact: (hinde h).
+    - rewrite use_mem_s_op1. exact: (hinde _ h).
 
-    - move: h => /norP [] /hinde0 h0 /hinde1 h1.
+    - move: h => /norP [] /(hinde0 cpm) h0 /(hinde1 cpm) h1.
       by rewrite (use_mem_s_op2 _ h0 h1).
 
     - rewrite /s_opN.
       have ih : ~~ has use_mem [seq const_prop_e None cpm i | i <- es].
       + elim: es h hindes => //= e es hind /norP [he hes] hindes.
         rewrite negb_or.
-        rewrite (hindes _ _ he) /=; last by left.
+        rewrite (hindes _ _ _ he) /=; last by left.
         apply: (hind hes) => e' he'.
         apply: hindes.
         by right.
-      case: opn => [ sz' pe | len | c ] => //; by case: app_sopn.
+      case: opn => [ sz' pe | len | c | | ] => //; by case: app_sopn.
+
+    - rewrite /s_if /=.
+      move: h => /norP [] /norP [] /(hinde cpm) h /(hinde0 cpm) h0 /(hinde1 cpm) h1.
+      case: is_bool => [[]|] //.
+      by rewrite !negb_or h h0 h1.
+
+    move: h => /norP [] /norP [] /norP [] /hi h /hb h0 /hstart h1 /hl h2.
+    have hdfl : ~~ use_mem (Pbig (const_prop_e None cpm i) op x
+                              (const_prop_e None (Mvar.remove cpm x) b)
+                              (const_prop_e None cpm start)
+                              (const_prop_e None cpm l)).
+    + by rewrite /= !negb_or h h0 h1 h2.
+    case: is_const => // ?; case: is_const => // ?.
+    elim: ziota (const_prop_e _ _ _) (h cpm) => // j js hrec e he.
+    by apply hrec; rewrite /= negb_or he h0.
 
-    rewrite /s_if /=.
-    move: h => /norP [] /norP [] /hinde h /hinde0 h0 /hinde1 h1.
-    case: is_bool => [[]|] //.
-    by rewrite !negb_or h h0 h1.
   Qed.
 
 End CONST_PROP.
@@ -1165,7 +1177,7 @@ Qed.
 
 Lemma Hproc : sem_Ind_proc p ev Pc Pfun.
 Proof.
-  move=> scs1 m1 _ _ fn [f_i f_tyi f_p f_b f_tyo f_r f_e] /= vargs vargs' s0 s1 s2 vres vres'
+  move=> scs1 m1 _ _ fn [f_i f_ci f_tyi f_p f_b f_tyo f_r f_e] /= vargs vargs' s0 s1 s2 vres vres'
     hf htargs hinit hwargs _ hrec hrres htres -> ->.
   move: (hp); rewrite /lower_slh_prog; t_xrbindP => hent fds hmap heq.
   have [fd' + hget]:= get_map_cfprog_name_gen hmap hf.
@@ -1255,8 +1267,8 @@ Lemma lower_fdP fn fd fd' :
     & f_extra fd' = f_extra fd
   ].
 Proof.
-case: fd; case: fd'; rewrite /lower_fd;
-  by t_xrbindP=> /= > -> _ -> -> -> -> -> -> -> ->.
+by case: fd; case: fd'; rewrite /lower_fd;
+  t_xrbindP=> /= > -> _ -> -> _ -> -> -> -> -> ->.
 Qed.
 
 Definition st_eq (env : Env.t) (s t : estate) : Prop :=
diff --git a/proofs/compiler/stack_alloc.v b/proofs/compiler/stack_alloc.v
index 679afa2737..1524c726f3 100644
--- a/proofs/compiler/stack_alloc.v
+++ b/proofs/compiler/stack_alloc.v
@@ -1053,6 +1053,12 @@ Fixpoint alloc_e (e:pexpr) ty :=
     Let e1 := alloc_e e1 ty in
     Let e2 := alloc_e e2 ty in
     ok (Pif ty e e1 e2)
+
+  | Pbig _ _ _ _ _ _ => Error (stk_ierror_no_var "Pbig is not supported in stack_alloc")
+
+  | Pis_var_init _ => Error (stk_ierror_no_var "Pis_var_init is not supported in stack_alloc")
+
+  | Pis_mem_init e1 e2 => Error (stk_ierror_no_var "Pis_mem_init is not supported in stack_alloc")
   end.
 
 Definition alloc_es es ty := mapM2 bad_arg_number alloc_e es ty.
@@ -1298,7 +1304,7 @@ Definition alloc_protect_ptr rmap ii r t e msf :=
   in
 
   match r with
-  | Lvar x => 
+  | Lvar x =>
     match get_local x with
     | None => Error (stk_ierror_basic x "register array remains")
     | Some pk =>
@@ -2042,6 +2048,7 @@ Definition alloc_fd_aux P p_extra mglob (local_alloc: funname -> stk_alloc_oracl
       check_results pmap rmap paramsi fd.(f_params) sao.(sao_return) fd.(f_res) in
   ok {|
     f_info := f_info fd;
+    f_contra := None;
     f_tyin := map2 (fun o ty => if o is Some _ then aword Uptr else ty) sao.(sao_params) fd.(f_tyin);
     f_params := params;
     f_body := flatten body;
diff --git a/proofs/compiler/stack_alloc_proof_1.v b/proofs/compiler/stack_alloc_proof_1.v
index be65088cc9..83379a78b8 100644
--- a/proofs/compiler/stack_alloc_proof_1.v
+++ b/proofs/compiler/stack_alloc_proof_1.v
@@ -1938,7 +1938,7 @@ Proof.
       rewrite Mvar.setP.
       case: eqP => [<-|_].
       + move=> [<-] /=.
-        move: ok_v; rewrite /get_gvar hlvar => ok_v.
+        move: ok_v; rewrite /get_gvar /= hlvar => ok_v.
         rewrite ok_v => -[<-].
         rewrite get_var_eq clone_ty;
           last by apply subctype_truncatable; rewrite -ty_v'.
@@ -3168,7 +3168,7 @@ Proof.
   + case: x htr hval {hsr hwf hreadeq hset} => x xii /= htr hval.
     move=> [? ? -> ->]; subst x.
     have [_ hty] := hval.
-    rewrite get_gvar_eq //.
+    rewrite get_gvar_eq //=.
     by t_xrbindP => hd <-.
   + move=> [hnglob hneq heqr hsry /= ->].
     have := check_gvalid_lvar hsry; rewrite mk_lvar_nglob // => hgvalid.
@@ -3815,7 +3815,7 @@ Lemma wfr_VAL_set_move rmap vme s1 s2 x sr status v :
   wfr_VAL (set_move rmap x sr status) vme (with_vm s1 (evm s1).[x <- v]) s2.
 Proof.
   move=> htr heqval hval y sry bytesy vy /check_gvalid_set_move [].
-  + by move=> [? ? <- ->]; subst x; rewrite get_gvar_eq //; t_xrbindP => hd <-.
+  + by move=> [? ? <- ->]; subst x; rewrite get_gvar_eq //=; t_xrbindP => hd <-.
   by move=> [? hgvalid]; rewrite get_gvar_neq => //; apply hval.
 Qed.
 
diff --git a/proofs/compiler/stack_alloc_proof_2.v b/proofs/compiler/stack_alloc_proof_2.v
index debb699b79..e58264f145 100644
--- a/proofs/compiler/stack_alloc_proof_2.v
+++ b/proofs/compiler/stack_alloc_proof_2.v
@@ -2306,6 +2306,9 @@ Proof.
   by apply (wfr_VARS_STATUS_alloc_syscall halloc).
 Qed.
 
+Local Lemma Wassert a: Pi_r (Cassert a).
+Proof. done. Qed.
+
 (* in practice, vars = Sv.inter var1 vars2, but we don't need it *)
 Lemma wfr_VARS_ZONE_merge vars1 vars2 rmap1 rmap2 vars :
   wfr_VARS_ZONE vars1 rmap1 ->
@@ -2383,9 +2386,6 @@ Proof.
   by apply wfr_VARS_STATUS_merge.
 Qed.
 
-Local Lemma Wassert a: Pi_r (Cassert a).
-Proof. done. Qed.
-
 Local Lemma Wif e c1 c2: Pc c1 -> Pc c2 -> Pi_r (Cif e c1 c2).
 Proof.
   move=> Hc1 Hc2 table1 rmap1 table2 rmap2 ii c /=.
@@ -4450,7 +4450,7 @@ Proof.
     have /vs_top_stack -> := hvs.
     by apply is_align_m.
 
-  apply wequiv_call_core with sa_pre sa_post Rv.
+  apply wequiv_call_core_wa with sa_pre sa_post Rv => //.
   + move => _ _ vargs1 [-> ->] hvargs1.
     have [vargs2 [*]]:= alloc_call_argsP hwf_Slots.(wfsl_no_overflow) hwf_Slots.(wfsl_disjoint)
       hwf_Slots.(wfsl_align) hwf_Slots.(wfsl_not_glob) hwf_pmap hvs hcargs hvargs1.
diff --git a/proofs/compiler/unrolling.v b/proofs/compiler/unrolling.v
index be2fa7ea86..a0e513b7b7 100644
--- a/proofs/compiler/unrolling.v
+++ b/proofs/compiler/unrolling.v
@@ -82,9 +82,9 @@ Section Section.
 Context {pT: progT}.
 
 Definition unroll_fun (f: fun_decl) :=
-  let: (fn, MkFun ii si p c so r ev) := f in
+  let: (fn, MkFun ii ci si p c so r ev) := f in
   let: (c', b) := unroll_cmd unroll_i c in
-  ((fn, MkFun ii si p c' so r ev), b).
+  ((fn, MkFun ii ci si p c' so r ev), b).
 
 Definition unroll_prog (p: prog) : prog * bool :=
   let: (fds, b) := map_repeat unroll_fun (p_funcs p) in
diff --git a/proofs/compiler/unrolling_proof.v b/proofs/compiler/unrolling_proof.v
index 12769f20f9..6b71af68bf 100644
--- a/proofs/compiler/unrolling_proof.v
+++ b/proofs/compiler/unrolling_proof.v
@@ -177,7 +177,7 @@ Section PROOF.
   Local Lemma Hproc : sem_Ind_proc p ev Pc Pfun.
   Proof.
     move => scs1 m1 scs2 m2 fn f vargs vargs' s0 s1 s2 vres vres'.
-    case: f=> fi ftyi fparams fc ftyo fres fe /= Hget Htyi Hi Hw _ Hc Hres Htyo Hsys Hfi.
+    case: f=> fi ci ftyi fparams fc ftyo fres fe /= Hget Htyi Hi Hw _ Hc Hres Htyo Hsys Hfi.
     move/p'_get_fundef: Hget Hc.
     rewrite /Pc /=.
     case: unroll_cmd => c _ /= Hget Hc.
@@ -238,7 +238,7 @@ Section PROOF.
     exists (unroll_fun (fn, fd)).1.2.
     + by apply: p'_get_fundef hfd.
     move=> s {hfd}.
-    case: fd => /= finfo ftyin fparams fbody ftyout fres fextra.
+    case: fd => /= finfo fcontract ftyin fparams fbody ftyout fres fextra.
     case heq: unroll_cmd => [c' b] /= hinit.
     exists s.
     + by move: hinit; rewrite /initialize_funcall /= p'_extra.
diff --git a/proofs/compiler/wint_int.v b/proofs/compiler/wint_int.v
index 26ccffcd2e..b4b786b93b 100644
--- a/proofs/compiler/wint_int.v
+++ b/proofs/compiler/wint_int.v
@@ -4,6 +4,7 @@ From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype ssralg.
 From mathcomp Require Import word_ssrZ.
 From Coq Require Import ZArith.
 Require Import expr sem_op_typed compiler_util.
+Require Export safety_shared.
 Import Utf8.
 Import oseq.
 Require Import flag_combination.
@@ -24,6 +25,13 @@ Module Import E.
   Definition ierror_e e :=
     ierror (pp_nobox [:: pp_s "ill typed expression "; pp_e e]).
 
+  Definition pp_user_error (pp : pp_error) :=
+    {| pel_msg := pp; pel_fn := None; pel_fi := None; pel_ii := None; pel_vi := None;
+       pel_pass := Some pass; pel_internal := false |}.
+
+  Definition error_e msg e :=
+    pp_user_error (pp_nobox [:: pp_s msg; pp_e e]).
+
   Definition ierror_lv lv :=
     ierror (pp_nobox [:: pp_s "ill typed left value "; pp_lv lv]).
 
@@ -33,18 +41,20 @@ Section WITH_PARAMS.
 
 Context `{asmop:asmOp} {pd: PointerData} {msfsz : MSFsize}.
 
-#[local]
-Existing Instance progUnit.
+Definition sc_op1 := sc_op1 (fun _ _ e => e).
 
-Definition is_wi1 (o: sop1) :=
-  if o is Owi1 s op then Some (s, op) else None.
+Definition sc_op2 o e1 e2 :=
+  match is_wi2 o with
+  | Some (sg, sz, o) => sc_wiop2 sg sz o e1 e2
+  | _ => [::]
+  end.
 
-Definition is_wi2 (o: sop2) :=
-  if o is Owi2 s _ op then Some (s, op) else None.
+#[local]
+Existing Instance progUnit.
 
 Definition wi2i_op2 (o : sop2) : sop2 :=
   match is_wi2 o with
-  | Some (s, op) =>
+  | Some (s, sz, op) =>
     match op with
     | WIadd => Oadd Op_int
     | WImul => Omul Op_int
@@ -63,16 +73,6 @@ Definition wi2i_op2 (o : sop2) : sop2 :=
   | None => o
   end.
 
-Definition esubtype (ty1 ty2 : extended_type positive) :=
- match ty1, ty2 with
- | ETword None w, ETword None w' => (w ≤ w')%CMP
- | ETword (Some sg) w, ETword (Some sg') w' => (sg == sg') && (w == w')
- | ETint, ETint => true
- | ETbool, ETbool => true
- | ETarr ws l, ETarr ws' l' => arr_size ws l == arr_size ws' l'
- | _, _ => false
- end.
-
 Definition wi2i_op1_e (o : sop1) (e : pexpr) :=
   match is_wi1 o with
   | Some (s, o) =>
@@ -106,49 +106,6 @@ Section Section.
 Context (m: var -> option (signedness * var)).
 Context (FV: Sv.t).
 
-Definition to_etype sg (t:atype) : extended_type positive:=
-  match t with
-  | abool     => tbool
-  | aint      => tint
-  | aarr ws l => tarr ws l
-  | aword ws  => ETword _ sg ws
-  end.
-
-Definition sign_of_var x := Option.map fst (m x).
-
-Definition etype_of_var x : extended_type positive :=
-  to_etype (sign_of_var x) (vtype x).
-
-Definition sign_of_gvar (x : gvar) :=
-  if is_lvar x then sign_of_var (gv x)
-  else None.
-
-Definition etype_of_gvar x := to_etype (sign_of_gvar x) (vtype (gv x)).
-
-Definition sign_of_etype (ty: extended_type positive) : option signedness :=
-  match ty with
-  | ETword (Some s) _ => Some s
-  | _ => None
-  end.
-
-Fixpoint etype_of_expr (e:pexpr) : extended_type positive :=
-  match e with
-  | Pconst _ => tint
-  | Pbool _ => tbool
-  | Parr_init ws len => tarr ws len
-  | Pvar x => etype_of_gvar x
-  | Pget al aa ws x e => tword ws
-  | Psub al ws len x e => tarr ws len
-  | Pload al ws e => tword ws
-  | Papp1 o e => (etype_of_op1 o).2
-  | Papp2 o e1 e2 => (etype_of_op2 o).2
-  | PappN o es => to_etype None (type_of_opN o).2
-  | Pif ty e1 e2 e3 => to_etype (sign_of_etype (etype_of_expr e2)) ty
-  end.
-
-Definition sign_of_expr (e:pexpr) : option signedness :=
-  sign_of_etype (etype_of_expr e).
-
 Definition wi2i_var (x:var) :=
   match m x with
   | Some (_, xi) => xi
@@ -162,6 +119,14 @@ Definition wi2i_vari (x:var_i) :=
   Let _ := assert (in_FV_var x) (E.ierror_e (Plvar x)) in
   ok {|v_var := wi2i_var x; v_info := v_info x |}.
 
+Definition wint_contract_condition (x:var_i) :=
+  Let xi := wi2i_vari x in
+  match m x.(v_var) , x.(v_var).(vtype) with
+  | Some (s,_) , aword sz  =>
+    ok [::(safety_lbl,  sc_wi_range s sz (Plvar xi))]
+  | _ , _ => ok [::]
+  end.
+
 Definition wi2i_gvar (x: gvar) :=
   if is_lvar x then
     Let xi := wi2i_vari (gv x) in
@@ -171,91 +136,155 @@ Definition wi2i_gvar (x: gvar) :=
 Definition wi2i_type (sg : option signedness) ty :=
   if sg == None then ty else aint.
 
-Fixpoint wi2i_e (e0:pexpr) : cexec pexpr :=
+Definition safety_cond := seq pexpr.
+
+Definition wi2i_es (wi2i_e : pexpr -> cexec (safety_cond * pexpr)) (es : pexprs) : cexec (safety_cond * pexprs) :=
+  Let es := mapM wi2i_e es in
+  ok (flatten (unzip1 es), unzip2 es).
+
+Fixpoint wi2i_e (e0:pexpr) : cexec (safety_cond * pexpr) :=
   match e0 with
-  | Pconst _ | Pbool _ | Parr_init _ _ => ok e0
+  | Pconst _ | Pbool _ | Parr_init _ _ => ok ([::], e0)
+
   | Pvar x =>
     Let x := wi2i_gvar x in
-    ok (Pvar x)
+    ok ([::], Pvar x)
+
   | Pget al aa ws x e =>
+    Let _ := assert (sign_of_expr m e == None)
+                    (E.ierror_e e0) in
     Let x := wi2i_gvar x in
     Let e := wi2i_e e in
-    ok (Pget al aa ws x e)
+    ok (e.1, Pget al aa ws x e.2)
+
   | Psub al ws len x e =>
+    Let _ := assert (sign_of_expr m e == None)
+                    (E.ierror_e e0) in
     Let x := wi2i_gvar x in
     Let e := wi2i_e e in
-    ok (Psub al ws len x e)
+    ok (e.1, Psub al ws len x e.2)
+
   | Pload al ws e =>
-    Let _ := assert (sign_of_expr e == None)
+    Let _ := assert (sign_of_expr m e == None)
                     (E.ierror_e e0) in
     Let e := wi2i_e e in
-    ok (Pload al ws e)
+    ok (e.1, Pload al ws e.2)
+
   | Papp1 o e =>
-    Let _ := assert (esubtype (etype_of_op1 o).1 (etype_of_expr e))
+    Let _ := assert (esubtype (etype_of_op1 o).1 (etype_of_expr m e))
                     (E.ierror_e e0) in
     Let e := wi2i_e e in
-    ok (wi2i_op1_e o e)
+    let sc := sc_op1 o e.2 in
+    ok (e.1 ++ sc, wi2i_op1_e o e.2)
+
   | Papp2 o e1 e2 =>
     let ty := etype_of_op2 o in
-    Let _ := assert [&& esubtype ty.1.1 (etype_of_expr e1) &
-                        esubtype ty.1.2 (etype_of_expr e2)]
+    Let _ := assert [&& esubtype ty.1.1 (etype_of_expr m e1) &
+                        esubtype ty.1.2 (etype_of_expr m e2)]
                     (E.ierror_e e0) in
     Let e1 := wi2i_e e1 in
     Let e2 := wi2i_e e2 in
-    ok (wi2i_op2_e o e1 e2)
+    let sc := sc_op2 o e1.2 e2.2 in
+    ok (e1.1 ++ e2.1 ++ sc, wi2i_op2_e o e1.2 e2.2)
 
   | PappN o es =>
-    Let _ := assert (all (fun e => sign_of_expr e == None) es)
+    Let _ := assert (all (fun e => sign_of_expr m e == None) es)
                     (E.ierror_e e0) in
-    Let es := mapM wi2i_e es in
-    ok (PappN o es)
+    Let es := wi2i_es wi2i_e es in
+    ok (es.1, PappN o es.2)
 
   | Pif ty e1 e2 e3 =>
-    let ety := etype_of_expr e0 in
-    Let _ := assert [&& esubtype ety (etype_of_expr e2) &
-                        esubtype ety (etype_of_expr e3)]
+    let ety := etype_of_expr m e0 in
+    Let _ := assert [&& esubtype ety (etype_of_expr m e2) &
+                        esubtype ety (etype_of_expr m e3)]
                     (E.ierror_e e0) in
-    let ty := wi2i_type (sign_of_expr e2) ty in
+    let ty := wi2i_type (sign_of_expr m e2) ty in
     Let e1 := wi2i_e e1 in
     Let e2 := wi2i_e e2 in
     Let e3 := wi2i_e e3 in
-    ok (Pif ty e1 e2 e3)
+    ok (e1.1 ++ e2.1 ++ e3.1, Pif ty e1.2 e2.2 e3.2)
+
+  | Pbig ei o v e es el =>
+
+    let ty := etype_of_op2 o in
+    Let _ := assert [&& esubtype ty.2 (etype_of_expr m ei)
+                      , esubtype ty.1.1 ty.2
+                      , esubtype ty.1.2 (etype_of_expr m e)
+                      , vtype v == aint
+                      , etype_of_expr m es == ETint _
+                      & etype_of_expr m el == ETint _]
+                     (E.ierror_e e0) in
+     Let _ := assert (if is_wi2 o is None then true else false)
+                (E.error_e "can not use bigop on wint operator" e0) in
+     Let ei := wi2i_e ei in
+     Let e := wi2i_e e in
+     Let es := wi2i_e es in
+     Let el := wi2i_e el in
+     Let v := wi2i_vari v in
+     ok (ei.1 ++ es.1 ++ el.1 ++ sc_all e.1 v es.2 el.2,
+         Pbig ei.2 (wi2i_op2 o) v e.2 es.2 el.2)
+
+  | Pis_var_init x =>
+    Let x := wi2i_vari x in
+    ok ([::], Pis_var_init x)
+
+  | Pis_mem_init e1 e2 =>
+    Let _ := assert [&& etype_of_expr m e1 == ETword _ None Uptr
+                      & etype_of_expr m e2 == ETint _] (E.ierror_e e0) in
+    Let e1 := wi2i_e e1 in
+    Let e2 := wi2i_e e2 in
+    ok (e1.1 ++ e2.1, Pis_mem_init e1.2 e2.2)
   end.
 
 Definition wi2i_lvar (ety : extended_type positive) (x : var_i) : cexec var_i :=
-  Let _ := assert (esubtype (etype_of_var x) ety)
+  Let _ := assert (esubtype (etype_of_var m x) ety)
                   (E.ierror_lv (Lvar x)) in
   wi2i_vari x.
 
-Definition wi2i_lv (ety : extended_type positive) (lv : lval) : cexec lval :=
+Definition wi2i_lv (ety : extended_type positive) (lv : lval) : cexec (safety_cond * lval) :=
   let s := sign_of_etype ety in
   match lv with
   | Lnone vi ty =>
-    ok (Lnone vi (wi2i_type s ty))
+    Let _ := assert (esubtype (to_etype (sign_of_etype ety) ty) ety) (E.ierror_lv lv) in
+    ok ([::], Lnone vi (wi2i_type s ty))
 
   | Lvar x =>
     Let x := wi2i_lvar ety x in
-    ok (Lvar x)
+    ok ([::], Lvar x)
 
   | Lmem al ws vi e =>
-    Let _ := assert [&& sign_of_expr e == None & s == None]
+    Let _ := assert [&& sign_of_expr m e == None & s == None]
                     (E.ierror_lv lv) in
     Let e := wi2i_e e in
-    ok (Lmem al ws vi e)
+    ok (e.1, Lmem al ws vi e.2)
 
   | Laset al aa ws x e =>
-    Let _ := assert [&& in_FV_var x, sign_of_expr e == None & s == None]
+    Let _ := assert [&& in_FV_var x, sign_of_expr m e == None & s == None]
                      (E.ierror_lv lv) in
     Let e := wi2i_e e in
-    ok (Laset al aa ws x e)
+    ok (e.1, Laset al aa ws x e.2)
 
   | Lasub aa ws len x e =>
-    Let _ := assert [&& in_FV_var x, sign_of_expr e == None & s == None]
+    Let _ := assert [&& in_FV_var x, sign_of_expr m e == None & s == None]
                      (E.ierror_lv lv) in
     Let e := wi2i_e e in
-    ok (Lasub aa ws len x e)
+    ok (e.1, Lasub aa ws len x e.2)
   end.
 
+Definition wi2i_lvs msg okmem xtys xs :=
+  let err := E.ierror_s msg in
+  Let scxs := mapM2 err wi2i_lv xtys xs in
+  let scs := unzip1 scxs in
+  let xs := unzip2 scxs in
+  (* FIXME : is it really an internal error ? *)
+  Let _ := assert (check_xs okmem Sv.empty xs scs) err in
+  ok (flatten scs, xs).
+
+
+Definition wi2i_a_and (a : assertion) :=
+  Let e := wi2i_e a.2 in
+  ok (a.1, eands (rcons e.1 e.2)).
+
 Context (sigs : funname -> option (list (extended_type positive) * list (extended_type positive))).
 
 Definition get_sig f :=
@@ -264,129 +293,168 @@ Definition get_sig f :=
   | None => Error (E.ierror_s "unknown function")
   end.
 
-Fixpoint wi2i_ir (ir:instr_r) : cexec instr_r :=
+Definition wi2i_c (wi2i : instr -> cexec cmd) c :=
+  Let c := mapM wi2i c in
+  ok (flatten c).
+
+Variant is_Polymorphic_op :=
+  | IsSpill of spill_op & seq atype
+  | IsSwap  of atype
+  | IsDeclassify of atype
+  | IsOther.
+
+Definition is_polymorphic_op o :=
+  match o with
+  | Opseudo_op (Ospill k tys) => IsSpill k tys
+  | Opseudo_op (Oswap ty) => IsSwap ty
+  | Opseudo_op (Odeclassify ty) => IsDeclassify ty
+  | _ => IsOther
+  end.
+
+Fixpoint wi2i_ir (ir:instr_r) : cexec (safety_cond * instr_r) :=
   match ir with
   | Cassgn x tag ty e =>
-    let ety := etype_of_expr e in
+    let ety := etype_of_expr m e in
     let sg  := sign_of_etype ety in
     let tyr := to_etype sg ty in
     Let _ := assert (esubtype tyr ety)
-                    (E.ierror_s "invalid type in assigned") in
+                    (E.ierror_s "invalid type in assignment") in
     Let x := wi2i_lv tyr x in
     Let e := wi2i_e e in
     let ty := wi2i_type sg ty in
-    ok (Cassgn x tag ty e)
+    ok (e.1 ++ x.1, Cassgn x.2 tag ty e.2)
 
   | Copn xs t o es =>
-      match o with
-      | Opseudo_op (Ospill k tys) =>
-          (* We check that the operator is well-typed *)
-          let etys := map etype_of_expr es in
-          let tys' := map2 (fun ety ty => to_etype (sign_of_etype ety) ty) etys tys in
-          Let _ := assert (size tys == size es) (E.ierror_s "ill typed spill") in
-          Let _ := assert (all2 esubtype tys' etys) (E.ierror_s "ill typed spill (arguments)") in
-          (* We patch the type of the operator *)
-          let tys := map2 (fun ty e => wi2i_type (sign_of_expr e) ty) tys es in
-          Let es := mapM wi2i_e es in
-          ok (Copn [::] t (Opseudo_op (Ospill k tys)) es)
-      | Opseudo_op (Oswap ty) =>
-          if es is [:: e1; e2 ] then
-            let ety := etype_of_expr e1 in
-            let sig := [:: ety; ety] in
-            Let _ := assert (all2 (fun ety e => esubtype ety (etype_of_expr e)) sig es)
-                       (E.ierror_s "invalid args in swap") in
-            Let es := mapM wi2i_e es in
-            Let xs := mapM2 (E.ierror_s "invalid dest in swap") wi2i_lv sig xs in
-            let ty := wi2i_type (sign_of_expr e1) ty in
-            ok (Copn xs t (Opseudo_op (Oswap ty)) es)
-          else Error (E.ierror_s "ill-typed swap")
-      | Opseudo_op (Odeclassify ty) =>
-          if es is [:: e ] then
-            Let e := wi2i_e e in
-            let ty := wi2i_type (sign_of_expr e) ty in
-            ok (Copn [::] t (Opseudo_op (Odeclassify ty)) [:: e])
-          else Error (E.ierror_s "ill-typed declassify")
-      | Opseudo_op (Ocopy _ _ | Onop | Omulu _ | Oaddcarry _ | Osubcarry _ | Odeclassify_mem _)
-      | Oslh _ | Oasm _ =>
-          Let _ := assert (all (fun e => sign_of_expr e == None) es)
-                          (E.ierror_s "invalid expr in Copn") in
-          Let es := mapM wi2i_e es in
-          let xtys := map (to_etype None) (sopn_tout o) in
-          Let xs := mapM2 (E.ierror_s "invalid dest in Copn") wi2i_lv xtys xs in
-          ok (Copn xs t o es)
-      end
+    Let es' := wi2i_es wi2i_e es in
+    Let tout_op :=
+      match is_polymorphic_op o with
+      | IsSpill k tys =>
+        (* We check that the operator is well typed *)
+        let etys := map (etype_of_expr m) es in
+        let tys' := map2 (fun ety ty => to_etype (sign_of_etype ety) ty) etys tys in
+        Let _ := assert (size tys == size es) (E.ierror_s "ill typed spill") in
+        Let _ := assert (all2 esubtype tys' etys) (E.ierror_s "ill typed spill (arguments)") in
+        (* We patch the type of the operator *)
+        let tys := map2 (fun ty e => wi2i_type (sign_of_expr m e) ty) tys es in
+        ok ([::], Opseudo_op (Ospill k tys))
+      | IsSwap ty =>
+        let e1 := nth etrue es 0 in
+        let sg := sign_of_expr m e1 in
+        let etys := map (etype_of_expr m) es in
+        let ety := to_etype sg ty in
+        let tys' := [::ety; ety] in
+        Let _ := assert (all2 esubtype tys' etys) (E.ierror_s "ill typed swap (arguments)") in
+        let ty := wi2i_type sg ty in
+        ok (tys', (Opseudo_op (Oswap ty)))
+      | IsDeclassify ty =>
+        let e1 := nth etrue es 0 in
+        let sg := sign_of_expr m e1 in
+        let etys := map (etype_of_expr m) es in
+        let ety := to_etype sg ty in
+        let tys' := [::ety] in
+        Let _ := assert (all2 esubtype tys' etys) (E.ierror_s "ill typed declassify (arguments)") in
+        let ty := wi2i_type sg ty in
+        ok ([::], (Opseudo_op (Odeclassify ty)))
+      | IsOther =>
+        Let _ := assert (all (fun e => sign_of_expr m e == None) es)
+                        (E.ierror_s "invalid expr in Copn") in
+        let xtys := map (to_etype None) (sopn_tout o) in
+        ok (xtys, o)
+      end in
+    Let xs := wi2i_lvs "invalid dest in Copn" true tout_op.1 xs in
+    ok (es'.1 ++ xs.1, Copn xs.2 t tout_op.2 es'.2)
 
   | Csyscall xs o es =>
-    Let _ := assert (all (fun e => sign_of_expr e == None) es)
+    Let _ := assert (all (fun e => sign_of_expr m e == None) es)
                     (E.ierror_s "invalid args in Csyscall") in
-    Let es := mapM wi2i_e es in
+    Let es := wi2i_es wi2i_e es in
     let xtys := map (to_etype None) (syscall_sig_u o).(scs_tout) in
-    Let xs := mapM2 (E.ierror_s "invalid dest in Csyscall") wi2i_lv xtys xs in
-    ok (Csyscall xs o es)
+    Let xs := wi2i_lvs "invalid dest in Csyscall" true xtys xs in
+    ok (es.1 ++ xs.1, Csyscall xs.2 o es.2)
 
-  | Cassert (msg, e) =>
-    Let e := wi2i_e e in
-    ok (Cassert (msg, e))
+  | Cassert a =>
+    Let a := wi2i_a_and a in
+    ok ([::], Cassert a)
 
   | Cif b c1 c2 =>
     Let b := wi2i_e b in
-    Let c1 := mapM wi2i_i c1 in
-    Let c2 := mapM wi2i_i c2 in
-    ok (Cif b c1 c2)
+    Let c1 := wi2i_c wi2i_i c1 in
+    Let c2 := wi2i_c wi2i_i c2 in
+    ok (b.1, Cif b.2 c1 c2)
 
   | Cfor x (dir, e1, e2) c =>
-    Let _ := assert (in_FV_var x) (E.ierror_s "invalid loop counter") in
+    Let _ := assert [&& in_FV_var x, vtype x == aint, etype_of_expr m e1 == ETint _ & etype_of_expr m e2 == ETint _]
+                (E.ierror_s "invalid loop counter") in
     Let e1 := wi2i_e e1 in
     Let e2 := wi2i_e e2 in
-    Let c := mapM wi2i_i c in
-    ok (Cfor x (dir, e1, e2) c)
+    Let c := wi2i_c wi2i_i c in
+    ok (e1.1 ++ e2.1, Cfor x (dir, e1.2, e2.2) c)
 
-  | Cwhile a c e info c' =>
+  | Cwhile a c e ii' c' =>
     Let e := wi2i_e e in
-    Let c := mapM wi2i_i c in
-    Let c' := mapM wi2i_i c' in
-    ok (Cwhile a c e info c')
+    Let c := wi2i_c wi2i_i c in
+    Let c' := wi2i_c wi2i_i c' in
+    ok ([::], Cwhile a (c ++ safe_assert ii' e.1) e.2 ii' c')
 
   | Ccall xs f es =>
     Let sig := get_sig f in
-    Let _ := assert (all2 (fun ety e => esubtype ety (etype_of_expr e)) sig.1 es)
+    Let _ := assert (all2 (fun ety e => esubtype ety (etype_of_expr m e)) sig.1 es)
                     (E.ierror_s "invalid args in Ccall") in
-    Let xs := mapM2 (E.ierror_s "bad xs length in Ccall") wi2i_lv sig.2 xs in
-    Let es := mapM wi2i_e es in
-    ok (Ccall xs f es)
+    Let es := wi2i_es wi2i_e es in
+    Let xs := wi2i_lvs "invalid dest in Ccall" false sig.2 xs in
+    ok (es.1 ++ xs.1, Ccall xs.2 f es.2)
   end
 
-with wi2i_i (i:instr) : cexec instr :=
+with wi2i_i (i:instr) : cexec cmd :=
   let (ii,ir) := i in
   Let ir := add_iinfo ii (wi2i_ir ir) in
-  ok (MkI ii ir).
-
+  ok (rcons (safe_assert ii ir.1) (MkI ii ir.2)).
+
+Definition wi2i_ci ci sig :=
+  Let ci_pre := mapM wi2i_a_and ci.(f_pre) in
+  Let wint_precond := mapM wint_contract_condition ci.(f_iparams) in
+  let ci_pre := ci_pre ++ flatten wint_precond in
+  Let ci_post := mapM wi2i_a_and ci.(f_post) in
+  Let wint_postcond := mapM wint_contract_condition ci.(f_ires) in
+  let ci_post := ci_post ++ flatten wint_postcond in
+  Let p := mapM2 (E.ierror_s "bad params in fun") wi2i_lvar sig.1 ci.(f_iparams) in
+  Let r := mapM2 (E.ierror_s "bad return in fun") wi2i_lvar sig.2 ci.(f_ires) in
+  ok (MkContra p r ci_pre ci_post).
 
 Definition wi2i_fun (fn:funname) (f: fundef) :=
   add_funname fn (
   Let sig := get_sig fn in
-  let 'MkFun ii si p c so r ev := f in
+  let 'MkFun ii ci si p c so r ev := f in
+  Let ci :=
+    match ci with
+    | None => ok None (*TODO: add conditions for params and return values that are wint*)
+    | Some ci =>
+      Let ci := wi2i_ci ci sig in
+      ok (Some ci)
+    end
+  in
+  Let _ := assert ((size p == size si) && (size r == size so))
+                  (E.ierror_s "bad signature in fun") in
   Let p := mapM2 (E.ierror_s "bad params in fun") wi2i_lvar sig.1 p in
-  Let c := mapM wi2i_i c in
-  Let r := mapM2 (E.ierror_s "bad return in fun") (fun ety x =>
-                    Let _ := assert (esubtype ety (etype_of_var x))
-                                    (E.ierror_e (Plvar x)) in
-                    wi2i_vari x) sig.2 r in
+  Let c := wi2i_c wi2i_i c in
+  Let r :=
+    mapM2 (E.ierror_s "bad return in fun")
+      (fun ety x => assert (esubtype ety (etype_of_var m x)) (E.ierror_lv x) >> wi2i_vari x)
+      sig.2 r in
   let mk := map (fun ety => wi2i_type (sign_of_etype ety) (to_atype ety)) in
   let tin := mk sig.1 in
   let tout := mk sig.2 in
-  ok (MkFun ii tin p c tout r ev)).
+  ok (MkFun ii ci tin p c tout r ev)).
 
 Definition build_sig (fd : funname * fundef) :=
- let 'MkFun ii si p c so r ev := fd.2 in
- let mk := map2 (fun (x:var_i) ty => to_etype (sign_of_var x) ty) in
+ let 'MkFun ii ci si p c so r ev := fd.2 in
+ let mk := map2 (fun (x:var_i) ty => to_etype (sign_of_var m x) ty) in
  (fd.1, (mk p si, mk r so)).
 
 End Section.
 
-Context (info : var -> option (signedness * var)).
 
-Definition build_info (fv : Sv.t) :=
+Definition build_info (info:var -> option (signedness * var)) (fv : Sv.t) :=
   Let fvm :=
     foldM (fun x (fvm: Sv.t * Mvar.t (signedness * var)) =>
       match info x with
@@ -404,9 +472,14 @@ Definition build_info (fv : Sv.t) :=
       (Sv.elements fv) in
    ok (Mvar.get fvm.2).
 
+(* FIXME: why get_info return a Sv.t, that should be include in (vars_p (p_funcs p)) ?
+          why we don't use (vars_p (p_funcs p)) directly ? *)
+Context (get_info : _uprog -> (Sv.t * (var -> option (signedness * var)))).
+
 Definition wi2i_prog (p:_uprog) : cexec _uprog :=
-  let FV := vars_p (p_funcs p) in
-  Let m := build_info FV in
+  let (FV,info) := get_info p in
+  Let m := build_info info FV in
+  Let _ := assert (Sv.subset (vars_p (p_funcs p)) FV) (E.ierror_s "FV is not included in vars_p") in
   let sigs := map (build_sig info) (p_funcs p) in
   Let funcs := map_cfprog_name (wi2i_fun m FV (get_fundef sigs)) (p_funcs p) in
   ok {| p_extra := p_extra p; p_globs := p_globs p; p_funcs := funcs |}.
diff --git a/proofs/compiler/wint_int_proof.v b/proofs/compiler/wint_int_proof.v
new file mode 100644
index 0000000000..77ac3f6c52
--- /dev/null
+++ b/proofs/compiler/wint_int_proof.v
@@ -0,0 +1,1544 @@
+From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssralg word_ssrZ.
+Require Import compiler_util pseudo_operator psem psem_facts.
+Require Import wint_int safety_shared_proof.
+Import Utf8.
+
+Section PROOF.
+
+#[local] Existing Instance progUnit.
+
+Context
+  {asm_op syscall_state : Type}
+  {ep : EstateParams syscall_state}
+  {spp : SemPexprParams}
+  {sip : SemInstrParams asm_op syscall_state}.
+
+#[local] Existing Instance sCP_unit.
+#[local] Existing Instance nosubword.
+#[local] Existing Instance indirect_c.
+#[local] Existing Instance withassert.
+Context {E E0: Type -> Type} {wE : with_Error E E0} {rE : EventRels E0}.
+
+(* ------------------------------------------------- *)
+
+Variable (p:uprog) (ev:extra_val_t).
+
+Notation gd := (p_globs p).
+
+#[local]Open Scope vm_scope.
+
+Section M.
+
+Context (m: var -> option (signedness * var)).
+Context (FV : Sv.t).
+
+Definition wf_m :=
+ forall x,
+    match m x with
+    | None => true
+    | Some (s, xi) =>
+      [/\ is_aword (vtype x), vtype xi = aint &
+          forall y, x <> y -> in_FV_var FV y ->
+             match m y with
+             | None => xi <> y
+             | Some (_, yi) => xi <> yi
+             end]
+    end.
+
+Hypothesis (hwf_m : wf_m).
+
+Definition val_to_int (s:option signedness) v :=
+  match v with
+  | Vword _ w =>
+    match s with
+    | None => v
+    | Some sg => Vint (int_of_word sg w)
+    end
+  | Vundef (cword _) _ =>
+    match s with
+    | None => v
+    | Some sg => undef_i
+    end
+  | _  => v
+  end.
+
+Definition eqvm (_:unit) (vmi vm : Vm.t) :=
+  forall x, in_FV_var FV x -> vmi.[wi2i_var m x] = val_to_int (sign_of_var m x) vm.[x].
+
+Definition eqst := st_rel eqvm.
+
+Lemma is_defined_val_to_int sg v : is_defined (val_to_int sg v) = is_defined v.
+Proof.
+  case: v => //=.
+  + by case: sg.
+  by move=> [] // >; case: sg.
+Qed.
+
+Lemma val_to_int_None v : val_to_int None v = v.
+Proof. by case: v => //= -[]. Qed.
+
+Lemma is_wi1P o :
+  match is_wi1 o with
+  | Some(s, oi) => o = Owi1 s oi
+  | None =>
+     let t := etype_of_op1 o in
+     sign_of_etype t.1 = None /\ sign_of_etype t.2 = None
+  end.
+Proof. by case: o => // -[]. Qed.
+
+Lemma is_wi2P o :
+  match is_wi2 o with
+  | Some(s, sz, oi) => o = Owi2 s sz oi
+  | None =>
+     let t := etype_of_op2 o in
+     [/\ sign_of_etype t.1.1 = None
+       , sign_of_etype t.1.2 = None
+       & sign_of_etype t.2 = None]
+  end.
+Proof.
+  case: o => //;
+  match goal with
+  | |- signedness -> _ => move=> ?
+  | |- _ => idtac
+  end; case => //=.
+Qed.
+
+Lemma esubtype_sign_of t1 t2 : esubtype t1 t2 -> sign_of_etype t2 = sign_of_etype t1.
+Proof. by case: t1 t2 => [||ws1 l1| [[]|] sz1] [||ws2 l2|[[]|] sz2]. Qed.
+
+Lemma sign_of_etype_expr e : sign_of_etype (etype_of_expr m e) = sign_of_expr m e.
+Proof. done. Qed.
+
+Lemma sign_of_to_etype_None ty : sign_of_etype (to_etype None ty) = None.
+Proof. by case: ty. Qed.
+
+Lemma sign_of_etype_var x : sign_of_etype (etype_of_var m x) = sign_of_var m x.
+Proof.
+  rewrite /etype_of_var /sign_of_var.
+  have := hwf_m x; case: m => /= [ | _]; last by apply sign_of_to_etype_None.
+  by move=> [sg xi [] + _ _]; case: vtype.
+Qed.
+
+Lemma sign_of_etype_gvar x : sign_of_etype (etype_of_gvar m x) = sign_of_gvar m x.
+Proof.
+  rewrite /etype_of_gvar /sign_of_gvar; case: ifP => _.
+  + by apply sign_of_etype_var.
+  by apply sign_of_to_etype_None.
+Qed.
+
+Lemma to_atypeK sg t : to_atype (to_etype sg t) = t.
+Proof. by case: t. Qed.
+
+Lemma get_var_type_of vm (x : var) (v : value) :
+  get_var true vm x = ok v → type_of_val v = eval_atype (to_atype (etype_of_var m x)).
+Proof.
+  rewrite /get_var /etype_of_var; t_xrbindP => /= hdef <-.
+  have := Vm.getP vm x; rewrite /compat_val hdef /= => /eqP ->.
+  by rewrite to_atypeK.
+Qed.
+
+Lemma get_gvar_type_of vm (x : gvar) (v : value) :
+  get_gvar true gd vm x = ok v → type_of_val v = eval_atype (to_atype (etype_of_gvar m x)).
+Proof.
+  rewrite /get_gvar /etype_of_gvar /sign_of_gvar; case: ifP => _.
+  + by apply get_var_type_of.
+  by move=> /type_of_get_global ->; rewrite to_atypeK.
+Qed.
+
+Lemma sem_pexpr_type_of s e v :
+  sem_pexpr true gd s e = ok v ->
+  type_of_val v = eval_atype (to_atype (etype_of_expr m e)).
+Proof.
+  case: e => //=; t_xrbindP.
+  1-3: by move=> > <-.
+  + by move=> ?; apply get_gvar_type_of.
+  1-2: by move=> >; apply: on_arr_gvarP; t_xrbindP => *; subst.
+  + by move=> *; subst.
+  + move=> o; rewrite /sem_sop1; t_xrbindP => *; subst.
+    by rewrite type_of_to_val; clear; case: o => // [ [] | sg []].
+  + move=> o; rewrite /sem_sop2; t_xrbindP => *; subst.
+    rewrite type_of_to_val; clear.
+    by case: o => //;
+    match goal with
+    | |- signedness -> wsize -> _ => move=> ??
+    | |- signedness -> _ => move=> ?
+    | _ => idtac
+    end; case.
+  + by rewrite /sem_opN; t_xrbindP => *; subst; rewrite to_atypeK type_of_to_val.
+  + move=> > _ _ > _ htr1 > _ htr2 <-.
+    rewrite to_atypeK; case: ifP => _; eauto using truncate_val_has_type.
+  + move => ? o > _ _ > _ _ acc ? _ /truncate_val_has_type.
+    elim : ziota acc.
+    + by move => //= ? h [] <-; rewrite h e_type_of_op2.
+    move => > hi acc /=; t_xrbindP => ? > ???.
+    rewrite /sem_sop2;t_rbindP => [[<-]].
+    apply: hi.
+    rewrite type_of_to_val; clear.
+    by case: o => //;
+       match goal with
+       | |- signedness -> wsize -> _ => move=> ??
+       | |- signedness -> _ => move=> ?
+       | _ => idtac
+       end; case.
+  all: by move=> > *; subst.
+Qed.
+
+Lemma wrepr_int_of_word sz sg (w:word sz) :
+  wrepr sz (int_of_word sg w) = w.
+Proof. by case: sg => /=; rewrite ?wrepr_signed ? wrepr_unsigned. Qed.
+
+Lemma sem_op2_type_of o v v1 v2 :
+  sem_sop2 o v1 v2 = ok v ->
+  type_of_val v = eval_atype ((type_of_op2 o).2).
+Proof.
+  rewrite /sem_sop2; t_xrbindP => //= ? _ ? _ ? _ <-.
+  by rewrite type_of_to_val.
+Qed.
+
+Lemma wi2i_lvarP_None d (x : var_i) si si' s v :
+  eqst d si s ->
+  in_FV_var FV x -> m x = None ->
+  write_var true x v si = ok si' ->
+  exists2 s', write_var true x v s = ok s' & eqst d si' s'.
+Proof.
+  move=> [?? hvm] hin hmx /write_varP [-> hdb htr].
+  exists (with_vm s (evm s).[x <- v]); first by apply/write_varP.
+  split => // z hinz.
+  case: (v_var x =P z) => [ ? | /eqP hne].
+  + by subst z; rewrite /wi2i_var /sign_of_var hmx val_to_int_None !Vm.setP_eq.
+  rewrite !Vm.setP_neq //; first by apply hvm.
+  rewrite /wi2i_var; case : (m z) (hwf_m z) => [[sg zi] | ] // [_ _ h].
+  apply /eqP => ?;  subst zi.
+  have:= h x _ hin; rewrite hmx; apply => //.
+  by apply/eqP; rewrite eq_sym.
+Qed.
+
+Section E.
+
+Let P e :=
+  forall ei, wi2i_e m FV e = ok ei ->
+  forall v si s, eqst tt si s ->
+    sem_cond gd (eands ei.1) si = ok true ->
+    sem_pexpr true gd si ei.2 = ok v ->
+    exists2 v', sem_pexpr true gd s e = ok v'
+              & v = val_to_int (sign_of_expr m e) v'.
+
+Let Q es :=
+  forall eis, wi2i_es (wi2i_e m FV) es = ok eis ->
+  forall vs si s, eqst tt si s ->
+    sem_cond gd (eands eis.1) si = ok true ->
+    sem_pexprs true gd si eis.2 = ok vs ->
+    exists2 vs', sem_pexprs true gd s es = ok vs'
+               & vs = map2 (fun e v => val_to_int (sign_of_expr m e) v) es vs'.
+
+Lemma wi2i_varP (x: var) v si s :
+  eqst tt si s ->
+  in_FV_var FV x ->
+  get_var true (evm si) (wi2i_var m x) = ok v ->
+  exists2 v', get_var true (evm s) x = ok v'
+            & v = val_to_int (sign_of_var m x) v'.
+Proof.
+  move=> heqs hin; case heqs => _ _ /(_ x hin); rewrite /wi2i_var /sign_of_var.
+  case hm : m (hwf_m x) => [ [sg xi] | ]; last first.
+  + by rewrite !val_to_int_None /get_var => _ ->; exists v => //=; rewrite val_to_int_None.
+  move=> [] hty htyi _ hto.
+  move=> /get_varP [/= -> hdb hcomp]; rewrite /get_var /=.
+  rewrite hto is_defined_val_to_int in hdb |- *; rewrite hdb /=.
+  by exists (evm s).[x].
+Qed.
+
+Lemma wi2i_variP x xi v si s :
+  eqst tt si s ->
+  wi2i_vari m FV x = ok xi ->
+  get_var true (evm si) xi = ok v ->
+  exists2 v', get_var true (evm s) x = ok v'
+            & v = val_to_int (sign_of_var m x) v'.
+Proof. by move => heqs; rewrite /wi2i_vari; t_xrbindP => + <-; apply wi2i_varP. Qed.
+
+Lemma wi2i_vari_nw (x:var_i) xi v si s :
+  eqst tt si s ->
+  ~is_aword (vtype x) ->
+  wi2i_vari m FV x = ok xi ->
+  get_var true (evm si) xi = ok v ->
+  get_var true (evm s) x = ok v.
+Proof.
+  move=> heqs hty hto hget; have [v' -> ->] := wi2i_variP heqs hto hget.
+  have -> : sign_of_var m x = None; last by rewrite val_to_int_None.
+  rewrite /sign_of_var.
+  by case: m (hwf_m x) => // -[sg ?] []?; elim hty.
+Qed.
+
+Lemma wi2i_gvarP x xi v si s :
+  eqst tt si s ->
+  wi2i_gvar m FV x = ok xi ->
+  get_gvar true gd (evm si) xi = ok v ->
+  exists2 v', get_gvar true gd (evm s) x = ok v'
+            & v = val_to_int (sign_of_gvar m x) v'.
+Proof.
+  move=> heqs; rewrite /wi2i_gvar /get_gvar /sign_of_gvar; case: ifP.
+  + by move=> /= _; t_xrbindP => ? + <- /=; apply wi2i_variP.
+  by move=> h [<-]; rewrite h => ->; exists v => //; rewrite val_to_int_None.
+Qed.
+
+Lemma wi2i_gvar_nw x xi v si s :
+  eqst tt si s ->
+  ~is_aword (vtype (gv x)) ->
+  wi2i_gvar m FV x = ok xi ->
+  get_gvar true gd (evm si) xi = ok v ->
+  get_gvar true gd (evm s) x = ok v.
+Proof.
+  move=> heqs hty hto hget; have [v' -> ->] := wi2i_gvarP heqs hto hget.
+  have -> : sign_of_gvar m x = None; last by rewrite val_to_int_None.
+  rewrite /sign_of_gvar  /sign_of_var; case: ifP => _ //.
+  by case: m (hwf_m (gv x)) => // -[sg ?] []?; elim hty.
+Qed.
+
+Lemma esubtype_to_word sg sz ty v w :
+  esubtype (twint sg sz) ty ->
+  type_of_val v = eval_atype (to_atype ty) ->
+  to_word sz v = ok w ->
+  v = Vword w.
+Proof.
+  rewrite /=; case: ty => // -[] // _ _ /andP [/eqP <- /eqP <-] /=.
+  move=> /type_of_valI [-> | [w' ->]] //=.
+  by rewrite truncate_word_u => -[->].
+Qed.
+
+Lemma wi2i_var_type x :
+  in_FV_var FV x → vtype (wi2i_var m x) ≠ aint → vtype x = vtype (wi2i_var m x).
+Proof.
+  by rewrite /wi2i_var; have := hwf_m x; case: (m x) => // -[sg x'] [_ ->].
+Qed.
+
+Lemma wi2i_vari_type x xi:
+  wi2i_vari m FV x = ok xi → vtype xi ≠ aint → vtype x = vtype xi.
+Proof. by rewrite /wi2i_vari; t_xrbindP => hin <- /=; apply wi2i_var_type. Qed.
+
+Lemma wi2i_gvar_type x xi:
+  wi2i_gvar m FV x = ok xi -> vtype (gv xi) <> aint -> vtype (gv x) = vtype (gv xi).
+Proof.
+  rewrite /wi2i_gvar; case: ifP.
+  + by t_xrbindP => hloc z + <- /=; apply wi2i_vari_type.
+  by move=> _ [<-].
+Qed.
+
+Lemma subtype_twint sg sz t : esubtype (twint sg sz) t -> t = twint sg sz.
+Proof. by case: t => //= -[] // ??/andP[/eqP -> /eqP ->]. Qed.
+
+Lemma esubtype_of_val et t v1 v1':
+  esubtype (to_etype (sign_of_etype et) t) et ->
+  of_val (eval_atype (wi2i_type (sign_of_etype et) t)) (val_to_int (sign_of_etype et) v1) = ok v1' ->
+  type_of_val v1 = eval_atype (to_atype et) ->
+  exists2 v, of_val (eval_atype t) v1 = ok v & to_val v1' = val_to_int (sign_of_etype et) (to_val v).
+Proof.
+  move=> hsub htr htyof.
+  have hse := esubtype_sign_of hsub.
+  move: v1' htr. rewrite /sign_of_expr hse /wi2i_type.
+  case: eqP => hsig.
+  + by rewrite hsig val_to_int_None => v1' ->; exists v1' => //; rewrite val_to_int_None.
+  have [ws [sg [heq1 ?]]] : exists ws sg, t = aword ws /\ et = ETword _ (Some sg) ws.
+  + case: (et) hsig hsub => //=; try by rewrite sign_of_to_etype_None.
+    move=> [sg |] ws; last by rewrite sign_of_to_etype_None.
+    case: (t) => //= _ _ /andP [_ /eqP ->].
+    by exists ws, sg.
+  subst t et => /=.
+  have [? | [w ?]] := type_of_valI htyof; subst v1 => //=.
+  rewrite truncate_word_u => v1' -[<-] /=.
+  by eexists; first reflexivity.
+Qed.
+
+Lemma esubtype_truncate_val et t v1 v1':
+  esubtype (to_etype (sign_of_etype et) t) et ->
+  truncate_val (eval_atype (wi2i_type (sign_of_etype et) t)) (val_to_int (sign_of_etype et) v1) = ok v1' ->
+  type_of_val v1 = eval_atype (to_atype et) ->
+  exists2 v, truncate_val (eval_atype t) v1 = ok v & v1' = val_to_int (sign_of_etype et) v.
+Proof.
+  rewrite /truncate_val; t_xrbindP => hsub v1_ hof <- htyof.
+  have [v -> /= ->] := esubtype_of_val hsub hof htyof; eauto.
+Qed.
+
+Lemma wi2i_type_of_op2 o :
+  let et := etype_of_op2 o in
+  let t := type_of_op2 (wi2i_op2 o) in
+  [/\ t.1.1 = wi2i_type (sign_of_etype et.1.1) (to_atype et.1.1)
+    , t.1.2 = wi2i_type (sign_of_etype et.1.2) (to_atype et.1.2)
+    & t.2 = wi2i_type (sign_of_etype et.2) (to_atype et.2)].
+Proof.
+  have l1 : ∀ o, type_of_opk o = wi2i_type (sign_of_etype (etype_of_opk o)) (to_atype (etype_of_opk o)).
+  + by case.
+  case: o => //= s w [] //=.
+Qed.
+
+Lemma to_etype_to_atype et : to_etype (sign_of_etype et) (to_atype et) = et.
+Proof. by case: et => // -[]. Qed.
+
+Lemma e_type_of_op2' o :
+  let et := etype_of_op2 o in
+  let t := type_of_op2 o in
+  [/\ t.1.1 = to_atype et.1.1
+    , t.1.2 = to_atype et.1.2
+    & t.2   = to_atype et.2].
+Proof. by rewrite /= (e_type_of_op2 o) /=. Qed.
+
+Lemma esubtype_refl et : esubtype et et.
+Proof. by case: et => //= -[] // >; rewrite !eqxx. Qed.
+
+Lemma wi2i_op2P si s t1 t2 o e1 e2 v1 v2 v :
+  eqst tt si s →
+  esubtype (etype_of_op2 o).1.1 t1 →
+  esubtype (etype_of_op2 o).1.2 t2 →
+  match eval_atype (to_atype t1) with
+  | cbool => ∃ b : bool, v1 = Vbool b
+  | cint => ∃ i0 : Z, v1 = Vint i0
+  | carr len => ∃ a : WArray.array len, v1 = Varr a
+  | cword ws => ∃ w : word ws, v1 = Vword w
+  end →
+  match eval_atype (to_atype t2) with
+  | cbool => ∃ b : bool, v2 = Vbool b
+  | cint => ∃ i0 : Z, v2 = Vint i0
+  | carr len => ∃ a : WArray.array len, v2 = Varr a
+  | cword ws => ∃ w : word ws, v2 = Vword w
+  end →
+  sem_pexpr true gd si e1 = ok (val_to_int (sign_of_etype t1) v1) →
+  sem_pexpr true gd si e2 = ok (val_to_int (sign_of_etype t2) v2) →
+  sem_cond gd (eands (sc_op2 o e1 e2)) si = ok true →
+  sem_sop2 (wi2i_op2 o) (val_to_int (sign_of_etype t1) v1) (val_to_int (sign_of_etype t2) v2) =  ok v →
+  exists2 v' : value,
+     sem_sop2 o v1 v2 = ok v' & v = val_to_int (sign_of_etype (etype_of_op2 o).2) v'.
+Proof.
+  move=> heqs hsub1 hsub2 hv1 hv2 he1 he2.
+  rewrite /sc_op2 /wi2i_op2 (esubtype_sign_of hsub1) (esubtype_sign_of hsub2) .
+  case: is_wi2 (is_wi2P o) => [[[sg sz] wio] | ]; last first.
+  + case: etype_of_op2 => -[t1' t2' tout] /= [-> -> ->] _.
+    by rewrite !val_to_int_None => ->; exists v => //; rewrite val_to_int_None.
+  move=> ?; subst o; rewrite /sc_wiop2.
+Opaque esubtype.
+  case: wio hsub1 hsub2 => /= /subtype_twint hsub1 /subtype_twint hsub2; subst t1 t2;
+    move: hv1 hv2 he1 he2 => /= -[w1 ?] [w2 ?]; subst v1 v2 => /= he1 he2.
+  1-3:
+    rewrite eandsE_1 /sem_sop2 /sc_wi_range_op2 /= => hsc [<-];
+    rewrite !truncate_word_u /= /mk_sem_wiop2 (sc_wi_range_of_int _ hsc) /=;
+    [ eexists; first reflexivity;
+      by rewrite /= (sc_int_of_word_wrepr _ hsc) //= he1 he2
+    | by rewrite he1 he2].
+  + rewrite /sem_sop2 /= => hsc [<-]; rewrite !truncate_word_u /=.
+    have {}hsc:= sem_sc_divmod he1 he2 hsc; rewrite /mk_sem_divmod hsc /= => {he1 he2}.
+    move/negbT:hsc; rewrite negb_or => /andP [/eqP hw2 hnand].
+    eexists; first reflexivity.
+    rewrite /=; case: sg hnand => /= /negP hnand.
+    + rewrite wsigned_repr //.
+      have ? : wsigned w2 <> 0%Z.
+      + by move=> heq; apply hw2; rewrite -(wrepr_signed w2) heq wrepr0.
+      apply: (Z_quot_bound (half_modulus_pos sz) (wsigned_range w1) (wsigned_range w2)) => //.
+      move=> [h1 h2]; apply/hnand/andP;split; apply/eqP => //.
+      by rewrite -(wrepr_signed w2) h2.
+    rewrite wunsigned_repr_small //.
+    have ? := wunsigned_range w1; have ? := wunsigned_range w2.
+    have ? : wunsigned w2 <> 0%Z.
+    + by move=> heq; apply hw2; rewrite -(wrepr_unsigned w2) heq wrepr0.
+    split; first by apply Z.div_pos; Lia.lia.
+    apply Z.div_lt_upper_bound; Lia.nia.
+  + rewrite /sem_sop2 /= => hsc [<-]; rewrite !truncate_word_u /=.
+    have {}hsc:= sem_sc_divmod he1 he2 hsc; rewrite /mk_sem_divmod hsc /= => {he1 he2}.
+    move/negbT:hsc; rewrite negb_or => /andP [/eqP hw2 hnand].
+    eexists; first reflexivity.
+    rewrite /=; case: sg hnand => /= /negP hnand.
+    + rewrite wsigned_repr //.
+      have /(Z_rem_bound (wsigned w1)) : (wsigned w2 <> 0)%Z.
+      + by move=> heq; apply hw2; rewrite -(wrepr_signed w2) heq wrepr0.
+      move: (wsigned_range w1) (wsigned_range w2).
+      by rewrite /wmin_signed /wmax_signed; Lia.lia.
+    rewrite wunsigned_repr_small //.
+    have ? : wunsigned w2 <> 0%Z.
+    + by move=> heq; apply hw2; rewrite -(wrepr_unsigned w2) heq wrepr0.
+    move: (wunsigned_range w1) (wunsigned_range w2) (Z.mod_pos_bound (wunsigned w1) (wunsigned w2)).
+    Lia.lia.
+  + rewrite eandsE_1 /sem_sop2 /= => hsc [<-];
+    rewrite !truncate_word_u /= /mk_sem_wishift (sc_wi_range_of_int _ hsc) /=;
+    [ eexists; first reflexivity;
+      by rewrite /= (sc_int_of_word_wrepr _ hsc) //= he1 he2
+    | by rewrite he1 he2 ].
+  + move=> _; rewrite /sem_sop2 /= => -[?]; subst v.
+    rewrite !truncate_word_u /= /mk_sem_wishift /wint_of_int.
+    have hin := in_wint_range_zasr sg w1 w2.
+    rewrite hin /=; eexists; first reflexivity.
+    by rewrite /= int_of_word_wrepr.
+  all: by move=> _; rewrite /sem_sop2 /= !truncate_word_u /= => -[<-];
+    eexists; first reflexivity; rewrite val_to_int_None.
+Qed.
+
+Lemma wi2i_eP_ : (forall e, P e) /\ (forall es, Q es).
+Proof.
+  apply: pexprs_ind_pair; rewrite /P /Q; split => //=; t_xrbindP.
+  + by move=> ? [<-] /= ? si s heqs _ [<-]; eauto.
+  + move=> e he es hes ?; rewrite /wi2i_es /=; t_xrbindP.
+    move=> ? ei /he{}he eis heis <- <- /= vs si s heqs.
+    move=> /eandsE_cat [hei1 heis1]; t_xrbindP => ? hei2 ? heis2 <-.
+    have [v' -> -> /=] := he _ _ _ heqs hei1 hei2.
+    have {}heis: wi2i_es (wi2i_e m FV) es = ok (flatten (unzip1 eis), unzip2 eis).
+    + by rewrite /wi2i_es heis.
+    have [vs' -> -> /=]:= hes _ heis _ _ _ heqs heis1 heis2.
+    by eexists; first reflexivity.
+  1-3: by move=> > <- > heqs /= _ [<-]; eexists; first reflexivity.
+  + move=> x ei xi + <- v /= si s heqs _.
+    have -> : sign_of_expr m x = sign_of_gvar m x; last by apply wi2i_gvarP.
+    by rewrite /sign_of_expr /= sign_of_etype_gvar.
+  + move=> al aa sz x e he _ /eqP htye xi hxi ei /he{}he <- v si s heqs /= hsc.
+    apply: on_arr_gvarP => len t htyx hx.
+    t_xrbindP => i ve /he {}he /to_intI ? w hget ?; subst ve v.
+    rewrite /= /on_arr_var (wi2i_gvar_nw heqs _ hxi hx) /=; last first.
+    + rewrite (wi2i_gvar_type hxi).
+      + by case: vtype htyx.
+      by move=> h; rewrite h in htyx.
+    have [v' -> /=]:= he _ heqs hsc.
+    rewrite htye val_to_int_None => <- /=.
+    by rewrite hget /=; eexists; first reflexivity.
+  + move=> aa sz len x e he _ /eqP htye xi hxi ei /he{}he <- v si s heqs /= hsc.
+    apply: on_arr_gvarP => len' t htyx hx.
+    t_xrbindP => i ve /he {}he /to_intI ? w hget ?; subst ve v.
+    rewrite /= /on_arr_var (wi2i_gvar_nw heqs _ hxi hx) /=; last first.
+    + rewrite (wi2i_gvar_type hxi).
+      + by case: vtype htyx.
+      by move=> h; rewrite h in htyx.
+    have [v' -> /=]:= he _ heqs hsc.
+    rewrite htye val_to_int_None => <- /=.
+    by rewrite hget /=; eexists; first reflexivity.
+  + move=> al sz e he ? /eqP hte ei /he{}he <- v si s heqs /= hsc; t_xrbindP.
+    move=> we ve /he{}he hptre w hr <- /=.
+    have [v' ->]:= he _ heqs hsc.
+    rewrite hte val_to_int_None => <- /=; rewrite hptre /=.
+    by case: heqs => _ <- _; rewrite hr /=; eexists; first reflexivity.
+  + move=> o e hrec _ hte ei /hrec{}hrec <- v si s heqs /= /eandsE_cat [hei1 hsco] hei2.
+    have hse := esubtype_sign_of hte.
+    move: hsco hei2; rewrite /sc_op1 /wi2i_op1_e.
+    case: is_wi1 (is_wi1P o); last first.
+    + move=> hoty _ /=; t_xrbindP => ve hei2.
+      have [v' he] := hrec _ _ _ heqs hei1 hei2.
+      have htve := sem_pexpr_type_of he.
+      rewrite he => -> /=; rewrite /sign_of_expr hse.
+      case heq: etype_of_op1 hoty => [ty1 ty2] /= [hty1 hty2].
+      rewrite heq /= hty1 hty2 val_to_int_None => ->.
+      by exists v => //; rewrite val_to_int_None.
+
+    move=> [sg [sz|sz|sz|sz|szo szi|sz]] ?; subst o => /=; rewrite /= in hse, hte.
+    + rewrite eandsE_1 => hsc hei2.
+      have [v' he heq] := hrec _ _ _ heqs hei1 hei2; subst v.
+      move: hei2; rewrite he /= /sign_of_expr /= hse /sem_sop1 /= val_to_int_None.
+      case: etype_of_expr hte (sem_pexpr_type_of he)=> //= _.
+      move=> /(sem_pexpr_tovI he) [i ?]; subst v' => /= hei.
+      rewrite (sc_wi_range_of_int hei hsc) /=; eexists; first reflexivity.
+      by rewrite /= (sc_int_of_word_wrepr hei hsc).
+    + move=> _ /(hrec _ _ _ heqs hei1) [v' he ?]; subst v.
+      rewrite he /sign_of_expr /= hse /sem_sop1 /=.
+      have := sem_pexpr_type_of he.
+      case: etype_of_expr hse hte => //= -[] //??[->]/andP[_ /eqP<-].
+      move=> /(sem_pexpr_tovI he) [w' ->] /=; rewrite truncate_word_u /=.
+      eexists; first reflexivity.
+      by rewrite val_to_int_None.
+    + move=> _; rewrite /sem_sop1 /=; t_xrbindP.
+      move=> vi /(hrec _ _ _ heqs hei1) [v' he ?]; subst vi; rewrite he /=.
+      have /(sem_pexpr_tovI he) := sem_pexpr_type_of he; rewrite /sign_of_expr.
+      case: etype_of_expr hse hte => //= -[] // ?? [->]/andP[_ /eqP<-] [w ?]; subst v' => /=.
+      move=> _ [<-] ?; rewrite wint_of_int_of_word => -[<-] <-; rewrite truncate_word_u /=.
+      eexists; first reflexivity.
+      by rewrite val_to_int_None.
+    + move=> _; rewrite /sem_sop1 /=; t_xrbindP.
+      move=> vi /(hrec _ _ _ heqs hei1) [v' he ?]; subst vi; rewrite he /=.
+      have /(sem_pexpr_tovI he) := sem_pexpr_type_of he; rewrite /sign_of_expr.
+      case: etype_of_expr hse hte => //= -[] // ?? hle [w ?] w'; subst v'.
+      rewrite val_to_int_None /= => -> <- /=.
+      by eexists; first reflexivity.
+    + move=> _; case:ifP => hsz.
+      + move=> /(hrec _ _ _ heqs hei1) [v' he ?]; subst v; rewrite he /=.
+        rewrite /sem_sop1 /sign_of_expr /=.
+        have /(sem_pexpr_tovI he) := sem_pexpr_type_of he; rewrite /sign_of_expr.
+        case: etype_of_expr hse hte => //= -[] // ?? [->]/andP[_ /eqP<-] [w ?]; subst v' => /=.
+        rewrite truncate_word_u /=; eexists; first reflexivity.
+        rewrite /= /sem_word_extend; case: sg => /=.
+        + rewrite /sign_extend wsigned_repr //.
+          by move: (wsigned_range_m hsz) (wsigned_range w); Lia.lia.
+        rewrite /zero_extend wunsigned_repr_small //.
+        by move: (wbase_m hsz) (wunsigned_range w); Lia.lia.
+      rewrite /= /sem_sop1 /=; t_xrbindP.
+      move=> v0 ? v1 /(hrec _ _ _ heqs hei1) [v' he ?]; subst v1.
+      have /(sem_pexpr_tovI he) := sem_pexpr_type_of he; rewrite /sign_of_expr.
+      case: etype_of_expr hse hte => //= -[] // ?? [->]/andP[_ /eqP<-] [w ?]; subst v' => /=.
+      move=> _ [<-] <-; rewrite he /= truncate_word_u /=.
+      move=> w3 hw3 w4 hw4 hto w5 hto' ?; subst v.
+      eexists; first reflexivity.
+      case: sg w3 hw3 w4 hw4 hto hto'=> /=; rewrite truncate_word_u => w3 [?] w4 [?] ?; subst w3 w4 v0;
+      rewrite /= truncate_word_u => -[<-].
+      + by rewrite wrepr_signed.
+      by rewrite wrepr_unsigned.
+    move=> hsc; rewrite /sem_sop1 /=; t_xrbindP => vei hei2.
+    have [v' he ?] := hrec _ _ _ heqs hei1 hei2; subst vei.
+    rewrite he /=.
+    have /(sem_pexpr_tovI he) := sem_pexpr_type_of he; rewrite /sign_of_expr.
+    move: hei2; rewrite /sign_of_expr.
+    case: etype_of_expr hse hte => //= -[] // ?? [->]/andP[_ /eqP<-] hei2 [w ?]; subst v' => /=.
+    move=> _ [<-] <- /=; rewrite truncate_word_u /=.
+    case: sg hei2 hsc => /=; rewrite eandsE_1 => hei2.
+    + rewrite (eneqiP (i2:= wmin_signed sz) hei2) // => -[/eqP h].
+      rewrite /wint_of_int /= /in_wint_range /=.
+      have -> /= : in_sint_range sz (- wsigned w).
+      + rewrite /in_sint_range; have := wsigned_range w.
+        move: h; rewrite /wmin_signed /wmax_signed => ??.
+        by apply/andP;split; apply/ZleP; Lia.lia.
+      eexists; first reflexivity.
+      by rewrite /= wrepr_opp wrepr_signed wsigned_opp.
+    rewrite (eeqiP (i2:= 0%Z) hei2) // => -[/eqP ->] /=.
+    by eexists; first reflexivity.
+
+  + move=> o e1 hrec1 e2 hrec2 ei /andP [hte1 hte2].
+    move=> ei1 hei1 ei2 hei2 <- /= v si i heqs.
+    rewrite !eandsE_cat => -[hei11] [hei21] hsc; t_xrbindP.
+    move=> v1 hei12 v2 hei22.
+    have [v1' he1 ?]:= hrec1 _ hei1 _ _ _ heqs hei11 hei12.
+    have [v2' he2 ?]:= hrec2 _ hei2 _ _ _ heqs hei21 hei22.
+    rewrite he1 he2 /=; subst v1 v2.
+    apply: (wi2i_op2P heqs) hsc => //.
+    + by have /(sem_pexpr_tovI he1) := sem_pexpr_type_of he1.
+    by have /(sem_pexpr_tovI he2) := sem_pexpr_type_of he2.
+
+  + move=> o es hes ei hall esi hesi <- /= v si s heqs hsc; t_xrbindP.
+    move=> vs hsem hvs.
+    have [vs'] := hes _ hesi _ _ _ heqs hsc hsem; rewrite /sem_pexprs => {}hsem.
+    have hsz := size_mapM hsem; rewrite hsem => hvs' /=.
+    have : map2 (λ (e : pexpr) (v0 : value), val_to_int (sign_of_expr m e) v0) es vs' = vs'.
+    + move=> {hvs' hsem hesi hes}; elim: es vs' hall hsz => [ | e es hrec] [ | v' vs'] //=.
+      by move=> /andP[]/eqP -> /hrec h [] /h ->; rewrite val_to_int_None.
+    move=> <-; rewrite -hvs' hvs /=; eexists; first reflexivity.
+    by rewrite /sign_of_expr /= sign_of_to_etype_None val_to_int_None.
+
+  + move=> t e he e1 he1 e2 he2 ei_ /andP[] hs1 hs2.
+    move=> ei /he{}he ei1 /he1{}he1 ei2 /he2{}he2 <- vr si s heqs /=.
+    rewrite !eandsE_cat => -[hei1] [hei11 hei21]; t_xrbindP.
+    move=> b v hv hb v1' v1 hv1 htr1 v2' v2 hv2 htr2 <-.
+    have [v' {}he ?] := he _ _ _ heqs hei1 hv.
+    have [v1_ {}he1 ?] := he1 _ _ _ heqs hei11 hv1.
+    have [v2_ {}he2 ?] := he2 _ _ _ heqs hei21 hv2.
+    subst v v1 v2; rewrite he he1 he2 /=.
+    have [w1 -> ?] := esubtype_truncate_val hs1 htr1 (sem_pexpr_type_of he1).
+    have hse1 := esubtype_sign_of hs1.
+    have hse2 := esubtype_sign_of hs2.
+    rewrite /sign_of_expr hse1 -hse2 in hs2, htr2.
+    have [w2 -> ? /=] := esubtype_truncate_val hs2 htr2 (sem_pexpr_type_of he2).
+    have ? : v' = Vbool b.
+    + have := to_boolI hb; case: (v') => //=.
+      + by move=> >; case sign_of_expr.
+      by move=> [] // >; case sign_of_expr.
+    subst v' => /=; eexists; first reflexivity.
+    by rewrite /sign_of_expr /=; subst v1' v2'; rewrite {1}hse1 hse2; case: (b).
+
+  + move=> idx hidx op x body hbody start hstart len hlen ei /and5P [hsub1 hsub2 hsub3 /eqP heqx /andP[] /eqP heq1 /eqP heq2] hnwio.
+    move=> idxi /hidx{}hidx bodyi/hbody{}hbody starti/hstart{}hstart leni/hlen{}hlen xi hxi.
+    move=> <- v si s heqs; rewrite !eandsE_cat => -[] hscid [] hscstart [] hsclen hscbody /=; t_xrbindP.
+    move=> stz vstz hstz hto1 lz vlz hlz hto2 vi vi' hvi' htr hfold.
+    have [vstz' hstz' ?] := hstart _ _ _ heqs hscstart hstz.
+    have [vlz' hlz' ?] := hlen _ _ _ heqs hsclen hlz.
+    have [vi1 hvi1 ?] := hidx _ _ _ heqs hscid hvi'.
+    subst vstz vlz vi'; rewrite hstz' hlz' hvi1 /=.
+    move: hto1 hto2; rewrite /sign_of_expr heq1 heq2 /=.
+    rewrite !val_to_int_None => /to_intI ? /to_intI ?; subst vstz' vlz' => /=.
+    have [heq11 heq12 heq_2] := wi2i_type_of_op2 op.
+    rewrite heq_2 /sign_of_expr -(esubtype_sign_of hsub1) in htr.
+    have := esubtype_truncate_val _ htr.
+    rewrite {1}(esubtype_sign_of hsub1) to_etype_to_atype.
+    move=> /(_ hsub1 (sem_pexpr_type_of hvi1)).
+    have [heq11_ heq12_ heq_2']:= e_type_of_op2' op.
+    rewrite -heq_2' (esubtype_sign_of hsub1) => -[w1 -> ?] /=; subst vi.
+    have [hin ? hmx] : [/\ in_FV_var FV x, x = xi & m x = None].
+    + move: (hwf_m x) hxi; rewrite /wi2i_vari /wi2i_var; t_xrbindP.
+      by rewrite heqx; case: (m x) => [ [??][] | _ ? <-] //; split => //; case: (x).
+    subst xi.
+    have [ht1 ht2 hto hop_]:
+         [/\ sign_of_etype (etype_of_op2 op).1.1 = None, sign_of_etype (etype_of_op2 op).1.2 = None
+           , sign_of_etype (etype_of_op2 op).2 = None & wi2i_op2 op = op].
+    + by move: hnwio; rewrite /wi2i_op2; case: is_wi2 (is_wi2P op) => // -[].
+    rewrite hto val_to_int_None hop_ in hfold.
+    move=> {htr}; elim: (ziota _ _) w1 (sc_allE heqx hstz hlz hscbody) hfold => [ | j js hrec] w1 /=.
+    + by move=> _ [<-]; exists w1 => //; rewrite hto val_to_int_None.
+    move=> /List.Forall_cons_iff []; t_xrbindP => si1 hw hsc hall.
+    rewrite hw => ? _ [<-] vbod hbod hop hfold.
+    have [s1 -> heqs1 /=]:= wi2i_lvarP_None heqs hin hmx hw.
+    have [vbod' hvbod' ?]:= hbody _ _ _ heqs1 hsc hbod; subst vbod.
+    rewrite hvbod' /=.
+    move: hop; rewrite /sign_of_expr (esubtype_sign_of hsub3) ht2 !val_to_int_None => -> /=.
+    apply (hrec _ hall hfold).
+  + move=> x _ xi hx <- /= vi si s heqs _ [<-]; rewrite /sign_of_expr /=.
+    move: hx; rewrite /wi2i_vari; t_xrbindP => hin <-.
+    case: heqs => _ _ /(_ _ hin) ->.
+    eexists; first reflexivity.
+    by rewrite is_defined_val_to_int val_to_int_None.
+  move=> e1 e2 he1 he2 sce_ /andP[/eqP hte1 /eqP hte2] sce1 hsce1 sce2 hsce2 <- v si s heqs /=.
+  move=> /eandsE_cat [hsce11 hsce21]; t_xrbindP.
+  move=> w vi1 hsce12 hto1 i vi2 hsce22 hto2 <-.
+  have [v1]:= he1 _ hsce1 _ _ _ heqs hsce11 hsce12.
+  have [v2]:= he2 _ hsce2 _ _ _ heqs hsce21 hsce22.
+  rewrite /sign_of_expr hte1 hte2 !val_to_int_None => -> /= ? -> /= ?; subst vi1 vi2.
+  rewrite hto1 hto2 /=.
+  eexists; first reflexivity; rewrite val_to_int_None.
+  by case: heqs => _ <-.
+Qed.
+
+Lemma wi2i_eP e : P e.
+Proof. by case wi2i_eP_. Qed.
+
+Lemma wi2i_esP es : Q es.
+Proof. by case wi2i_eP_. Qed.
+
+Lemma wi2i_condP b e ei :
+  wi2i_e m FV e = ok ei ->
+  forall si s, eqst tt si s ->
+    sem_cond gd (eands ei.1) si = ok true ->
+    sem_cond gd ei.2 si = ok b ->
+    sem_cond gd e s = ok b.
+Proof.
+  move=> hei si s heqs hei1; rewrite /sem_cond; t_xrbindP => v hei2 /to_boolI ?; subst v.
+  have [v' -> ]:= wi2i_eP hei heqs hei1 hei2.
+  rewrite /val_to_int; case: v' => //.
+  + by move=> ? <-.
+  + by case: sign_of_expr.
+  by case => //; case: sign_of_expr.
+Qed.
+
+End E.
+
+Lemma sign_to_etype_type_of ty sg sg' v :
+  type_of_val v = eval_atype ty ->
+  sign_of_etype (to_etype sg ty) = Some sg' ->
+  sg = Some sg' /\
+  exists ws, v = undef_w \/ exists (w:word ws), v = Vword w.
+Proof.
+  move=> hty; have := (@type_of_valI v _ erefl); rewrite hty => {hty}.
+  case: ty => //=.
+  move=> ws h; case: sg => // ? [->]; eauto.
+Qed.
+
+Lemma is_awordP ty : is_aword ty -> exists ws, ty = aword ws.
+Proof. case: ty => //; eauto. Qed.
+
+Lemma eval_atypeI ty :
+  match eval_atype ty with
+  | cbool => ty = abool
+  | cint  => ty = aint
+  | carr len => exists ws len', ty = aarr ws len' /\ len = Z.to_pos (arr_size ws len')
+  | cword ws => ty = aword ws
+  end.
+Proof. by case: ty => // ws len'; exists ws, len'. Qed.
+
+Lemma wi2i_lvarP x xi ty ety si si' s v :
+  eqst tt si s ->
+  type_of_val v = eval_atype ty ->
+  wi2i_lvar m FV (to_etype (sign_of_etype ety) ty) x = ok xi ->
+  write_var true xi (val_to_int (sign_of_etype (to_etype (sign_of_etype ety) ty)) v) si = ok si' ->
+  exists2 s' : estate,
+      write_var true x v s = ok s' &
+      eqst tt si' s'.
+Proof.
+  rewrite /wi2i_lvar /wi2i_vari; t_xrbindP => heqs heval hsub hin ?; subst xi.
+  move: hsub; rewrite /wi2i_vari /wi2i_var /etype_of_var /sign_of_var.
+  case heqm: m (hwf_m x) => [[sg xi]| ] /=.
+  + move=> [/is_awordP [sw hxty] htxi hdiff] hsub.
+    have := (esubtype_sign_of hsub); rewrite hxty /=.
+    move=> hsig; rewrite hsig.
+    move=> /write_varP [-> hdb htr].
+    have [heq [ws [? | [w ?]]]] := sign_to_etype_type_of heval hsig; subst.
+    + by move: hdb; rewrite /DB.
+    move: hsub; rewrite /esubtype hxty heq /=.
+    have := eval_atypeI ty; rewrite -heval /= => -> /andP[_ /eqP?]; subst sw.
+    rewrite /val_to_int /=.
+    exists (with_vm s (evm s).[x <- Vword w]).
+    + by apply/write_varP; split => //=; rewrite hxty /=.
+    case: heqs => ?? hvm.
+    split => //= z hz.
+    rewrite (Vm.setP _ x); case: eqP => heqx.
+    + subst z; rewrite /wi2i_var heqm Vm.setP_eq.
+      by rewrite hxty /= cmp_le_refl htxi /sign_of_var heqm.
+    rewrite Vm.setP_neq; first by apply hvm.
+    by apply/eqP; have := hdiff _ heqx hz; rewrite /wi2i_var; case: m => [[]|].
+  move=> _ hsub.
+  have := (esubtype_sign_of hsub); rewrite sign_of_to_etype_None => ->.
+  by rewrite val_to_int_None; apply: wi2i_lvarP_None.
+Qed.
+
+Lemma wi2i_lvP ty ety lv lvi si si' s v:
+  eqst tt si s ->
+  type_of_val v = eval_atype ty ->
+  let ety := to_etype (sign_of_etype ety) ty in
+  wi2i_lv m FV ety lv = ok lvi ->
+  sem_cond gd (eands lvi.1) si = ok true ->
+  write_lval true gd lvi.2 (val_to_int (sign_of_etype ety) v) si = ok si' ->
+  exists2 s', write_lval true gd lv v s = ok s' & eqst tt si' s'.
+Proof.
+  move=> heqs heval; case: lv => /=.
+  + move=> i ty'; t_xrbindP.
+    move=> hsub <- /= hsc /write_noneP [-> htr hdb]; exists s => //=.
+    rewrite /write_none.
+    case heq: sign_of_etype htr hdb => [sg | ] /=.
+    + have [_ [ws [ ? | [w ?]]]] := sign_to_etype_type_of heval heq; subst v.
+      + by rewrite /DB.
+      rewrite /= => _ _.
+      rewrite heq in hsub.
+      move: heq hsub => /=.
+      have := eval_atypeI ty; rewrite -heval /= => -> /=.
+      case: sign_of_etype => // _ [->].
+      by case: ty' => //= ? /andP [] _ /eqP ->; rewrite cmp_le_refl.
+    by rewrite val_to_int_None => -> ->.
+  + by move=> x; t_xrbindP => xi /= + <- /= _; apply: wi2i_lvarP.
+  + t_xrbindP => a ws vi e /andP [/eqP hse /eqP hsty].
+    move=> ei hei <- /= hsc; t_xrbindP.
+    move=> we ve hseme htoe ? htov m' hw <-.
+    have [ve' -> /= ? ]:= wi2i_eP hei heqs hsc hseme; subst ve.
+    move: htoe htov; rewrite hse hsty !val_to_int_None => -> /= -> /=.
+    case heqs => ? hmem ?.
+    by exists (with_mem s m') => //; rewrite -hmem hw.
+  + t_xrbindP => a aa ws x e /and3P[hinx /eqP hse /eqP hsety].
+    move=> ei hei <- /= hsc; apply: on_arr_varP; t_xrbindP.
+    move=> len t htx hget i vi hseme /to_intI ?; rewrite hsety val_to_int_None => ? -> /=; subst vi.
+    move=> t' hset hw.
+    have := wi2i_varP heqs hinx.
+    have hmx : m x = None.
+    + have := hwf_m x; case: m => // -[sg ?] [].
+      by have := eval_atypeI (vtype x); rewrite htx => -[?] [?] [->].
+    rewrite /sign_of_var /wi2i_var hmx => /(_ _ hget) [vt] -> /=.
+    rewrite val_to_int_None => <- /=.
+    have [i'] := wi2i_eP hei heqs hsc hseme.
+    rewrite hse val_to_int_None => -> <- /=; rewrite hset /=.
+    by apply (wi2i_lvarP_None heqs hinx hmx hw).
+
+  t_xrbindP => a aa ws x e /and3P[hinx /eqP hse /eqP hsty].
+  move=> ei hei <- /= hsc; apply: on_arr_varP; t_xrbindP.
+  move=> len t htx hget i vi hseme /to_intI ?; subst vi.
+  rewrite hsty val_to_int_None => ? hto ? hsub hw.
+  have := wi2i_varP heqs hinx.
+  have hmx : m x = None.
+  + have := hwf_m x; case: m => // -[sg ?] [].
+    by have := eval_atypeI (vtype x); rewrite htx => -[?] [?] [->].
+  rewrite /sign_of_var /wi2i_var hmx => /(_ _ hget) [?] /=.
+  rewrite val_to_int_None => -> /= <-.
+  have [i'] := wi2i_eP hei heqs hsc hseme.
+  rewrite hse val_to_int_None => -> <- /=.
+  rewrite hto /= hsub.
+  by apply (wi2i_lvarP_None heqs hinx hmx hw).
+Qed.
+
+Lemma wi2i_lvsP msg ety lvs lvis si0 si si' s vs okmem:
+  wi2i_lvs m FV msg okmem ety lvs = ok lvis ->
+  sem_cond gd (eands lvis.1) si0 = ok true ->
+  (evm si0 = evm si) ->
+  (okmem -> emem si0 = emem si) ->
+  eqst tt si s ->
+  write_lvals true gd si lvis.2 (map2 (fun ety v => val_to_int (sign_of_etype ety) v) ety vs) = ok si' ->
+  List.Forall2 (fun ety v => exists2 ty, type_of_val v = eval_atype ty &
+                             ety = (to_etype (sign_of_etype ety) ty)) ety vs ->
+  exists2 s',
+    write_lvals true gd s lvs vs = ok s' &
+    eqst tt si' s'.
+Proof.
+  rewrite /wi2i_lvs; t_xrbindP.
+  move=> lvsi' hlv hcheck <- /= {lvis} hcond hvm.
+  have : evm si0 =[\Sv.empty] evm si by rewrite hvm.
+  move=> {hvm}.
+  elim: ety lvs vs lvsi' okmem Sv.empty si s hlv hcheck hcond =>
+    [|ety etys hrec] [|lv lvs] //= [|v vs] //= ? okmem W si s; t_xrbindP.
+  + by move=> <- _ _ _ _ ? /= [<-] _; exists s.
+  + by move=> ??????? /List_Forall2_inv.
+  + by move=> ??????????? /List_Forall2_inv.
+  move=> lvi hlvi lvis hlvis <- /= /and3P [hmemok hdisj hcheck]; t_xrbindP.
+  rewrite eandsE_cat => -[hsc hscs] hvm hokm heqs si1 hw hws /List_Forall2_inv [ [ty heval heq] hall] /=.
+  rewrite heq in hlvi, hw.
+  rewrite (check_scP _ s hmemok hdisj hvm hokm) in hsc.
+  have [s1 -> /= heqs2 ]:= wi2i_lvP heqs heval hlvi hsc hw.
+  apply: (hrec _ _ _ _ _ _ _ hlvis hcheck) heqs2 hws hall => //.
+  + rewrite vrv_recE.
+    apply (eq_exT (vm2:= evm si)).
+    + by apply: eq_exI hvm; SvD.fsetdec.
+    by apply: eq_exI (vrvP hw); SvD.fsetdec.
+  by move=> /andP [/hokm -> hlv]; apply: lv_write_memP hw.
+Qed.
+
+Lemma wi2i_esP_none es sce scs :
+  all (λ e : pexpr, sign_of_expr m e == None) es →
+  wi2i_es (wi2i_e m FV) es = ok sce →
+  wrequiv (λ si s : estate, eqst tt si s ∧ sem_cond gd (eands (sce.1 ++ scs)) si = ok true)
+    ((sem_pexprs true gd)^~ sce.2) ((sem_pexprs true gd)^~ es) eq.
+Proof.
+  move=> hnone hsce si s vsi [heqs /eandsE_cat[hsce1 hscx1]] hsce2.
+  have [vs' hes ->] := wi2i_esP hsce heqs hsce1 hsce2.
+  exists vs' => //.
+  have {hes hsce} h := size_mapM hes.
+  elim: es vs' h hnone => [| e es hes] [| ve ves] //= [] hsz /andP [/eqP -> /hes ->] //.
+  by rewrite val_to_int_None.
+Qed.
+
+Lemma wi2i_lvsP_none msg vs tys xs scx scs :
+  map type_of_val vs = map eval_atype tys →
+  wi2i_lvs m FV msg true [seq to_etype None i | i <- tys] xs = ok scx →
+  wrequiv (λ si s : estate, eqst tt si s ∧ sem_cond gd (eands (scs ++ scx.1)) si = ok true)
+    (λ s1 : estate, write_lvals true gd s1 scx.2 vs) (λ s2 : estate, write_lvals true gd s2 xs vs)
+    (eqst tt).
+Proof.
+  move=> heq hscx si s si' [heqs /eandsE_cat [hsce1 hscx1]] hw.
+  apply: (wi2i_lvsP hscx hscx1 _ _ heqs) => //.
+  + have -> //: map2 (λ ety v, val_to_int (sign_of_etype ety) v) [seq to_etype None i | i <- tys] vs = vs.
+    have : size vs = size tys.
+    + by have := f_equal size heq; rewrite !size_map.
+    elim : (vs) (tys) => [ | ?? hrec] [|??] //= [/hrec ->].
+    by rewrite sign_of_to_etype_None val_to_int_None.
+  elim : (vs) (tys) heq => [ | ?? hrec] [| ??] //= [{}heq hres]; constructor.
+  + by eexists; eauto; rewrite sign_of_to_etype_None.
+  by apply hrec.
+Qed.
+
+Context (p_funcsi : ufun_decls)
+        (sigs : funname → option (seq (extended_type positive) * seq (extended_type positive)))
+        (hsig : forall fn fd, get_fundef (p_funcs p) fn = Some fd ->
+                  sigs fn = Some
+                    (map2 (fun (x:var_i) ty => to_etype (sign_of_var m x) ty) fd.(f_params) fd.(f_tyin),
+                     map2 (fun (x:var_i) ty => to_etype (sign_of_var m x) ty) fd.(f_res) fd.(f_tyout)))
+        (hp' : forall fn fdi, get_fundef p_funcsi fn = Some fdi ->
+               exists2 fd, wi2i_fun m FV sigs fn fd = ok fdi & get_fundef (p_funcs p) fn = Some fd).
+
+Let pi : uprog := {| p_funcs := p_funcsi; p_globs := gd; p_extra := p_extra p |}.
+
+Definition vs_pre fsig (vargsi vargs: values) :=
+  [/\
+    List.Forall2 (fun ety v => exists2 ty, type_of_val v = eval_atype ty &
+                               esubtype ety (to_etype (sign_of_etype ety) ty)) fsig vargs
+    & vargsi = map2 (fun ety v => val_to_int (sign_of_etype ety) v) fsig vargs].
+
+Definition vs_post fsig (vargsi vargs: values) :=
+  [/\ List.Forall2 (fun ety v => exists2 ty, type_of_val v = eval_atype ty &
+                                 ety = (to_etype (sign_of_etype ety) ty)) fsig vargs
+    & vargsi = map2 (fun ety v => val_to_int (sign_of_etype ety) v) fsig vargs].
+
+Definition wi2i_spec :=
+  {| rpreF_ := λ fn1 fn2 fs1 fs2,
+       fn1 = fn2 /\ exists2 fsig, sigs fn1 = Some fsig & fs_rel (vs_pre fsig.1) fs1 fs2
+   ; rpostF_ := λ fn1 fn2 fs1 fs2 fr1 fr2,
+       exists2 fsig, sigs fn1 = Some fsig &
+               fs_rel (vs_post fsig.2) fr1 fr2
+  |}.
+
+Let Pi_r ir :=
+  forall ii sci, wi2i_ir m FV sigs ir = ok sci ->
+  wequiv_rec pi p ev ev wi2i_spec
+    (fun si s => eqst tt si s /\ sem_cond (p_globs pi) (eands sci.1) si = ok true)
+    [::MkI ii sci.2] [::MkI ii ir] (eqst tt).
+
+Let Pi i :=
+  forall ci, wi2i_i m FV sigs i = ok ci ->
+  wequiv_rec pi p ev ev wi2i_spec (eqst tt) ci [::i] (eqst tt).
+
+Let Pc c :=
+  forall ci, wi2i_c (wi2i_i m FV sigs) c = ok ci ->
+  wequiv_rec pi p ev ev wi2i_spec (eqst tt) ci c (eqst tt).
+
+Lemma esubtype_truncate_vals xs tys vs vis' :
+  let etys := map2 (λ (x:var_i) ty, to_etype (sign_of_var m x) ty) xs tys in
+  size xs = size tys →
+  List.Forall2 (fun ety v => exists2 ty, type_of_val v = eval_atype ty &
+                               esubtype ety (to_etype (sign_of_etype ety) ty)) etys vs →
+  mapM2 ErrType truncate_val
+      (map (λ ety, eval_atype (wi2i_type (sign_of_etype ety) (to_atype ety))) etys)
+      (map2 (λ ety v, val_to_int (sign_of_etype ety) v) etys vs) = ok vis' →
+  exists2 vs',
+    mapM2 ErrType truncate_val (map eval_atype tys) vs = ok vs' &
+    vis' = map2 (λ ety v, val_to_int (sign_of_etype ety) v) etys vs' /\
+    map eval_atype tys = map type_of_val vs'.
+Proof.
+  rewrite /=.
+  elim: tys vs xs vis' => [|ty tys hrec] [|v vs] [| x xs] //= .
+  + by move=> ? _ _ [<-]; eauto.
+  + by move=> ? _ /List_Forall2_inv.
+  move=> vis'_ [hsize] /List_Forall2_inv [] [ty1 hty1 hsub] hsubs; t_xrbindP => vi' htr vis' htrs <-.
+  have [hsign htoe1 hto2]:
+    [/\ sign_of_etype (to_etype (sign_of_var m x) ty) =
+        sign_of_etype (to_etype (sign_of_var m x) ty1)
+      , to_etype (sign_of_etype (to_etype (sign_of_var m x) ty1)) ty = to_etype (sign_of_var m x) ty
+      & to_etype (sign_of_etype (to_etype (sign_of_var m x) ty)) ty1 =
+          to_etype (sign_of_var m x) ty1].
+  + case: (sign_of_var m x) hsub => [sg | ]; last first.
+    + by rewrite !sign_of_to_etype_None.
+    by case: (ty) (ty1) => [||ws1 len1|ws1] [||ws2 len2|ws2].
+  have := esubtype_truncate_val (et := to_etype (sign_of_var m x) ty1) (t:=ty) (v1:= v) (v1':= vi').
+  rewrite !to_atypeK in htr |- *.
+  rewrite htoe1 -hsign; rewrite hto2 in hsub.
+  move=> /(_ hsub htr hty1) [v' h1 ->] /=; rewrite h1.
+  have <- := truncate_val_has_type h1.
+  have [vs' -> [-> /= ->] ] := hrec _ _ _ hsize hsubs htrs.
+  by eexists; first reflexivity.
+Qed.
+
+Lemma wi2i_write_vars msg xs ixs ixsi tys vs :
+  let etys := map2 (λ (x : var_i) ty, to_etype (sign_of_var m x) ty) xs tys in
+  let vparitr := map2 (λ ety v, val_to_int (sign_of_etype ety) v) etys vs in
+  size xs = size tys →
+  map type_of_val vs = map eval_atype tys ->
+  mapM2 (E.ierror_s msg) (wi2i_lvar m FV) etys ixs = ok ixsi →
+  forall si s si',
+  eqst tt si s →
+  write_vars true ixsi vparitr si = ok si' →
+  exists2 s', write_vars true ixs vs s = ok s' & eqst tt si' s'.
+Proof.
+  rewrite /=.
+  elim: vs xs tys ixs ixsi => [|v vs hrec] //= [| x xs] //= [|ty tys] //= [|ix ixs] ixsi_ //=.
+  + by move=> _ _ [<-] si s si' heqs [<-]; exists s.
+  move=> [hsize]; t_xrbindP.
+  move=> [heqty heqtys] ixi hixi ixis hixis <- si s si' heqs /=; t_xrbindP.
+  move=> si1 hw hws.
+  have heq : forall ty,
+     to_etype (sign_of_etype (to_etype (sign_of_var m x) ty)) ty =
+     to_etype (sign_of_var m x) ty.
+  + by case => //= ws; case: sign_of_var.
+  rewrite -heq in hixi, hw.
+  have [s1 -> /= heqs1]:= wi2i_lvarP heqs heqty hixi hw.
+  have [s' -> ?] := hrec _ _ _ _ hsize heqtys hixis _ _ _ heqs1 hws.
+  by exists s'.
+Qed.
+
+Lemma eqst_init scs1 scs2 mem1 mem2 :
+  scs1 = scs2 -> mem1 = mem2 ->
+  eqst tt {| escs := scs1; emem := mem1; evm := Vm.init |}
+          {| escs := scs2; emem := mem2; evm := Vm.init |}.
+Proof.
+  move=> -> ->; split => //= z hin.
+  rewrite !Vm.initP /wi2i_var /sign_of_var.
+  case: m (hwf_m z) => [[sg zi] | ] //=; last by rewrite val_to_int_None.
+  by move=> [] /is_awordP [ws ->] -> _ /=; apply undef_x_vundef.
+Qed.
+
+Lemma wi2i_a_andP a_s ai_s si s' t :
+  eqst tt si s' →
+  mapM (wi2i_a_and m FV) a_s = ok ai_s →
+  mapM (sem_assert gd si) ai_s = ok t →
+  mapM (sem_assert gd s') a_s >> ok tt = ok tt.
+Proof.
+  move=> heqs; elim: a_s ai_s t => /= [|a a_s hrec] ai_s_ t.
+  + by move=> [<-].
+  t_xrbindP => ai hai ai_s hai_s <- /=; t_xrbindP => hsemai ? /(hrec _ _ hai_s); t_xrbindP.
+  move=> ? -> _ _ /=.
+  move: hai hsemai; rewrite /sem_assert /wi2i_a_and; t_xrbindP.
+  move=> sca he <- _ [] //=.
+  rewrite -cats1 eandsE_cat eandsE_1 => -[] hsc ha2 _ _.
+  by rewrite (wi2i_condP he heqs hsc ha2).
+Qed.
+
+Lemma wi2i_sem_pre fn fsig fsi fs:
+  sigs fn = Some fsig →
+  fs_rel (vs_pre fsig.1) fsi fs →
+  sem_pre pi fn fsi = ok tt → sem_pre p fn fs = ok tt.
+Proof.
+  move=> hfsig [hscs hmem [hsub hval]]; rewrite /sem_pre /=.
+  case hfdi : get_fundef => [fdi | //].
+  have [[fi fc ftyi fpar fbod ftyo fres fex] + hfd] := hp' hfdi.
+  have /= := hsig hfd.
+  rewrite hfsig => -[?]; subst fsig.
+  rewrite hfd /wi2i_fun /= /get_sig hfsig /= => /add_funnameP {hfd}; t_xrbindP.
+  move=> fc' hfc' /andP [/eqP hsizei /eqP hsizeo] _ _ _ _ _ _ <- /=.
+  case: fc hfc' => [fc | //]; t_xrbindP => fci + <-.
+  rewrite /wi2i_ci; t_xrbindP => fpre' hfpre fpre_range hfpre_range.
+  move=> fpost' hfpost fpost_range hfpost_range fipar hfipar hires hfires <-.
+  move=> vparitr hvpari si hw ? hassert _; rewrite hval in hvpari.
+  rewrite -map_comp in hvpari.
+  have [vs' -> [? htys]] := esubtype_truncate_vals hsizei hsub hvpari => /=; subst vparitr.
+  have [s' -> heqs /=]:= wi2i_write_vars hsizei (esym htys) hfipar (eqst_init hscs hmem) hw.
+  move: hassert; rewrite /= mapM_cat; t_xrbindP => ? hassert _ _ _.
+  apply: wi2i_a_andP heqs hfpre hassert.
+Qed.
+
+Lemma eq_to_etype_eval s1 s2 ty1 ty2 :
+  to_etype s1 ty1 = to_etype s2 ty2 -> eval_atype ty1 = eval_atype ty2.
+Proof.
+  by case: ty1 ty2 => [||w1 len1|w1] [||w2 len2|w2] //= [] h1 h2; rewrite h2 ?h1.
+Qed.
+
+Lemma wi2i_sem_post fn fsig vsi vs fri fr:
+  sigs fn = Some fsig →
+  vs_pre fsig.1 vsi vs →
+  fs_rel (vs_post fsig.2) fri fr →
+  sem_post pi fn vsi fri = ok tt → sem_post p fn vs fr = ok tt.
+Proof.
+  move=> hfsig [hsub1 hval1] [hscs hmem [heq2 hval2]]; rewrite /sem_post /=.
+  case hfdi : get_fundef => [fdi | //].
+  have [[fi fc ftyi fpar fbod ftyo fres fex] + hfd] := hp' hfdi.
+  have /= := hsig hfd.
+  rewrite hfsig => -[?]; subst fsig.
+  rewrite hfd /wi2i_fun /= /get_sig hfsig /= => /add_funnameP {hfd}; t_xrbindP.
+  move=> fc' hfc' /andP [/eqP hsizei /eqP hsizeo] _ _ _ _ _ _ <- /=.
+  case: fc hfc' => [fc | //]; t_xrbindP => fci + <-.
+  rewrite /wi2i_ci; t_xrbindP => fpre' hfpre fpre_range hfpre_range fpost' hfpost fpost_range hfpost_range fipar hfipar hires hfires <-.
+  move=> vparitr hvpari si_ hw1 si hw2 ? hassert _.
+  rewrite hval1 -map_comp in hvpari.
+  have [vs' -> [? htys]] := esubtype_truncate_vals hsizei hsub1 hvpari => /=; subst vparitr.
+  have [s' -> heqs' /=]:= wi2i_write_vars hsizei (esym htys) hfipar (eqst_init hscs hmem) hw1.
+  have [hftyo hsize] : map type_of_val (fvals fr) = map eval_atype ftyo /\
+                       size fres = size [seq type_of_val i | i <- fvals fr].
+  + elim : (fres) (ftyo) (fvals fr) hsizeo heq2 => [|x xs hrec] [|ty tys] //= [|vr vrs] //=.
+    1,2: by move=> _ /List_Forall2_inv.
+    move=> [/hrec{}hrec] /List_Forall2_inv [] [ty0 h1 h2] /hrec [] -> ->.
+    by rewrite -(to_atypeK (sign_of_var m x) ty) h1 to_atypeK (eq_to_etype_eval h2).
+  rewrite hval2 /= in hw2.
+  rewrite hftyo size_map in hsize.
+  have [s -> heqs /=] := wi2i_write_vars hsize hftyo hfires heqs' hw2.
+  move: hassert; rewrite /= mapM_cat; t_xrbindP => ? hassert _ _ _.
+  apply: wi2i_a_andP heqs hfpost hassert.
+Qed.
+
+Lemma wi2i_get_var_is msg xs tys xis vis vis' si s :
+  let etys := map2 (λ (x : var_i) ty, to_etype (sign_of_var m x) ty) xs tys in
+  let f_tyout := map (λ ety, wi2i_type (sign_of_etype ety) (to_atype ety)) etys in
+  eqst tt si s →
+  size xs = size tys →
+  mapM2 msg (fun ety x => assert (esubtype ety (etype_of_var m x)) (E.ierror_lv x) >> wi2i_vari m FV x)
+    etys xs = ok xis →
+  get_var_is (~~ direct_call) (evm si) xis = ok vis →
+  mapM2 ErrType dc_truncate_val (map eval_atype f_tyout) vis = ok vis' →
+  exists vs vs',
+    [/\ get_var_is (~~ direct_call) (evm s) xs = ok vs
+      , mapM2 ErrType dc_truncate_val (map eval_atype tys) vs = ok vs'
+      , vis' =  map2 (λ ety v, val_to_int (sign_of_etype ety) v) etys vs'
+      &  List.Forall2 (fun ety v => exists2 ty, type_of_val v = eval_atype ty &
+                                      ety = to_etype (sign_of_etype ety) ty) etys vs'].
+Proof.
+  move=> /= heqs; rewrite /get_var_is /=.
+  elim: xs tys xis vis vis' => [|x xs hrec] [| ty tys] xis_ vis_ vis'_ //=.
+  + by move=> _ [<-] [<-] [<-]; exists [::], [::].
+  move=> [hsize]; t_xrbindP => xi hsub hxi xis hxis <- /=.
+  t_xrbindP => vi hvi vis hvis <-; t_xrbindP.
+  move=> vi' htr vis' htrs <-.
+  have [v hv ? /=]:= wi2i_variP heqs hxi hvi; rewrite hv; subst vi.
+  have /(_ ty vi') := esubtype_truncate_val _ _ (get_var_type_of hv).
+  rewrite to_atypeK -(esubtype_sign_of hsub) sign_of_etype_var in htr.
+  rewrite sign_of_etype_var => /(_ hsub htr) [v' htr' ?]; subst vi'.
+  have [vs [vs' [-> htrs' ? hsubs /=]]] := hrec _ _ _ _ hsize hxis hvis htrs; subst vis'.
+  exists (v :: vs), (v' :: vs'); split => //.
+  + by rewrite /dc_truncate_val htr' /= htrs'.
+  + by rewrite -(esubtype_sign_of hsub) sign_of_etype_var.
+  constructor => //.
+  rewrite (truncate_val_has_type htr') -(esubtype_sign_of hsub) sign_of_etype_var.
+  by exists ty.
+Qed.
+
+(* FIXME: TODO move this in psem *)
+Lemma sem_cond_with_scs gd e s scs:
+  sem_cond gd e s = sem_cond gd e (with_scs s scs).
+Proof. by rewrite /sem_cond -sem_pexpr_with_scs. Qed.
+
+(* FIXME: TODO move this in psem *)
+Lemma eandP_inv gd e1 e2 s b :
+  sem_cond gd (eand e1 e2) s = ok b ->
+  (Let b1 := sem_cond gd e1 s in
+   Let b2 := sem_cond gd e2 s in
+   ok (b1 && b2)) = ok b.
+Proof.
+  rewrite /eand /sem_cond /= /sem_sop2 /=; t_xrbindP.
+  by move=> > -> /= > -> /= > -> > -> <- [<-].
+Qed.
+
+Lemma eandP gd e1 e2 s b1 b2 :
+  sem_cond gd e1 s = ok b1 ->
+  sem_cond gd e2 s = ok b2 ->
+  sem_cond gd (eand e1 e2) s = ok (b1 && b2).
+Proof.
+  rewrite /eand /sem_cond /= /sem_sop2 /=; t_xrbindP.
+  by move=> > -> /= > -> > -> /= ->.
+Qed.
+
+Lemma eands_consP_inv gd e1 e2 s b :
+  sem_cond gd (eands (e1 :: e2)) s = ok b ->
+  (Let b1 := sem_cond gd e1 s in
+   Let b2 := sem_cond gd (eands e2) s in
+   ok (b1 && b2)) = ok b.
+Proof.
+  case: e2.
+  + by move=> ->; rewrite eandsE_nil /= andbT.
+  by move=> e2 es2 /eandP_inv.
+Qed.
+
+Lemma eands_consP gd e1 e2 s b1 b2 :
+  sem_cond gd e1 s = ok b1 ->
+  sem_cond gd (eands e2) s = ok b2 ->
+  sem_cond gd (eands (e1 :: e2)) s = ok (b1 && b2).
+Proof.
+  case: e2.
+  + by rewrite eandsE_nil eandsE_1 => -> [<-]; rewrite andbT.
+  move=> e2 es2 /=; apply eandP.
+Qed.
+
+Lemma eands_catP_inv gd e1 e2 s b :
+  sem_cond gd (eands (e1 ++ e2)) s = ok b ->
+  (Let b1 := sem_cond gd (eands e1) s in
+   Let b2 := sem_cond gd (eands e2) s in
+   ok (b1 && b2)) = ok b.
+Proof.
+  elim: e1 b => [| e1 es1 hrec] b_.
+  + by rewrite /= => ->.
+  rewrite cat_cons => /eands_consP_inv.
+  t_xrbindP => b1 hb1 ? /hrec; t_xrbindP => bs1 hbs1 bs2 hbs2 <- <-.
+  by rewrite (eands_consP hb1 hbs1) /= hbs2 /= andbA.
+Qed.
+
+Lemma eands_catP gd e1 e2 s b1 b2 :
+  sem_cond gd (eands e1) s = ok b1 ->
+  sem_cond gd (eands e2) s = ok b2 ->
+  sem_cond gd (eands (e1 ++ e2)) s = ok (b1 && b2).
+Proof.
+  elim: e1 b1 => [|e1 es1 hrec] b1.
+  + by rewrite eandsE_nil /= => -[<-] ->.
+  rewrite cat_cons => /eands_consP_inv.
+  t_xrbindP => ? he1 ? hes1 <- he2; rewrite -andbA.
+  by apply eands_consP => //; apply hrec.
+Qed.
+(* END FIXME *)
+
+Lemma is_polymorphic_opP o :
+  match is_polymorphic_op o with
+  | IsSpill k tys => o = Opseudo_op (Ospill k tys)
+  | IsSwap ty => o = Opseudo_op (Oswap ty)
+  | IsDeclassify ty => o = Opseudo_op (Odeclassify ty)
+  | IsOther => true
+  end.
+Proof. by case: o => // -[]. Qed.
+
+Lemma oto_val_sem_prod_id t (w : sem_t t) : oto_val (sem_prod_id w) = to_val w.
+Proof. by case: t w. Qed.
+
+Lemma wi2i_callP_aux fn : wiequiv_f pi p ev ev (rpreF (eS:= wi2i_spec)) fn fn (rpostF (eS:=wi2i_spec)).
+Proof.
+  apply wequiv_fun_ind_wa => {}fn _ fsi fs [<- [fsig hfsig hrel]] fdi hgeti.
+  have [fd hfdi hget] := hp' hgeti.
+  exists fd => // {hgeti}.
+  move=> hpre; split.
+  + by apply: wi2i_sem_pre hfsig hrel hpre.
+  move=> si hinit.
+  case: hrel => hscs hmem [hsub1 hval1].
+  have /= {hget} := hsig hget.
+  rewrite hfsig => -[?]; subst fsig.
+  case: fd hfsig hval1 hsub1 hfdi => fi fc ftyi fpar fbod ftyo fres fex;
+  rewrite /= /wi2i_fun /get_sig => hfsig.
+  rewrite hfsig => /= hval1 hsub1 /add_funnameP; t_xrbindP.
+  move=> fc' hfc' /andP [/eqP hsizei /eqP hsizeo] ipar hipar ci hci ires hires ?; subst fdi.
+  set fd := {| f_contra := fc |}. set fdi:= {|f_contra := fc'|} => /=.
+  move: hinit; rewrite /initialize_funcall /=; t_xrbindP => vis htr hw.
+  rewrite hval1 -map_comp in htr.
+  have [vs' -> [? htys]] := esubtype_truncate_vals hsizei hsub1 htr; subst vis.
+  have [s /= -> heqs /=] := wi2i_write_vars hsizei (esym htys) hipar (eqst_init hscs hmem) hw.
+  exists s => //; exists (eqst tt), (eqst tt); split => //; last first.
+  + move=> fr1 fr2 [_ [<-]] /=.
+    rewrite hval1 => hfs.
+    by apply (wi2i_sem_post hfsig).
+  + move=> si1 s1 fr1 heqs1; rewrite /finalize_funcall.
+    t_xrbindP => vresi hvresi vresi' {}htr ?; subst fr1.
+    have [vs1 [vs1' [-> /= -> /= ??]]]:= wi2i_get_var_is heqs1 hsizeo hires hvresi htr; subst vresi'.
+    eexists; first reflexivity.
+    eexists; first reflexivity.
+    by case: heqs1 => <- <- _.
+  clear s heqs htys fd fdi hires hipar hsizeo hfsig hval1 hsub1 hfc' hsizei htr hw vs' fc hmem hscs ires
+        ipar fc' fex fres ftyo fpar fi si hpre fsi fs fn.
+  apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {ci fbod hci}; subst Pi_r Pi Pc => /=.
+  + move=> i ii hi ci_; t_xrbindP => sci /add_iinfoP /(hi ii) {}hi <-.
+    rewrite -(cat0s [:: MkI _ _]) -cats1.
+    apply wequiv_cat with (λ si s : estate, eqst tt si s ∧ sem_cond (p_globs pi) (eands sci.1) si = ok true).
+    + by apply safe_assertP.
+    by apply hi.
+  + by move=> ci [<-]; apply wequiv_nil.
+  + move=> i c hi hc ci_; rewrite /wi2i_c /=; t_xrbindP.
+    move=> _ ci /hi{}hi cci hcci <- <-.
+    rewrite /= -cat1s; apply wequiv_cat with (eqst tt) => //.
+    by apply hc; rewrite /wi2i_c hcci.
+  + t_xrbindP => x tg ty e ii sci hsub scx hscx sce hsce <- /=.
+    apply wequiv_assgn_core.
+    move=> si s si' [heqs /eandsE_cat [hsce1 hscx1]]; rewrite /sem_assgn; t_xrbindP.
+    move=> vei hvei vei' htri hwi.
+    have [v hv ?] := wi2i_eP hsce heqs hsce1 hvei; subst vei; rewrite hv /=.
+    have [v' htr' ?]:= esubtype_truncate_val hsub htri (sem_pexpr_type_of hv); rewrite htr' /=; subst vei'.
+    apply: (wi2i_lvP (ety := etype_of_expr m e) (v:=v') heqs _ _ hscx1).
+    + by rewrite (truncate_val_has_type htr').
+    + by apply hscx.
+    by rewrite -(esubtype_sign_of hsub).
+  + t_xrbindP => xs tg o es ii sci sce hsce [otys o'].
+    case: is_polymorphic_op (is_polymorphic_opP o).
+    + move=> k tys -> /=; t_xrbindP => /eqP hsze hsub <- <- /= scx hscx <-.
+      apply wequiv_opn with
+       (fun vsi vs =>
+          map type_of_val vs = map (fun e => eval_atype (to_atype (etype_of_expr m e))) es /\
+          vsi = map2 (λ (e : pexpr) (v : value), val_to_int (sign_of_expr m e) v) es vs)
+       (fun vsi vs => vsi = vs /\
+          map type_of_val vsi = map eval_atype (sopn_tout (Opseudo_op (Ospill k tys)))).
+      + move=> si s vsi [heq /eandsE_cat [] hconde hcondx] hsei.
+        have [vs hse ->]:= wi2i_esP hsce heq hconde hsei.
+        exists vs => //; split => //.
+        elim: (es) vs hse => [|e' es' hrec'] /= vs.
+        + by move=> -[<-].
+        t_xrbindP => v' hv' vs' hvs' <- /=.
+        by rewrite (sem_pexpr_type_of hv') (hrec' _ hvs').
+      + move=> si s [heq /eandsE_cat [] hconde hcondx] ? vs vis [heval ->].
+        rewrite /exec_sopn /= /sopn_sem_ /= /sopn_tout => {hsce}; t_xrbindP.
+        move=> [] h <-.
+        exists [::] => //.
+        elim: tys es vs heval hsze hsub h => [ | ty tys hrect] [| e es] => //=.
+        + by case.
+        case => // v vs [] htof htofs []hsze /andP [hsub1 hsub].
+        t_xrbindP => ov hov h.
+        have {hrect h} := hrect _ _ htofs hsze hsub h.
+        t_xrbindP => -[] -> _.
+        by have [? -> _]:= esubtype_of_val hsub1 hov htof.
+      move=> [|??] _ [<- ] //= _ si s si'.
+      by case: xs hscx => //= -[?]; subst scx => /= -[??] [<-]; exists s.
+    + move=> ty ->; t_xrbindP => hsub <- <-.
+      set (sig := [:: to_etype (sign_of_expr _ _) _; _]).
+      move=> rscx hscx <- /=.
+      apply wequiv_opn with
+       (fun vsi vs =>
+          map type_of_val vs = map (fun e => eval_atype (to_atype (etype_of_expr m e))) es /\
+          vsi = map2 (λ (e : pexpr) (v : value), val_to_int (sign_of_expr m e) v) es vs)
+       (vs_post sig).
+      + move=> si s vsi [heq /eandsE_cat [] hconde hcondx] hsei.
+        have [vs hse ->]:= wi2i_esP hsce heq hconde hsei.
+        exists vs => //; split => //.
+        elim: (es) vs hse => [|e' es' hrec'] /= vs.
+        + by move=> -[<-].
+        t_xrbindP => v' hv' vs' hvs' <- /=.
+        by rewrite (sem_pexpr_type_of hv') (hrec' _ hvs').
+      + move=> si s [heq /eandsE_cat [] hconde hcondx] ? vs vis [heval ->].
+        rewrite /exec_sopn /= /sopn_sem_ /= /sopn_tout /sig => {hsce}; t_xrbindP => {hscx sig}.
+        case: es hsub heval => // e1 [] //=.
+        + by case: vs => // v1 [] //; t_xrbindP.
+        move=> e2 [] //=; last first.
+        + by case: vs => // v1 [] // v2 [] //; t_xrbindP.
+        move=> /and3P [] hsub1 hsub2 _.
+        case: vs => // v1 [] // v2 [] //; t_xrbindP.
+        move=> [htyv1 htyv2] [u1 u2] w1 hw1 w2 hw2 [???]; subst u1 u2 vis.
+        have [w1' -> /= htow1'] := esubtype_of_val hsub1 hw1 htyv1.
+        set u := oto_val (sem_prod_id w1).
+        have hs: sign_of_expr m e1 = sign_of_expr m e2.
+        + by rewrite /sign_of_expr (esubtype_sign_of hsub1) (esubtype_sign_of hsub2).
+        move: w2 hw2 htyv2 hsub2; rewrite hs => w2 hw2 htyv2 hsub2; rewrite /u => {u}.
+        have [w2' -> /= htow2'] := esubtype_of_val hsub2 hw2 htyv2.
+        eexists; eauto; split.
+        + constructor.
+          + exists ty; first by rewrite type_of_oto_val.
+            by rewrite -(esubtype_sign_of hsub2).
+          constructor; last by constructor.
+          exists ty; first by rewrite type_of_oto_val.
+          by rewrite -(esubtype_sign_of hsub2).
+        rewrite /= -(esubtype_sign_of hsub2) !oto_val_sem_prod_id.
+        by rewrite htow1' htow2' -/(sign_of_expr m e1) hs.
+      move=> vs1 vs2 [hall ->] si1 s1 si2 [heqst /eandsE_cat [_ hsc]] hw.
+      by apply: wi2i_lvsP hscx hsc erefl (fun _ => erefl) heqst hw hall.
+   + move=> ty ->; t_xrbindP => hsub <- <- rscx hscx <- /=.
+      apply wequiv_opn with
+       (fun vsi vs =>
+          map type_of_val vs = map (fun e => eval_atype (to_atype (etype_of_expr m e))) es /\
+          vsi = map2 (λ (e : pexpr) (v : value), val_to_int (sign_of_expr m e) v) es vs)
+       (vs_post [::]).
+      + move=> si s vsi [heq /eandsE_cat [] hconde hcondx] hsei.
+        have [vs hse ->]:= wi2i_esP hsce heq hconde hsei.
+        exists vs => //; split => //.
+        elim: (es) vs hse => [|e' es' hrec'] /= vs.
+        + by move=> -[<-].
+        t_xrbindP => v' hv' vs' hvs' <- /=.
+        by rewrite (sem_pexpr_type_of hv') (hrec' _ hvs').
+      + move=> si s [heq /eandsE_cat [] hconde hcondx] ? vs vis [heval ->].
+        rewrite /exec_sopn /= /sopn_sem_ /= /sopn_tout => {hsce hscx}.
+        case: es hsub heval => // e1 [] //=; last first.
+        + by move=> ??; rewrite andbF.
+        case: vs => // v1 [] //.
+        rewrite andbT; t_xrbindP => hsub1 [htyv1] [] w1 hw1 _ ?; subst vis.
+        exists [::] => //.
+        by have [w1' -> /= htow1'] := esubtype_of_val hsub1 hw1 htyv1.
+      move=> vs1 vs2 [hall ->] si1 s1 si2 [heqst /eandsE_cat [_ hsc]] hw.
+      by apply: wi2i_lvsP hscx hsc erefl (fun _ => erefl) heqst hw hall.
+    move=> _; t_xrbindP => hnone <- <- scx hscx <- /=.
+    apply wequiv_opn with eq (fun vs1 vs2 => vs1 = vs2 /\ map type_of_val vs1 = map eval_atype (sopn_tout o)).
+    + by apply wi2i_esP_none.
+    + move=> s1 s2 _ vs ? vs' <- hex; exists vs' => //.
+      by rewrite -(sopn_toutP hex).
+    by move=> vs _ [<- htyof]; apply: wi2i_lvsP_none hscx.
+  + t_xrbindP => xs o es ii sci hnone sce hsce scx hscx <- /=.
+    apply wkequivP' => si0 s0.
+    apply wequiv_syscall with
+     eq (fun fs1 fs2 => [/\ fs1 = fs2, emem si0 = fmem fs1
+                          & map type_of_val fs1.(fvals) = map eval_atype (scs_tout (syscall_sig_u o))]).
+    + apply wrequiv_weaken with
+        (fun si s => eqst tt si s ∧ sem_cond gd (eands (sce.1 ++ scx.1)) si = ok true) eq => //.
+      + by move=> ?? [].
+      by apply wi2i_esP_none.
+    + rewrite /mk_fstate => s1 s2 [[<- _]] [[<- <- _] _] fs ? fvs' <- hex; exists fvs' => //.
+      by have /= [] := syscall_u_toutP hex.
+    move=> fs1 _ [<- hmem htyof] si s si' [[??] hpre]; rewrite /upd_estate; subst si0 s0.
+    have /(_ sce.1) := (wi2i_lvsP_none htyof hscx); apply.
+    rewrite -hmem with_mem_same.
+    by case: hpre => -[_ ? ? hsc]; split => //; rewrite -sem_cond_with_scs.
+  + move=> a ii sci; rewrite /wi2i_a_and; t_xrbindP.
+    move=> ? [sc ai] ha <- <- /=.
+    apply wequiv_assert => //.
+    move=> _; split => //.
+    move=> si s [heqs _].
+    rewrite -cats1 eandsE_cat eandsE_1 => -[] hsc hai.
+    by rewrite (wi2i_condP ha heqs hsc hai).
+  + move=> e c1 c2 hc1 hc2 ii sci_; t_xrbindP => sce hsce ci1 /hc1{}hc1 ci2 /hc2{}hc2 <- /=.
+    apply wequiv_if.
+    + by move=> ??? [heqs hsc1] hsc; have := (wi2i_condP hsce heqs hsc1 hsc); eauto.
+    move=> b; apply wequiv_weaken with (eqst tt) (eqst tt) => //; first by move=> ??[].
+    by case: b.
+  + move=> x dir lo hi c hc ii sci_; t_xrbindP.
+    move=> /and4P [hfv /eqP htx /eqP htlo /eqP hthi] sclo hsclo schi hschi ci /hc{}hc <- /=.
+    apply wequiv_for_eq with (eqst tt) => //.
+    + by move=> > [].
+    + move=> si s vis [heqs /eandsE_cat [hsclo1 hschi1] /=]; t_xrbindP.
+      move=> vilo hvilo ? vihi hvihi <- <-.
+      have [vlo hvlo ->] := wi2i_eP hsclo heqs hsclo1 hvilo.
+      have [vhi hvhi ->] := wi2i_eP hschi heqs hschi1 hvihi.
+      by rewrite /= hvlo hvhi /sign_of_expr /= htlo hthi /= !val_to_int_None; eauto.
+    move=> i si s si' heqs hw.
+    have [ |s' -> ?]:=  wi2i_lvarP_None heqs hfv _ hw; last by eauto.
+    by move: (hwf_m x); case: (m x) => // -[??] []; rewrite htx.
+  + move=> al c e ii' c' hc hc' ii sci_; t_xrbindP.
+    move=> sce hsce ci /hc{}hc ci' /hc'{}hc' <- /=.
+    apply wequiv_weaken with (eqst tt) (λ si s, eqst tt si s ∧ sem_cond (p_globs pi) (eands sce.1) si = ok true).
+    1-2: by move=> > [].
+    apply wequiv_while.
+    + by move=> ??? [heqs hsc1] hsc; have := (wi2i_condP hsce heqs hsc1 hsc); eauto.
+    + by rewrite -(cats0 c); apply wequiv_cat with (eqst tt) => //; apply: safe_assertP.
+    by apply wequiv_weaken with (eqst tt) (eqst tt) => // > [].
+  move=> xs f es ii sci_; t_xrbindP.
+  move=> fsig hgetsig hsub sce hsce scx hscx <- /=.
+  move: hgetsig; rewrite /get_sig; case heq : sigs => [a|] // [?]; subst a.
+  apply wequiv_call_wa with (rpreF (eS:= wi2i_spec)) (rpostF (eS:=wi2i_spec)) (vs_pre fsig.1).
+  + move=> si s vis [heqs /eandsE_cat [hsce1 _]] hsce2.
+    have [vs hes ->] := wi2i_esP hsce heqs hsce1 hsce2; rewrite /vs_pre hes; exists vs => //.
+    clear hsce.
+    elim: fsig.1 es vs hsub hes => [|ety tin hrec1] [|e es] //=; t_xrbindP.
+    + by move=> _ _ <-.
+    move=> vs_ /andP [hsub hsubs] v hv vs hvs <-.
+    have [hall ->] := hrec1 _ _ hsubs hvs.
+    rewrite -(esubtype_sign_of hsub); split => //; constructor => //.
+    rewrite (sem_pexpr_type_of hv).
+    exists (to_atype (etype_of_expr m e)) => //.
+    by rewrite -(esubtype_sign_of hsub) to_etype_to_atype.
+  + by move=> si s vis vs [[???] _] hvs; apply (wi2i_sem_pre heq).
+  + by move=> si s vis vs [[???] _] ?; split => //; exists fsig.
+  + by move=> fsi fs fri fr [_ [x]] + + [x']; rewrite heq => -[<-] [?? +] [<-]; apply wi2i_sem_post.
+  + by move=> ???; apply wequiv_fun_rec.
+  move=> fsi fs fri fr [_ [x]] ++ [x']; rewrite heq => -[<-] [_ _ hpre] [<-] [?? [hall hfvals]].
+  move=> si s si' [[_ _ hvm] /eandsE_cat [_ hscx1]]; rewrite /upd_estate hfvals in hall |- * => hw.
+  by apply: (wi2i_lvsP hscx hscx1 _ _ _ hw).
+Qed.
+
+End M.
+
+Section FINAL.
+
+Lemma build_infoP (info : var → option (signedness * var)) FV m :
+  build_info info FV = ok m ->
+  wf_m m FV /\ forall x, Sv.In x FV -> m x = info x.
+Proof.
+  rewrite /build_info; t_xrbindP => -[FV' m'] /= + <-.
+  set f := (f in foldM f _ _).
+  have :
+    forall xs (xs':seq var) FV1 FV2 m1 m2,
+      Sv.Subset FV FV1 →
+      (forall x, x \in xs → Sv.In x FV) →
+      (forall x, Sv.In x FV → (x \in xs') || (x \in xs)) →
+      (forall x, x \in xs' → Mvar.get m1 x = info x) →
+      (forall x xi, Mvar.get m1 x = Some xi -> x \in xs' /\ Sv.In xi.2 FV1) →
+      wf_m (Mvar.get m1) FV →
+      foldM f (FV1, m1) xs = ok (FV2, m2) →
+      wf_m (Mvar.get m2) FV ∧ ∀ x : Sv.elt, Sv.In x FV → Mvar.get m2 x = info x.
+  + elim => [| x xs hrec] xs' FV1 FV2 m1 m2 hsub hin hor hget hget' hwf /=.
+    + by move=> [_ <-]; split => // x /hor; rewrite orbC => /hget.
+    t_xrbindP => -[FV1' m1']; rewrite {1}/f.
+    case heq: info => [[sg xi] | ]; last first.
+    + move=> [<- <-] /(hrec (x::xs')) [] //.
+      + by move=> z hz; apply hin; rewrite in_cons hz orbT.
+      + by move=> z /hor; rewrite !in_cons; case: eqP.
+      + move=> z; rewrite in_cons => /orP [/eqP |] ?; last by apply hget.
+        subst z; case h : Mvar.get => [ xi| //].
+        by rewrite -h; apply hget; case: (hget' _ _ h).
+      by move=> z xi /hget' []; rewrite in_cons => ->; rewrite orbT.
+    case hw: is_word_type => [ws|] //=; t_xrbindP => /andP[htxi /Sv_memP hxi].
+    have htx := is_word_typeP hw.
+    move=> <- <- /(hrec (x::xs')) [] //.
+    + by SvD.fsetdec.
+    + by move=> z hz; apply hin; rewrite in_cons hz orbT.
+    + by move=> z /hor; rewrite !in_cons; case: eqP.
+    + move=> z; rewrite in_cons Mvar.setP eq_sym.
+      case: eqP => /=; first by move=> <-; rewrite heq.
+      by move=> _; apply hget.
+    + move=> z sz; rewrite Mvar.setP; case: eqP.
+      + by move=> <- [<-]; rewrite in_cons eqxx; split => //=; SvD.fsetdec.
+      by rewrite in_cons => _ /hget' [] ->; rewrite orbT; split => //; SvD.fsetdec.
+    move=> z; rewrite Mvar.setP; case: eqP => [<- | hne].
+    + rewrite htx; split => //.
+      + have := convertible_subatype htxi.
+        by case: vtype.
+      move=> y hxy hiny.
+      rewrite Mvar.setP_neq; last by apply/eqP.
+      case: Mvar.get (hget' y).
+      + by move=> [sy yi] /(_ _ erefl) /= [_ hinyi] heqy; apply hxi; rewrite heqy.
+      move=> _ heqy;apply hxi; rewrite heqy.
+      move/Sv_memP: hiny; SvD.fsetdec.
+    have := hwf z.
+    case heqz: Mvar.get => [[sgz zi] | ] => //.
+    move=> [?? h]; split => // y hzy hiny.
+    rewrite Mvar.setP; case: eqP => hxy; last by apply h.
+    by have [/= _ hinzi]:= hget' _ _ heqz; SvD.fsetdec.
+  move=> h {}/h -/(_ [::]) [] //.
+  + by move=> ? /Sv_elemsP.
+  by move=> ? /Sv_elemsP ->.
+Qed.
+
+Lemma wi2w_callP (get_info : _uprog → Sv.t * (var → option (signedness * var))) pi :
+  wi2i_prog get_info p = ok pi ->
+  forall fn fd, get_fundef (p_funcs p) fn = Some fd ->
+  let info := (get_info p).2 in
+  let fsig := (build_sig info (fn, fd)).2 in
+  wiequiv_f pi p ev ev
+     (λ _ _ fs1 fs2, fs_rel (vs_pre fsig.1) fs1 fs2)
+     fn fn
+     (λ _ _ _ _ fr1 fr2, fs_rel (vs_post fsig.2) fr1 fr2).
+Proof.
+  rewrite /wi2i_prog.
+  case: get_info => FV info; t_xrbindP.
+  move=> M /build_infoP [hwf_m hMeq] /Sv.subset_spec hFVsub.
+  move=> p_funcsi heqp' <-.
+  have hp' := get_map_cfprog_name_gen' heqp'.
+  move=> fn fd hfn.
+  have hsigs : ∀ fn fd,
+    get_fundef (p_funcs p) fn = Some fd →
+    get_fundef [seq build_sig info i | i <- p_funcs p] fn =
+       Some
+          (map2 (λ (x : var_i) (ty : atype), to_etype (sign_of_var M x) ty) (f_params fd) (f_tyin fd),
+           map2 (λ (x : var_i) (ty : atype), to_etype (sign_of_var M x) ty) (f_res fd) (f_tyout fd)).
+  + move=> fn' fd' hfn'.
+    rewrite /get_fundef assoc_mapE; last by move=> ? [].
+    rewrite -/(get_fundef (p_funcs p) fn') hfn' /= /build_sig /=.
+    case: fd' hfn' => /= finfo fci ftyin fparams fbody ftyout fres fextra hfn'.
+    have heq : forall xs ty,
+      (forall x, x \in map v_var xs -> Sv.In x FV) ->
+      map2 (λ (x : var_i) (ty : atype), to_etype (sign_of_var info x) ty) xs ty =
+      map2 (λ (x : var_i) (ty : atype), to_etype (sign_of_var M x) ty) xs ty.
+    + elim => [|x xs hrec] [|t ts] => //= hin.
+      rewrite hrec.
+      + by rewrite /sign_of_var hMeq //; apply hin; rewrite in_cons eqxx.
+      by move=> z h; apply hin; rewrite in_cons h orbT.
+    have /(_ _ _ _ hfn') := [elaborate vars_pP].
+    rewrite /vars_fd /=.
+    have vars_lP: forall l, Sv.Equal (vars_l l) (sv_of_list v_var l).
+    + by elim => //= ?? ->; rewrite sv_of_list_cons.
+    rewrite !vars_lP => hsub.
+    by rewrite !heq // => z /sv_of_listP; SvD.fsetdec.
+  have hsig : get_fundef [seq build_sig info i | i <- p_funcs p] fn = Some (build_sig info (fn, fd)).2.
+  + rewrite /get_fundef assoc_mapE; last by move=> ? [].
+    by rewrite -/(get_fundef (p_funcs p) fn) hfn.
+  have /(_ fn) := wi2i_callP_aux hwf_m hsigs hp'.
+  apply: wkequiv_io_weaken => //.
+  + by move=> fsi fs ?;split => //; eexists; first apply hsig.
+  by move=> fsi fs fri fr _ [?]; rewrite hsig => -[<-].
+Qed.
+
+End FINAL.
+End PROOF.
diff --git a/proofs/compiler/wint_word.v b/proofs/compiler/wint_word.v
index cfa1f919f0..bad22991c8 100644
--- a/proofs/compiler/wint_word.v
+++ b/proofs/compiler/wint_word.v
@@ -11,6 +11,9 @@ Require Import flag_combination.
 Local Open Scope seq_scope.
 Local Open Scope Z_scope.
 
+(* This pass is used as a first step for the compilation.
+   It replaces wint operator by the corresponding word operator
+ *)
 
 Definition wi2w_wiop1 s (o : wiop1) (e : pexpr) : pexpr :=
   match o with
@@ -61,6 +64,9 @@ Fixpoint wi2w_e (e: pexpr) : pexpr :=
   | Papp2 o e1 e2 => Papp2 (wi2w_op2 o) (wi2w_e e1) (wi2w_e e2)
   | PappN o es => PappN o (map wi2w_e es)
   | Pif ty e1 e2 e3 => Pif ty (wi2w_e e1) (wi2w_e e2) (wi2w_e e3)
+  | Pbig ei o v e es el => Pbig (wi2w_e ei) (wi2w_op2 o) v (wi2w_e e) (wi2w_e es) (wi2w_e el)
+  | Pis_var_init _ => e
+  | Pis_mem_init e1 e2 => Pis_mem_init (wi2w_e e1) (wi2w_e e2)
   end.
 
 Definition wi2w_lv (x : lval) : lval :=
diff --git a/proofs/compiler/wint_word_proof.v b/proofs/compiler/wint_word_proof.v
index 169ec24f87..d4dbb18bcf 100644
--- a/proofs/compiler/wint_word_proof.v
+++ b/proofs/compiler/wint_word_proof.v
@@ -66,7 +66,7 @@ Section E.
       by (eexists; first reflexivity) => /=.
     + move=> o e he v v1 /he{he} [v' he hu].
       rewrite /sem_sop1 /=; t_xrbindP => + /(of_value_uincl_te hu).
-      case: o => [sz | si sz | si sz | si sz | | sz | [ | sz] | sg o] /=;
+      case: o => [sz | si sz | si sz | si sz | | sz | [ | sz] | sg o ] /=;
         rewrite /= ?he /sem_sop1 /=; t_xrbindP;
         try by move=> > -> /= > [->] <-; (eexists; first reflexivity) => /=.
       case: o => /=; rewrite he /sem_sop1 /=.
@@ -123,7 +123,6 @@ Section E.
            case: si => //=; rewrite ?(Z.gtb_ltb, Z.geb_leb) //.
     + move=> op es hes v vs /hes [vs']; rewrite /sem_pexprs => -> /= hus hs.
       by rewrite (vuincl_sem_opN hus hs); eexists; first reflexivity.
-
     move=> t e he e1 he1 e2 he2 v b v0 /he [v0' -> hu0].
     move=> /to_boolI => ?; subst v0.
     have ? := value_uinclE hu0; subst v0'.
@@ -345,7 +344,7 @@ Proof.
   + by rewrite get_map_prog Hfun.
   move=> {Hfun}.
   case: f htra Hi Hw Hc Hres Hfull Hfi hfun' => /=.
-  move=> info tyin params body tyout res extra htra hi hw hc hres hfull hfi hfun'.
+  move=> info fci tyin params body tyout res extra htra hi hw hc hres hfull hfi hfun'.
   have [vargs2 {}htra hu1] := mapM2_dc_truncate_val htra hu.
   have [vm1 {}hw hu2] := [elaborate write_vars_uincl (vm_uincl_refl _) hu1 hw].
   have [vm' {}hc hu3] := hc _ hu2.
diff --git a/proofs/compiler/x86_extra.v b/proofs/compiler/x86_extra.v
index f1e3114122..8a44180442 100644
--- a/proofs/compiler/x86_extra.v
+++ b/proofs/compiler/x86_extra.v
@@ -76,26 +76,26 @@ Definition Oset0_instr sz  :=
              (let vf := Some false in
               let vt := Some true in
               (::vf, vf, vf, vt, vt & (0%w: word sz)))
-              true
+              true [:: IBool true; IBool true; IBool true; IBool true; IBool true; IBool true]
   else
     mk_instr_desc_safe (pp_sz "set0" sz)
              [::] [::]
              (map atype_of_ltype (w_ty sz)) [::E 0]
-             (0%w: word sz) true.
+             (0%w: word sz) true [:: IBool true].
 
 Definition Oconcat128_instr :=
   mk_instr_desc_safe (pp_s "concat_2u128")
            [:: aword U128; aword U128 ] [:: E 1; E 2]
            [:: aword U256] [:: E 0]
            (λ h l : u128, make_vec U256 [::l;h])
-           true.
+           true [:: IBool true]. 
 
 Definition Ox86MOVZX32_instr :=
   mk_instr_desc_safe (pp_s "MOVZX32")
            [:: aword U32] [:: E 1]
            [:: aword U64] [:: E 0]
            (λ x : u32, zero_extend U64 x)
-           true.
+           true [:: IBool true].
 
 Definition x86_MULX sz (v1 v2: word sz) : tpl (w2_ty sz sz) :=
   wumul v1 v2.
@@ -105,7 +105,7 @@ Definition Ox86MULX_instr sz :=
    mk_instr_desc_safe (pp_sz name sz)
         [:: aword sz; aword sz] [::ADImplicit (to_var RDX); E 2]
         [:: aword sz; aword sz] [:: E 0; E 1] (* hi, lo *)
-        (@x86_MULX sz) (size_32_64 sz).
+        (@x86_MULX sz) (size_32_64 sz) [:: IBool true; IBool true].
 
 Definition x86_MULX_hi sz (v1 v2: word sz) : tpl (w_ty sz) :=
   wmulhu v1 v2.
@@ -115,8 +115,7 @@ Definition Ox86MULX_hi_instr sz :=
    mk_instr_desc_safe (pp_sz name sz)
         [:: aword sz; aword sz] [::ADImplicit (to_var RDX); E 1]
         [:: aword sz] [:: E 0]
-        (@x86_MULX_hi sz) (size_32_64 sz).
-
+        (@x86_MULX_hi sz) (size_32_64 sz) [:: IBool true].
 
 Definition Ox86SLHinit_str := append "Ox86_" SLHinit_str.
 Definition Ox86SLHinit_instr :=
@@ -126,7 +125,8 @@ Definition Ox86SLHinit_instr :=
       [:: ty_msf ]
       [:: E 0 ]
       se_init_sem
-      true.
+      true
+      [:: IBool true].
 
 Definition x86_se_update_sem (b:bool) (w: wmsf) : wmsf * wmsf :=
   let aux :=  wrepr Uptr (-1) in
@@ -141,7 +141,8 @@ Definition Ox86SLHupdate_instr :=
                 [:: ty_msf; ty_msf]
                 [:: E 2; E 1]
                 x86_se_update_sem
-                true.
+                true
+                [:: IBool true; IBool true].
 
 Definition Ox86SLHmove_str := append "Ox86_" SLHmove_str.
 Definition Ox86SLHmove_instr :=
@@ -151,7 +152,8 @@ Definition Ox86SLHmove_instr :=
       [:: ty_msf ]
       [:: E 0 ]
       se_move_sem
-      true.
+      true
+      [:: IBool true].
 
 Definition se_protect_small_sem
   (ws:wsize) (w:word ws) (msf:word ws) : (sem_ltuple (b5w_ty ws)) :=
@@ -178,6 +180,7 @@ Definition Ox86SLHprotect_instr rk :=
       [:: E 0 ]
       (@se_protect_mmx_sem ws)
       (ws == reg_size)
+      [:: IBool true]
   else if (ws <= Uptr)%CMP then
     mk_instr_desc_safe (pp_sz SLHprotect_str ws)
                   [:: aword ws; aword ws]
@@ -186,6 +189,7 @@ Definition Ox86SLHprotect_instr rk :=
                   out
                   (@se_protect_small_sem ws)
                   true
+                  [:: IBool true; IBool true; IBool true; IBool true; IBool true; IBool true]
   else
     mk_instr_desc_safe (pp_sz SLHprotect_str ws)
                   [:: aword ws; ty_msf]
@@ -193,7 +197,8 @@ Definition Ox86SLHprotect_instr rk :=
                   [:: aword ws; aword ws]
                   [:: E 2; E 0]
                   (@se_protect_large_sem ws)
-                  (Uptr < ws)%CMP.
+                  (Uptr < ws)%CMP
+                  [:: IBool true; IBool true].
 
 Definition get_instr_desc o :=
   match o with
diff --git a/proofs/compiler/x86_instr_decl.v b/proofs/compiler/x86_instr_decl.v
index 0b64ed1da1..daad43b802 100644
--- a/proofs/compiler/x86_instr_decl.v
+++ b/proofs/compiler/x86_instr_decl.v
@@ -2,7 +2,7 @@ From elpi.apps Require Import derive.std.
 From HB Require Import structures.
 From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype tuple.
 From mathcomp Require Import ssralg word word_ssrZ.
-Require Import utils strings word waes sha256 sem_type global oseq sopn.
+Require Import utils strings word waes sha256 sem_type global oseq sopn operators.
 Import Utf8 Relation_Operators ZArith.
 
 Require Import arch_utils.
@@ -380,11 +380,45 @@ Definition iCF := F CF.
 
 (* -------------------------------------------------------------------- *)
 
+Definition x86_shift_mask_int (s:wsize) : Z :=
+  match s with
+  | U8 | U16 | U32 =>  31
+  | U64  => 63
+  | U128 => 127
+  | U256 => 255
+  end%Z.
+
+Definition x86_shift_mask (s:wsize) : u8 :=
+  wrepr U8 (x86_shift_mask_int s).
+
+Definition iweq sz ic1 ic2:= IOp2 (Oeq (Op_w sz)) ic1 ic2.
+Definition iwneq sz ic1 ic2:= IOp2 (Oneq (Op_w sz)) ic1 ic2.
+
+Definition get_init_cond_x86_shift_mask (s:wsize) n :=
+  IOp2 (Oland s) (IVar n) (IConst (x86_shift_mask_int s)).
+
+Definition get_init_cond_x86_rotate_with_carry (s:wsize) n :=
+  let i := get_init_cond_x86_shift_mask s n in
+  match s with
+    | U8 => IOp2 (Omod Unsigned Op_int) (IOp1 (Oint_of_word Unsigned s) (IVar n)) (IConst 9)
+    | U16 => IOp2 (Omod Unsigned Op_int) (IOp1 (Oint_of_word Unsigned s) (IVar n)) (IConst 17)
+    | _  => IOp1 (Oint_of_word Unsigned s) (IVar n)
+  end.
+
+Definition x_86_shift_mask_OF_condition (s:wsize) n :=
+  let i := get_init_cond_x86_shift_mask s n in
+  iweq s i (IOp1 (Oword_of_int s) (IConst 1)).
+
+Definition x_86_shift_mask_other_flags_condition (s:wsize) n :=
+  let i := get_init_cond_x86_shift_mask s n in
+  iwneq s i (IOp1 (Oword_of_int s) (IConst 0)).
+(* -------------------------------------------------------------------- *)
+
 Definition reg_msb_flag (sz : wsize) :=
   if (sz <= U16)%CMP then MSB_MERGE
   else MSB_CLEAR.
 
-Notation mk_instr str_jas tin tout ain aout msb semi args_kinds nargs safe_cond valid pp_asm safe_wf semi_errty semi_safe :=
+Notation mk_instr str_jas tin tout ain aout msb semi args_kinds nargs safe_cond init_cond valid pp_asm safe_wf semi_errty semi_safe :=
  {|
   id_valid      := valid;
   id_msb_flag   := msb;
@@ -399,6 +433,7 @@ Notation mk_instr str_jas tin tout ain aout msb semi args_kinds nargs safe_cond
   id_check_dest := refl_equal;
   id_str_jas    := str_jas;
   id_safe       := safe_cond;
+  id_init       := init_cond;
   id_pp_asm     := pp_asm;
   id_safe_wf    := safe_wf;
   id_semi_errty := semi_errty;
@@ -406,100 +441,100 @@ Notation mk_instr str_jas tin tout ain aout msb semi args_kinds nargs safe_cond
 |}.
 
 (* Can only be use for safe instruction *)
-Notation mk_instr_safe str_jas tin tout ain aout msb semi args_kinds nargs valid pp_asm :=
-  (mk_instr str_jas tin tout ain aout msb (sem_lprod_ok tin semi) args_kinds nargs [::] valid pp_asm
+Notation mk_instr_safe str_jas tin tout ain aout msb semi args_kinds nargs valid pp_asm init_cond :=
+  (mk_instr str_jas tin tout ain aout msb (sem_lprod_ok tin semi) args_kinds nargs [::] init_cond valid pp_asm
     refl_equal
     (fun _ => sem_lprod_ok_error tin semi)
     (fun _ => sem_lprod_ok_safe tin semi))
   (only parsing).
 
 (* Can only be use for safe instruction *)
-Notation mk_instr_pp name tin tout ain aout msb semi check nargs prc pp_asm :=
-  (mk_instr_safe (pp_s name%string) tin tout ain aout msb semi check nargs true pp_asm,
+Notation mk_instr_pp name tin tout ain aout msb semi check nargs prc pp_asm init_cond :=
+  (mk_instr_safe (pp_s name%string) tin tout ain aout msb semi check nargs true pp_asm init_cond,
    (name%string, prc)) (only parsing).
 
 (* Can only be use for safe instruction *)
 Notation mk_instr_w_w name semi ain aout nargs check prc valid pp_asm :=
  ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w_ty sz) (w_ty sz) ain aout (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz)), (name%string,prc)) (only parsing).
+  mk_instr_safe (pp_sz name sz) (w_ty sz) (w_ty sz) ain aout (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz) [::IBool true]), (name%string,prc)) (only parsing).
 
 Notation mk_instr_w_w'_10 name sign semi check prc valid pp_asm :=
  ((fun szo szi =>
-  mk_instr_safe (pp_sz_sz name sign szo szi) (w_ty szi) (w_ty szo) [:: Eu 1] [:: Eu 0] (reg_msb_flag szo) (semi szi szo) (check szi szo) 2 (valid szi szo) (pp_asm szi szo)), (name%string,prc)) (only parsing).
+  mk_instr_safe (pp_sz_sz name sign szo szi) (w_ty szi) (w_ty szo) [:: Eu 1] [:: Eu 0] (reg_msb_flag szo) (semi szi szo) (check szi szo) 2 (valid szi szo) (pp_asm szi szo) [::IBool true]), (name%string,prc)) (only parsing).
 
 Notation mk_instr_bw2_w_0211 name semi check prc valid pp_asm :=
  ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (bw2_ty sz) (w_ty sz) [:: Ea 0; Eu 2; Ea 1] [:: Ea 1] (reg_msb_flag sz) (semi sz) (check sz) 3 (valid sz) (pp_asm sz)), (name%string, prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (bw2_ty sz) (w_ty sz) [:: Ea 0; Eu 2; Ea 1] [:: Ea 1] (reg_msb_flag sz) (semi sz) (check sz) 3 (valid sz) (pp_asm sz) [::IBool true]), (name%string, prc))  (only parsing).
 
-Notation mk_instr_w_b5w name semi ain aout nargs check prc valid pp_asm :=
+Notation mk_instr_w_b5w name semi ain aout nargs check prc valid pp_asm init_cond :=
  ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w_ty sz) (b5w_ty sz) ain (implicit_flags ++ aout) (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w_ty sz) (b5w_ty sz) ain (implicit_flags ++ aout) (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz) init_cond), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w_b4w_00 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w_ty sz) (b4w_ty sz) [:: Eu 0] (implicit_flags_noCF ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 1 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w_ty sz) (b4w_ty sz) [:: Eu 0] (implicit_flags_noCF ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 1 (valid sz) (pp_asm sz)[::IBool true; IBool true; IBool true; IBool true ; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2_b name semi ain aout nargs check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b_ty) ain aout (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz)(pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b_ty) ain aout (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz)(pp_asm sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2_b5 name semi ain nargs check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5_ty) ain implicit_flags (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5_ty) ain implicit_flags (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz) [::IBool true; IBool true; IBool true; IBool true; IBool true]), (name%string,prc))  (only parsing).
 
-Notation mk_instr_w2_b5w name semi ain aout nargs check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5w_ty sz) ain (implicit_flags ++ aout) (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+Notation mk_instr_w2_b5w name semi ain aout nargs check prc valid pp_asm init_cond:= ((fun sz =>
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5w_ty sz) ain (implicit_flags ++ aout) (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz) init_cond), (name%string,prc))  (only parsing).
 
-Notation mk_instr_w2_b5w_010 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5w_ty sz) [:: Eu 0; Eu 1] (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc)) (only parsing).
+Notation mk_instr_w2_b5w_010 name semi check prc valid pp_asm init_cond:= ((fun sz =>
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5w_ty sz) [:: Eu 0; Eu 1] (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz) init_cond), (name%string,prc)) (only parsing).
 
 Notation mk_instr_w2b_b5w_010 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2b_ty sz sz) (b5w_ty sz) ([:: Eu 0; Eu 1] ++ [::iCF]) (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2b_ty sz sz) (b5w_ty sz) ([:: Eu 0; Eu 1] ++ [::iCF]) (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2_bw name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (bw_ty sz) [:: Ea 0; Eu 1] [::F CF; Ea 0] MSB_MERGE (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (bw_ty sz) [:: Ea 0; Eu 1] [::F CF; Ea 0] MSB_MERGE (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::IBool true; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2b_bw name semi flag check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2b_ty sz sz) (bw_ty sz) ([:: Ea 0; Eu 1] ++ [::F flag]) ([::F flag; Ea 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2b_ty sz sz) (bw_ty sz) ([:: Ea 0; Eu 1] ++ [::F flag]) ([::F flag; Ea 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::IBool true; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2_b5w2 name semi ain aout nargs check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5w2_ty sz) ain (implicit_flags ++ aout) (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (b5w2_ty sz) ain (implicit_flags ++ aout) (reg_msb_flag sz) (semi sz) (check sz) nargs (valid sz) (pp_asm sz) [::IBool true; IBool true; IBool false; IBool false; IBool false; IBool true; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_division sg name semi check prc valid pp_asm semi_errty semi_safe := ((fun sz =>
-  mk_instr (pp_sz name sz) (w3_ty sz) (b5w2_ty sz) [:: R RDX; R RAX; Eu 0]  (implicit_flags ++ [:: R RAX; R RDX]) (reg_msb_flag sz) (semi sz) (check sz) 1 [::X86Division sz sg] (valid sz) (pp_asm sz) refl_equal (semi_errty sz) (semi_safe sz)), (name%string,prc))  (only parsing).
+  mk_instr (pp_sz name sz) (w3_ty sz) (b5w2_ty sz) [:: R RDX; R RAX; Eu 0]  (implicit_flags ++ [:: R RAX; R RDX]) (reg_msb_flag sz) (semi sz) (check sz) 1 [::X86Division sz sg] [::IBool false; IBool false; IBool false; IBool false; IBool false; IBool true; IBool true] (valid sz) (pp_asm sz) refl_equal (semi_errty sz) (semi_safe sz)), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2_w_120 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (w_ty sz) [:: Ea 1 ; Eu 2] [:: Ea 0] MSB_CLEAR (semi sz) (check sz) 3 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (w_ty sz) [:: Ea 1 ; Eu 2] [:: Ea 0] MSB_CLEAR (semi sz) (check sz) 3 (valid sz) (pp_asm sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_ww8_w_120 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (ww8_ty sz) (w_ty sz) [:: Eu 1 ; Ea 2] [:: Ea 0] (reg_msb_flag sz) (semi sz) (check sz) 3 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (ww8_ty sz) (w_ty sz) [:: Eu 1 ; Ea 2] [:: Ea 0] (reg_msb_flag sz) (semi sz) (check sz) 3 (valid sz) (pp_asm sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_ww8_b2w_0c0 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (ww8_ty sz) (b2w_ty sz) [:: Eu 0; Ef 1 RCX] [::F OF; F CF; Eu 0] (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (ww8_ty sz) (b2w_ty sz) [:: Eu 0; Ef 1 RCX] [::F OF; F CF; Eu 0] (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::x_86_shift_mask_OF_condition sz 1; x_86_shift_mask_other_flags_condition sz 1; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_ww8b_b2w_0c0 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (ww8b_ty sz) (b2w_ty sz) [:: Eu 0; Ef 1 RCX; F CF] [::F OF; F CF; Eu 0] (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (ww8b_ty sz) (b2w_ty sz) [:: Eu 0; Ef 1 RCX; F CF] [::F OF; F CF; Eu 0] (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::x_86_shift_mask_OF_condition sz 1; x_86_shift_mask_other_flags_condition sz 1; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_ww8_b5w_0c0 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (ww8_ty sz) (b5w_ty sz) [:: Eu 0; Ef 1 RCX] (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (ww8_ty sz) (b5w_ty sz) [:: Eu 0; Ef 1 RCX] (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::x_86_shift_mask_OF_condition sz 1; x_86_shift_mask_other_flags_condition sz 1; x_86_shift_mask_other_flags_condition sz 1; x_86_shift_mask_other_flags_condition sz 1; x_86_shift_mask_other_flags_condition sz 1; IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2w8_b5w_01c0 name semi check safe_cond prc valid pp_asm safe_wf semi_errty semi_safe := ((fun sz =>
-  mk_instr (pp_sz name sz) (w2w8_ty sz) (b5w_ty sz) [:: Eu 0; Ea 1; Ef 2 RCX] (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 3 (safe_cond sz) (valid sz) (pp_asm sz) (safe_wf sz) (semi_errty sz) (semi_safe sz)), (name%string,prc))  (only parsing).
+  mk_instr (pp_sz name sz) (w2w8_ty sz) (b5w_ty sz) [:: Eu 0; Ea 1; Ef 2 RCX] (implicit_flags ++ [:: Eu 0]) (reg_msb_flag sz) (semi sz) (check sz) 3 (safe_cond sz) [::x_86_shift_mask_OF_condition sz 2; x_86_shift_mask_other_flags_condition sz 2; x_86_shift_mask_other_flags_condition sz 2; x_86_shift_mask_other_flags_condition sz 2; x_86_shift_mask_other_flags_condition sz 2; IBool true] (valid sz) (pp_asm sz) (safe_wf sz) (semi_errty sz) (semi_safe sz)), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w2w8_w_1230 name semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w2w8_ty sz) (w_ty sz) [:: Ea 1 ; Eu 2 ; Ea 3] [:: Ea 0] (reg_msb_flag sz) (semi sz) (check sz) 4 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w2w8_ty sz) (w_ty sz) [:: Ea 1 ; Eu 2 ; Ea 3] [:: Ea 0] (reg_msb_flag sz) (semi sz) (check sz) 4 (valid sz) (pp_asm sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_ve_instr_w2w8_w_1230 name semi check prc valid pp_asm := ((fun (ve:velem) sz =>
-  mk_instr_safe (pp_ve_sz name ve sz) (w2w8_ty sz) (w_ty sz) [:: Ea 1 ; Eu 2 ; Ea 3] [:: Ea 0] (reg_msb_flag sz) (semi ve sz) (check sz) 4 (valid ve sz) (pp_asm ve sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_ve_sz name ve sz) (w2w8_ty sz) (w_ty sz) [:: Ea 1 ; Eu 2 ; Ea 3] [:: Ea 0] (reg_msb_flag sz) (semi ve sz) (check sz) 4 (valid ve sz) (pp_asm ve sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_instr_w_w128_10 name msb semi check prc valid pp_asm := ((fun sz =>
-  mk_instr_safe (pp_sz name sz) (w_ty sz) (w128_ty) [:: Eu 1] [:: Eu 0] msb (semi sz) (check sz) 2 (valid sz) (pp_asm sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_sz name sz) (w_ty sz) (w128_ty) [:: Eu 1] [:: Eu 0] msb (semi sz) (check sz) 2 (valid sz) (pp_asm sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_ve_instr_w_w_10 name semi check prc valid pp_asm := ((fun (ve:velem) sz =>
-  mk_instr_safe (pp_ve_sz name ve sz) (w_ty _) (w_ty sz) [:: Eu 1] [:: Ea 0] (reg_msb_flag sz) (semi ve sz) (check sz) 2 (valid ve sz) (pp_asm ve sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_ve_sz name ve sz) (w_ty _) (w_ty sz) [:: Eu 1] [:: Ea 0] (reg_msb_flag sz) (semi ve sz) (check sz) 2 (valid ve sz) (pp_asm ve sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_ve_instr_w2_w_120 name semi check prc valid pp_asm := ((fun (ve:velem) sz =>
-  mk_instr_safe (pp_ve_sz name ve sz) (w2_ty sz sz) (w_ty sz) [:: Ea 1 ; Eu 2] [:: Ea 0] MSB_CLEAR (semi ve sz) (check sz) 3 (valid ve sz) (pp_asm ve sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_ve_sz name ve sz) (w2_ty sz sz) (w_ty sz) [:: Ea 1 ; Eu 2] [:: Ea 0] MSB_CLEAR (semi ve sz) (check sz) 3 (valid ve sz) (pp_asm ve sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Notation mk_ve_instr_ww128_w_120 name semi check prc valid pp_asm := ((fun ve sz =>
-  mk_instr_safe (pp_ve_sz name ve sz) (w2_ty sz U128) (w_ty sz) [:: Ea 1 ; Eu 2] [:: Ea 0] (reg_msb_flag sz) (semi ve sz) (check sz) 3 (valid ve sz) (pp_asm ve sz)), (name%string,prc))  (only parsing).
+  mk_instr_safe (pp_ve_sz name ve sz) (w2_ty sz U128) (w_ty sz) [:: Ea 1 ; Eu 2] [:: Ea 0] (reg_msb_flag sz) (semi ve sz) (check sz) 3 (valid ve sz) (pp_asm ve sz) [::IBool true]), (name%string,prc))  (only parsing).
 
 Definition max_32 (sz:wsize) := if (sz <= U32)%CMP then sz else U32.
 
@@ -639,6 +674,7 @@ Definition Ox86_POR_instr :=
       2
       true
       (pp_name "por" U64)
+      [::IBool true]
   in
   (desc, ("POR"%string, primM POR)).
 
@@ -648,7 +684,7 @@ Definition Ox86_PADD_instr :=
   let padd := "PADD"%string in
   (λ (ve: velem) (sz: wsize),
     mk_instr_safe (pp_ve_sz padd ve sz) (w2_ty sz sz) (w_ty sz) [:: Eu 0; Eu 1 ] [:: Eu 0 ] MSB_CLEAR
-      (lift2_vec ve +%w sz) check_padd 2 (size_64_128 sz) (pp_viname "padd" ve sz),
+      (lift2_vec ve +%w sz) check_padd 2 (size_64_128 sz) (pp_viname "padd" ve sz) [::IBool true],
    (padd, primMMX PADD)).
 
 Definition check_movsx (_ _:wsize) := [:: r_rm ].
@@ -697,7 +733,7 @@ Definition x86_XCHG sz (v1 v2: word sz) : tpl (w2_ty sz sz) :=
 
 Definition Ox86_XCHG_instr :=
   let name := "XCHG"%string in
-  ( (fun sz => mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (w2_ty sz sz) [:: Eu 0; Eu 1] [:: Eu 0; Eu 1] (reg_msb_flag sz) (@x86_XCHG sz) check_xchg 2 (size_8_64 sz) (pp_name "xchg" sz)), (name, primP XCHG)).
+  ( (fun sz => mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (w2_ty sz sz) [:: Eu 0; Eu 1] [:: Eu 0; Eu 1] (reg_msb_flag sz) (@x86_XCHG sz) check_xchg 2 (size_8_64 sz) (pp_name "xchg" sz) [::IBool true; IBool true]), (name, primP XCHG)).
 
 Definition c_r_rm := [:: c; r; rm true].
 
@@ -716,7 +752,7 @@ Definition x86_ADD sz (v1 v2 : word sz) : tpl (b5w_ty sz) :=
     (wsigned   v1 + wsigned   v2)%Z.
 
 Definition Ox86_ADD_instr  :=
-  mk_instr_w2_b5w_010 "ADD" x86_ADD check_add (prim_8_64 ADD) size_8_64 (pp_iname "add").
+  mk_instr_w2_b5w_010 "ADD" x86_ADD check_add (prim_8_64 ADD) size_8_64 (pp_iname "add")  [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition x86_SUB sz (v1 v2 : word sz) : tpl (b5w_ty sz) :=
   rflags_of_aluop_w
@@ -725,7 +761,7 @@ Definition x86_SUB sz (v1 v2 : word sz) : tpl (b5w_ty sz) :=
     (wsigned   v1 - wsigned   v2)%Z.
 
 Definition Ox86_SUB_instr :=
-  mk_instr_w2_b5w_010 "SUB" x86_SUB check_add (prim_8_64 SUB) size_8_64 (pp_iname "sub").
+  mk_instr_w2_b5w_010 "SUB" x86_SUB check_add (prim_8_64 SUB) size_8_64 (pp_iname "sub")  [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition check_mul (_:wsize) := [:: [::rm true]].
 
@@ -762,11 +798,13 @@ Definition x86_IMULt sz (v1 v2: word sz) : tpl (b5w_ty sz) :=
 
 Definition Ox86_IMULr_instr             :=
   mk_instr_w2_b5w_010 "IMULr" x86_IMULt
-    (fun _ => [::r_rm]) (prim_16_64 IMULr) size_16_64 (pp_iname "imul").
+    (fun _ => [::r_rm]) (prim_16_64 IMULr) size_16_64 (pp_iname "imul")
+    [::IBool true; IBool true; IBool false; IBool false; IBool false; IBool true].
 
 Definition Ox86_IMULri_instr :=
   mk_instr_w2_b5w "IMULri" x86_IMULt [:: Eu 1; Eu 2] [:: Eu 0] 3
-  (fun sz => [:: [::r; rm true; i (max_32 sz)]]) (prim_16_64 IMULri) size_16_64 (pp_iname "imul").
+  (fun sz => [:: [::r; rm true; i (max_32 sz)]]) (prim_16_64 IMULri) size_16_64 (pp_iname "imul")
+  [:: IBool true; IBool true; IBool false; IBool false; IBool false; IBool true].
 
 Definition x86_DIV sz (hi lo dv: word sz) : ex_tpl (b5w2_ty sz) :=
   let dd := wdwordu hi lo in
@@ -875,7 +913,7 @@ Definition Ox86_MULX_lo_hi_instr :=
    ((fun (sz:wsize) =>
      mk_instr_safe (pp_sz name sz) (w2_ty sz sz) (w2_ty sz sz)
          [::R RDX; Eu 2] [:: Eu 1; Eu 0] (* lo, hi *) (reg_msb_flag sz)
-         (@x86_MULX_lo_hi sz) check_mulx 3 (size_32_64 sz) (pp_iname "mulx" sz)),
+         (@x86_MULX_lo_hi sz) check_mulx 3 (size_32_64 sz) (pp_iname "mulx" sz) [::IBool true; IBool true]),
     (name, prim_32_64 MULX_lo_hi)).
 
 Definition check_neg (_:wsize) := [::[::rm false]].
@@ -888,7 +926,7 @@ Definition x86_NEG sz (w: word sz) : tpl (b5w_ty sz) :=
   v.
 
 Definition Ox86_NEG_instr               :=
-  mk_instr_w_b5w "NEG" x86_NEG [:: Eu 0] [:: Eu 0] 1 check_neg (prim_8_64 NEG) size_8_64 (pp_iname "neg").
+  mk_instr_w_b5w "NEG" x86_NEG [:: Eu 0] [:: Eu 0] 1 check_neg (prim_8_64 NEG) size_8_64 (pp_iname "neg") [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition x86_INC sz (w: word sz) : tpl (b4w_ty sz) :=
   rflags_of_aluop_nocf_w
@@ -913,7 +951,7 @@ Definition x86_LZCNT sz (w: word sz) : tpl (b5w_ty sz) :=
          ((:: None, Some (ZF_of_word w), None, None & Some (ZF_of_word v)) : sem_ltuple b5_ty) v.
 
 Definition Ox86_LZCNT_instr               :=
-  mk_instr_w_b5w "LZCNT" x86_LZCNT [:: Eu 1] [:: Eu 0] 2 (fun _ => [::r_rm]) (prim_16_64 LZCNT) size_16_64 (pp_iname "lzcnt").
+  mk_instr_w_b5w "LZCNT" x86_LZCNT [:: Eu 1] [:: Eu 0] 2 (fun _ => [::r_rm]) (prim_16_64 LZCNT) size_16_64 (pp_iname "lzcnt") [::IBool false; IBool true; IBool false; IBool false; IBool true; IBool true].
 
 Definition x86_TZCNT sz (w: word sz) : tpl (b5w_ty sz) :=
   let v := trailing_zero w in
@@ -922,7 +960,7 @@ Definition x86_TZCNT sz (w: word sz) : tpl (b5w_ty sz) :=
     ((:: None, Some (ZF_of_word w), None, None & Some (ZF_of_word v)) : sem_ltuple b5_ty) v.
 
 Definition Ox86_TZCNT_instr               :=
-  mk_instr_w_b5w "TZCNT" x86_TZCNT [:: Eu 1] [:: Eu 0] 2 (fun _ => [::r_rm]) (prim_16_64 TZCNT) size_16_64 (pp_iname "tzcnt").
+  mk_instr_w_b5w "TZCNT" x86_TZCNT [:: Eu 1] [:: Eu 0] 2 (fun _ => [::r_rm]) (prim_16_64 TZCNT) size_16_64 (pp_iname "tzcnt") [::IBool false; IBool true; IBool false; IBool false; IBool true; IBool true].
 
 Definition x86_BSR sz (w: word sz) : ex_tpl (b5w_ty sz) :=
   Let _ := assert (w != 0%w) ErrArith in
@@ -944,7 +982,7 @@ Qed.
 Definition Ox86_BSR_instr :=
   (fun sz =>
      mk_instr (pp_sz "BSR" sz) [:: lword sz ] (b5w_ty sz) [:: Eu 1 ] (implicit_flags ++ [:: Ea 0 ]) MSB_CLEAR
-       (@x86_BSR sz) [:: r_rm ] 2 [:: NotZero sz 0 ] (size_16_64 sz) (pp_iname "bsr" sz)
+       (@x86_BSR sz) [:: r_rm ] 2 [:: NotZero sz 0 ] [::IBool false; IBool false; IBool false; IBool false; IBool true] (size_16_64 sz) (pp_iname "bsr" sz)
        erefl (@x86_BSR_errty sz) (@x86_BSR_safe sz),
      ("BSR"%string, prim_16_64 BSR)).
 
@@ -953,7 +991,7 @@ Definition check_setcc := [:: [::c; rm false]].
 Definition x86_SETcc (b:bool) : tpl (w_ty U8) := wrepr U8 (Z.b2z b).
 
 Definition Ox86_SETcc_instr             :=
-  mk_instr_pp "SETcc" b_ty w8_ty [:: Eu 0] [:: Eu 1] (reg_msb_flag U8) x86_SETcc check_setcc 2 (primM SETcc) (pp_ct "set" U8).
+  mk_instr_pp "SETcc" b_ty w8_ty [:: Eu 0] [:: Eu 1] (reg_msb_flag U8) x86_SETcc check_setcc 2 (primM SETcc) (pp_ct "set" U8) [::IBool true].
 
 Definition check_bt of wsize := [:: [:: r; ri U8 ]].
 
@@ -968,12 +1006,12 @@ Definition Ox86_BT_instr                :=
 Definition x86_CLC : tpl b_ty := Some false.
 
 Definition Ox86_CLC_instr :=
-  mk_instr_pp "CLC" [::] b_ty [::] [:: F CF ] MSB_CLEAR x86_CLC [:: [::]] 0 (primM CLC) (pp_name "clc" U8).
+  mk_instr_pp "CLC" [::] b_ty [::] [:: F CF ] MSB_CLEAR x86_CLC [:: [::]] 0 (primM CLC) (pp_name "clc" U8) [::IBool true].
 
 Definition x86_STC : tpl b_ty := Some true.
 
 Definition Ox86_STC_instr :=
-  mk_instr_pp "STC" [::] b_ty [::] [:: F CF ] MSB_CLEAR x86_STC [:: [::]] 0 (primM STC) (pp_name "stc" U8).
+  mk_instr_pp "STC" [::] b_ty [::] [:: F CF ] MSB_CLEAR x86_STC [:: [::]] 0 (primM STC) (pp_name "stc" U8) [::IBool true].
 
 (* -------------------------------------------------------------------- *)
 Definition check_lea (_:wsize) := [:: [::r; m true]].
@@ -1004,19 +1042,19 @@ Definition x86_AND sz (v1 v2: word sz) : tpl (b5w_ty sz) :=
   rflags_of_bwop_w (wand v1 v2).
 
 Definition Ox86_AND_instr :=
-  mk_instr_w2_b5w_010 "AND" x86_AND check_cmp (prim_8_64 AND) size_8_64 (pp_iname "and").
+  mk_instr_w2_b5w_010 "AND" x86_AND check_cmp (prim_8_64 AND) size_8_64 (pp_iname "and") [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition x86_OR sz (v1 v2: word sz) : tpl (b5w_ty sz) :=
   rflags_of_bwop_w (wor v1 v2).
 
 Definition Ox86_OR_instr                :=
-  mk_instr_w2_b5w_010 "OR" x86_OR check_cmp (prim_8_64 OR) size_8_64 (pp_iname "or").
+  mk_instr_w2_b5w_010 "OR" x86_OR check_cmp (prim_8_64 OR) size_8_64 (pp_iname "or") [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition x86_XOR sz (v1 v2: word sz) : tpl (b5w_ty sz) :=
   rflags_of_bwop_w (wxor v1 v2).
 
 Definition Ox86_XOR_instr               :=
-  mk_instr_w2_b5w_010 "XOR" x86_XOR check_cmp (prim_8_64 XOR) size_8_64 (pp_iname "xor").
+  mk_instr_w2_b5w_010 "XOR" x86_XOR check_cmp (prim_8_64 XOR) size_8_64 (pp_iname "xor") [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition check_andn (_:wsize) := [:: [:: r; r; rm true]].
 
@@ -1026,7 +1064,7 @@ Definition x86_ANDN sz (v1 v2: word sz) : tpl (b5w_ty sz) :=
 
 Definition Ox86_ANDN_instr              :=
   mk_instr_w2_b5w "ANDN" x86_ANDN [:: Eu 1; Eu 2] [:: Eu 0] 3
-  check_andn (prim_32_64 ANDN) size_32_64 (pp_iname "andn").
+  check_andn (prim_32_64 ANDN) size_32_64 (pp_iname "andn") [:: IBool true; IBool true; IBool true; IBool false; IBool true; IBool true].
 
 Definition x86_NOT sz (v: word sz)  : tpl (w_ty sz) := wnot v.
 
@@ -1034,13 +1072,6 @@ Definition Ox86_NOT_instr               :=
   mk_instr_w_w "NOT" x86_NOT [:: Eu 0] [:: Eu 0] 1 check_neg (prim_8_64 NOT) size_8_64 (pp_iname "not").
 
 Definition check_ror (_:wsize):= [::[::rm false; ri U8]].
-Definition x86_shift_mask (s:wsize) : u8 :=
-  match s with
-  | U8 | U16 | U32 => wrepr U8 31
-  | U64  => wrepr U8 63
-  | U128 => wrepr U8 127
-  | U256 => wrepr U8 255
-  end%Z.
 
 Definition x86_ROR sz (v: word sz) (i: u8) : tpl (b2w_ty sz) :=
   let i := wand i (x86_shift_mask sz) in
@@ -1280,7 +1311,7 @@ Definition x86_POPCNT sz (v: word sz): tpl (b5w_ty sz) :=
   (:: Some false, Some false, Some false, Some false, Some (ZF_of_word v) & r).
 
 Definition Ox86_POPCNT_instr :=
-  mk_instr_w_b5w "POPCNT" x86_POPCNT [:: Eu 1] [:: Eu 0] 2 (fun _ => [::r_rm]) (prim_16_64 POPCNT) size_16_64 (pp_name "popcnt").
+  mk_instr_w_b5w "POPCNT" x86_POPCNT [:: Eu 1] [:: Eu 0] 2 (fun _ => [::r_rm]) (prim_16_64 POPCNT) size_16_64 (pp_name "popcnt") [::IBool true; IBool true; IBool true; IBool true; IBool true; IBool true].
 
 Definition x86_BTX op sz (x y: word sz) : tpl (bw_ty sz) :=
   let bit := (wunsigned y mod wsize_bits sz)%Z in
@@ -1353,7 +1384,7 @@ Definition Ox86_VPMOVSX_instr :=
   (λ ve sz ve' sz',
    mk_instr_safe (pp_ve_sz_ve_sz name ve sz ve' sz') [:: lword sz ] [:: lword sz' ] [:: Eu 1 ] [:: Eu 0 ]
             MSB_CLEAR (@x86_VPMOVSX ve sz ve' sz') [:: [:: xmm ; xmmm true]] 2
-                      (size_128_256 sz' && check_vector_length ve sz ve' sz') (pp_vpmovx "vpmovsx" ve sz ve' sz'),
+                      (size_128_256 sz' && check_vector_length ve sz ve' sz') (pp_vpmovx "vpmovsx" ve sz ve' sz') [::IBool true],
    (name, prim_vv VPMOVSX)
    ).
 
@@ -1365,7 +1396,7 @@ Definition Ox86_VPMOVZX_instr :=
   (λ ve sz ve' sz',
    mk_instr_safe (pp_ve_sz_ve_sz name ve sz ve' sz') [:: lword sz ] [:: lword sz' ] [:: Eu 1 ] [:: Eu 0 ]
             MSB_CLEAR (@x86_VPMOVZX ve sz ve' sz') [:: [:: xmm ; xmmm true]] 2
-                      (size_128_256 sz' && check_vector_length ve sz ve' sz') (pp_vpmovx "vpmovzx" ve sz ve' sz'),
+                      (size_128_256 sz' && check_vector_length ve sz ve' sz') (pp_vpmovx "vpmovzx" ve sz ve' sz') [::IBool true],
    (name, prim_vv VPMOVZX)
    ).
 
@@ -1411,15 +1442,15 @@ Definition Ox86_VPMULL_instr := mk_ve_instr_w2_w_120 "VPMULL" x86_VPMULL check_x
 
 Definition x86_VPMUL sz := @wpmul sz.
 
-Definition Ox86_VPMUL_instr  := ((fun sz => mk_instr_safe (pp_sz "VPMUL" sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1 ; Eu 2] [:: Eu 0] MSB_CLEAR (@x86_VPMUL sz) (check_xmm_xmm_xmmm sz) 3 (size_128_256 sz) (pp_name "vpmuldq" sz)), ("VPMUL"%string, (prim_128_256 VPMUL))).
+Definition Ox86_VPMUL_instr  := ((fun sz => mk_instr_safe (pp_sz "VPMUL" sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1 ; Eu 2] [:: Eu 0] MSB_CLEAR (@x86_VPMUL sz) (check_xmm_xmm_xmmm sz) 3 (size_128_256 sz) (pp_name "vpmuldq" sz) [::IBool true]), ("VPMUL"%string, (prim_128_256 VPMUL))).
 
 Definition x86_VPMULU sz := @wpmulu sz.
 
-Definition Ox86_VPMULU_instr := ((fun sz => mk_instr_safe (pp_sz "VPMULU" sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1 ; Eu 2] [:: Eu 0] MSB_CLEAR (@x86_VPMULU sz) (check_xmm_xmm_xmmm sz) 3 (size_128_256 sz) (pp_name "vpmuludq" sz)), ("VPMULU"%string, (prim_128_256 VPMULU))).
+Definition Ox86_VPMULU_instr := ((fun sz => mk_instr_safe (pp_sz "VPMULU" sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1 ; Eu 2] [:: Eu 0] MSB_CLEAR (@x86_VPMULU sz) (check_xmm_xmm_xmmm sz) 3 (size_128_256 sz) (pp_name "vpmuludq" sz) [::IBool true]), ("VPMULU"%string, (prim_128_256 VPMULU))).
 
 Notation mk_instr_vpmulh name semi prc asm_name :=
   ((λ sz,
-     mk_instr_safe (pp_ve_sz name VE16 sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1 ; Eu 2 ] [:: Eu 0] (reg_msb_flag sz) (semi sz) (check_xmm_xmm_xmmm sz) 3 (size_128_256 sz) (pp_viname asm_name VE16 sz)), (name%string, primV_16 (λ _, prc)))  (only parsing).
+     mk_instr_safe (pp_ve_sz name VE16 sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1 ; Eu 2 ] [:: Eu 0] (reg_msb_flag sz) (semi sz) (check_xmm_xmm_xmmm sz) 3 (size_128_256 sz) (pp_viname asm_name VE16 sz) [::IBool true]), (name%string, primV_16 (λ _, prc)))  (only parsing).
 
 Definition x86_VPMULH sz v1 v2 :=
   lift2_vec U16 (@wmulhs U16) sz v1 v2.
@@ -1455,7 +1486,7 @@ Definition Ox86_VPEXTR_instr :=
       let ve := match sz with U8 => VE8 | U16 => VE16 | U32 => VE32 | _ => VE64 end in
       mk_instr_safe (pp_sz "VPEXTR" sz) w128w8_ty (w_ty sz) [:: Eu 1 ; Eu 2] [:: Eu 0]
                MSB_CLEAR (@x86_VPEXTR sz) (check_vpextr sz) 3 (size_8_64 sz)
-               (pp_viname_t "vpextr" ve [:: if sz==U32 then U32 else U64; U128; U8])),
+               (pp_viname_t "vpextr" ve [:: if sz==U32 then U32 else U64; U128; U8]) [::IBool true]),
    ("VPEXTR"%string, (prim_8_64 VPEXTR))).
 
 Definition pp_vpinsr ve args :=
@@ -1475,7 +1506,7 @@ Arguments x86_VPINSR : clear implicits.
 Definition Ox86_VPINSR_instr  :=
   ((fun (ve:velem) =>
       mk_instr_safe (pp_ve_sz "VPINSR" ve U128) (w128ww8_ty ve) w128_ty [:: Eu 1 ; Eu 2 ; Eu 3] [:: Eu 0] MSB_CLEAR (x86_VPINSR ve)
-                               (check_vpinsr ve) 4 true (pp_vpinsr ve)),
+                               (check_vpinsr ve) 4 true (pp_vpinsr ve) [::IBool true]),
    ("VPINSR"%string, primV_128 (λ ve _, VPINSR ve))).
 
 Definition check_xmm_xmm_imm8 (_:wsize) := [:: [:: xmm; xmm; i U8]].
@@ -1604,7 +1635,8 @@ Definition Ox86_BLENDV_instr :=
                      | VE32 => "vblendvps"
                      | VE64 => "vblendvpd"
                      | _ => "<assert false>"
-                     end sz),
+                     end sz)
+                  [::IBool true],
      ("BLENDV"%string, primV_range [seq PVv ve sz | ve <- [:: VE8; VE32; VE64 ], sz <- [:: U128; U256 ]] BLENDV)
   ).
 
@@ -1695,13 +1727,13 @@ Definition x86_VPALIGNR sz (v1 v2: word sz) (m:u8) : tpl (w_ty sz) :=
 Definition Ox86_VPALIGNR_instr :=
   ((fun sz =>
      mk_instr_safe (pp_sz "VPALIGNR" sz) (w2w8_ty sz) (w_ty sz) [:: Eu 1 ; Eu 2 ; Eu 3] [:: Eu 0] MSB_CLEAR
-      (@x86_VPALIGNR sz) (check_xmm_xmm_xmmm_imm8 sz) 4 (size_128_256 sz) (pp_name "vpalignr" sz)), ("VPALIGNR"%string, prim_128_256 VPALIGNR)).
+      (@x86_VPALIGNR sz) (check_xmm_xmm_xmmm_imm8 sz) 4 (size_128_256 sz) (pp_name "vpalignr" sz) [::IBool true]), ("VPALIGNR"%string, prim_128_256 VPALIGNR)).
 
 (* 256 *)
 
 Definition Ox86_VBROADCASTI128_instr    :=
   (mk_instr_safe (pp_s "VPBROADCAST_2u128") w128_ty w256_ty [:: Eu 1] [:: Eu 0] MSB_CLEAR (x86_VPBROADCAST U256)
-            ([:: [::xmm; m true]]) 2 true (pp_name_ty "vbroadcasti128" [::U256; U128]),
+            ([:: [::xmm; m true]]) 2 true (pp_name_ty "vbroadcasti128" [::U256; U128]) [::IBool true],
    ("VPBROADCAST_2u128"%string, (primM VBROADCASTI128))).
 
 Definition check_xmmm_xmm_imm8 (_:wsize) := [:: [:: xmmm false; xmm; i U8]].
@@ -1712,35 +1744,35 @@ Definition x86_VEXTRACTI128 (v: u256) (i: u8) : tpl (w_ty U128) :=
 
 Definition Ox86_VEXTRACTI128_instr :=
   mk_instr_pp "VEXTRACTI128" w256w8_ty w128_ty [:: Eu 1; Eu 2] [:: Eu 0] MSB_CLEAR x86_VEXTRACTI128
-              (check_xmmm_xmm_imm8 U256) 3 (primM VEXTRACTI128) (pp_name_ty "vextracti128" [::U128; U256; U8]).
+              (check_xmmm_xmm_imm8 U256) 3 (primM VEXTRACTI128) (pp_name_ty "vextracti128" [::U128; U256; U8]) [::IBool true].
 
 Definition x86_VINSERTI128 (v1: u256) (v2: u128) (m: u8) : tpl (w_ty U256) :=
   winserti128 v1 v2 m.
 
 Definition Ox86_VINSERTI128_instr :=
   mk_instr_pp "VINSERTI128" w256w128w8_ty w256_ty [:: Eu 1; Eu 2; Eu 3] [:: Eu 0] MSB_CLEAR x86_VINSERTI128
-              (check_xmm_xmm_xmmm_imm8 U256) 4 (primM VINSERTI128) (pp_name_ty "vinserti128" [::U256;U256; U128; U8]).
+              (check_xmm_xmm_xmmm_imm8 U256) 4 (primM VINSERTI128) (pp_name_ty "vinserti128" [::U256;U256; U128; U8]) [::IBool true].
 
 Definition x86_VPERM2I128 (v1 v2: u256) (m: u8) : tpl (w_ty U256) :=
   wperm2i128 v1 v2 m.
 
 Definition Ox86_VPERM2I128_instr :=
   mk_instr_pp "VPERM2I128" w256x2w8_ty w256_ty [:: Eu 1; Eu 2; Eu 3] [:: Eu 0] MSB_CLEAR x86_VPERM2I128
-              (check_xmm_xmm_xmmm_imm8 U256) 4 (primM VPERM2I128) (pp_name_ty "vperm2i128" [::U256;U256;U256;U8]).
+              (check_xmm_xmm_xmmm_imm8 U256) 4 (primM VPERM2I128) (pp_name_ty "vperm2i128" [::U256;U256;U256;U8]) [::IBool true].
 
 Definition x86_VPERMD (v1 v2: u256): tpl w256_ty :=
   wpermd v1 v2.
 
 Definition Ox86_VPERMD_instr :=
   mk_instr_pp "VPERMD" (w2_ty U256 U256) w256_ty [:: Eu 1; Eu 2] [:: Eu 0] MSB_CLEAR x86_VPERMD
-       (check_xmm_xmm_xmmm U256) 3 (primM VPERMD) (pp_name "vpermd" U256).
+       (check_xmm_xmm_xmmm U256) 3 (primM VPERMD) (pp_name "vpermd" U256) [::IBool true].
 
 Definition x86_VPERMQ (v: u256) (m: u8) : tpl (w_ty U256) :=
   wpermq v m.
 
 Definition Ox86_VPERMQ_instr :=
   mk_instr_pp "VPERMQ" w256w8_ty w256_ty [:: Eu 1; Eu 2] [:: Eu 0] MSB_CLEAR x86_VPERMQ
-              (check_xmm_xmmm_imm8 U256) 3 (primM VPERMQ) (pp_name_ty "vpermq" [::U256;U256;U8]).
+              (check_xmm_xmmm_imm8 U256) 3 (primM VPERMQ) (pp_name_ty "vpermq" [::U256;U256;U8]) [::IBool true].
 
 Definition Ox86_MOVEMASK_instr :=
   (fun (ve: velem) sz =>
@@ -1751,7 +1783,7 @@ Definition Ox86_MOVEMASK_instr :=
           | VE32 => "vmovmskps"
           | VE64 => "vmovmskpd"
           | _ => "<assert false>"
-          end [:: U32; sz ]),
+          end [:: U64; sz ]) [::IBool true],
      ("MOVEMASK"%string, primV_range [seq PVv ve sz | ve <- [:: VE8; VE32; VE64 ], sz <- [:: U128; U256 ]] MOVEMASK)
   ).
 
@@ -1771,6 +1803,7 @@ Definition Ox86_VPCMPEQ_instr :=
                   3
                   (size_8_64 ve && size_128_256 sz)
                   (pp_viname "vpcmpeq" ve sz)
+                  [::IBool true]
                 ,("VPCMPEQ"%string, primV VPCMPEQ)
   ).
 
@@ -1790,6 +1823,7 @@ Definition Ox86_VPCMPGT_instr :=
                   3
                   (size_8_64 ve && size_128_256 sz)
                   (pp_viname "vpcmpgt" ve sz)
+                  [::IBool true]
                 ,("VPCMPGT"%string, primV VPCMPGT)
   ).
 
@@ -1809,6 +1843,7 @@ Definition Ox86_VPSIGN_instr :=
                   3
                   (size_8_32 ve && size_128_256 sz)
                   (pp_viname "vpsign" ve sz)
+                  [::IBool true]
                 ,("VPSIGN"%string, primV_8_32 VPSIGN)
   ).
 
@@ -1828,6 +1863,7 @@ Definition Ox86_VPMADDUBSW_instr :=
                 3
                 (size_128_256 sz)
                 (pp_name_ty "vpmaddubsw" [:: sz; sz; sz])
+                [::IBool true]
              ,("VPMADDUBSW"%string, prim_128_256 VPMADDUBSW)
   ).
 
@@ -1847,6 +1883,7 @@ Definition Ox86_VPMADDWD_instr :=
                 3
                 (size_128_256 sz)
                 (pp_name_ty "vpmaddwd" [:: sz; sz; sz])
+                [::IBool true]
              ,("VPMADDWD"%string, prim_128_256 VPMADDWD)
   ).
 
@@ -1856,13 +1893,13 @@ Definition x86_VMOVLPD (v: u128): tpl (w_ty U64) :=
   zero_extend U64 v.
 
 Definition Ox86_VMOVLPD_instr :=
-  mk_instr_pp "VMOVLPD" (w_ty U128) (w_ty U64) [:: Eu 1] [:: Eu 0] MSB_CLEAR x86_VMOVLPD check_movpd 2 (primM VMOVLPD) (pp_name_ty "vmovlpd" [::U64; U128]).
+  mk_instr_pp "VMOVLPD" (w_ty U128) (w_ty U64) [:: Eu 1] [:: Eu 0] MSB_CLEAR x86_VMOVLPD check_movpd 2 (primM VMOVLPD) (pp_name_ty "vmovlpd" [::U64; U128]) [::IBool true].
 
 Definition x86_VMOVHPD (v: u128): tpl (w_ty U64) :=
   zero_extend U64 (wshr v 64).
 
 Definition Ox86_VMOVHPD_instr :=
-  mk_instr_pp "VMOVHPD" (w_ty U128) (w_ty U64) [:: Eu 1] [:: Eu 0] MSB_CLEAR x86_VMOVHPD check_movpd 2 (primM VMOVHPD) (pp_name_ty "vmovhpd" [::U64;U128]).
+  mk_instr_pp "VMOVHPD" (w_ty U128) (w_ty U64) [:: Eu 1] [:: Eu 0] MSB_CLEAR x86_VMOVHPD check_movpd 2 (primM VMOVHPD) (pp_name_ty "vmovhpd" [::U64;U128]) [::IBool true].
 
 Definition x86_VPMINS (ve: velem) sz (x y : word sz) : tpl (w_ty sz) :=
   wmin Signed ve x y.
@@ -1912,7 +1949,7 @@ Definition Ox86_VPTEST_instr :=
                (pp_sz "VPTEST" sz) (w2_ty sz sz) (b5_ty) [:: Eu 0; Eu 1] implicit_flags MSB_MERGE
                (@x86_VPTEST sz) (check_vptest sz) 2
                (size_128_256 sz)
-               (pp_name "vptest" sz), ("VPTEST"%string, prim_128_256 VPTEST)).
+               (pp_name "vptest" sz) [::IBool true; IBool true; IBool true; IBool true; IBool true], ("VPTEST"%string, prim_128_256 VPTEST)).
 
 (* Monitoring instructions.
    These instructions are declared for the convenience of the programmer.
@@ -1940,6 +1977,7 @@ Definition Ox86_RDTSC_instr :=
               [:: [::]]
               0 (* nargs *)
               [:: ScFalse]
+              [::IBool true; IBool true]
               (size_32_64 sz)
               (pp_name_ty "rdtsc" [:: sz; sz]) (* asm pretty-print*)
               refl_equal
@@ -1960,6 +1998,7 @@ Definition Ox86_RDTSCP_instr :=
               [:: [::]] (* arg checks *)
               0 (* nargs *)
               [:: ScFalse]
+              [::IBool true; IBool true; IBool true]
               (size_32_64 sz)
               (pp_name_ty "rdtscp" [:: sz; sz; sz]) (* asm pprinter *)
               refl_equal
@@ -1970,23 +2009,26 @@ Definition Ox86_RDTSCP_instr :=
 
 (* Fences & cache-related instructions *)
 Definition Ox86_CLFLUSH_instr :=
-  mk_instr_pp "CLFLUSH" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM CLFLUSH) (pp_name "clflush" U8).
+  mk_instr_pp "CLFLUSH" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM CLFLUSH) (pp_name "clflush" U8) [::].
 
 Definition Ox86_PREFETCHT0_instr :=
-  mk_instr_pp "PREFETCHT0" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHT0) (pp_name "prefetcht0" U8).
+  mk_instr_pp "PREFETCHT0" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHT0) (pp_name "prefetcht0" U8) [::].
+
 Definition Ox86_PREFETCHT1_instr :=
-  mk_instr_pp "PREFETCHT1" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHT1) (pp_name "prefetcht1" U8).
+  mk_instr_pp "PREFETCHT1" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHT1) (pp_name "prefetcht1" U8) [::].
+
 Definition Ox86_PREFETCHT2_instr :=
-  mk_instr_pp "PREFETCHT2" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHT2) (pp_name "prefetcht2" U8).
+  mk_instr_pp "PREFETCHT2" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHT2) (pp_name "prefetcht2" U8) [::].
+
 Definition Ox86_PREFETCHNTA_instr :=
-  mk_instr_pp "PREFETCHNTA" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHNTA) (pp_name "prefetchnta" U8).
+  mk_instr_pp "PREFETCHNTA" [:: lword Uptr ] [::] [:: Ec 0 ] [::] MSB_CLEAR (λ _, tt) [:: [:: m true ] ] 1 (primM PREFETCHNTA) (pp_name "prefetchnta" U8) [::].
 
 Definition Ox86_LFENCE_instr :=
-  mk_instr_pp "LFENCE" [::] [::] [::] [::] MSB_CLEAR tt [:: [::] ] 0 (primM LFENCE) (pp_name "lfence" U8).
+  mk_instr_pp "LFENCE" [::] [::] [::] [::] MSB_CLEAR tt [:: [::] ] 0 (primM LFENCE) (pp_name "lfence" U8) [::].
 Definition Ox86_MFENCE_instr :=
-  mk_instr_pp "MFENCE" [::] [::] [::] [::] MSB_CLEAR tt [:: [::] ] 0 (primM MFENCE) (pp_name "mfence" U8).
+  mk_instr_pp "MFENCE" [::] [::] [::] [::] MSB_CLEAR tt [:: [::] ] 0 (primM MFENCE) (pp_name "mfence" U8) [::].
 Definition Ox86_SFENCE_instr :=
-  mk_instr_pp "SFENCE" [::] [::] [::] [::] MSB_CLEAR tt [:: [::] ] 0 (primM SFENCE) (pp_name "sfence" U8).
+  mk_instr_pp "SFENCE" [::] [::] [::] [::] MSB_CLEAR tt [:: [::] ] 0 (primM SFENCE) (pp_name "sfence" U8) [::].
 
 (* AES instructions *)
 Definition x86_AESDEC          (v1 v2 : u128)           : tpl (w_ty U128) := wAESDEC          v1 v2.
@@ -1998,7 +2040,7 @@ Definition x86_AESKEYGENASSIST (v1    : u128) (v2 : u8) : tpl (w_ty U128) := wAE
 
 Definition mk_instr_aes2 jname aname (constr:x86_op) x86_sem msb_flag :=
   mk_instr_pp jname (w2_ty U128 U128) (w_ty U128) [:: Eu 0; Eu 1] [:: Eu 0] msb_flag x86_sem
-         (check_xmm_xmmm U128) 2 (primM constr) (pp_name_ty aname [::U128;U128]).
+         (check_xmm_xmmm U128) 2 (primM constr) (pp_name_ty aname [::U128;U128]) [::IBool true].
 
 Definition mk_instr_aes3 jname aname (constr: wsize → x86_op) x86_sem :=
   (λ sz, mk_instr_safe (pp_sz jname sz) (w2_ty sz sz) (w_ty sz) [:: Eu 1; Eu 2]
@@ -2006,7 +2048,7 @@ Definition mk_instr_aes3 jname aname (constr: wsize → x86_op) x86_sem :=
            (lift2_vec U128 x86_sem sz)
            (check_xmm_xmm_xmmm sz) 3
            (size_128_256 sz)
-           (pp_name_ty aname [:: sz; sz; sz ]),
+           (pp_name_ty aname [:: sz; sz; sz ]) [::IBool true],
    (jname%string, prim_128_256 constr)).
 
 Definition Ox86_AESDEC_instr :=
@@ -2035,23 +2077,23 @@ Definition Ox86_VAESENCLAST_instr :=
 
 Definition Ox86_AESIMC_instr :=
   mk_instr_pp "AESIMC" (w_ty U128) (w_ty U128) [:: Eu 1] [:: Eu 0] MSB_MERGE x86_AESIMC
-         (check_xmm_xmmm U128) 2 (primM AESIMC) (pp_name_ty "aesimc" [::U128;U128]).
+         (check_xmm_xmmm U128) 2 (primM AESIMC) (pp_name_ty "aesimc" [::U128;U128]) [::IBool true].
 
 Definition Ox86_VAESIMC_instr :=
   mk_instr_pp "VAESIMC" (w_ty U128) (w_ty U128) [:: Eu 1] [:: Eu 0] MSB_CLEAR x86_AESIMC
-         (check_xmm_xmmm U128) 2 (primM VAESIMC) (pp_name_ty "vaesimc" [::U128;U128]).
+         (check_xmm_xmmm U128) 2 (primM VAESIMC) (pp_name_ty "vaesimc" [::U128;U128]) [::IBool true].
 
 Definition Ox86_AESKEYGENASSIST_instr :=
   mk_instr_pp "AESKEYGENASSIST" (w2_ty U128 U8) (w_ty U128) [:: Eu 1; Eu 2] [:: Eu 0]
     MSB_MERGE x86_AESKEYGENASSIST
    (check_xmm_xmmm_imm8 U128) 3 (primM AESKEYGENASSIST)
-   (pp_name_ty "aeskeygenassist" [::U128;U128;U8]).
+   (pp_name_ty "aeskeygenassist" [::U128;U128;U8]) [::IBool true].
 
 Definition Ox86_VAESKEYGENASSIST_instr :=
   mk_instr_pp "VAESKEYGENASSIST" (w2_ty U128 U8) (w_ty U128) [:: Eu 1; Eu 2] [:: Eu 0]
     MSB_CLEAR x86_AESKEYGENASSIST
    (check_xmm_xmmm_imm8 U128) 3 (primM VAESKEYGENASSIST)
-   (pp_name_ty "vaeskeygenassist" [::U128;U128;U8]).
+   (pp_name_ty "vaeskeygenassist" [::U128;U128;U8]) [::IBool true].
 
 (* PCLMULDQD instructions *)
 (* --------------------------------------------------------------------------------------
@@ -2091,14 +2133,14 @@ Definition Ox86_PCLMULQDQ_instr :=
   mk_instr_pp "PCLMULQDQ" [:: lword U128; lword U128; lword U8] (w_ty U128)
     [:: Eu 0; Eu 1; Eu 2] [:: Eu 0] MSB_CLEAR (@x86_VPCLMULQDQ U128)
     (check_xmm_xmmm_imm8 U128) 3 (primM PCLMULQDQ)
-    (pp_name_ty "pclmulqdq" [::U128;U128;U8]).
+    (pp_name_ty "pclmulqdq" [::U128;U128;U8]) [::IBool true].
 
 Definition Ox86_VPCLMULQDQ_instr :=
  (fun sz =>
    mk_instr_safe (pp_sz "VPCLMULQDQ"%string sz) [:: lword sz; lword sz; lword U8] (w_ty sz)
        [:: Eu 1; Eu 2; Eu 3] [:: Eu 0] MSB_CLEAR (@x86_VPCLMULQDQ sz)
-       (check_xmm_xmm_xmmm_imm8 sz) 4 (size_128_256 sz) (pp_name "vpclmulqdq" sz)
- , ("VPCLMULQDQ"%string, prim_128_256 VPCLMULQDQ)).
+       (check_xmm_xmm_xmmm_imm8 sz) 4 (size_128_256 sz) (pp_name "vpclmulqdq" sz) [::IBool true]
+ , ("VPCLMULQDQ"%string, prim_128_256 VPCLMULQDQ)) .
 
 (* -------------------------------------------------------------------------------------- *)
 (* SHA instructions *)
@@ -2106,15 +2148,15 @@ Definition Ox86_SHA256RNDS2_instr :=
   mk_instr_pp "SHA256RNDS2" (w3_ty U128) (w_ty U128)
     [:: Eu 0; Eu 1; ADExplicit (AK_mem Unaligned) 2 (ACR_vector XMM0)]
     [:: Eu 0] MSB_MERGE sha256rnds2
-    [:: [:: xmm; xmmm true; xmm ]] 3 (primM SHA256RNDS2) (pp_name_ty "sha256rnds2" [:: U128; U128; U128 ]).
+    [:: [:: xmm; xmmm true; xmm ]] 3 (primM SHA256RNDS2) (pp_name_ty "sha256rnds2" [:: U128; U128; U128 ]) [::IBool true].
 
 Definition Ox86_SHA256MSG1_instr :=
   mk_instr_pp "SHA256MSG1" (w2_ty U128 U128) (w_ty U128) [:: Eu 0; Eu 1] [:: Eu 0] MSB_MERGE sha256msg1
-    (check_xmm_xmmm U128) 2 (primM SHA256MSG1) (pp_name_ty "sha256msg1" [::U128;U128]).
+    (check_xmm_xmmm U128) 2 (primM SHA256MSG1) (pp_name_ty "sha256msg1" [::U128;U128]) [::IBool true].
 
 Definition Ox86_SHA256MSG2_instr :=
   mk_instr_pp "SHA256MSG2" (w2_ty U128 U128) (w_ty U128) [:: Eu 0; Eu 1] [:: Eu 0] MSB_MERGE sha256msg2
-         (check_xmm_xmmm U128) 2 (primM SHA256MSG2) (pp_name_ty "sha256msg2" [::U128;U128]).
+         (check_xmm_xmmm U128) 2 (primM SHA256MSG2) (pp_name_ty "sha256msg2" [::U128;U128]) [::IBool true].
 
 (* -------------------------------------------------------------------------------------- *)
 
diff --git a/proofs/compiler/x86_lowering_proof.v b/proofs/compiler/x86_lowering_proof.v
index 0e2a0fde53..c249d8d39a 100644
--- a/proofs/compiler/x86_lowering_proof.v
+++ b/proofs/compiler/x86_lowering_proof.v
@@ -512,7 +512,7 @@ Section PROOF.
   Proof.
   Local Opaque convertible.
     rewrite /lower_cassgn_classify.
-    move: e Hs=> [z|b|ws n|x|al aa ws x e | aa ws len x e |al sz e| o e|o e1 e2| op es |e e1 e2] //.
+    move: e Hs=> [z|b|ws n|x|al aa ws x e | aa ws len x e |al sz e| o e|o e1 e2| op es |e e1 e2|||] //.
     + case: x => - [] [] [] // sz vn vi vs //= /[dup] ok_v.
       case/type_of_get_gvar => sz' [Hs Hs'].
       have := truncate_val_subctype Hv'. rewrite Hs -(truncate_val_has_type Hv').
@@ -1137,7 +1137,7 @@ Section PROOF.
       - rewrite /exec_sopn /sopn_sem /sopn_sem_; case.
         + by move => ws ? /=; case: eqP => /= ? -> /=.
         by move => _ /= ->.
-      by rewrite /exec_sopn => op _ ->.
+      by rewrite /exec_sopn => /= op _ ->.
 
     exists s'; split => //. by rewrite LetK /sem_sopn hx /= hr.
   Qed.
@@ -1614,7 +1614,7 @@ Section PROOF.
     {
       clear - hsz64 des hx hv C ho.
       case: C => [ [? [? [? ?]]] | [cfi [?[?[? ?]]]]]; subst; apply (conj des).
-      + move: hv hx; rewrite /exec_sopn /sopn_sem; t_xrbindP; case: sub => _ hval <- y hy;
+      + move: hv hx; rewrite /exec_sopn /sopn_sem /with_catch /nocatch; t_xrbindP; case: sub => _ hval <- y hy;
         have {hy} := app_wwb_dec hy => -[sz1] [w1] [sz2] [w2] [b] [hsz1] [hsz2] [?] [?] ?;subst x y v =>
           /sem_pexprs_dec3 [hx] [hy] [?]; subst b;
         (exists [:: Vword w1; Vword w2]; split; [by rewrite /sem_pexprs /= hx /= hy|]);
@@ -1625,7 +1625,7 @@ Section PROOF.
         + by [].
         by rewrite /= Z.add_0_r add_overflow wrepr_add !wrepr_unsigned in ho.
       exists x; split; [ exact hx |]; clear hx.
-      move: hv;rewrite /exec_sopn /sopn_sem; t_xrbindP; case: sub => _ hval <- y hy;
+      move: hv;rewrite /exec_sopn /sopn_sem /with_catch /nocatch; t_xrbindP; case: sub => _ hval <- y hy;
        have {hy} := app_wwb_dec hy=> -[sz1] [w1] [sz2] [w2] [b] [hsz1] [hsz2] [?] [?] ?;
       subst x y v;
       rewrite /= /sopn_sem /sopn_sem_ /= /semi_to_atype !computational_eq_refl
@@ -1657,7 +1657,7 @@ Section PROOF.
     case: o Hv default => // -[] //;
      (move => sz Hv default || move => Hv default).
     (* Omulu *)
-    + move: Hv; rewrite /exec_sopn /sopn_sem ; t_xrbindP => _ hval <- y hy.
+    + move: Hv; rewrite /exec_sopn /sopn_sem /with_catch /nocatch; t_xrbindP => _ hval <- y hy.
       have := app_ww_dec hy => -[sz1] [w1 [sz2 [w2 [hsz1 [hsz2 [? [?]]]]]]] ?; subst x y v.
       move=> {Hx Hw}.
       have [x1 [x2 ?]] := write_lvals_dec2_s Hw'; subst xs.
diff --git a/proofs/ec_extraction/compiler_extraction.v b/proofs/ec_extraction/compiler_extraction.v
new file mode 100644
index 0000000000..000550128e
--- /dev/null
+++ b/proofs/ec_extraction/compiler_extraction.v
@@ -0,0 +1,48 @@
+Require Import
+compiler
+psem
+safety
+insert_cast
+wint_int
+extra_vars_call
+contracts_asserts
+remove_init_preds.
+
+
+Section SAFETY_ASSERTS.
+Context `{asmop:asmOp} {pd: PointerData} {msfsz : MSFsize}.
+Context (create_var : v_kind -> string -> atype -> var_info -> var).
+Context (B : var -> var).
+Context {fcp : FlagCombinationParams}.
+Context (is_move_op : asm_op_t -> bool).
+Context (print_uprog : string -> _uprog -> _uprog).
+
+Definition create_safety_asserts (p: _uprog): result compiler_util.pp_error_loc _uprog :=
+  (* First add the safety conditions *)
+  let p := insert_cast_prog p in
+  let p := print_uprog "insert cast " p in
+  Let p := sc_prog p in
+  let p := print_uprog "safety assert" p in
+  (* This make the arguments and destinations of function call uniq variable.
+     Similar to make reference argument *)
+  Let p := extra_vars_call_prog create_var p in
+  let p := print_uprog "extra vars call" p in
+  (* Introduce the boolean variables that encode is_var_init and is_arr_init *)
+  let p := rm_var_init_prog B p in
+  let p := print_uprog "var init" p in
+  (* Add the post after the call.
+     Do we really want to keep it or to intergrate it into constant_prop ?
+     One advantage is that static analysis can reuse the result more easyly ?
+  *)
+  let p := contracts_asserts_prog p in
+  let p := print_uprog "contracts asserts" p in
+  (* Performs constant propagation *)
+  let p := rm_var_init_const_prop B p in
+  let p := print_uprog "constant prop" p in
+  (* Dead code *)
+  let p := rm_var_init_dc is_move_op p in
+  let p := print_uprog "rm var init" p in
+  ok p
+.
+
+End SAFETY_ASSERTS.
diff --git a/proofs/ec_extraction/constant_prop_extraction.v b/proofs/ec_extraction/constant_prop_extraction.v
new file mode 100644
index 0000000000..0cf0fcc9ac
--- /dev/null
+++ b/proofs/ec_extraction/constant_prop_extraction.v
@@ -0,0 +1,544 @@
+(* ** Imports and settings *)
+Require Import safety_shared constant_prop.
+From HB Require Import structures.
+From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssralg.
+From mathcomp Require Import word_ssrZ.
+From Coq Require Import ZArith String.
+Require Import expr strings sem_op_typed compiler_util.
+Import Utf8 oseq.
+Require Import flag_combination.
+
+Local Open Scope string_scope.
+Local Open Scope seq_scope.
+Local Open Scope Z_scope.
+
+
+
+Section WITH_PARAMS.
+
+Context {fcp : FlagCombinationParams}.
+(* ** constant propagation
+ * -------------------------------------------------------------------- *)
+
+(* TODO: elpi.derive is not clever enough to deal with words *)
+Variant const_v :=
+  | Cbool of bool
+  | Cint of Z
+  | Cword sz `(word sz)
+  | Cfull_init of positive.
+
+Definition const_v_beq (c1 c2: const_v) : bool :=
+  match c1, c2 with
+  | Cbool b1, Cbool b2 => b1 == b2
+  | Cint z1, Cint z2 => z1 == z2
+  | Cword sz1 w1, Cword sz2 w2 =>
+    match wsize_eq_dec sz1 sz2 with
+    | left e => eq_rect _ word w1 _ e == w2
+    | _ => false
+    end
+  | Cfull_init p1 , Cfull_init p2 => p1 == p2
+  | _, _ => false
+  end.
+
+Lemma const_v_eq_axiom : Equality.axiom const_v_beq.
+Proof.
+case => [ b1 | z1 | sz1 w1 | p1 ] [ b2 | z2 | sz2 w2 | p2] /=; try (constructor; congruence).
+1-2,4: by case: eqP => [ -> | ne ]; constructor; congruence.
+case: wsize_eq_dec => [ ? | ne ]; last (constructor; congruence).
+subst => /=.
+by apply:(iffP idP) => [ /eqP | [] ] ->.
+Qed.
+
+HB.instance Definition _ := hasDecEq.Build const_v const_v_eq_axiom.
+
+Local Notation cpm := (Mvar.t const_v).
+
+Definition e255 :=  word_of_int Unsigned U8 255.
+
+Definition full_init len := nseq (Pos.to_nat len) e255.
+
+Definition const v :=
+  match v with
+  | Cbool b => Pbool b
+  | Cint z  => Pconst z
+  | Cword sz z => wconst z
+  | Cfull_init len => PappN (Oarray len) (full_init len)
+  end.
+
+Definition is_full_init len e :=
+  if e is PappN (Oarray len') es then
+    (len == len') && all (eq_expr e255) es
+  else false.
+
+Definition globals : Type := option (var → option glob_value).
+
+Let without_globals : globals := None.
+Let with_globals (gd: glob_decls) (tag: assgn_tag) : globals :=
+  if tag is AT_inline then Some (assoc gd) else None.
+
+
+Section CL_FLAG.
+
+Context (cl : bool).
+
+Definition empty_cpm : cpm := @Mvar.empty const_v.
+
+Definition merge_cpm : cpm -> cpm -> cpm :=
+  Mvar.map2 (fun _ (o1 o2: option const_v) =>
+   match o1, o2 with
+   | Some n1, Some n2 =>
+     if (n1 == n2)%Z then Some n1
+     else None
+   | _, _ => None
+   end).
+
+Definition and_cpm : cpm -> cpm -> cpm :=
+  Mvar.map2 (fun _ (o1 o2: option const_v) =>
+   match o1, o2 with
+   | Some n1, Some n2 =>
+     if (n1 == n2)%Z then Some n1
+     else None
+   | Some n1, None => Some n1
+   | None, Some n2 => Some n2
+   | None, None => None
+   end).
+
+Definition includes_cpm (m1:cpm) (m2:cpm): bool :=
+  Mvar.fold (fun x n1 b =>
+    match Mvar.get m2 x with
+    | Some n2 => (n1 == n2)%Z && b
+    | None => true
+    end) m1 true.
+
+
+
+Definition remove_cpm (m:cpm) (s:Sv.t): cpm :=
+  Sv.fold (fun x m => Mvar.remove m x) s m.
+
+
+Section GLOBALS.
+
+Context (globs: globals).
+
+Let pget_global al aa sz x e : pexpr :=
+  if globs is Some f then if f x.(gv) is Some (Garr len a) then if e is Pconst i then if WArray.get al aa sz a i is Ok w then wconst w
+  else Pget al aa sz x e
+  else Pget al aa sz x e
+  else Pget al aa sz x e
+  else Pget al aa sz x e.
+
+
+Fixpoint const_prop_e (m:cpm) e :=
+  match e with
+  | Pconst _
+  | Pbool  _
+  | Parr_init _ _
+    => e
+  | Pvar {| gs := scope ; gv := x |} =>
+    match scope with
+    | Slocal => if Mvar.get m x is Some n then const n else e
+    | Sglob => if globs is Some f then if f x is Some (Gword ws w) then const (Cword w) else e else e
+    end
+  | Pget al aa sz x e =>
+    let e := const_prop_e m e in
+    if is_glob x
+    then pget_global al aa sz x e
+    else Pget al aa sz x e
+  | Psub aa sz len x e => Psub aa sz len x (const_prop_e m e)
+  | Pload al sz e => Pload al sz (const_prop_e m e)
+  | Papp1 o e     => s_op1 o (const_prop_e m e)
+  | Papp2 o e1 e2 => s_op2 o (const_prop_e m e1)  (const_prop_e m e2)
+  (* FIXME improve s_opN to take Ois_init into account *)
+  | PappN op es   => s_opN op (map (const_prop_e m) es)
+  | Pif t e e1 e2 => s_if t (const_prop_e m e) (const_prop_e m e1) (const_prop_e m e2)
+  | Pbig idx op x body s len =>
+    let s   := const_prop_e m s in
+    let len := const_prop_e m len in
+    let idx := const_prop_e m idx in
+    match is_const s, is_const len, cl with
+    | Some s, Some len, true =>
+      foldl (fun acc i =>
+              let m := Mvar.set m x (Cint i) in
+              let b := const_prop_e m body in
+              Papp2 op acc b)
+            idx (ziota s len)
+    | _, _, _ =>
+      let body := const_prop_e (Mvar.remove m x) body in
+      match is_bool body, op, idx with
+      | Some true, Oand, Pbool true => Pbool true
+      | _, _, _ => Pbig idx op x body s len
+      end
+    end
+
+  | Pis_var_init _ => e
+
+  | Pis_mem_init e1 e2 =>
+    let e1 := const_prop_e m e1 in
+    let e2 := const_prop_e m e2 in
+    Pis_mem_init e1 e2
+  end.
+
+Definition op1_merge_m (m:cpm) (m':cpm) o :=
+  if o == Onot then m else m'.
+
+Definition wsize_of_atype (ty: atype) : wsize :=
+  if ty is aword sz then sz else U64.
+
+Definition op2_add_cpm (m:cpm) (e1:pexpr) (e2:pexpr) :=
+  if e1 is Pvar {| gv := x; gs := Slocal |} then
+    match e2 with
+    | Pbool b  => Some (Mvar.set m x (Cbool b))
+    | Pconst z =>  Some (Mvar.set m x (Cint z))
+    | PappN (Oarray len) es =>
+      if is_full_init len e2 then Some (Mvar.set m x (Cfull_init len))
+      else None
+    | _ => None
+    end
+  else None.
+
+(* FIXME this require improvment and explanation.
+   In particular the case for equality  *)
+Definition op2_merge_m (m:cpm) (m1:cpm) (m2:cpm) o  (e1:pexpr) (e2:pexpr):=
+  match o with
+  | Oand => and_cpm m1 m2
+  | Oor  => merge_cpm m1 m2
+  | Oeq _ =>
+    match op2_add_cpm m e1 e2 with
+    | Some m => m
+    | None =>
+      match op2_add_cpm m e2 e1 with
+      | Some m => m
+      | None => m
+      end
+    end
+  | _ => m
+  end.
+
+Fixpoint const_prop_e_assert m e : cpm * pexpr :=
+  match e with
+  | Pvar x =>
+    let e := const_prop_e m e in
+    let m :=
+      match e with
+      | Pvar {|gv:={|v_var:={|vtype:=sbool|}|}|} => Mvar.set m x.(gv) (Cbool true)
+      | _ => m
+      end in
+    (m,e)
+  | Papp1 o e     =>
+    let (m',e) := const_prop_e_assert m e in
+    let m := op1_merge_m m m' o in
+    (m, s_op1 o e)
+  | Papp2 o e1 e2 =>
+    let (m1,e1) := const_prop_e_assert m e1 in
+    let (m2,e2) := const_prop_e_assert m e2 in
+    let m := op2_merge_m m m1 m2 o e1 e2 in
+    (m, s_op2 o e1 e2)
+  | Pif t e e1 e2 =>
+    let e := const_prop_e m e in
+    let (m1,e1) := const_prop_e_assert m e1 in
+    let (m2,e2) := const_prop_e_assert m e2 in
+    match is_bool e with
+    | Some b =>
+      let m := if b then m1 else m2 in
+      (m, s_if t e e1 e2) (* FIXME can we keep only eb ? *)
+    | None =>
+      let m := merge_cpm m1 m2 in
+      (m, s_if t e e1 e2)
+    end
+  | PappN (Ois_barr_init len) [:: et; e1; e2] =>
+    let et := const_prop_e m et in
+    let e1 := const_prop_e m e1 in
+    let e2 := const_prop_e m e2 in
+    if is_full_init len et then (m, Pbool true)
+    else
+      let m :=
+        match et with
+        | Pvar {| gv := x;  gs := Slocal|} =>
+          match is_const e1, is_const e2 with
+          | Some z1, Some z2 =>
+            if (z1 == 0%Z) && (z2 == Zpos len) then
+              Mvar.set m x (Cfull_init len)
+            else m
+          | _, _ => m
+          end
+        | _ => m
+        end
+      in
+      (m, PappN (Ois_barr_init len) [::et; e1; e2])
+
+  | _ =>
+      let e := const_prop_e m e in
+      (m,e)
+end.
+
+End GLOBALS.
+
+Definition empty_const_prop_e := const_prop_e without_globals empty_cpm.
+
+
+Definition const_prop_rv globs (m:cpm) (rv:lval) : cpm * lval :=
+  match rv with
+  | Lnone _ _       => (m, rv)
+  | Lvar  x         => (Mvar.remove m x, rv)
+  | Lmem al sz vi e => (m, Lmem al sz vi (const_prop_e globs m e))
+  | Laset al aa sz x e => (m, Laset al aa sz x (const_prop_e globs m e))
+  | Lasub aa sz len x e => (Mvar.remove m x, Lasub aa sz len x (const_prop_e globs m e))
+  end.
+
+Fixpoint const_prop_rvs globs (m:cpm) (rvs:lvals) : cpm * lvals :=
+  match rvs with
+  | [::] => (m, [::])
+  | rv::rvs =>
+    let (m,rv)  := const_prop_rv globs m rv in
+    let (m,rvs) := const_prop_rvs globs m rvs in
+    (m, rv::rvs)
+  end.
+
+Section LOOP.
+  Context `{asmop : asmOp}.
+
+  Variable cp_c : cpm ->  cpm * cmd.
+  Variable cp_c2 : cpm ->  cpm * (cpm * (cmd*cmd)).
+
+  Variable loop_fallback: cpm * cmd.
+
+  Variable wloop_fallback: cpm * (cmd * cmd).
+
+  Fixpoint loop (n:nat) (m:cpm) :=
+    match n with
+    | O => loop_fallback
+    | S n =>
+      let: (m', c'):= cp_c m in
+      if includes_cpm m' m then (m,c')
+      else loop n (merge_cpm m' m)
+    end.
+
+  Fixpoint wloop (n:nat) (m:cpm) :=
+    match n with
+    | O => wloop_fallback
+    | S n =>
+      let: (m2,(m1,cs)) := cp_c2 m in
+      if includes_cpm m2 m then (m1,cs)
+      else wloop n (merge_cpm m2 m)
+    end.
+
+End LOOP.
+
+Definition add_cpm (m:cpm) (rv:lval) (tag:assgn_tag) e cpf ty  :=
+  if rv is Lvar x then
+    if cpf rv tag e then
+      match e with
+      | Pbool b  => Mvar.set m x (Cbool b)
+      | Pconst z =>  Mvar.set m x (Cint z)
+      | Papp1 (Oword_of_int _) (Pconst z) =>
+        let szty := wsize_of_atype ty in
+        let szx := wsize_of_atype (vtype x) in
+        let sz := cmp_min szty szx in
+        let w := Cword (wrepr sz z) in
+        Mvar.set m x w
+      | PappN (Oarray len) es =>
+          if is_full_init len e then Mvar.set m x (Cfull_init len)
+          else m
+      | _ => m
+      end
+    else m
+  else m.
+
+Section ASM_OP.
+
+Context {msfsz : MSFsize} `{asmop:asmOp}.
+
+Section CMD.
+
+  Variable const_prop_i : cpm -> instr -> cpm * cmd.
+
+  Fixpoint const_prop (m:cpm) (c:cmd) : cpm * cmd :=
+    match c with
+    | [::] => (m, [::])
+    | i::c =>
+      let (m,ic) := const_prop_i m i in
+      let (m, c) := const_prop m c in
+      (m, ic ++ c)
+    end.
+
+End CMD.
+
+Definition is_update_imm (xs:lvals) o es :=
+  match o, es, xs with
+  | Oslh SLHupdate, [:: Pbool b; e], [:: x] => Some (x, b, e)
+  | _, _, _=> None
+  end.
+
+Section GLOBALS.
+
+Context (gd: glob_decls).
+
+Fixpoint const_prop_ir cpf (m:cpm) ii (ir:instr_r) : cpm * cmd :=
+  let const_prop_i :=  const_prop_i cpf in
+  match ir with
+  | Cassgn x tag ty e =>
+    let globs := with_globals gd tag in
+    let e := const_prop_e globs m e in
+    let (m,x) := const_prop_rv globs m x in
+    let m := add_cpm m x tag e cpf ty in
+    (m, [:: MkI ii (Cassgn x tag ty e)])
+
+  | Copn xs t o es =>
+    (* TODO: Improve this *)
+    let es := map (const_prop_e without_globals m) es in
+    let (m,xs) := const_prop_rvs without_globals m xs in
+    let ir :=
+      if is_update_imm xs o es is Some (x, b, e) then
+        if b then Copn [:: x ] AT_none (Oslh SLHmove) [:: e ]
+        else Cassgn x AT_none ty_msf (wconst (sz := msf_size) (-1))
+      else (Copn xs t o es)
+    in
+    (m, [:: MkI ii ir ])
+
+  | Csyscall xs o es =>
+    let es := map (const_prop_e without_globals m) es in
+    let (m,xs) := const_prop_rvs without_globals m xs in
+    (m, [:: MkI ii (Csyscall xs o es) ])
+
+  (* FIXME : provide explanation on this line *)
+  | Cassert ("safety_inv",e) =>
+    let (m,_) := const_prop_e_assert without_globals m e in
+    (m,[:: MkI ii ir])
+  | Cassert (t,e) =>
+    let (m,e) := const_prop_e_assert without_globals m e in
+    match is_bool e with
+      | Some e =>
+        let c := if e then [::] else [:: MkI ii (Cassert (t,Pbool e))] in
+        (m, c)
+      | None => (m, [:: MkI ii (Cassert (t,e))])
+    end
+  | Cif b c1 c2 =>
+    let b := const_prop_e without_globals m b in
+    match is_bool b with
+    | Some b =>
+      let c := if b then c1 else c2 in
+      const_prop const_prop_i m c
+    | None =>
+      let (m1,c1) := const_prop const_prop_i m c1 in
+      let (m2,c2) := const_prop const_prop_i m c2 in
+      (merge_cpm m1 m2, [:: MkI ii (Cif b c1 c2) ])
+    end
+
+  | Cfor x (dir, e1, e2) c =>
+    let e1 := const_prop_e without_globals m e1 in
+    let e2 := const_prop_e without_globals m e2 in
+    let loop_fallback :=
+      let m := remove_cpm m (write_i ir) in
+      let (_,c) := const_prop const_prop_i m c in
+      (m,c)
+    in
+    let dobody m' :=
+      let (m1,c1) := const_prop const_prop_i m' c in
+      (m1,c1)
+    in
+    let (m,c) := loop dobody loop_fallback Loop.nb m in
+    (m, [:: MkI ii (Cfor x (dir, e1, e2) c) ])
+
+  | Cwhile a c e info c' =>
+    let wloop_fallback :=
+      let m := remove_cpm m (write_i ir) in
+      let (m',c) := const_prop const_prop_i m c in
+      let (_,c') := const_prop const_prop_i m' c' in
+      (m',(c,c'))
+    in
+    let dobody m' :=
+      let (m1,c1) := const_prop const_prop_i m' c in
+      let (m2,c2) := const_prop const_prop_i m1 c' in
+      (m2,(m1,(c1,c2)))
+    in
+    let (m,cs) := wloop dobody wloop_fallback Loop.nb m in
+    let e := const_prop_e without_globals m e in
+    let cw :=
+      match is_bool e with
+      | Some false => cs.1
+      | _          => [:: MkI ii (Cwhile a cs.1 e info cs.2)]
+      end in
+    (m, cw)
+
+  | Ccall xs f es =>
+    let es := map (const_prop_e without_globals m) es in
+    let (m,xs) := const_prop_rvs without_globals m xs in
+    (m, [:: MkI ii (Ccall xs f es) ])
+
+  end
+
+with const_prop_i cpf (m:cpm) (i:instr) : cpm * cmd :=
+  let (ii,ir) := i in
+  const_prop_ir cpf m ii ir.
+
+End GLOBALS.
+
+Section Section.
+
+Context {pT: progT}.
+
+Let with_globals_cl (gd: glob_decls) : globals := Some (assoc gd).
+
+(* Receives two lists of corresponding variables and adds to the state
+   that if one variable is a constant then the corresponding one will be as well *)
+Fixpoint translate_vars_contract (p:seq var_i) (p':seq var_i) (m:cpm) : cpm :=
+  match p, p' with
+  | x::p, x'::p' =>
+    if Mvar.get m x is Some n then
+      translate_vars_contract p p' (Mvar.set m x' n)
+    else
+      translate_vars_contract p p' m
+  | _ , _ => m
+end.
+
+(* In addition to doing constant_prop with an empty state for the post condition,
+  to help in the proofs, if we know that some condition is true, we can
+  add the corresponding assignment to the body of the function.
+  For example, if we know that b_a is fully initialized,
+  and we have a post condition that uses b_a,
+  we can add an assignment of an array with all elements true to the end of the
+  body of the function
+*)
+
+Definition assign_full_init (m:cpm) (assocs : list (var * var_i)) (x:var) :=
+  match assoc assocs x with
+  | Some x' =>
+    if Mvar.get m x' is Some (Cfull_init n) then
+     Some (MkI dummy_instr_info (Cassgn (Lvar x') AT_inline (aarr U8 n) (const (Cfull_init n))))
+    else None
+  | None => None
+  end.
+
+Definition assigns_full_init (m:cpm) (f:fundef) :=
+  match  f.(f_contra) with
+  | None => [::]
+  | Some ci =>
+    let fv := Sv.elements (foldl (fun fv e => read_e_rec fv e.2) Sv.empty ci.(f_post)) in
+    let assocs := zip (map v_var ci.(f_ires)) f.(f_res) in
+    pmap (assign_full_init m assocs) fv
+  end.
+
+Definition const_prop_fun (gd: glob_decls) cpf (f: fundef) :=
+  let with_globals := if cl then (fun _ _ => with_globals_cl gd) else with_globals in
+  let without_globals := if cl then with_globals_cl gd else without_globals in
+  let 'MkFun ii ci si p c so r ev := f in
+  let mc := const_prop (const_prop_i gd cpf) empty_cpm c in
+  let extra_body := assigns_full_init mc.1 f in
+  let c:= mc.2 ++ extra_body in
+  MkFun ii ci si p c so r ev.
+
+(* cpf is a function that indicates what should be propagated,
+receiving the paraments of the Cassgn (with the exception of the type)
+and returning a bool that indicates whether to propagate or not*)
+Definition const_prop_prog_fun (p:prog) (cpf:lval -> assgn_tag -> pexpr -> bool) : prog :=
+  map_prog (const_prop_fun p.(p_globs) cpf) p.
+
+Definition const_prop_prog (p:prog) : prog :=
+  const_prop_prog_fun p (fun _ tag _ =>  (tag == AT_inline)).
+
+End Section.
+
+End ASM_OP.
+End CL_FLAG.
+End WITH_PARAMS.
+
diff --git a/proofs/ec_extraction/contracts_asserts.v b/proofs/ec_extraction/contracts_asserts.v
new file mode 100644
index 0000000000..a9d72b5e81
--- /dev/null
+++ b/proofs/ec_extraction/contracts_asserts.v
@@ -0,0 +1,236 @@
+Require Import expr compiler_util utils safety_shared operators.
+From mathcomp Require Import eqtype .
+
+Section PROG.
+Context `{asmop:asmOp}.
+Context {pT: progT}.
+
+Section CMD.
+
+Variable contracts_asserts_i: (funname -> option ufundef) -> instr -> cmd.
+
+Definition contracts_asserts gf c : cmd := conc_map (contracts_asserts_i gf) c.
+
+End CMD.
+
+Fixpoint has_var_e (xs: seq var_i) (e: pexpr) : bool :=
+  match e with
+  | Pconst _ => false
+  | Pbool _ => false
+  | Parr_init _ _ => false
+  | Papp1 _ e
+  | Pload _ _ e => has_var_e xs e
+  | Pvar x => List.existsb (fun x' => var_beq x.(gv).(v_var) x'.(v_var)) xs
+  | Pget _ _ _ x e
+  | Psub _ _ _ x e => List.existsb (fun x' => var_beq x.(gv).(v_var) x'.(v_var)) xs || has_var_e xs e
+  | Pis_mem_init e1 e2
+  | Papp2 _ e1 e2 => has_var_e xs e1 || has_var_e xs e2
+  | PappN _ es => has (fun e => has_var_e xs e) es
+  | Pif _ e1 e2 e3 =>
+      has_var_e xs e1 || has_var_e xs e2 || has_var_e xs e3
+  | Pbig e1 _ x e2 e3 e4 =>
+    has_var_e xs e1 || has_var_e xs e2 || has_var_e xs e3 || has_var_e xs e4 || List.existsb (fun x' => var_beq x.(v_var) x'.(v_var)) xs
+  | Pis_var_init x => List.existsb (fun x' => var_beq x.(v_var) x'.(v_var)) xs
+  end.
+
+
+Definition lval_to_vare (lv: lval) : option pexpr :=
+  match lv with
+  | Lnone vi ty => None
+  | Lmem _ _ _ e => Some e
+  | Lvar x
+  | Laset _ _ _ x _
+  | Lasub _ _ _ x _ => Some (Plvar x)
+  end.
+
+Fixpoint get_expr_contract (v: var_i) (vs: seq var_i) (es:seq (option pexpr)) : option pexpr :=
+  match vs, es with
+  | x::vs, (Some x')::es =>
+    if var_beq v x then Some x' else get_expr_contract v vs es
+  | _, _ => None
+  end.
+
+
+Fixpoint replace_expr_contract (vs:seq var_i) (es:seq (option pexpr)) (e:pexpr): pexpr:=
+  match e with
+  | Pvar x =>
+    match get_expr_contract x.(gv) vs es with
+    | Some x' => x'
+    | _ => e
+    end
+  | Pget a aa ws x e =>
+    let e := replace_expr_contract vs es e in
+    match get_expr_contract x.(gv) vs es with
+    | Some (Pvar x') => Pget a aa ws x' e
+    | _ => e
+    end
+  | Psub aa ws l x e =>
+    let e := replace_expr_contract vs es e in
+    match get_expr_contract x.(gv) vs es with
+    | Some (Pvar x') => Psub aa ws l x' e
+    | _ => e
+    end
+  | Pload a ws e =>
+    let e := replace_expr_contract vs es e in
+    Pload a ws e
+  | Papp1 o e =>
+    let e := replace_expr_contract vs es e in
+    Papp1 o e
+  | Papp2 o e1 e2 =>
+    let e1 := replace_expr_contract vs es e1 in
+    let e2 := replace_expr_contract vs es e2 in
+    Papp2 o e1 e2
+  | PappN o es' =>
+    let es' := map (replace_expr_contract vs es) es' in
+    PappN o es'
+  | Pif ty e1 e2 e3 =>
+    let e1 := replace_expr_contract vs es e1 in
+    let e2 := replace_expr_contract vs es e2 in
+    let e3 := replace_expr_contract vs es e3 in
+    Pif ty e1 e2 e3
+  | Pbig e1 o x e2 e3 e4 =>
+    let e1 := replace_expr_contract vs es e1 in
+    let e2 := replace_expr_contract vs es e2 in
+    let e3 := replace_expr_contract vs es e3 in
+    let e4 := replace_expr_contract vs es e4 in
+    match get_expr_contract x vs es with
+    | Some (Pvar x') => Pbig e1 o x'.(gv) e2 e3 e4
+    | _ => e
+    end
+  | Pis_var_init x =>
+    match get_expr_contract x vs es with
+    | Some (Pvar x') => Pis_var_init x'.(gv)
+    | _ => e
+    end
+  | Pis_mem_init e1 e2 =>
+    let e1 := replace_expr_contract vs es e1 in
+    let e2 := replace_expr_contract vs es e2 in
+    Pis_mem_init e1 e2
+  | _ => e
+  end.
+
+Definition disjoint_assign (lvs: seq lval) (es: pexprs) : bool :=
+  let lvs := read_rvs lvs in
+  let es := read_es es in
+  Sv.is_empty (Sv.inter lvs es).
+
+Fixpoint contracts_asserts_i (gf:funname-> option ufundef) i:=
+  let 'MkI ii ir := i in
+  match ir with
+  | Ccall lvs n es =>
+    match gf n with
+    | Some f' =>
+      match f'.(f_contra) with
+      | (Some ci) =>
+        let asserts := conc_map (fun (e:assertion) =>
+            if (disjoint_assign lvs es) then
+              let (_,e) := e in
+              let lvs := map (fun x => lval_to_vare x) lvs in
+              let es := map (fun e => Some e) es in
+              let e := replace_expr_contract ci.(f_iparams) es e in
+              let e :=  replace_expr_contract ci.(f_ires) lvs e in
+              if has_var_e (ci.(f_iparams) ++ ci.(f_ires)) e then [::]
+              else safe_assert ii [::e]
+            else [::]
+        ) ci.(f_post) in
+        i :: asserts
+      | _ => [::i]
+      end
+    | _ => [::i]
+    end
+  | Cif e c1 c2 =>
+    let c1 := contracts_asserts contracts_asserts_i gf c1 in
+    let c2 := contracts_asserts contracts_asserts_i gf c2 in
+    [:: MkI ii (Cif e c1 c2)]
+  | Cfor x r c =>
+    let c := contracts_asserts contracts_asserts_i gf c in
+    [:: MkI ii (Cfor x r c)]
+  | Cwhile a c1 e w_ii c2 =>
+    let c1 := contracts_asserts contracts_asserts_i gf c1 in
+    let c2 := contracts_asserts contracts_asserts_i gf c2 in
+    [:: MkI ii (Cwhile a c1 e w_ii c2)]
+  | _ => [::i]
+  end.
+
+Definition contracts_asserts_cmd gf c : cmd := contracts_asserts contracts_asserts_i gf c.
+
+Fixpoint replace_vars_contract (vs:seq var_i) (vs': seq var_i) (e:pexpr): pexpr:=
+  match e with
+  | Pvar x =>
+    match get_var_contract x.(gv) vs vs' with
+    | Some x' => Plvar x'
+    | _ => e
+    end
+  | Pget a aa ws x e =>
+    let e := replace_vars_contract vs vs' e in
+    match get_var_contract x.(gv) vs vs' with
+    | Some x' => Pget a aa ws (mk_lvar x') e
+    | _ => e
+    end
+  | Psub aa ws l x e =>
+    let e := replace_vars_contract vs vs' e in
+    match get_var_contract x.(gv) vs vs' with
+    | Some x' => Psub aa ws l (mk_lvar x') e
+    | _ => e
+    end
+  | Pload a ws e =>
+    let e := replace_vars_contract vs vs' e in
+    Pload a ws e
+  | Papp1 o e =>
+    let e := replace_vars_contract vs vs' e in
+    Papp1 o e
+  | Papp2 o e1 e2 =>
+    let e1 := replace_vars_contract vs vs' e1 in
+    let e2 := replace_vars_contract vs vs' e2 in
+    Papp2 o e1 e2
+  | PappN o es =>
+    let es := map (replace_vars_contract vs vs') es in
+    PappN o es
+  | Pif ty e1 e2 e3 =>
+    let e1 := replace_vars_contract vs vs' e1 in
+    let e2 := replace_vars_contract vs vs' e2 in
+    let e3 := replace_vars_contract vs vs' e3 in
+    Pif ty e1 e2 e3
+  | Pbig e1 o x e2 e3 e4 =>
+    let e1 := replace_vars_contract vs vs' e1 in
+    let e2 := replace_vars_contract vs vs' e2 in
+    let e3 := replace_vars_contract vs vs' e3 in
+    let e4 := replace_vars_contract vs vs' e4 in
+    match get_var_contract x vs vs' with
+    | Some x' => Pbig e1 o x' e2 e3 e4
+    | _ => e
+    end
+  | Pis_var_init x =>
+    match get_var_contract x vs vs' with
+    | Some x' => Pis_var_init x'
+    | _ => e
+    end
+  | Pis_mem_init e1 e2 =>
+    let e1 := replace_vars_contract vs vs' e1 in
+    let e2 := replace_vars_contract vs vs' e2 in
+    Pis_mem_init e1 e2
+  | _ => e
+  end.
+
+Definition pre_cond_asserts (ci:fun_contract) (params: seq var_i) :=
+  let do_c (c:assertion) :=
+    let (_,e):= c in
+    replace_vars_contract ci.(f_iparams) params e in
+  let pre := map do_c ci.(f_pre) in
+  safe_assert dummy_instr_info pre.
+
+Definition contracts_asserts_f gf (f:ufundef) : ufundef :=
+  let 'MkFun ii ci si p c so r ev := f in
+  let asserts :=
+    match ci with
+    | Some ci => pre_cond_asserts ci p
+    | None => [::]
+    end in
+  let c := contracts_asserts_cmd gf c in
+  MkFun ii ci si p (asserts++c) so r ev.
+
+Definition contracts_asserts_prog (p:_uprog) : _uprog :=
+  let get_f := get_fundef p.(p_funcs) in
+  map_prog (contracts_asserts_f get_f) p.
+
+End PROG.
diff --git a/proofs/ec_extraction/extra_vars_call.v b/proofs/ec_extraction/extra_vars_call.v
new file mode 100644
index 0000000000..34fca13abf
--- /dev/null
+++ b/proofs/ec_extraction/extra_vars_call.v
@@ -0,0 +1,88 @@
+From mathcomp Require Import ssreflect ssrbool.
+Require Import utils expr.
+Require Import compiler_util.
+Require Import operators.
+
+Module Import E.
+
+  Definition pass : string := "extra_var_call".
+
+  Definition ierror msg := {|
+    pel_msg      := PPEstring msg;
+    pel_fn       := None;
+    pel_fi       := None;
+    pel_ii       := None;
+    pel_vi       := None;
+    pel_pass     := Some pass;
+    pel_internal := true
+  |}.
+
+End E.
+
+Section ASM_OP.
+Context `{asmop:asmOp}.
+Context (create_var : v_kind -> string -> atype -> var_info -> var).
+
+Definition create_fresh_var (name : string) (ty: atype): var_i :=
+    let x := create_var (Reg(Normal, Direct)) name ty dummy_var_info in
+    mk_var_i x.
+
+Section Section.
+Context (get_fun: funname -> option ufundef).
+
+(* Ensure that the arguments and the destination are uniq variables. This is useful to validate the next passes *)
+
+Definition extra_vars_call_c (extra_vars_call_i : instr -> cexec cmd) (c:cmd) :=
+  Let c := mapM extra_vars_call_i c in
+  ok (flatten c).
+
+Fixpoint extra_vars_call_i (fv: Sv.t) (i:instr) : cexec cmd :=
+    let 'MkI ii ir := i in
+    match ir with
+    | Cif e c1 c2 =>
+      Let c1 := extra_vars_call_c (extra_vars_call_i fv) c1 in
+      Let c2 := extra_vars_call_c (extra_vars_call_i fv) c2 in
+      let i := MkI ii (Cif e c1 c2) in
+      ok [::i]
+    | Cwhile a c1 e ii_w c2 =>
+      Let c1 := extra_vars_call_c (extra_vars_call_i fv) c1 in
+      Let c2 := extra_vars_call_c (extra_vars_call_i fv) c2 in
+      let i := MkI ii (Cwhile a c1 e ii_w c2) in
+      ok [::i]
+    | Cfor x r c =>
+      Let c := extra_vars_call_c (extra_vars_call_i fv) c in
+      let i := MkI ii (Cfor x r c) in
+      ok [::i]
+    | Ccall lvs n es =>
+      match get_fun n with
+      | Some (MkFun _ _ ty_in _ _ ty_out _ _) =>
+        let params := map (create_fresh_var "param") ty_in in
+        let xs := map (create_fresh_var "result") ty_out in
+        Let _ := assert ([&& uniq (map v_var params),
+                             uniq (map v_var xs),
+                             disjoint fv (sv_of_list v_var params) &
+                             disjoint fv (sv_of_list v_var xs)])
+                          (E.ierror "create_fresh_var not fresh"%string) in
+        let pre := map3 (fun ty x e => MkI ii (Cassgn (Lvar x) AT_inline ty e)) ty_in params es in
+        let params := map (Plvar) params in
+        let post :=  map3 (fun ty lv x => MkI ii (Cassgn lv AT_inline ty (Plvar x))) ty_out lvs xs in
+        let xs := map (Lvar) xs in
+        ok (pre ++ [::MkI ii (Ccall xs n params)] ++ post)
+      | _ => ok [::i]
+      end
+    | Cassgn _ _ _ _ | Copn _ _ _ _ | Csyscall _ _ _ | Cassert _ => ok [::i]
+    end.
+
+Definition extra_vars_call_fn (f: ufundef) : cexec ufundef :=
+  let fv := vars_fd f in
+  Let c := extra_vars_call_c (extra_vars_call_i fv) f.(f_body) in
+  ok (with_body f c).
+
+End Section.
+
+Definition extra_vars_call_prog (p:_uprog) : cexec _uprog :=
+  let get_f := get_fundef p.(p_funcs) in
+  Let funcs := map_cfprog (extra_vars_call_fn get_f) p.(p_funcs) in
+  ok {| p_extra := p_extra p; p_globs := p_globs p; p_funcs := funcs |}.
+
+End ASM_OP.
diff --git a/proofs/ec_extraction/insert_cast.v b/proofs/ec_extraction/insert_cast.v
new file mode 100644
index 0000000000..94348d175a
--- /dev/null
+++ b/proofs/ec_extraction/insert_cast.v
@@ -0,0 +1,118 @@
+From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype.
+Require Import expr compiler_util word safety.
+
+Module Import E.
+
+  Definition pass : string := "insert_cast".
+
+  Definition ierror msg := {|
+    pel_msg      := PPEstring msg;
+    pel_fn       := None;
+    pel_fi       := None;
+    pel_ii       := None;
+    pel_vi       := None;
+    pel_pass     := Some pass;
+    pel_internal := true
+  |}.
+
+End E.
+
+Section INSERT.
+
+Context `{asmop:asmOp} {pd: PointerData} {msfsz : MSFsize}.
+
+Definition add_cast (e : pexpr) (ty : atype) : pexpr :=
+  let ety := type_of_expr e in
+  if convertible ety ty then e
+  else match ty, ety with
+  | aword ws, aword ews =>
+      if (ws <= ews)%CMP then Papp1 (Ozeroext ws ews) e
+      else e
+  | _, _ => e
+  end.
+
+Fixpoint insert_cast_e (e : pexpr) : pexpr :=
+  match e with
+  | Pconst _ | Pbool _ | Parr_init _ _ | Pvar _ | Pis_var_init _ => e
+  | Pget al aa ws x e => Pget al aa ws x (insert_cast_e e)
+  | Psub al ws len x e => Psub al ws len x (insert_cast_e e)
+  | Pload al ws e => Pload al ws (insert_cast_e e)
+  | Papp1 o e =>
+      Papp1 o (add_cast (insert_cast_e e) (type_of_op1 o).1)
+  | Papp2 o e1 e2 =>
+      let: (ty1, ty2, _) := type_of_op2 o in
+      Papp2 o (add_cast (insert_cast_e e1) ty1) (add_cast (insert_cast_e e2) ty2)
+  | PappN o es =>
+      let tys := (type_of_opN o).1 in
+      let es := map insert_cast_e es in
+      if size tys == size es then PappN o (map2 add_cast es tys)
+      else e
+  | Pif ty e1 e2 e3 =>
+    Pif ty (insert_cast_e e1) (add_cast (insert_cast_e e2) ty) (add_cast (insert_cast_e e3) ty)
+  | Pbig _ _ _ _ _ _  => e (* This will be removed *)
+  | Pis_mem_init e1 e2 => Pis_mem_init (insert_cast_e e1) (insert_cast_e e2)
+  end.
+
+Definition insert_cast_lv (lv : lval) :=
+  match lv with
+  | Lnone _ _ | Lvar _ => lv
+  | Lmem al ws vi e => Lmem al ws vi (insert_cast_e e)
+  | Laset al aa ws x e => Laset al aa ws x (insert_cast_e e)
+  | Lasub aa ws len x e => Lasub aa ws len x e
+  end.
+
+Definition insert_cast_lvs := map insert_cast_lv.
+
+Definition insert_cast_assertion (a : assertion) := (a.1, insert_cast_e a.2).
+Definition insert_cast_assertions := map insert_cast_assertion.
+
+Section PROG.
+
+Context (p : _uprog).
+
+Fixpoint insert_cast_i (i : instr) :=
+  let (ii, ir) := i in
+  let ir :=
+    match ir with
+    | Cassgn x tag ty e => Cassgn (insert_cast_lv x) tag ty (add_cast (insert_cast_e e) ty)
+    | Copn xs tag o es =>
+      let tys := sopn_tin o in
+      let es := map insert_cast_e es in
+      if size tys == size es then Copn (insert_cast_lvs xs) tag o (map2 add_cast es tys)
+      else ir
+    | Csyscall xs o es =>
+      let tys := scs_tin (syscall_sig_u o) in
+      let es := map insert_cast_e es in
+      if size tys == size es then Csyscall (insert_cast_lvs xs) o (map2 add_cast es tys)
+      else ir
+    | Cassert a => Cassert (insert_cast_assertion a)
+    | Cif e c1 c2 => Cif (insert_cast_e e) (map insert_cast_i c1) (map insert_cast_i c2)
+    | Cfor x (d, e1, e2) c => Cfor x (d, insert_cast_e e1, insert_cast_e e2) (map insert_cast_i c)
+    | Cwhile al c1 e ii c2 =>
+        Cwhile al (map insert_cast_i c1) (insert_cast_e e) ii (map insert_cast_i c2)
+    | Ccall xs f es =>
+      match get_fundef (p_funcs p) f with
+      | None => ir
+      | Some fd =>
+        let tys := f_tyin fd in
+        let es := map insert_cast_e es in
+        if size tys == size es then Ccall (insert_cast_lvs xs) f (map2 add_cast es tys)
+        else ir
+      end
+    end in
+  MkI ii ir.
+
+Definition insert_cast_fc (fc : fun_contract) :=
+  let (p, r, pre, post) := fc in
+  MkContra p r (insert_cast_assertions pre) (insert_cast_assertions post).
+
+Definition insert_cast_fd (fd : ufundef) :=
+  let (fi, fc, fti, fp, fb, fto, fr, fe) := fd in
+  MkFun fi (omap insert_cast_fc fc) fti fp (map insert_cast_i fb) fto fr fe.
+
+Definition insert_cast_prog :=
+  map_prog insert_cast_fd p.
+
+End PROG.
+
+End INSERT.
diff --git a/proofs/ec_extraction/insert_cast_proof.v b/proofs/ec_extraction/insert_cast_proof.v
new file mode 100644
index 0000000000..081206c121
--- /dev/null
+++ b/proofs/ec_extraction/insert_cast_proof.v
@@ -0,0 +1,405 @@
+From HB Require Import structures.
+From Coq Require Import ZArith.
+From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssralg word_ssrZ.
+Require Import compiler_util psem psem_facts safety safety_shared_proof safety_proof insert_cast.
+Import Utf8.
+
+Local Open Scope Z_scope.
+Local Open Scope seq_scope.
+
+Section PROOF.
+#[local] Existing Instance progUnit.
+
+Context
+  {asm_op syscall_state : Type}
+  {ep : EstateParams syscall_state}
+  {spp : SemPexprParams}
+  {sip : SemInstrParams asm_op syscall_state}.
+
+#[local] Existing Instance sCP_unit.
+#[local] Existing Instance nosubword.
+#[local] Existing Instance indirect_c.
+#[local] Existing Instance withassert.
+Context {E E0: Type -> Type} {wE : with_Error E E0} {rE : EventRels E0}.
+
+Variable (p :uprog) (ev:extra_val_t).
+
+Notation gd := (p_globs p).
+
+Definition value_wuincl (v1 v2 : value) : Prop :=
+  match v1, v2 with
+  | Vword sz1 w1, Vword sz2 w2 => word_uincl w1 w2
+  | _, _ => v1 = v2
+  end.
+
+Lemma value_wuincl_uincl (v1 v2 : value) :
+  value_wuincl v1 v2 -> value_uincl v1 v2.
+Proof.
+  case: v1 => >; case: v2 => > //=.
+  1, 2 : by move=> [->].
+  + by move=> /Varr_inj [? <-]; subst.
+  by move=> [->].
+Qed.
+
+Lemma value_wuincl_refl v : value_wuincl v v.
+Proof. by case v => //=. Qed.
+Hint Resolve value_wuincl_refl : core.
+
+Lemma add_castP s e ty v :
+  sem_pexpr true gd s (add_cast e ty) = ok v ->
+  exists2 v', sem_pexpr true gd s e = ok v' & value_wuincl v v'.
+Proof.
+  rewrite /add_cast.
+  case: ifP.
+  + by move=> *; exists v.
+  move=> _.
+  case: ty; try by move => *; exists v.
+  move=> ws; case heq: type_of_expr; try by move=> *;exists v.
+  case: ifP; last by move=> *; exists v.
+  move=> hle /=; t_xrbindP => v' hv'.
+  rewrite /sem_sop1 /=; t_xrbindP => w /to_wordI' [ws' [w' [hle' ??]]] <-.
+  exists v' => //; subst v' w => /=.
+  rewrite zero_extend_idem //.
+  by apply word_uincl_zero_ext; apply: cmp_le_trans hle hle'.
+Qed.
+
+Lemma add_castsP s es tys vs :
+  size tys = size es ->
+  sem_pexprs true gd s (map2 add_cast es tys) = ok vs ->
+  exists2 vs', sem_pexprs true gd s es = ok vs' & List.Forall2 value_wuincl vs vs'.
+Proof.
+  elim: es tys vs => [ | e es ih] [|ty tys] //=.
+  + by move=> ? _ [<-]; exists [::].
+  move=> vs [] /ih{}ih; t_xrbindP => > /add_castP [v' -> ?] > /ih [vs' -> ?] <-.
+  by exists (v' :: vs') => //; constructor.
+Qed.
+
+Lemma value_wuincl_truncate_val ty v1 v2 v :
+  value_wuincl v1 v2 -> truncate_val ty v1 = ok v -> truncate_val ty v2 = ok v.
+Proof.
+  case: v1 => >; case: v2 => > //=.
+  1-3,5: by move=> ->.
+  move=> hu /truncate_valE [ws [w [-> htr ->]]].
+  by rewrite /truncate_val /= (word_uincl_truncate hu htr).
+Qed.
+
+Lemma vwuincl_truncate_val vs1 vs2 vs tys :
+  List.Forall2 value_wuincl vs1 vs2 ->
+  mapM2 ErrType truncate_val tys vs1 = ok vs ->
+  mapM2 ErrType truncate_val tys vs2 = ok vs.
+Proof.
+  move=> hwu; elim: hwu tys vs => //= {vs1 vs2}.
+  move=> v1 v2 vs1 vs2 hwu hwus hrec [ | ty tys] vs //=; t_xrbindP.
+  move=> > htr1 > /hrec -> <-.
+  by rewrite (value_wuincl_truncate_val hwu htr1).
+Qed.
+
+Lemma vwuincl_sem_opN op vs vs' v :
+  List.Forall2 value_wuincl vs vs' → sem_opN op vs = ok v → sem_opN op vs' = ok v.
+Proof.
+  move=> hwu /sem_opN_truncate_val [vs1] [hmap].
+  rewrite /sem_opN; t_xrbindP => /= v1 hv1 <-.
+  have -> //: app_sopn [seq eval_atype i | i <- (type_of_opN op).1] (sem_opN_typed op) vs' = ok v1.
+  apply: truncate_val_app_sopn hv1.
+  apply: vwuincl_truncate_val hwu hmap.
+Qed.
+
+Lemma vwuincl_exec_sopn o vs1 vs2 vs:
+  List.Forall2 value_wuincl vs1 vs2 ->
+  exec_sopn o vs1 = ok vs → exec_sopn o vs2 = ok vs.
+Proof.
+  move=> hu; rewrite /exec_sopn /=; t_xrbindP => /= f -> /= vs' h <-.
+  have [vs'' [htr happ]] := app_sopn_truncate_val h.
+  have -> // : app_sopn [seq eval_atype i | i <- tin (get_instr_desc o)] f vs2 = ok vs'.
+  apply: truncate_val_app_sopn happ.
+  apply: vwuincl_truncate_val hu htr.
+Qed.
+
+Lemma vwuincl_exec_syscall o s s' vs1 vs2 :
+  List.Forall2 value_wuincl vs1 vs2 ->
+  fexec_syscall o (mk_fstate vs1 s) = ok s' ->
+  fexec_syscall o (mk_fstate vs2 s) = ok s'.
+Proof.
+  case: o => ws len; rewrite /fexec_syscall /=.
+  set wlen := (_ * _)%positive.
+  rewrite /exec_getrandom_u; case => // v1 v2 {}vs1 {}vs2 hu [] //.
+  t_xrbindP => > /to_arrI ? ? hf <- <- [<-]; subst v1.
+  by move: hu => /= <- /=; rewrite WArray.castK /= hf /=.
+Qed.
+
+Section EXPR.
+
+Let Pe e :=
+  forall s v,
+  sem_pexpr true gd s (insert_cast_e e) = ok v ->
+  sem_pexpr true gd s e = ok v.
+
+Let Qe es :=
+  forall s vs,
+  sem_pexprs true gd s (map insert_cast_e es) = ok vs ->
+  sem_pexprs true gd s es = ok vs.
+
+Lemma insert_cast_eP_aux: (forall e, Pe e) /\ (forall es, Qe es).
+Proof.
+  apply: pexprs_ind_pair; subst Pe Qe; split => //=.
+  + by move=> > he > hes >; t_xrbindP => > /he -> /= > /hes -> <-.
+  1,2:
+    by move=> > he >; apply on_arr_gvarP => > ? ->;
+       rewrite /on_arr_var /=; t_xrbindP => > /he -> /= -> /= ? -> <-.
+  + by move=> > he >; t_xrbindP => > /he -> /= -> /= ? -> <-.
+  + move=> > he >; t_xrbindP => v /add_castP [v' /he] -> /= hwu.
+    by apply/vuincl_sem_sop1/value_wuincl_uincl.
+  + move=> > he1 > he2 > /=.
+    case: type_of_op2 => -[ty1 ty2 _] /=.
+    t_xrbindP => > /add_castP [? /he1] -> ? > /add_castP [? /he2] -> /= ?.
+    by apply vuincl_sem_sop2; apply value_wuincl_uincl.
+  + move=> > hes >; case: eqP => //= hsz; t_xrbindP => > /(add_castsP hsz) [vs' /hes].
+    by rewrite /sem_pexprs => -> /=; apply vwuincl_sem_opN.
+  + move=> > he > he1 > he2; t_xrbindP => > /he -> /= ->.
+    move=> > /add_castP [v1' /he1 ->] /=.
+    move=> hu1 htr1; rewrite (value_wuincl_truncate_val hu1 htr1) /=.
+    move=> > /add_castP [v2' /he2 ->] /=.
+    by move=> hu2 htr2 <-; rewrite (value_wuincl_truncate_val hu2 htr2) /=.
+  by move=> > he1 he2 >; t_xrbindP => > /he1 -> /= -> > /he2 -> /= -> /= <-.
+Qed.
+
+Lemma insert_cast_eP : forall e, Pe e.
+Proof. apply insert_cast_eP_aux. Qed.
+
+Lemma insert_cast_esP : forall e, Qe e.
+Proof. apply insert_cast_eP_aux. Qed.
+
+End EXPR.
+
+Lemma insert_cast_lvP lv v s s' :
+  write_lval true gd (insert_cast_lv lv) v s = ok s' ->
+  write_lval true gd lv v s = ok s'.
+Proof.
+  case: lv => //=.
+  + by t_xrbindP => > _ > /insert_cast_eP -> /= -> > -> /= > -> /= ->.
+  move=> >; apply on_arr_varP => >.
+  by rewrite /on_arr_var /=; t_xrbindP => > ? -> /= > /insert_cast_eP -> /= -> > -> > /= -> /= ->.
+Qed.
+
+Lemma insert_cast_lvsP lvs vs s s' :
+  write_lvals true gd s (insert_cast_lvs lvs) vs = ok s' ->
+  write_lvals true gd s lvs vs = ok s'.
+Proof.
+  elim : lvs vs s => // lv lvs hrec [ | v vs] //= s.
+  by t_xrbindP => > /insert_cast_lvP -> /= /hrec ->.
+Qed.
+
+Definition fs_wuincl := fs_rel (List.Forall2 value_wuincl).
+
+Definition wuincl_spec : EquivSpec :=
+  {| rpreF_ := fun (fn1 fn2 : funname) (fs1 fs2 : fstate) => fn1 = fn2 /\ fs_wuincl fs1 fs2
+   ; rpostF_ := fun (fn1 fn2 : funname) (fs1 fs2 fr1 fr2: fstate) => fr1 = fr2 |}.
+
+Let pi := map_prog (insert_cast_fd p) p.
+
+Lemma value_wuincl_dc_truncate_vals ty v1 v2 v :
+  List.Forall2 value_wuincl v1 v2 ->
+  mapM2 ErrType dc_truncate_val ty v1 = ok v ->
+  mapM2 ErrType dc_truncate_val ty v2 = ok v.
+Proof.
+  move=> h; elim: h ty v => //= > hu hus ih [ | ty tys] //= v.
+  t_xrbindP => > htr > /ih -> <-.
+  by rewrite /dc_truncate_val (value_wuincl_truncate_val hu htr).
+Qed.
+
+Lemma insert_cast_iparams fc: f_iparams (insert_cast_fc fc) = f_iparams fc.
+Proof. by case: fc. Qed.
+
+Lemma insert_cast_e_condP s e b:
+  sem_cond gd (insert_cast_e e) s = ok b ->
+  sem_cond gd e s = ok b.
+Proof. by rewrite /sem_cond; t_xrbindP => > /insert_cast_eP -> /=. Qed.
+
+Lemma insert_cast_assertionP s ass v:
+  sem_assert gd s (insert_cast_assertion ass) = ok v ->
+  sem_assert gd s ass = ok v.
+Proof.
+  rewrite /insert_cast_assertion /sem_assert /=.
+  by t_xrbindP => > /insert_cast_e_condP -> /= -> <-.
+Qed.
+
+Lemma insert_cast_assertionsP s ass v:
+  mapM (sem_assert gd s) (insert_cast_assertions ass) = ok v ->
+  mapM (sem_assert gd s) ass = ok v.
+Proof.
+  elim: ass v => //= a ass ih v; t_xrbindP.
+  by move=> /insert_cast_assertionP -> /= > /ih -> /= <-.
+Qed.
+
+Lemma fs_wuincl_sem_pre fn fs1 fs2:
+  fs_wuincl fs1 fs2 ->
+  sem_pre pi fn fs1 = ok tt -> sem_pre p fn fs2 = ok tt.
+Proof.
+  rewrite /sem_pre get_map_prog /= => -[<- <- hwu].
+  case: get_fundef=> [fd | //] /=.
+  case: fd => /= _ [] //= func funty _ _ _ _ _.
+  t_xrbindP => v /(value_wuincl_dc_truncate_vals hwu) -> /= >.
+  have [-> ->] :
+     f_iparams (insert_cast_fc func) = f_iparams func /\
+     f_pre (insert_cast_fc func) = insert_cast_assertions (f_pre func) by case: func.
+  by move => -> /= > /insert_cast_assertionsP ->.
+Qed.
+
+Lemma wuincl_sem_post f vs1 vs2 fr :
+  List.Forall2 value_wuincl vs1 vs2 ->
+  sem_post pi f vs1 fr = ok tt → sem_post p f vs2 fr = ok tt.
+Proof.
+  rewrite /sem_post get_map_prog /= => hwu.
+  case: get_fundef=> [fd | //] /=.
+  case: fd => /= _ [] //= func funty _ _ _ _ _.
+  t_xrbindP => v /(value_wuincl_dc_truncate_vals hwu) -> /= >.
+  have [-> -> ->] :
+     [/\ f_iparams (insert_cast_fc func) = f_iparams func
+       , f_ires (insert_cast_fc func) = f_ires func
+       & f_post (insert_cast_fc func) = insert_cast_assertions (f_post func)] by case: func.
+  by move => -> /= > -> > /= /insert_cast_assertionsP ->.
+Qed.
+
+Lemma p_extraP : p_extra pi = p_extra p.
+Proof. done. Qed.
+
+Lemma insert_cast_initialize_funcall fd fs1 fs2 s :
+  fs_wuincl fs1 fs2 ->
+  initialize_funcall pi ev (insert_cast_fd p fd) fs1 = ok s ->
+  initialize_funcall p ev fd fs2 = ok s.
+Proof.
+  rewrite /initialize_funcall /estate0; t_xrbindP.
+  move=> [<- <- hwu] > /(value_wuincl_dc_truncate_vals hwu).
+  have [-> -> ->] : [/\ f_tyin (insert_cast_fd p fd) = f_tyin fd
+              , f_extra  (insert_cast_fd p fd) = f_extra fd
+              & f_params (insert_cast_fd p fd) = f_params fd] by case: fd.
+  by rewrite p_extraP => -> > /= [<-] ->.
+Qed.
+
+(* This comme from remove_globals_proof, share it *)
+Notation st_equal := (st_rel (fun _ : unit => eq)).
+
+Lemma st_equalP d s1 s2 : st_equal d s1 s2 <-> s1 = s2.
+Proof.
+  rewrite st_relP; split.
+  + by move=> [-> <-]; rewrite with_vm_same.
+  by move=> ->; rewrite with_vm_same.
+Qed.
+
+Definition check_es_equal (_:unit) (es1 es2 : pexprs) (_:unit) := es1 = es2.
+
+Definition check_lvals_equal (_:unit) (xs1 xs2 : lvals) (_:unit) := xs1 = xs2.
+
+Lemma check_esP_R_equal d es1 es2 d' :
+  check_es_equal d es1 es2 d' →
+  ∀ s1 s2, st_equal d s1 s2 → st_equal d' s1 s2.
+Proof. done. Qed.
+
+Definition checker_equal : Checker_e st_equal :=
+  {| check_es := check_es_equal
+   ; check_lvals := check_lvals_equal
+   ; check_esP_rel := check_esP_R_equal
+  |}.
+
+(* End FIXME *)
+Lemma checker_eqP : Checker_eq pi p checker_equal.
+Proof.
+  constructor.
+  + by move=> > /wdb_ok_eq <- <- ??? /st_equalP ->; eauto.
+  by move=> > /wdb_ok_eq <- <- ??? s /st_equalP ->; exists s.
+Qed.
+#[local] Hint Resolve checker_eqP : core.
+
+Lemma insert_cast_callP_aux fn :
+  wiequiv_f
+    pi p ev ev (rpreF (eS:= wuincl_spec)) fn fn (rpostF (eS:= wuincl_spec)).
+Proof.
+  apply wequiv_fun_ind_wa => {} fn _ fs1 fs2 [<- hu] fd' hget.
+  have [fd hget' ?]: exists2 fd, get_fundef (p_funcs p) fn = Some fd &
+                     fd' = insert_cast_fd p fd.
+  + move: hget; rewrite get_map_prog /=.
+    by case heq: get_fundef => [fd|] //= [?]; subst fd'; eauto.
+  exists fd => // hpre; split.
+  + by apply: fs_wuincl_sem_pre hu hpre.
+  move=> s11 hinit; exists s11; subst fd'.
+  + by apply: insert_cast_initialize_funcall hu hinit.
+  move=> {hget hget' hpre hinit}.
+  exists (st_rel (fun _ => eq) tt), (st_rel (fun _ => eq) tt); split => // {s11}; first last.
+  + by rewrite /rpostF /= => > <-; apply wuincl_sem_post; case: hu.
+  + apply wrequiv_weaken with (st_eq tt) eq => //.
+    + by move => > /st_equalP <-.
+    by apply st_eq_finalize; case: fd.
+  have -> : f_body (insert_cast_fd p fd) = map (insert_cast_i p) (f_body fd) by case: (fd).
+  set Pi := (fun i =>
+               wequiv_rec pi p ev ev wuincl_spec (st_rel (λ _ : unit, eq) tt)
+                 [:: insert_cast_i p i] [::i] (st_rel (λ _ : unit, eq) tt)).
+  set Pc := (fun c =>
+               wequiv_rec pi p ev ev wuincl_spec (st_rel (λ _ : unit, eq) tt)
+                 (map (insert_cast_i p) c) c (st_rel (λ _ : unit, eq) tt)).
+  set Pi_r := (fun ir => forall ii, Pi (MkI ii ir)).
+  apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => //;
+    subst Pi_r Pi Pc => /= {fd fs1 fs2 hu}.
+  + by move=> ?; apply wequiv_nil.
+  + by move=> > hi hc /=; apply wequiv_cons with (st_rel (fun _ => eq) tt).
+  + move=> >; apply wequiv_assgn with (Rv:= value_wuincl) (Rtr := eq).
+    + by move=> s1 s2 v /st_equalP <- /add_castP [v'] /insert_cast_eP; exists v'.
+    + move=> _ _ _ v1 v2 v hu htr; exists v => //.
+      by apply: value_wuincl_truncate_val hu htr.
+    by move=> > <- s1 s2 s1' /st_equalP <- /insert_cast_lvP ->; exists s1'.
+  + move=> ?????; case: eqP => hsz;
+     last by apply wequiv_opn_rel_eq with checker_equal tt => //.
+    apply wequiv_opn with (Rve := List.Forall2 value_wuincl) (Rvo := eq).
+    + by move=> ?? vs /st_equalP <- /(add_castsP hsz) [vs'] /insert_cast_esP; exists vs'.
+    + by move=> _ _ _ vs1 vs2 vs hu /(vwuincl_exec_sopn hu); eauto.
+    by move=> > <- s1 s2 s1' /st_equalP <- /insert_cast_lvsP ->; exists s1'.
+  + move=> ????; case: eqP => hsz;
+     last by apply wequiv_syscall_rel_eq with checker_equal tt => //.
+    apply wequiv_syscall with (Rv := List.Forall2 value_wuincl) (Ro := eq).
+    + by move=> ?? vs /st_equalP <- /(add_castsP hsz) [vs'] /insert_cast_esP; exists vs'.
+    + by move=> s1 _ /st_equalP <- vs1 vs2 s1' hu /(vwuincl_exec_syscall hu) ->; eauto.
+    by move=> > <- ?? s' /st_equalP <- /insert_cast_lvsP; exists s'.
+  + by move=> ??; apply wequiv_assert => _; split => // > /st_equalP <- /insert_cast_e_condP.
+  + move=> > hc1 hc2 ii; apply wequiv_if.
+    + by move=> ??? /st_equalP <- /insert_cast_e_condP; eauto.
+    by case.
+  + move=> > hc ?; apply wequiv_for with (Pi := st_equal tt) => //.
+    + move => ??? /st_equalP <-; rewrite /sem_bound.
+      by t_xrbindP => > /insert_cast_eP -> /= -> > /insert_cast_eP -> /= -> <- /=; eauto.
+    + by move => ??? s' /st_equalP <- ->; exists s'.
+  + move=> > hc hc' ?; apply wequiv_while => //.
+    by move=> ??? /st_equalP <- /insert_cast_e_condP; eauto.
+  move=> xs f es ii.
+  have h :
+   wequiv_rec pi p ev ev wuincl_spec
+     (st_equal tt) [:: MkI ii (Ccall xs f es)] [:: MkI ii (Ccall xs f es)] (st_equal tt).
+  + apply wequiv_call_rel_eq_wa with checker_equal tt => //.
+    + move=> s1 s2 vs /st_equalP <-; apply fs_wuincl_sem_pre; split => //.
+      by apply List_Forall2_refl.
+    + set hE := relEvent_recCall (rE0 := rE) wuincl_spec.
+      apply wkequiv_io_weaken with (rpreF (eS:=wuincl_spec) f f) (rpostF (eS:=wuincl_spec) f f) => //.
+      + by move=> > <-; split => //; split => //; apply List_Forall2_refl.
+      by move=> >; apply wequiv_fun_rec.
+    + by move=> vs fr; apply wuincl_sem_post; apply List_Forall2_refl.
+  case: get_fundef => [fd | //].
+  case: eqP => hsz //.
+  apply wequiv_call_wa with (rpreF (eS:=wuincl_spec)) (rpostF (eS:=wuincl_spec)) (List.Forall2 value_wuincl).
+  + by move=> ?? vs /st_equalP <- /(add_castsP hsz) [vs'] /insert_cast_esP; exists vs'.
+  + by move=> > /st_equalP <- hu; apply fs_wuincl_sem_pre.
+  + by move=> > /st_equalP <-.
+  + by move=> > [_ [_ _ hu]] <-; apply wuincl_sem_post.
+  + by move=> >; apply wequiv_fun_rec.
+  move=> > _; rewrite /rpostF /= => <-.
+  by move=> ?? s' /st_equalP <- /insert_cast_lvsP; exists s'.
+Qed.
+
+Lemma insert_cast_callP fn :
+  wiequiv_f
+    pi p ev ev (rpreF (eS:= eq_spec)) fn fn (rpostF (eS:= eq_spec)).
+Proof.
+  move: (insert_cast_callP_aux (fn := fn)).
+  apply wkequiv_io_weaken => //.
+  move=> ?? [_ <-]; split => //; split => //.
+  by apply List_Forall2_refl.
+Qed.
+
+End PROOF.
diff --git a/proofs/ec_extraction/remove_init_preds.v b/proofs/ec_extraction/remove_init_preds.v
new file mode 100644
index 0000000000..076ede9c3a
--- /dev/null
+++ b/proofs/ec_extraction/remove_init_preds.v
@@ -0,0 +1,449 @@
+Require Import expr.
+Require Import safety_shared.
+Require Import constant_prop_extraction.
+Require Import flag_combination.
+Require Import dead_code.
+Require Import compiler_util.
+Require Import operators.
+Require Import pseudo_operator.
+
+
+
+Section EXPR.
+Context `{asmop:asmOp} {pd: PointerData} {msfsz : MSFsize}.
+Context {fcp : FlagCombinationParams}.
+Context {pT: progT}.
+Context (is_move_op : asm_op_t -> bool).
+Context (B : var -> var).
+
+
+Definition not_array (var:var) : bool :=
+  match var.(vtype) with
+  | aarr _ _ => false
+  | _ => true
+  end.
+
+Definition arr_size (v:var) :=
+  match v.(vtype) with
+  | aarr ws n => ok (Z.to_pos (arr_size ws n))
+  | _ => type_error
+  end.
+
+(* Transforms an init_cond to an equivalent pexpr *)
+Fixpoint ic_to_e vs ic: pexpr :=
+  match ic with
+  | IBool b => Pbool b
+  | IConst c => Pconst c
+  | IVar n =>
+    match List.nth_error vs n with
+    | Some x => x
+    | None => Pbool false
+    end
+  | IOp1 op e1 => Papp1 op (ic_to_e vs e1)
+  | IOp2 op e1 e2 => Papp2 op (ic_to_e vs e1) (ic_to_e vs e2)
+  end.
+
+Definition expr_true := Pbool true.
+Definition expr_false := Pbool false.
+
+Definition var_i_to_bvar x := {| v_var:= B x.(v_var) ; v_info:=x.(v_info)|}.
+Definition var_to_bvar x := {| v_var:= B x ; v_info:=dummy_var_info|}.
+
+Section IS_VAR_INIT.
+
+Variable rm_is_var_init: var_i -> pexpr.
+
+(* FIXME : move this *)
+Definition is_Ois_arr_init o :=
+  match o with
+  | Ois_arr_init len => Some len
+  | _ => None
+  end.
+
+(* Receives an expression, if it is [is_var_init x] it substitutes it by its corresponding boolean variable *)
+Fixpoint rm_var_init_e (e : pexpr) : pexpr :=
+  match e with
+  | Pis_var_init x => rm_is_var_init x(*Plvar (var_i_to_bvar x)*)
+
+  | Papp1 op e1 =>
+    let e1 := rm_var_init_e e1 in
+    Papp1 op e1
+
+  | Papp2 op e1 e2 =>
+    let e1 := rm_var_init_e e1 in
+    let e2 := rm_var_init_e e2 in
+    Papp2 op e1 e2
+
+  | PappN op es =>
+    let es := map rm_var_init_e es in
+    match is_Ois_arr_init op, es with
+    | Some len, Pvar x :: es =>
+      let xb := var_i_to_bvar (gv x) in
+      PappN (Ois_barr_init len) (Pvar (Gvar xb (gs x)) :: es)
+    | Some len, Psub aa ws l x i :: es =>
+      let xb := var_i_to_bvar (gv x) in
+      let xb := Psub aa ws l (Gvar xb (gs x)) i in
+      PappN (Ois_barr_init len) (xb :: es)
+    | _, _ => PappN op es
+    end
+
+  | Pif ty e e1 e2 =>
+    let e := rm_var_init_e e in
+    let e1 := rm_var_init_e e1 in
+    let e2 := rm_var_init_e e2 in
+    Pif ty e e1 e2
+
+  | Pbig idx op var e1 e2 e3  =>
+    let idx := rm_var_init_e idx in
+    let e1 := rm_var_init_e e1 in
+    let e2 := rm_var_init_e e2 in
+    let e3 := rm_var_init_e e3 in
+    Pbig idx op var e1 e2 e3
+
+  | _ => e
+  end.
+
+Definition lv_get_scalar_var (lv : lval) : option var_i  :=
+  match lv with
+  | Lvar x => if not_array x.(v_var) then Some x else None
+  | _ => None
+  end.
+
+Definition lv_get_var (lv : lval) : option var_i  :=
+  match lv with
+  | Lvar x => Some x
+  | _ => None
+  end.
+
+(* Creates an instruction that assigns the boolean variable of x to a given expression e *)
+Definition assign_bvar_i_e (ii:instr_info) (e: pexpr) (x : var_i) : cmd :=
+  let x := Lvar(var_i_to_bvar x) in
+  [:: (MkI ii (Cassgn x AT_inline abool e))].
+
+Definition assign_bvar_e (ii:instr_info) (e: pexpr) (x : var) : cmd :=
+  let x := Lvar(var_to_bvar x) in
+  [:: (MkI ii (Cassgn x AT_inline abool e))].
+
+(* Check if there is an assignment to a variable and if so, change the corresponding boolean variable *)
+Definition assign_bvar_lval (ii:instr_info) (e:pexpr) (lv: lval)  : cmd :=
+  match lv_get_scalar_var lv with
+  | Some x => assign_bvar_i_e ii e x
+  | None =>
+    match lv with
+    | Laset a aa ws x e =>
+      let e := emk_scale aa ws e in
+      let x := var_i_to_bvar x in
+      let x := Laset a AAdirect ws x e in
+      let c := Papp1 (Oword_of_int ws) (Pconst (-1)) in
+      [:: (MkI ii (Cassgn x AT_inline (aword ws) c))]
+    | _ => [::]
+    end
+  end.
+
+(* If x is global variable - the lv will be fully initialized,
+otherwise will be equal to b_x *)
+Definition assign_arr_bvar (ii:instr_info) (lv: lval) (t:atype) (e:pexpr)  : cmd :=
+  match t with
+  | aarr ws len =>
+    match e with
+    | Pvar x =>
+      let e :=
+        if is_glob x then const (Cfull_init (Z.to_pos (type.arr_size ws len)))
+        else
+          let x := x.(gv) in
+          Plvar(var_i_to_bvar x)
+      in
+      [:: MkI ii (Cassgn lv AT_inline t e)]
+    | Psub aa ws len x i =>
+      let e :=
+        if is_glob x then const (Cfull_init (Z.to_pos (type.arr_size ws len)))
+        else
+          let x := x.(gv) in
+          let x := Plvar (var_i_to_bvar x) in
+          Psub aa ws len x i
+      in
+      [:: (MkI ii (Cassgn lv AT_inline t e))]
+    | _ => [::]
+    end
+  | _ => [::]
+  end.
+
+(* When there is an assignment there are a few cases
+  where we need to generate extra instructions:
+  - Laset: change the boolean array variable of the positions that were initialized
+  - Lvar: if it is a scalar variables, assign the boolean variable to true
+          if it is an array, so a = b, then create assignment b_a = b_b
+                             or a = b[i:j], then create assignment b_a = b_b[i:j]
+  - Lasub: similar to Lvar for arrays
+*)
+Definition cassign_bvar (ii:instr_info) (lv: lval) (t:atype) (e:pexpr)  : cmd :=
+  match lv with
+  | Laset a aa ws x e =>
+    let e := emk_scale aa ws e in
+    let x := var_i_to_bvar x in
+    let x := Laset a AAdirect ws x e in
+    let c := Papp1 (Oword_of_int ws) (Pconst (-1)) in
+    [:: (MkI ii (Cassgn x AT_inline (aword ws) c))]
+  | Lvar x =>
+    if not_array x.(v_var) then
+      assign_bvar_i_e ii expr_true x
+    else
+      let x := var_i_to_bvar x in
+      assign_arr_bvar ii (Lvar x) t e
+  | Lasub aa ws len x i =>
+    let x := var_i_to_bvar x in
+    let lv := Lasub aa ws len x i in
+    assign_arr_bvar ii lv t e
+  | _ => [::]
+  end.
+
+(* Get a list with a initialization condition for each output of the given operation *)
+Definition get_sopn_init_conds (es:pexprs) (o: sopn) : seq pexpr :=
+  let instr_descr := get_instr_desc o in
+  map (ic_to_e es) instr_descr.(i_init).
+
+(*Add boolean array variables in params and return values of function call*)
+Definition change_ccall_signature lvs es : seq lval * seq pexpr :=
+  let lvs :=  conc_map (fun lv =>
+    match lv with
+      | Lnone _ (aarr _ _) => [::lv;lv]
+      | Lvar x =>
+         if not_array x.(v_var) then
+          [:: lv]
+         else
+          [:: lv; Lvar (var_i_to_bvar x)]
+      | Lasub aa ws len x i =>
+        let x := var_i_to_bvar x in
+        let blv := Lasub aa ws len x i in
+        [:: lv; blv]
+      | _ => [:: lv]
+      end
+  ) lvs in
+    let es := conc_map (fun e =>
+    match e with
+    | Pvar x =>
+      if not_array x.(gv).(v_var) then
+        [:: e]
+      else
+        [:: e; Plvar (var_i_to_bvar x.(gv))]
+    | Psub aa ws len x i =>
+      let x := Plvar (var_i_to_bvar x.(gv)) in
+      let be := Psub aa ws len x i in
+      [:: e; be]
+    | _ => [:: e]
+    end
+  ) es in
+  (lvs,es).
+
+Definition lval_to_blvar (lv:lval) : lval :=
+  match lv with
+  | Lvar x => Lvar (var_i_to_bvar x)
+  | Lasub aa ws len x i => Lasub aa ws len (var_i_to_bvar x) i
+  | _ => lv
+  end.
+
+Definition e_to_bexpr (e:pexpr) : pexpr :=
+  match e with
+  | Pvar x => Plvar (var_i_to_bvar x.(gv))
+  | Psub aa ws len x i =>
+    let x := Plvar (var_i_to_bvar x.(gv)) in
+    Psub aa ws len x i
+  | _ => e
+  end.
+
+
+
+(* Remove is_var_init and is_arr_init from the instruction and replace them with the corresponding boolean variables *)
+
+
+Definition rm_init_swap ii ws n lvs es : instr :=
+  let lvs := map lval_to_blvar lvs in
+  let es := map e_to_bexpr es in
+  MkI ii (Copn lvs AT_inline (Opseudo_op (Oswap (aarr ws n))) es).
+
+Definition rm_init_copy ii ws (n:positive) lv e : instr :=
+  let lv := lval_to_blvar lv in
+  let e := e_to_bexpr e in
+  MkI ii (Cassgn lv AT_inline (aarr ws n) e).
+
+Definition assign_bvar_syscall (lvs:seq lval) ws (l:positive) (ii:instr_info) : cmd :=
+  match lvs with
+  | [::Lvar x] =>
+    if not_array x.(v_var) then
+      [::]
+    else
+      let x := Lvar (var_i_to_bvar x) in
+      let e := const (Cfull_init (Z.to_pos (type.arr_size ws l))) in
+      let i := Cassgn x AT_inline (aarr ws l) e in
+      let i := MkI ii i in
+      [:: i]
+  | _ => [::]
+  end.
+
+(* Remove is_var_init and is_arr_init from the instruction and replace them with the corresponding boolean variables *)
+Fixpoint rm_var_init_i (i : instr) : cmd :=
+  let: (MkI ii ir) := i in
+  match ir with
+  | Cassgn lv _ t e => cassign_bvar ii lv t e ++ [::i]
+  | Csyscall lvs (RandomBytes ws l) _ =>
+    assign_bvar_syscall lvs ws l ii ++ [::i]
+  | Ccall lvs n es =>
+    let (lvs,es) := change_ccall_signature lvs es in
+    let i := MkI ii (Ccall lvs n es) in
+    conc_map (assign_bvar_lval ii expr_true) lvs ++ [::i]
+  | Copn lvs _ (Opseudo_op (Oswap (aarr ws n))) es =>
+    [:: rm_init_swap ii ws n lvs es;i]
+  | Copn lvs _ o es  =>
+    match o with
+    | Opseudo_op (Ocopy ws n) =>
+      let n := Z.to_nat (wsize_size ws) * (Z.to_nat n) in
+      let n := Pos.of_nat n in
+      match lvs, es with
+      | [:: lv], [:: e] => [:: rm_init_copy ii ws n lv e;i]
+      | _,_ => [::i]
+      end
+    | Oslh (SLHprotect_ptr ws n)
+    | Oslh (SLHprotect_ptr_fail ws n) =>
+      match lvs, es with
+      | [:: lv], [:: e; _] =>[:: rm_init_copy ii ws n lv e;i]
+      | _,_ => [::i]
+      end
+    | _ => flatten (map2 (assign_bvar_lval ii) (get_sopn_init_conds es o) lvs) ++ [::i]
+    end
+  | Cif e c1 c2 =>
+    let c1 := conc_map rm_var_init_i c1 in
+    let c2 := conc_map rm_var_init_i c2 in
+    let ir := MkI ii (Cif e c1 c2) in
+    [:: ir]
+  | Cfor x r c =>
+    let c := conc_map rm_var_init_i c in
+    let b := assign_bvar_i_e ii expr_true x in
+    let ir := MkI ii (Cfor x r c) in
+    b ++ [:: ir]
+  | Cwhile a c1 e ii_w c2 =>
+    let c1 := conc_map rm_var_init_i c1 in
+    let c2 := conc_map rm_var_init_i c2 in
+    let ir := MkI ii (Cwhile a c1 e ii_w c2) in
+    [:: ir]
+  | Cassert (ak,e) =>
+    let e := rm_var_init_e e in
+    [:: MkI ii (Cassert (ak,e))]
+  end.
+
+Definition rm_var_init_cmd (c : cmd) : cmd := conc_map rm_var_init_i c.
+
+End IS_VAR_INIT.
+
+Definition add_bvar_arr xs :=
+  conc_map (fun x =>
+    if not_array x.(v_var) then
+      [:: x]
+    else
+      [:: x; var_i_to_bvar x]
+  ) xs.
+
+(* Change function declaration types and variables to add boolean arrays -
+everytime there is an array a, there will be a new variable b_a with the same size as a.
+b_a[i] represents the initialization of byte i of a (0 - Not initialized; 1 - Initialized) *)
+Definition add_barray_fun_decl (f:ufundef) :=
+  let aux_ty := conc_map (fun x =>
+    match x with
+      | aarr ws n => [:: x; x]
+      | _ => [:: x]
+    end
+  ) in
+  let tyin := aux_ty f.(f_tyin) in
+  let tyout := aux_ty f.(f_tyout) in
+
+  let params := add_bvar_arr f.(f_params) in
+  let res := add_bvar_arr f.(f_res) in
+
+  (tyin, params, tyout, res).
+
+(* Add boolean arrays variables to contract variables and
+remove is_var_init and is_arr_init from the pre and post conditions *)
+Definition update_fun_contra c : option fun_contract :=
+  match c with
+  | None => None
+  | Some c =>
+    let iparams :=  add_bvar_arr c.(f_iparams) in
+    let ires :=  add_bvar_arr c.(f_ires) in
+
+    let aux (e:assertion) :=
+      let (a,e) := e in
+      (a,rm_var_init_e (fun _ => Pbool true) e)
+    in
+    let f_pre := map aux c.(f_pre) in
+    let f_post := map aux c.(f_post) in
+    Some (MkContra iparams ires f_pre f_post)
+  end.
+
+(*
+ For each variable in the function, initializes the correspondent boolean variable
+ with true if it is in the parameters otherwise to false
+ For array variables not in the parameters, initializes the correspondent array of booleans with 0
+*)
+Definition init_bvars ii (f:ufundef) :=
+  let X := Sv.elements (vars_fd f) in
+  let args_varsL := vars_l f.(f_params) in
+  conc_map (fun v =>
+    match arr_size v with
+    | Error _ =>
+      if (Sv.mem v args_varsL) then assign_bvar_e ii expr_true v
+      else assign_bvar_e ii expr_false v
+    | Ok sz =>
+      if (Sv.mem v args_varsL) then [::]
+      else
+        let e:= PappN (Oarray sz) (nseq (Pos.to_nat sz) (word_of_int Unsigned U8 0)) in
+        assign_bvar_e ii e v
+    end
+  ) X
+.
+
+(* Remove is_var_init and is_arr_init - replacing with corresponding boolean variables *)
+Definition rm_var_init_f (f:ufundef): ufundef :=
+  let: (f_tyin, f_params,f_tyout,f_res) := add_barray_fun_decl f in
+  let f_contra := update_fun_contra f.(f_contra) in
+  let body := rm_var_init_cmd (fun x => Plvar (var_i_to_bvar x)) f.(f_body) in
+  let init_bvars := match body with
+    | [::] => [::]
+    | (MkI ii _) :: _ => init_bvars ii f
+    end in
+  {|
+    f_info   := f.(f_info) ;
+    f_contra := f_contra ;
+    f_tyin   := f_tyin ;
+    f_params := f_params ;
+    f_body   := init_bvars ++ body ;
+    f_tyout  := f_tyout ;
+    f_res    := f_res ;
+    f_extra  := f.(f_extra) ;
+  |}.
+
+
+Definition rm_var_init_prog (p:_uprog) : _uprog :=
+  map_prog rm_var_init_f p.
+
+Definition all_b_vars vars := Sv.fold (fun x acc => Sv.add (B x) acc) vars Sv.empty.
+
+(* Use constant prop to remove trivial assertions *)
+Definition rm_var_init_const_prop (p: uprog) : uprog :=
+  let bX := all_b_vars(vars_p (p_funcs p)) in
+  (* Function for const_prop to only propagate the B variables *)
+  let fun_cp := fun lv _ _ =>
+              let x := lv_get_var lv in
+              match x with
+              | Some x => Sv.mem x bX
+              | None => false
+              end
+  in
+  const_prop_prog_fun false p fun_cp
+.
+
+Definition rm_var_init_dc (p: uprog) :  _uprog :=
+  match dead_code_prog is_move_op p false with
+  | Ok p => p
+  | Error e => p
+  end.
+
+End EXPR.
diff --git a/proofs/lang/expr.v b/proofs/lang/expr.v
index fea79a69c9..9df3b8328f 100644
--- a/proofs/lang/expr.v
+++ b/proofs/lang/expr.v
@@ -55,7 +55,7 @@ Lemma e_type_of_opk k : type_of_opk k = to_atype (etype_of_opk k).
 Proof. by case: k. Qed.
 
 (* Type of unany operators: input, output *)
-Definition etype_of_op1 {len} (o: sop1) : extended_type len * extended_type len :=
+Definition etype_of_op1 (o: sop1) : extended_type positive * extended_type positive :=
   match o with
   | Oword_of_int sz => (tint, tword sz)
   | Oint_of_word _ sz => (tword sz, tint)
@@ -206,6 +206,8 @@ Definition type_of_opN (op: opN) : seq atype * atype :=
     (nseq n aint, aword ws)
   | Oarray len => (nseq (Pos.to_nat len) (aword U8), aarr U8 len)
   | Ocombine_flags c => (tin_combine_flags, abool)
+  | Ois_arr_init len => ([:: aarr U8 len; aint; aint], abool)
+  | Ois_barr_init len => ([:: aarr U8 len; aint; aint], abool)
   end.
 
 (* ** Expressions
@@ -240,7 +242,7 @@ Notation vid ident :=
   (mk_var_i {| vtype := aword Uptr; vname := ident%string; |}).
 
 #[only(eqbOK)] derive
-Variant v_scope := 
+Variant v_scope :=
   | Slocal
   | Sglob.
 
@@ -265,7 +267,12 @@ Inductive pexpr : Type :=
 | Papp1  : sop1 -> pexpr -> pexpr
 | Papp2  : sop2 -> pexpr -> pexpr -> pexpr
 | PappN of opN & seq pexpr
-| Pif    : atype -> pexpr -> pexpr -> pexpr -> pexpr.
+| Pif    : atype -> pexpr -> pexpr -> pexpr -> pexpr
+| Pbig : pexpr -> sop2 -> var_i -> pexpr -> pexpr -> pexpr -> pexpr
+(** Pbig idx op x e start len = big idx op (fun x => e) [iota start len] *)
+| Pis_var_init : var_i → pexpr
+(* FIXME : this should be an operator *)
+| Pis_mem_init : pexpr → pexpr → pexpr.
 
 Notation pexprs := (seq pexpr).
 
@@ -483,8 +490,16 @@ Class progT := {
   extra_val_t  : Type;
 }.
 
+Record fun_contract := MkContra {
+    f_iparams : seq var_i;  (* initial value of the parameter *)
+    f_ires    : seq var_i;  (* name of the result used in post *)
+    f_pre     : assertions;
+    f_post    : assertions;
+  }.
+
 Record _fundef (extra_fun_t: Type) := MkFun {
   f_info   : fun_info;
+  f_contra : option fun_contract;
   f_tyin   : seq atype;
   f_params : seq var_i;
   f_body   : cmd;
@@ -668,6 +683,7 @@ Definition to_sprog (p:_sprog) : sprog := p.
 (* Update functions *)
 Definition with_body eft (fd:_fundef eft) (body : cmd) := {|
   f_info   := fd.(f_info);
+  f_contra := fd.(f_contra);
   f_tyin   := fd.(f_tyin);
   f_params := fd.(f_params);
   f_body   := body;
@@ -678,6 +694,7 @@ Definition with_body eft (fd:_fundef eft) (body : cmd) := {|
 
 Definition swith_extra {_: PointerData} (fd:ufundef) f_extra : sfundef := {|
   f_info   := fd.(f_info);
+  f_contra := fd.(f_contra);
   f_tyin   := fd.(f_tyin);
   f_params := fd.(f_params);
   f_body   := fd.(f_body);
@@ -719,6 +736,7 @@ Definition is_load (e: pexpr) : bool :=
   | Pconst _ | Pbool _ | Parr_init _ _
   | Psub _ _ _ _ _
   | Papp1 _ _ | Papp2 _ _ _ | PappN _ _ | Pif _ _ _ _
+  | Pbig _ _ _ _ _ _
     => false
   | Pvar {| gs := Sglob |}
   | Pget _ _ _ _ _
@@ -726,6 +744,7 @@ Definition is_load (e: pexpr) : bool :=
     => true
   | Pvar {| gs := Slocal ; gv := x |}
     => is_var_in_memory x
+  | _ => false (* tocheck *)
   end.
 
 Definition is_array_init (e : pexpr) :=
@@ -841,12 +860,13 @@ Definition write_c c := write_c_rec Sv.empty c.
 
 Fixpoint use_mem (e : pexpr) :=
   match e with
-  | Pconst _ | Pbool _ | Parr_init _ _ | Pvar _ => false
-  | Pload _ _ _ => true
+  | Pconst _ | Pbool _ | Parr_init _ _ | Pvar _ | Pis_var_init _ => false
+  | Pload _ _ _ | Pis_mem_init _ _ => true
   | Pget _ _ _ _ e | Psub _ _ _ _ e | Papp1 _ e => use_mem e
   | Papp2 _ e1 e2 => use_mem e1 || use_mem e2
   | PappN _ es => has use_mem es
   | Pif _ e e1 e2 => use_mem e || use_mem e1 || use_mem e2
+  | Pbig idx _ _ body start len => use_mem idx || use_mem body || use_mem start || use_mem len
   end.
 
 (* ** Compute read variables
@@ -869,6 +889,11 @@ Fixpoint read_e_rec (s:Sv.t) (e:pexpr) : Sv.t :=
   | Papp2  _ e1 e2 => read_e_rec (read_e_rec s e2) e1
   | PappN _ es     => foldl read_e_rec s es
   | Pif  _ t e1 e2 => read_e_rec (read_e_rec (read_e_rec s e2) e1) t
+  | Pbig idx _ x body start len =>
+    Sv.union (Sv.remove x (read_e_rec Sv.empty body))
+             (read_e_rec (read_e_rec (read_e_rec s len) start) idx)
+  | Pis_var_init x => Sv.add x s
+  | Pis_mem_init e1 e2 => read_e_rec (read_e_rec s e2) e1
   end.
 
 Definition read_e := read_e_rec Sv.empty.
@@ -965,6 +990,12 @@ Fixpoint eq_expr (e e' : pexpr) :=
   | PappN o es, PappN o' es' => (o == o') && (all2 eq_expr es es')
   | Pif t e e1 e2, Pif t' e' e1' e2' =>
     (t == t') && eq_expr e e' && eq_expr e1 e1' && eq_expr e2 e2'
+  | Pbig idx op x body start len, Pbig idx' op' x' body' start' len' =>
+    eq_expr idx idx' && (op == op') && (v_var x == v_var x') &&
+    eq_expr body body' &&
+    eq_expr start start' && eq_expr len len'
+  | Pis_var_init x  , Pis_var_init x' => v_var x == v_var x'
+  | Pis_mem_init e1 e2  , Pis_mem_init e1' e2' =>  eq_expr e1 e1' && eq_expr e2 e2'
   | _             , _                 => false
   end.
 
diff --git a/proofs/lang/expr_facts.v b/proofs/lang/expr_facts.v
index 108f3323e5..6b90b44014 100644
--- a/proofs/lang/expr_facts.v
+++ b/proofs/lang/expr_facts.v
@@ -23,7 +23,10 @@ Section PEXPR_IND.
     (Happ2: ∀ op e1, P e1 → ∀ e2, P e2 → P (Papp2 op e1 e2))
     (HappN: ∀ op es, (∀ e, List.In e es → P e) → P (PappN op es))
     (Hif: ∀ t e, P e → ∀ e1, P e1 → ∀ e2, P e2 → P (Pif t e e1 e2))
-  .
+    (Hbig: forall idx, P idx -> forall op x body, P body -> forall start, P start -> forall len, P len ->
+             P (Pbig idx op x body start len))
+    (His_var_init: ∀ x, P (Pis_var_init x))
+    (His_mem_init: ∀ e1, P e1 → ∀ e2, P e2 → P (Pis_mem_init e1 e2 )).
 
   Definition pexpr_ind_rec (f: ∀ e, P e) : ∀ es : pexprs, ∀ e, List.In e es → P e :=
     fix loop es :=
@@ -45,6 +48,10 @@ Section PEXPR_IND.
     | Papp2 op e1 e2 => Happ2 op (pexpr_ind e1) (pexpr_ind e2)
     | PappN op es => HappN op (@pexpr_ind_rec pexpr_ind es)
     | Pif t e e1 e2 => Hif t (pexpr_ind e) (pexpr_ind e1) (pexpr_ind e2)
+    | Pbig idx op x body start len =>
+      Hbig (pexpr_ind idx) op x (pexpr_ind body) (pexpr_ind start) (pexpr_ind len)
+    | Pis_var_init x => His_var_init x
+    | Pis_mem_init e1 e2 => His_mem_init (pexpr_ind e1) (pexpr_ind e2)
     end.
 
 End PEXPR_IND.
@@ -70,6 +77,11 @@ Section PEXPRS_IND.
     pexprs_app2: ∀ op e1, P e1 → ∀ e2, P e2 → P (Papp2 op e1 e2);
     pexprs_appN: ∀ op es, Q es → P (PappN op es);
     pexprs_if: ∀ t e, P e → ∀ e1, P e1 → ∀ e2, P e2 → P (Pif t e e1 e2);
+    pexprs_big:
+      forall idx, P idx -> forall op x body, P body -> forall start, P start -> forall len, P len ->
+        P (Pbig idx op x body start len);
+    pexprs_is_var_init: ∀ x, P (Pis_var_init x);
+    pexprs_is_mem_init: ∀ e1 e2, P e1 → P e2 → P (Pis_mem_init e1 e2);
   }.
 
   Context (h: pexpr_ind_hypotheses).
@@ -93,6 +105,10 @@ Section PEXPRS_IND.
     | Papp2 op e1 e2 => pexprs_app2 h op (pexpr_mut_ind e1) (pexpr_mut_ind e2)
     | PappN op es => pexprs_appN h op (pexprs_ind pexpr_mut_ind es)
     | Pif t e e1 e2 => pexprs_if h t (pexpr_mut_ind e) (pexpr_mut_ind e1) (pexpr_mut_ind e2)
+    | Pbig idx op x body start len =>
+      pexprs_big h (pexpr_mut_ind idx) op x (pexpr_mut_ind body) (pexpr_mut_ind start) (pexpr_mut_ind len)
+    | Pis_var_init x => pexprs_is_var_init h x
+    | Pis_mem_init e1 e2 => pexprs_is_mem_init h (pexpr_mut_ind e1) (pexpr_mut_ind e2)
     end.
 
   Definition pexprs_ind_pair :=
@@ -313,8 +329,11 @@ Lemma read_e_esE :
   (∀ es s, Sv.Equal (read_es_rec s es) (Sv.union (read_es es) s)).
 Proof.
   apply: pexprs_ind_pair;
-  split => //= [ e He es Hes | v | al aa w v e He | aa w len v e He | o e1 He1 e2 He2 | t e He e1 He1 e2 He2 ] s;
-    rewrite /read_e /= ?He ?He1 ?He2; try (clear; SvD.fsetdec).
+  split => //=
+  [ e He es Hes | v | al aa w v e He | aa w len v e He | o e1 He1 e2 He2
+  | t e He e1 He1 e2 He2 | idx He op x body He1 start He2 len He3
+  | v | e1 e2 He1 He2] s;
+    rewrite /read_e /= ?He ?He1 ?He2 ?He3; try (clear; SvD.fsetdec).
   rewrite /read_es /= -/read_e Hes He Hes; clear; SvD.fsetdec.
 Qed.
 
@@ -379,6 +398,19 @@ Lemma read_e_Pif ty e e0 e1 :
     (Sv.union (read_e e) (Sv.union (read_e e0) (read_e e1))).
 Proof. by rewrite {1}/read_e /= 2!read_eE. Qed.
 
+Lemma read_e_Pbig idx op x body s len :
+  Sv.Equal (read_e (Pbig idx op x body s len))
+           (Sv.union (read_e idx) (Sv.union (Sv.remove x (read_e body))
+              (Sv.union (read_e s) (read_e len)))).
+Proof. rewrite {1}/read_e /= !read_eE; clear; SvD.fsetdec. Qed.
+
+Lemma read_e_Pis_var_init (x:var_i) : Sv.Equal (read_e (Pis_var_init x))(vars_l [::x]).
+Proof. by []. Qed.
+
+Lemma read_e_Pis_mem_init e1 e2 :
+  Sv.Equal (read_e (Pis_mem_init e1 e2)) (Sv.union (read_e e1) (read_e e2)).
+Proof. by rewrite {1}/read_e /= read_eE. Qed.
+
 Let Pr i := forall s, Sv.Equal (read_i_rec s i) (Sv.union s (read_i i)).
 Let Pi i := forall s, Sv.Equal (read_I_rec s i) (Sv.union s (read_I i)).
 Let Pc c := forall s, Sv.Equal (foldl read_I_rec s c) (Sv.union s (read_c c)).
@@ -549,8 +581,10 @@ Proof. by rewrite /eq_gvar ?eqxx. Qed.
 Lemma eq_expr_refl e : eq_expr e e.
 Proof.
   suff : (∀ e, eq_expr e e) ∧ (∀ es, all2 eq_expr es es) by case.
-  by apply: pexprs_ind_pair; split => //= [ ? -> ? -> | ?? | ? | ????? -> | ????? -> | ??? -> | ?? -> | ?? -> ? -> | ?? -> | ?? -> ? -> ];
-  rewrite ?eqxx ?eq_gvar_refl //.
+  by apply: pexprs_ind_pair; split => //=
+    [ ? -> ? -> | ?? | ? | ????? -> | ????? -> | ??? ->
+    | ?? -> | ?? -> ? -> | ?? -> | ?? -> ? -> ? -> | ? -> ??? -> ? -> ? -> | ?? -> ];
+  rewrite ?eqxx ?eq_gvar_refl.
 Qed.
 
 Lemma eq_gvar_symm gx gy :
@@ -562,8 +596,7 @@ Lemma eq_expr_symm e0 e1 :
 Proof.
   suff : (∀ e0 e1, eq_expr e0 e1 -> eq_expr e1 e0) ∧ (∀ es es', all2 eq_expr es es' → all2 eq_expr es' es).
   - case=> h _; exact: h.
-  apply: pexprs_ind_pair; split => //= [ [] |????[]|?[]|?[]|??[]|?[]|??????[]|??????[]|????[]|???[]|?????[]|???[]|???????[]] //= *.
-
+  apply: pexprs_ind_pair; split => //= [ [] |????[]|?[]|?[]|??[]|?[]|??????[]|??????[]|????[]|???[]|?????[]|???[]|???????[]|??????????[]|?[]|????[]] //= *.
   all:
     repeat
       match goal with
@@ -621,9 +654,16 @@ Proof.
     by move=> /andP[]/andP[]/eqP-> /h1 -> /h2 ->; rewrite !eqxx.
   + move=> o es1 hrec [] //= ? es2 [] ? es3 //=.
     move=> /andP[]/eqP-> h1 /andP[]/eqP-> h2;rewrite eqxx /=; eauto.
-  move=> ?? hrec ? hrec1 ? hrec2 []//= ???? []//= ????.
-  move=> /andP[]/andP[]/andP[] /eqP-> /hrec h /hrec1 h1 /hrec2 h2.
-  by move=> /andP[]/andP[]/andP[] /eqP-> /h -> /h1 -> /h2 ->; rewrite eqxx.
+  + move=> ?? hrec ? hrec1 ? hrec2 []//= ???? []//= ????.
+    move=> /andP[]/andP[]/andP[] /eqP-> /hrec h /hrec1 h1 /hrec2 h2.
+    by move=> /andP[]/andP[]/andP[] /eqP-> /h -> /h1 -> /h2 ->; rewrite eqxx.
+  + move => ? hrec ??? hrec1 ? hrec2 ? hrec3 []//= ?????? [] //= > /andP[] /andP[] /andP[] /andP[] /andP[].
+    move=> h /eqP -> /eqP -> h1 h2 h3 /andP[] /andP[] /andP[] /andP[] /andP[].
+    by move=> /hrec -> // /eqP -> /eqP -> /hrec1 -> // /hrec2 -> // /hrec3 -> //; rewrite !eqxx.
+  + by move=> ? [] // ? [] //= ? /eqP -> /eqP ->.
+  move=> ?? hrec1 hrec2 [] //= ?? [] //= ??.
+  move=> /andP[] /hrec1 h1 /hrec2 h2 /andP[] /h1 h1' /h2 h2'.
+  by rewrite h1' h2'.
 Qed.
 
 #[export]
@@ -644,7 +684,7 @@ Proof.
   suff : (∀ e e', eq_expr e e' → use_mem e = use_mem e') ∧
            (∀ es es', all2 eq_expr es es' → has use_mem es = has use_mem es') by case; eauto.
   clear; apply: pexprs_ind_pair; split => //=
-    [ | e he es hes |?|?|??|?|??????|??????|????|???|?????|???|???????] [] //.
+    [ | e he es hes |?|?|??|?|??????|??????|????|???|?????|???|???????|??????????|?|????] [] //.
   - by move => ?? /andP[] /he -> /hes ->.
   all: move => *.
 
@@ -707,7 +747,10 @@ Section EQ_EXPR_READ_E.
       ?read_e_Pload
       ?read_e_Papp1
       ?read_e_Papp2
-      ?read_e_Pif;
+      ?read_e_Pif
+      ?read_e_Pbig
+      ?read_e_Pis_var_init
+      ?read_e_Pis_mem_init;
     (repeat move=> /andP []);
     move=> /= *;
     t_eq_rewrites;
@@ -720,7 +763,7 @@ Section EQ_EXPR_READ_E.
     suff : (∀ e e', eq_expr e e' → Sv.Equal (read_e e) (read_e e'))
            ∧ (∀ es es', all2 eq_expr es es' → Sv.Equal (read_es es) (read_es es')) by case; eauto.
     clear; apply: pexprs_ind_pair; split => //
-    [|e he es hes|?|?|??|?|??????|??????|????|???|?????|? es hes|???????] [] //= >;
+    [|e he es hes|?|?|??|?|??????|??????|????|???|?????|? es hes|???????|? hi ??? hb ? hs ? hl|?|????] [] //= >;
     try by t_solve.
     - by rewrite !read_es_cons => /andP[] /he -> /hes ->.
     - by move => /eq_gvar_read_gvar; rewrite /read_e /= => ->.
diff --git a/proofs/lang/extraction.v b/proofs/lang/extraction.v
index 45809265b4..dc67faa69e 100644
--- a/proofs/lang/extraction.v
+++ b/proofs/lang/extraction.v
@@ -83,4 +83,5 @@ Separate Extraction
   riscv_extra
   riscv_params
   compiler
+  compiler_extraction
   wint_int.
diff --git a/proofs/lang/hoare_logic.v b/proofs/lang/hoare_logic.v
index f4ea829d90..461adfa775 100644
--- a/proofs/lang/hoare_logic.v
+++ b/proofs/lang/hoare_logic.v
@@ -93,6 +93,7 @@ Context
   {syscall_state : Type}
   {ep : EstateParams syscall_state}
   {spp : SemPexprParams}
+  {wc : WithCatch}
   {wa: WithAssert}
   {asm_op: Type}
   {sip : SemInstrParams asm_op syscall_state}
@@ -586,7 +587,7 @@ Qed.
 
 Lemma hoare_if P Q Qerr ii e c c' :
   (forall s e, P s -> Qerr e -> rInvErr s e) ->
-  rhoare P (sem_cond (p_globs p) e) (fun _ => True) Qerr ->
+  rhoare P (sem_cond (p_globs p) e) PredT Qerr ->
   (forall b, hoare P (if b then c else c') Q) ->
   hoare P [:: MkI ii (Cif e c c')] Q.
 Proof.
@@ -669,21 +670,42 @@ Lemma hoare_call (Pf : PreF) (Qf : PostF) Rv P Q Qerr ii xs fn es :
   (forall s e, P s -> Qerr e -> rInvErr s e) ->
   rhoare P (fun s => sem_pexprs (~~ direct_call) (p_globs p) s es) Rv Qerr ->
   (forall s vs, P s -> Rv vs -> Pf fn (mk_fstate vs s)) ->
+  (forall vs, Rv vs -> rhoare PredT (fun s => sem_pre p fn (mk_fstate vs s)) PredT Qerr) ->
   hoare_f_ii Pf ii fn Qf ->
+  (forall vs fs fr,
+      Rv vs ->
+      hoare_f_ii Pf ii fn Qf -> Qf fn fs fr ->
+      rhoare PredT
+        (fun _:estate => sem_post p fn vs fr) PredT Qerr) ->
   (forall fs fr,
     Pf fn fs -> Qf fn fs fr ->
     rhoare P (upd_estate (~~ direct_call) (p_globs p) xs fr) Q Qerr) ->
   hoare P [:: MkI ii (Ccall xs fn es)] Q.
 Proof.
-  move=> herr hes hPPf hCall hPQf; rewrite /hoare /isem_cmd_ /=.
+  move=> herr hes hPPf hpre hCall hpost hPQf; rewrite /hoare /isem_cmd_ /=.
   apply khoare_bind with Q; last by apply khoare_ret.
   apply khoare_read with Rv.
   + by apply (khoare_iresult herr) => >; apply: hes.
   move=> vs hvs; apply khoare_eq_pred => s0.
   set (fs := mk_fstate vs s0).
+  apply khoare_read with PredT.
+  + apply khoare_iresult with Qerr.
+    + move => s e [] heq;subst.
+      exact: herr.
+    move => s [] heq hpre'; subst.
+    by apply: (hpre _ hvs).
+  move => _ _.
   apply khoare_read with (Qf fn fs).
   + by move=> _ [-> hP]; apply/hCall/hPPf.
-  move=> fr hQf; apply khoare_iresult with Qerr.
+  move=> fr hQf.
+  apply khoare_read with PredT.
+  + apply khoare_iresult with Qerr.
+    + move => s e [] heq;subst.
+      exact: herr.
+    move => s [] heq hpre';subst.
+    by apply : (hpost _ _ _ hvs hCall hQf).
+  move => _ _.
+  apply khoare_iresult with Qerr.
   + by move=> > []; auto.
   move=> _ [-> hP]; apply (hPQf fs fr) => //.
   by apply hPPf.
@@ -696,6 +718,8 @@ Definition hoare_fun_body_hyp (Pf : PreF) fn (Qf : PostF) Qerr :=
   match get_fundef (p_funcs p) fn with
   | None => Qerr ErrType
   | Some fd =>
+      sem_pre p  fn fs = ok tt /\
+      (forall fr, Qf fn fs fr -> sem_post p fn fs.(fvals) fr = ok tt) /\
     exists (P Q : Pred_c),
       [/\ rhoare (Pf fn) (initialize_funcall p ev fd) P Qerr
         , hoare P fd.(f_body) Q
@@ -716,19 +740,41 @@ Proof.
   + rewrite /kget_fundef => ??.
     case: get_fundef hf => /= [fd | ] h; [apply lutt_Ret | apply lutt_Vis] => //.
     by rewrite preInv_Throw; apply herr.
-  move=> fd hfd; move: hf; rewrite hfd => -[P] [Q] [hinit hbody hQerr hfin].
-  apply khoare_bind with P.
+  move=> fd hfd; move: hf; rewrite hfd => [[Pre]] [Post] -[P] [Q] [hinit hbody hQerr hfin].
+  apply khoare_read with PredT.
+  + move => ? ?; subst.
+    rewrite /isem_pre Pre => //=.
+    by apply lutt_Ret.
+  move => _ _.
+  apply khoare_read with P.
   + move=> _ ->; have := hinit _ hPf.
     case: initialize_funcall => [s | e] h; [apply lutt_Ret | apply lutt_Vis] => //.
     by rewrite preInv_Throw; apply herr.
-  by apply: (khoare_bind hbody); apply (khoare_iresult hQerr).
+    move => s1 hs1.
+  eapply khoare_read.
+  + move => s hpre'.
+    by apply hbody.
+  move => s hQ.
+  eapply khoare_read.
+  + move => s' hpre'.
+    by apply: (khoare_iresult hQerr hfin).
+  move => s' hQf.
+  apply khoare_read with PredT.
+  + move => ? ?; subst.
+    rewrite /isem_post Post => //=.
+    by apply lutt_Ret.
+  move => ????; subst.
+  by apply lutt_Ret.
 Qed.
 
 End HOARE_CORE.
 
 Section TRIVIAL.
 
-Context {E E0: Type -> Type}  {sem_F : sem_Fun E} {wE: with_Error E E0}.
+  Context
+    {E E0: Type -> Type}
+    {sem_F : sem_Fun E}
+    {wE: with_Error E E0}.
 
 Context (p : prog) (ev: extra_val_t).
 
@@ -753,7 +799,11 @@ Notation ihoare   := (hoare (sem_F := sem_fun_full)).
 
 Section HOARE_FUN.
 
-Context {E E0: Type -> Type} {wE: with_Error E E0} {iE0 : InvEvent E0} {iEr : InvErr}.
+  Context
+      {E E0: Type -> Type}
+      {wE: with_Error E E0}
+      {iE0 : InvEvent E0}
+      {iEr : InvErr}.
 
 Context (p : prog) (ev: extra_val_t) (spec : HoareSpec).
 
@@ -770,6 +820,8 @@ Definition hoare_fun_body_hyp_rec Pf fn Qf Qerr :=
   match get_fundef (p_funcs p) fn with
   | None => Qerr ErrType
   | Some fd =>
+      sem_pre p  fn fs = ok tt /\
+      (forall fr, Qf fn fs fr -> sem_post p fn fs.(fvals) fr = ok tt) /\
     exists (P Q : Pred_c),
       [/\ rhoare (Pf fn) (initialize_funcall p ev fd) P Qerr
         , hoare_rec P fd.(f_body) Q
@@ -809,8 +861,8 @@ Proof.
     move=> ? [ii_ fn fs] /= hpre.
     have := hoare_fun_body (iE0 := invEvent_recCall spec) (hbody fn) hpre.
     apply lutt_weaken; auto using weak_pre, weak_post.
-  have := hoare_fun_body (iE0 := invEvent_recCall spec) (hbody fn) hpre.
-  apply lutt_weaken; auto using weak_pre, weak_post.
+    have := hoare_fun_body (iE0 := invEvent_recCall spec) (hbody fn) hpre.
+    apply lutt_weaken; auto using weak_pre, weak_post.
 Qed.
 
 End HOARE_FUN.
@@ -824,7 +876,11 @@ Notation whoare_f := (hoare_f_ii (iEr := invErrT)).
 
 Section WHOARE_CORE.
 
-Context {E E0: Type -> Type}  {sem_F : sem_Fun E} {wE: with_Error E E0} {iE0 : InvEvent E0}.
+Context
+  {E E0: Type -> Type}
+  {sem_F : sem_Fun E}
+  {wE: with_Error E E0}
+  {iE0 : InvEvent E0}.
 
 Context (p : prog) (ev: extra_val_t).
 
@@ -858,14 +914,14 @@ Lemma whoare_assert (P Q : Pred_c) ii a :
 Proof. by apply hoare_assert. Qed.
 
 Lemma whoare_if_full P Q ii e c c' :
-  rhoare P (sem_cond (p_globs p) e) (fun _ => True) PredT ->
+  rhoare P (sem_cond (p_globs p) e) PredT PredT ->
   (forall b,
      whoare p ev (fun s => P s /\ sem_cond (p_globs p) e s = ok b) (if b then c else c') Q) ->
   whoare p ev P [:: MkI ii (Cif e c c')] Q.
 Proof. by apply hoare_if_full. Qed.
 
 Lemma whoare_if P Q ii e c c' :
-  rhoare P (sem_cond (p_globs p) e) (fun _ => True) PredT ->
+  rhoare P (sem_cond (p_globs p) e) PredT PredT ->
   (forall b, whoare p ev P (if b then c else c') Q) ->
   whoare p ev P [:: MkI ii (Cif e c c')] Q.
 Proof. by apply hoare_if. Qed.
@@ -881,7 +937,7 @@ Lemma whoare_for_full P Pb Pi ii i d lo hi c :
 Proof. by apply hoare_for_full. Qed.
 
 Lemma whoare_for P Pi ii i d lo hi c :
-  rhoare P (sem_bound (p_globs p) lo hi) (fun _ => True) PredT ->
+  rhoare P (sem_bound (p_globs p) lo hi) PredT PredT ->
   (forall (j:Z), rhoare P (write_var true i (Vint j)) Pi PredT) ->
   whoare p ev Pi c P ->
   whoare p ev P [:: MkI ii (Cfor i (d, lo, hi) c)] P.
@@ -889,7 +945,7 @@ Proof. by apply hoare_for. Qed.
 
 Lemma whoare_while_full I I' ii al e inf c c' :
   whoare p ev I c I' ->
-  rhoare I' (sem_cond (p_globs p) e) (fun _ => True) PredT  ->
+  rhoare I' (sem_cond (p_globs p) e) PredT PredT  ->
   whoare p ev (fun s => I' s /\ sem_cond (p_globs p) e s = ok true) c' I ->
   whoare p ev I [:: MkI ii (Cwhile al c e inf c')]
      (fun s => I' s /\ sem_cond (p_globs p) e s = ok false).
@@ -897,7 +953,7 @@ Proof. by apply hoare_while_full. Qed.
 
 Lemma whoare_while I I' ii al e inf c c' :
   whoare p ev I c I' ->
-  rhoare I' (sem_cond (p_globs p) e) (fun _ => True) PredT  ->
+  rhoare I' (sem_cond (p_globs p) e) PredT PredT  ->
   whoare p ev I' c' I ->
   whoare p ev I [:: MkI ii (Cwhile al c e inf c')] I'.
 Proof. by apply hoare_while. Qed.
@@ -905,7 +961,13 @@ Proof. by apply hoare_while. Qed.
 Lemma whoare_call (Pf : PreF) (Qf : PostF) Rv P Q ii xs fn es :
   rhoare P (fun s => sem_pexprs (~~ direct_call) (p_globs p) s es) Rv PredT ->
   (forall s vs, P s -> Rv vs -> Pf fn (mk_fstate vs s)) ->
+  (forall vs, Rv vs -> rhoare PredT (fun s => sem_pre p fn (mk_fstate vs s)) PredT PredT) ->
   whoare_f p ev Pf ii fn Qf ->
+  (forall vs fs fr,
+      Rv vs ->
+      whoare_f p ev Pf ii fn Qf -> Qf fn fs fr ->
+      rhoare PredT
+        (fun _:estate => sem_post p fn vs fr) PredT PredT) ->
   (forall fs fr,
     Pf fn fs -> Qf fn fs fr ->
     rhoare P (upd_estate (~~ direct_call) (p_globs p) xs fr) Q PredT) ->
@@ -919,7 +981,10 @@ Notation iwhoare   := (hoare (sem_F := sem_fun_full) (iEr := invErrT)).
 
 Section WHOARE_FUN.
 
-Context {E E0: Type -> Type} {wE: with_Error E E0} {iE0 : InvEvent E0}.
+Context
+  {E E0: Type -> Type}
+  {wE: with_Error E E0}
+  {iE0 : InvEvent E0}.
 
 Context (p : prog) (ev: extra_val_t) (spec : HoareSpec).
 
@@ -933,6 +998,8 @@ Definition whoare_fun_body_hyp_rec Pf fn Qf :=
   forall fs,
   Pf fn fs ->
   forall fd, get_fundef (p_funcs p) fn = Some fd ->
+  sem_pre p  fn fs = ok tt /\
+  (forall fr, Qf fn fs fr -> sem_post p fn fs.(fvals) fr = ok tt) /\
   exists (P Q : Pred_c),
     [/\ rhoare (Pf fn) (initialize_funcall p ev fd) P PredT
       , whoare_rec P fd.(f_body) Q
@@ -946,7 +1013,12 @@ Proof.
   move=> h; apply ihoare_fun with PredT.
   move=> /h{}h fn fs /h{}h; split => //.
   case heq : get_fundef => [fd | ] //.
-  by have [P [Q [???]]]:= h _ heq; exists P, Q.
+  have [Pre [Post [P [Q [???]]]]] := h _ heq.
+  split.
+  + exact: Pre.
+  split.
+  + exact: Post.
+ by exists P, Q.
 Qed.
 
 End WHOARE_FUN.
@@ -969,8 +1041,9 @@ Context
   {syscall_state : Type}
   {ep : EstateParams syscall_state}
   {spp : SemPexprParams}
-  {asm_op: Type}
+  {wc : WithCatch }
   {wa: WithAssert}
+  {asm_op: Type}
   {sip : SemInstrParams asm_op syscall_state}
   {pT : progT}
   {wsw : WithSubWord}
@@ -1061,5 +1134,3 @@ Proof.
 Qed.
 
 End Test.
-
-
diff --git a/proofs/lang/it_sems_core.v b/proofs/lang/it_sems_core.v
index ed4dc95e7d..328e4a4de6 100644
--- a/proofs/lang/it_sems_core.v
+++ b/proofs/lang/it_sems_core.v
@@ -135,13 +135,12 @@ Context
   {syscall_state : Type}
   {ep : EstateParams syscall_state}
   {spp : SemPexprParams}
+  {wc : WithCatch }
   {wa: WithAssert}
   {sip : SemInstrParams asm_op syscall_state}
   {pT : progT}
   {scP : semCallParams}.
 
-Record fstate := { fscs : syscall_state_t; fmem : mem; fvals : values }.
-
 (* Recursion events (curried version of Call in ITree) *)
 Variant recCall : Type -> Type :=
  | RecCall (ii:instr_info) (f:funname) (fs:fstate) : recCall fstate.
@@ -201,15 +200,6 @@ Definition sem_syscall (xs : lvals) (o : syscall_t) (es : pexprs)
   Let fs := fexec_syscall o (mk_fstate ves s) in
   upd_estate true (p_globs p) xs fs s.
 
-Definition sem_cond (gd : glob_decls) (e : pexpr) (s : estate) : exec bool :=
-  (sem_pexpr true gd s e >>= to_bool)%result.
-
-Definition sem_assert (gd : glob_decls) (s : estate) (e : assertion) : exec unit :=
-  Let _ := assert (assert_allowed) ErrType in
-  Let b := sem_cond gd e.2 s in
-  Let _ := assert b (ErrAssert e.1) in
-  ok tt.
-
 Lemma sem_cond_sem_pexpr gd e s b :
   sem_cond gd e s = ok b -> sem_pexpr true gd s e = ok (Vbool b).
 Proof. rewrite /sem_cond /=; by t_xrbindP=> _ -> /to_boolI ->. Qed.
@@ -229,6 +219,12 @@ Definition isem_bound (lo hi : pexpr) (s : estate) : itree E (Z * Z) :=
 Definition isem_assert (a: assertion) (s: estate) : itree E unit :=
   iresult s (sem_assert (p_globs p) s a).
 
+Definition isem_pre {dc : DirectCall} s (fn : funname) (fs:fstate) : itree E unit :=
+  iresult s (sem_pre p fn fs).
+
+Definition isem_post {dc : DirectCall} s (fn : funname) (vargs : values) (fr:fstate) : itree E unit :=
+  iresult s (sem_post p fn vargs fr).
+
 (* recCall trigger *)
 Definition rec_call (ii:instr_info) (f : funname) (fs : fstate) :
    itree (recCall +' E) fstate :=
@@ -286,6 +282,7 @@ Section SEM_I.
 
 Context {E E0} {wE : with_Error E E0} {sem_F : sem_Fun E }.
 
+
 (* semantics of instructions, abstracting on function calls (through
    sem_fun) *)
 Fixpoint isem_i_body (p : prog) (ev : extra_val_t) (i : instr) (s : estate) :
@@ -313,9 +310,13 @@ Fixpoint isem_i_body (p : prog) (ev : extra_val_t) (i : instr) (s : estate) :
 
   | Ccall xs fn args =>
     vargs <- isem_pexprs  (~~direct_call) (p_globs p) args s;;
-    fs <- sem_fun p ev ii fn (mk_fstate vargs s) ;;
+    let fi := mk_fstate vargs s in
+    isem_pre p s fn fi;; 
+    fs <- sem_fun p ev ii fn fi ;;
+    isem_post p s fn vargs fs;;
     iresult s (upd_estate (~~direct_call) (p_globs p) xs fs s)
   end.
+
 (* similar, for commands *)
 Definition isem_cmd_ := isem_foldr isem_i_body.
 
@@ -365,9 +366,12 @@ Definition isem_fun_body (p : prog) (ev : extra_val_t)
    (fn : funname) (fs : fstate) :=
    fd <- kget_fundef (p_funcs p) fn fs;;
    let sinit := estate0 fs in
+   isem_pre p sinit fn fs;;
    s1 <- iresult sinit (initialize_funcall p ev fd fs);;
    s2 <- isem_cmd_ p ev fd.(f_body) s1;;
-   iresult s2 (finalize_funcall fd s2).
+   fr <- iresult s2 (finalize_funcall fd s2);;
+   isem_post p s2 fn fs.(fvals) fr;;
+   Ret fr.
 
 (* A variant of the semantic based on exec, usefull for the proofs *)
 Fixpoint esem_i (p : prog) (ev : extra_val_t) (i : instr) (s : estate) :
@@ -495,7 +499,9 @@ Proof.
     by apply eqit_bind; [apply hc' | reflexivity].
   move=> xs f es ii s /=.
   apply eqit_bind; first reflexivity.
+  move=> ?; apply eqit_bind; first reflexivity.
   move=> ?; apply eqit_bind; first by apply sem_F_ext.
+  move=> ?; apply eqit_bind; first reflexivity.
   move=> ?; reflexivity.
 Qed.
 
@@ -550,7 +556,8 @@ Definition sem_fun_inline
    (do_inline :  funname (* caller *) -> instr_info -> funname (* callee *) -> bool)
    (caller : funname) :=
  {| sem_fun := fun (p : prog) (ev : extra_val_t) (ii:instr_info) (callee : funname) (fs : fstate) =>
-     if do_inline caller ii callee then isem_fun_rec p ev callee fs (* Interprete the call but not the internal ones *)
+     if do_inline caller ii callee then 
+       isem_fun_rec p ev callee fs (* Interprete the call but not the internal ones *)
      else rec_call (E:=E) ii callee fs (* Do not interprete the call, simply emmit an event *)
  |}.
 
@@ -647,9 +654,13 @@ Proof.
     rewrite interp_ret; reflexivity.
   move=> xs f es ii s; rewrite /isem_i /isem_i_rec /=.
   rewrite interp_bind; apply eqit_bind; first by apply interp_iresult.
-  move=> vs.
-  rewrite interp_bind; apply eqit_bind; last by move=> >; apply interp_iresult.
-  rewrite interp_mrecursive; reflexivity.
+  move=> vs; rewrite interp_bind; apply eqit_bind.
+  + by apply interp_iresult.
+  move => ?;rewrite interp_bind;apply eqit_bind.
+  + rewrite interp_mrecursive; reflexivity.
+  move => ?;rewrite interp_bind;apply eqit_bind.
+  + by apply interp_iresult.
+  move=> ?; exact: interp_iresult.
 Qed.
 
 Lemma isem_call_unfold (fn : funname) (fs : fstate) :
@@ -662,9 +673,15 @@ Proof.
   + by apply interp_ioget.
   move=> fd; rewrite interp_bind; apply eqit_bind.
   + by apply interp_iresult.
+  move=> _; rewrite interp_bind; apply eqit_bind.
+  + by apply interp_iresult.
   move=> s1; rewrite interp_bind; apply eqit_bind.
   + apply interp_isem_cmd.
-  move=> s2; apply interp_iresult.
+  move=> s2; rewrite interp_bind; apply eqit_bind.
+  + by apply interp_iresult.
+  move=> fr; rewrite interp_bind; apply eqit_bind.
+  + by apply interp_iresult.
+  move=> _; rewrite interp_ret; reflexivity.
 Qed.
 
 Lemma interp_cond_throw  (cond : forall T, recCall T -> bool) (ctx : forall T, recCall T -> itree (recCall +' E) T) (e: error * unit) T :
@@ -699,9 +716,12 @@ Proof.
   have haux : forall (ii1 : instr_info) (fn1 : funname) (fs1 : fstate),
     ctx2_cond cond F (RecCall ii1 fn1 fs1)
     ≈ fd <- kget_fundef (p_funcs p) fn1 fs1;;
+      _ <- isem_pre p (estate0 fs1) fn1 fs1;;
       s1 <- iresult (estate0 fs1) (initialize_funcall p ev fd fs1);;
       s2 <- isem_cmd_ (sem_F:= sem_fun_inline do_inline fn1) p ev (f_body fd) s1;;
-      iresult s2 (finalize_funcall fd s2).
+      fr <- iresult s2 (finalize_funcall fd s2) ;;
+      _ <- isem_post p s2 fn1 (fvals fs1) fr;;
+      Ret fr.
   + move=> ii1 fn1 fs1.
     rewrite /ctx2_cond /Handler.cat interp_bind.
     apply eutt_eq_bind'.
@@ -709,12 +729,20 @@ Proof.
       + rewrite interp_ret; reflexivity.
       by apply interp_cond_throw.
     move=> fd.
+    rewrite interp_bind. 
+    apply eutt_eq_bind'.
+    + rewrite interp_cond_iresult; reflexivity.
+    move=> ?.
     rewrite interp_bind.
     apply eutt_eq_bind'.
     + by apply interp_cond_iresult.
     move=> s; rewrite interp_bind.
     apply eutt_eq_bind'; last first.
-    + by move=> s'; apply interp_cond_iresult.
+    + move=> ?; rewrite interp_bind; apply eutt_eq_bind'.
+      + by apply interp_cond_iresult.
+      move=> ?; rewrite interp_bind; apply eutt_eq_bind'.
+      + by apply interp_cond_iresult.
+      move=> ?; rewrite interp_ret; reflexivity.
     set Pi := fun i =>
       forall s,
        interp (ctx_cond (cond fstate (RecCall dummy_instr_info fn1 fs1)) F)
@@ -759,10 +787,13 @@ Proof.
       rewrite interp_ret; reflexivity.
     move=> xs f es ii s; rewrite interp_bind.
     rewrite /isem_pexprs interp_cond_iresult; apply eutt_eq_bind => ?.
-    rewrite interp_bind.
-    apply eutt_eq_bind'.
+    rewrite interp_bind; apply eutt_eq_bind'.
+    + by apply interp_cond_iresult.
+    move=> _; rewrite interp_bind; apply eutt_eq_bind'.
     + rewrite /ctx_cond /cond /Handler.case_ /rec_call /F.
       setoid_rewrite interp_trigger; reflexivity.
+    move=> ?; rewrite interp_bind; apply eutt_eq_bind'.
+    + by apply interp_cond_iresult. 
     by move=> ?; apply interp_cond_iresult.
   apply Proper_interp_mrec => //.
   by move=> T [].
diff --git a/proofs/lang/memory_model.v b/proofs/lang/memory_model.v
index 25cdc99fa3..3143ce254f 100644
--- a/proofs/lang/memory_model.v
+++ b/proofs/lang/memory_model.v
@@ -187,6 +187,15 @@ Section CoreMem.
     by case: set.
   Qed.
 
+  Lemma getok_setok m r q w :
+    get m q = ok r ->
+    exists m', set m q w = ok m'.
+  Proof.
+    move=> hg; apply get_valid8 in hg.
+    move: hg => /(valid8P _ _ w) [x hs].
+    by eauto.
+  Qed.
+
   Lemma readE m al p sz :
     read m al p sz =
       Let _ := assert (is_aligned_if al p sz) ErrAddrInvalid in
diff --git a/proofs/lang/operators.v b/proofs/lang/operators.v
index dbc181e15f..051731a509 100644
--- a/proofs/lang/operators.v
+++ b/proofs/lang/operators.v
@@ -121,6 +121,8 @@ Variant opN :=
 | Opack of wsize & pelem (* Pack words of size pelem into one word of wsize *)
 | Oarray of positive (* Literal array of bytes *)
 | Ocombine_flags of combine_flags
+| Ois_arr_init of positive
+| Ois_barr_init of positive
 .
 
 HB.instance Definition _ := hasDecEq.Build op_kind op_kind_eqb_OK.
@@ -132,3 +134,12 @@ HB.instance Definition _ := hasDecEq.Build sop2 sop2_eqb_OK.
 HB.instance Definition _ := hasDecEq.Build opN opN_eqb_OK.
 
 (* ----------------------------------------------------------------------------- *)
+
+
+Inductive init_cond :=
+  | IBool of bool
+  | IConst of Z
+  | IVar of nat
+  | IOp1 of sop1 & init_cond
+  | IOp2 of sop2 & init_cond & init_cond
+.
diff --git a/proofs/lang/psem.v b/proofs/lang/psem.v
index 8c2d75e85d..1a4ca24ebe 100644
--- a/proofs/lang/psem.v
+++ b/proofs/lang/psem.v
@@ -586,6 +586,9 @@ Context
   {scP : semCallParams (wsw:= wsw) (pT := pT)}
   {dc: DirectCall}.
 
+Section WITHASSERT.
+
+Context {wc:WithCatch} {wa: WithAssert}.
 Lemma st_eq_refl d s : st_eq d s s.
 Proof. by split. Qed.
 Hint Resolve st_eq_refl : core.
@@ -638,11 +641,13 @@ Let Pi_r i := forall ii, Pi (MkI ii i).
 
 Let Pc c := wequiv p p' ev ev' (st_eq tt) c c (st_eq tt).
 
-Lemma wequiv_st_eq c :
-  (forall ii f, wequiv_f_ii p p' ev ev' (λ (_ _ : funname), eq) ii ii f f (λ (_ _ : funname) (_ _ : fstate), eq)) ->
+Lemma wequiv_st_eq_wa c :
+  (∀ f vs s, sem_pre p f (mk_fstate vs s) = ok tt → sem_pre p' f (mk_fstate vs s) = ok tt) →
+  (∀ f vs fr, sem_post p f vs fr = ok tt → sem_post p' f vs fr = ok tt) →
+  (forall ii f, wequiv_f_ii p p' ev ev' (λ (_ _ : funname), eq) ii ii f f (λ (_ _ : funname) (_ _ : fstate), eq)) →
   Pc c.
 Proof.
-  move=> hf; apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {c}.
+  move=> hpre hpost hf; apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {c}.
   + by apply wequiv_nil.
   + by move=> *; apply wequiv_cons with (st_eq tt).
   + by move=> >;apply wequiv_assgn_rel_eq with checker_st_eq tt.
@@ -652,7 +657,9 @@ Proof.
   + by move=> > hc1 hc2 ii; apply wequiv_if_rel_eq with checker_st_eq tt tt tt.
   + by move=> > hc ii; apply wequiv_for_rel_eq with checker_st_eq tt tt.
   + by move=> > hc hc' ii; apply wequiv_while_rel_eq with checker_st_eq tt.
-  by move=> ????; apply wequiv_call_rel_eq with checker_st_eq tt.
+  move=> ? f ??; apply wequiv_call_rel_eq_wa with checker_st_eq tt => //.
+  + by move=> s1 s2 vs /st_relP [-> _] /= /hpre.
+  apply hpost.
 Qed.
 
 End FUN.
@@ -695,6 +702,9 @@ Proof.
     move=> vs hes fs ho hw heq.
     rewrite -(sem_pexprs_ext_eq true (p_globs p) _ heq) hes /= ho /= /upd_estate.
     by have /(_ _ heq) [vm2 ??]:= write_lvars_ext_eq _ hw; exists vm2.
+  + move=> a ii s1 s2 vm1 /=; rewrite /sem_assert /sem_cond -eq_globs; t_xrbindP.
+    move=> -> [] // v he /to_boolI ? _ _ <- heq; subst v.
+    by rewrite -(sem_pexpr_ext_eq true (p_globs p) _ heq) he /=; eexists; eauto.
   + move=> e c1 c2 hc1 hc2 ii s1 s2 vm1 /=; rewrite /sem_cond -eq_globs; t_xrbindP.
     move=> b v he hb hc heq.
     rewrite -(sem_pexpr_ext_eq true (p_globs p) _ heq) he /= hb /= => {hb}.
@@ -718,9 +728,12 @@ Section REC.
 
 Context {E E0 : Type -> Type} {wE: with_Error E E0} {rE0 : EventRels E0}.
 
-Lemma wequiv_rec_st_eq c : wequiv_rec p p' ev ev' eq_spec (st_eq tt) c c (st_eq tt).
+Lemma wequiv_rec_st_eq_wa c :
+  (∀ f vs s, sem_pre p f (mk_fstate vs s) = ok tt → sem_pre p' f (mk_fstate vs s) = ok tt) →
+  (∀ f vs fr, sem_post p f vs fr = ok tt → sem_post p' f vs fr = ok tt) →
+  wequiv_rec p p' ev ev' eq_spec (st_eq tt) c c (st_eq tt).
 Proof.
-  apply wequiv_st_eq.
+  move=> hpre hpost; apply wequiv_st_eq_wa => //.
   by move=> ii f s t <-; apply xrutt_facts.xrutt_trigger.
 Qed.
 
@@ -750,17 +763,44 @@ Qed.
 Lemma wiequiv_f_eq fn :
   wiequiv_f p p ev ev (rpreF (eS := eq_spec)) fn fn (rpostF (eS := eq_spec)).
 Proof.
-apply wequiv_fun_ind => {}fn _ fs _ [<- <-] fd hget.
-exists fd => // s1 ?; exists s1 => //; exists (st_eq tt), (st_eq tt).
-split=> //; first exact/wequiv_rec_st_eq.
-exact/st_eq_finalize.
+  apply wequiv_fun_ind_wa => {}fn _ fs _ [<- <-] fd hget.
+  exists fd => // ?; split => //.
+  move=> s1; exists s1 => //.
+  exists (st_eq tt), (st_eq tt); split => //.
+  + by apply wequiv_rec_st_eq_wa.
+  + by apply st_eq_finalize.
+  by move=> ? _ <-.
 Qed.
 
 Lemma wiequiv_st_eq c : wiequiv p p ev ev (st_eq tt) c c (st_eq tt).
-Proof. by apply wequiv_st_eq => // ii f ???; apply wiequiv_f_eq. Qed.
+Proof. by apply wequiv_st_eq_wa => // ii f ???; apply wiequiv_f_eq. Qed.
+
 
 End WIEQUIV_F.
 
+End WITHASSERT.
+
+Section FUN.
+
+Context (p p': prog) (ev ev': extra_val_t).
+
+Context (eq_globs: p_globs p = p_globs p').
+
+Context {E E0 : Type -> Type} {sem_F : sem_Fun E} {wE: with_Error E E0} {rE0 : EventRels E0}.
+
+Let Pc c := wequiv p p' ev ev' (st_eq tt) c c (st_eq tt).
+
+Lemma wequiv_st_eq c :
+  (forall ii f, wequiv_f_ii p p' ev ev' (λ (_ _ : funname), eq) ii ii f f (λ (_ _ : funname) (_ _ : fstate), eq)) →
+  Pc c.
+Proof. by apply wequiv_st_eq_wa. Qed.
+
+Lemma wequiv_rec_st_eq c :
+  wequiv_rec p p' ev ev' eq_spec (st_eq tt) c c (st_eq tt).
+Proof. by apply wequiv_rec_st_eq_wa. Qed.
+
+End FUN.
+
 End ST_EQ.
 
 Section Sem_eqv.
@@ -909,6 +949,8 @@ Section IT_Sem_eqv.
 
 Context
   {dc:DirectCall}
+  {wc: WithCatch}
+  {wa: WithAssert}
   {sip : SemInstrParams asm_op syscall_state}
   {pT : progT}
   {sCP : semCallParams}.
@@ -952,6 +994,10 @@ Definition checker_st_eq_on : Checker_e (st_rel eq_on) :=
 
 Definition st_uincl_on X := st_rel uincl_on X.
 
+Section NOT_ALLOW_ASSERT.
+#[local] Existing Instance nocatch.
+#[local] Existing Instance noassert.
+
 Lemma read_es_st_uincl_on gd wdb es X :
   Sv.Subset (read_es es) X ->
   wrequiv (st_uincl_on X) ((sem_pexprs wdb gd)^~ es) ((sem_pexprs wdb gd)^~ es) (List.Forall2 value_uincl).
@@ -973,6 +1019,8 @@ Proof.
   by eexists; eauto.
 Qed.
 
+End NOT_ALLOW_ASSERT.
+
 Lemma check_esP_R_st_uincl_on X es1 es2 X':
   check_es_st_eq_on X es1 es2 X' → ∀ s1 s2, st_rel uincl_on X s1 s2 → st_rel uincl_on X' s1 s2.
 Proof. by move=> [h _ _]; apply st_rel_weaken => ??; apply uincl_onI. Qed.
@@ -1017,6 +1065,10 @@ Proof.
 Qed.
 #[local] Hint Resolve checker_st_eq_onP : core.
 
+Section NOT_ALLOW_ASSERT.
+#[local] Existing Instance nocatch.
+#[local] Existing Instance noassert.
+
 Lemma checker_st_uincl_onP : Checker_uincl p p' checker_st_uincl_on.
 Proof.
   constructor; rewrite -eq_globs.
@@ -1026,6 +1078,7 @@ Proof.
   + by apply st_rel_weaken => ??; apply uincl_onI.
   by apply: write_lvals_st_uincl_on hu.
 Qed.
+End NOT_ALLOW_ASSERT.
 
 Section FUN.
 
@@ -1044,12 +1097,14 @@ Let Pc c :=
   wequiv p p' ev ev' (st_eq_on X) c c (st_eq_on X).
 
 Lemma it_read_cP_aux c X :
-  (forall ii fn,
-     wequiv_f_ii p p' ev ev' (λ (_ _ : funname), eq) ii ii fn fn (λ _ _  _ _, eq)) ->
-  Sv.Subset (read_c c) X ->
+  (∀ f vs s, sem_pre p f (mk_fstate vs s) = ok tt → sem_pre p' f (mk_fstate vs s) = ok tt) →
+  (∀ f vs fr, sem_post p f vs fr = ok tt → sem_post p' f vs fr = ok tt) →
+  (∀ ii fn,
+     wequiv_f_ii p p' ev ev' (λ (_ _ : funname), eq) ii ii fn fn (λ _ _  _ _, eq)) →
+  Sv.Subset (read_c c) X →
   wequiv p p' ev ev' (st_eq_on X) c c (st_eq_on X).
 Proof.
-  move=> hfn; apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {c X}.
+  move=> hpre hpost hfn; apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {c X}.
   + by move=> i ii hi X; apply hi.
   + by move=> ii X; apply wequiv_nil.
   + move=> i c hi hc X; rewrite read_c_cons => hsub.
@@ -1080,10 +1135,12 @@ Proof.
     + by split => //; rewrite /read_es /= read_eE; SvD.fsetdec.
     + by apply hc; SvD.fsetdec.
     by apply hc'; SvD.fsetdec.
-  + move=> xs fn es ii X; rewrite read_i_call => hsub.
-  apply wequiv_call_rel_eq with checker_st_eq_on X => //.
+  move=> xs fn es ii X; rewrite read_i_call => hsub.
+  apply wequiv_call_rel_eq_wa with checker_st_eq_on X => //.
+  + by split => //; SvD.fsetdec.
   + by split => //; SvD.fsetdec.
-  by split => //; SvD.fsetdec.
+  + by move=> s1 s2 vs /st_relP [-> _] /= /hpre.
+  apply hpost.
 Qed.
 
 End FUN.
@@ -1093,10 +1150,12 @@ Section REC.
 Context {E E0 : Type -> Type} {wE: with_Error E E0} {rE0 : EventRels E0}.
 
 Lemma it_read_cP_rec X c :
-  Sv.Subset (read_c c) X ->
+  (∀ f vs s, sem_pre p f (mk_fstate vs s) = ok tt → sem_pre p' f (mk_fstate vs s) = ok tt) →
+  (∀ f vs fr, sem_post p f vs fr = ok tt → sem_post p' f vs fr = ok tt) →
+  Sv.Subset (read_c c) X →
   wequiv_rec p p' ev ev' eq_spec (st_eq_on X) c c (st_eq_on X).
 Proof.
-  apply it_read_cP_aux.
+  move=> hpre hpost; apply it_read_cP_aux => //.
   by move=> ii f s t <-; apply xrutt_facts.xrutt_trigger.
 Qed.
 
@@ -1120,7 +1179,6 @@ Qed.
 
 End REFL.
 
-
 End IT_Sem_eqv.
 
 (* ---------------------------------------------------------------- *)
@@ -1455,6 +1513,10 @@ Context
   {pT : progT}
   {sCP : semCallParams}.
 
+Section NOT_ALLOW_ASSERT.
+#[local] Existing Instance nocatch.
+#[local] Existing Instance noassert.
+
 Lemma read_es_st_uincl d gd wdb es :
   wrequiv (st_uincl d) ((sem_pexprs wdb gd)^~ es) ((sem_pexprs wdb gd)^~ es) (List.Forall2 value_uincl).
 Proof. by move=> s t vs /st_relP [/= -> h]; apply sem_pexprs_uincl. Qed.
@@ -1497,12 +1559,17 @@ Let Pi_r i :=
 Let Pc c :=
   wequiv p p' ev ev' (st_uincl tt) c c (st_uincl tt).
 
-Lemma it_sem_uincl_aux c :
-  (forall ii fn,
-     wequiv_f_ii p p' ev ev' (λ (_ _ : funname), fs_uincl) ii ii fn fn (λ _ _  _ _, fs_uincl)) ->
+Lemma it_sem_uincl_aux_wa c :
+  (∀ fn s1 vs1 vs2, List.Forall2 value_uincl vs1 vs2 →
+    sem_pre p fn (mk_fstate vs1 s1) = ok tt → sem_pre p' fn (mk_fstate vs2 s1) = ok tt) →
+  (∀ fn vs1 vs2 fr1 fr2,
+    List.Forall2 value_uincl vs1 vs2
+    → fs_uincl fr1 fr2 → sem_post p fn vs1 fr1 = ok tt → sem_post p' fn vs2 fr2 = ok tt) →
+  (∀ ii fn,
+     wequiv_f_ii p p' ev ev' (λ (_ _ : funname), fs_uincl) ii ii fn fn (λ _ _  _ _, fs_uincl)) →
   wequiv p p' ev ev' (st_uincl tt) c c (st_uincl tt).
 Proof.
-  move=> hfn; apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {c}.
+  move=> hpre hpost hfn; apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => // {c}.
   + by move=> i ii hi X; apply hi.
   + by move=> ii X; apply wequiv_nil.
   + move=> i c hi hc.
@@ -1514,7 +1581,7 @@ Proof.
   + by move=> e c1 c2 hc1 hc2 ii; apply wequiv_if_rel_uincl with checker_st_uincl tt tt tt.
   + by move=> > hc ii; apply wequiv_for_rel_uincl with checker_st_uincl tt tt.
   + by move=> > ?? ii; apply wequiv_while_rel_uincl with checker_st_uincl tt.
-  by move=> xs fn es ii; apply wequiv_call_rel_uincl with checker_st_uincl tt.
+  move=> xs fn es ii; apply wequiv_call_rel_uincl_wa with checker_st_uincl tt => //.
 Qed.
 
 End PROG.
@@ -1585,22 +1652,39 @@ Proof.
   by eexists; eauto.
 Qed.
 
-Lemma it_sem_uincl_f fn :
+Lemma it_sem_uincl_f_wa fn :
+  (∀ fn fs1 fs2, fs_uincl fs1 fs2 → sem_pre p fn fs1 = ok tt → sem_pre p fn fs2 = ok tt) →
+  (∀ fn vs1 vs2 fr1 fr2,
+    List.Forall2 value_uincl vs1 vs2
+    → fs_uincl fr1 fr2 → sem_post p fn vs1 fr1 = ok tt → sem_post p fn vs2 fr2 = ok tt) →
   wiequiv_f p p ev ev (rpreF (eS:= uincl_spec)) fn fn (rpostF (eS:=uincl_spec)).
 Proof.
-apply wequiv_fun_ind => {}fn _ fs1 fs2 [<-] hu fd ->.
-exists fd => // s /(fs_uincl_initialize erefl erefl erefl erefl hu) [t] -> {}hu.
-exists t => //; exists (st_uincl tt), (st_uincl tt); split=> //.
-+ apply it_sem_uincl_aux => // ii fn' fs1' fs2' h; exact/wequiv_fun_rec.
-exact/fs_uincl_finalize.
-Qed.
-
-Lemma it_sem_uincl c :
+  move=> hpre hpost.
+  apply wequiv_fun_ind_wa => {}fn _ fs1 fs2 [<-] hu fd ->; exists fd => //.
+  move=> /(hpre _ _ _ hu) ?; split => //.
+  move=> s /(fs_uincl_initialize erefl erefl erefl erefl hu) [t] -> {}hu; exists t => //.
+  exists (st_uincl tt), (st_uincl tt); split => //.
+  + apply it_sem_uincl_aux_wa => //.
+   move=> ii fn' fs1' fs2' h; exact/wequiv_fun_rec.
+  by apply: fs_uincl_finalize.
+Qed.
+
+Lemma it_sem_uincl_wa c :
+  (∀ fn fs1 fs2, fs_uincl fs1 fs2 → sem_pre p fn fs1 = ok tt → sem_pre p fn fs2 = ok tt) →
+  (∀ fn vs1 vs2 fr1 fr2,
+    List.Forall2 value_uincl vs1 vs2
+    → fs_uincl fr1 fr2 → sem_post p fn vs1 fr1 = ok tt → sem_post p fn vs2 fr2 = ok tt) →
   wiequiv p p ev ev (st_uincl tt) c c (st_uincl tt).
-Proof. by apply it_sem_uincl_aux => //; move=> ? fn ?? h; apply it_sem_uincl_f. Qed.
+Proof.
+  move=> hpre hpost.
+  apply it_sem_uincl_aux_wa => //.
+  by move=> ? fn ?? h; apply it_sem_uincl_f_wa.
+Qed.
 
 End REFL.
 
+End NOT_ALLOW_ASSERT.
+
 Context
   {pT1 : progT}
   {wsw1 : WithSubWord}
@@ -1640,7 +1724,7 @@ apply: (
 - move=> s1 s2 s3 s1' s3' [<- <-] [_ hincl] [s2' [?? hincl1'] [?? hincl2']].
   split; [congruence | congruence|].
   exact: Forall2_trans value_uincl_trans hincl1' hincl2'.
-exact: it_sem_uincl_f.
+exact: it_sem_uincl_f_wa.
 Qed.
 
 Lemma it_sem_refl_EE_UU :
@@ -1662,6 +1746,7 @@ End WITH_PARAMS.
 
 End WSW.
 
+
 Notation pre_incl := (rpreF (eS := uincl_spec)).
 Notation post_incl := (rpostF (eS := uincl_spec)).
 
@@ -1770,6 +1855,7 @@ Context
   {E E0 : Type -> Type}
   {wE : with_Error E E0}
   {wsw1 wsw2 wsw3 : WithSubWord}
+  {wc1 wc2 wc3 : WithCatch }
   {wa1 wa2 wa3 : WithAssert}
   {scP1 : semCallParams (wsw := wsw1) (pT := pT1)}
   {scP2 : semCallParams (wsw := wsw2) (pT := pT2)}
@@ -1797,6 +1883,7 @@ Context
 Let wiequiv_f_trans' :=
   wiequiv_f_trans
     (wsw1 := wsw1) (wsw2 := wsw2) (wsw3 := wsw3)
+    (wc1 := wc1) (wc2 := wc2) (wc3  := wc3)
     (wa1 := wa1) (wa2 := wa2) (wa3 := wa3)
     (scP1 := scP1) (scP2 := scP2) (scP3 := scP3)
     (dc1 := dc1) (dc2 := dc2) (dc3 := dc3)
@@ -1830,3 +1917,4 @@ Definition wiequiv_f_trans_UU_UU :=
     rpostF_trans_uincl_uincl_uincl_uincl.
 
 End TRANS_UTILS.
+
diff --git a/proofs/lang/psem_core.v b/proofs/lang/psem_core.v
index 1db49c1c81..456dc1cfe7 100644
--- a/proofs/lang/psem_core.v
+++ b/proofs/lang/psem_core.v
@@ -35,25 +35,6 @@ Class semCallParams
      mem_equiv m rm;
 }.
 
-(** Switch for the semantics of function calls:
-  - when false, arguments and returned values are truncated to the declared type of the called function;
-  - when true, arguments and returned values are allowed to be undefined.
-
-Informally, “direct call” means that passing arguments and returned value does not go through an assignment;
-indeed, assignments truncate and fail on undefined values.
-*)
-Class DirectCall := {
-  direct_call : bool;
-}.
-
-Definition indirect_c : DirectCall := {| direct_call := false |}.
-Definition direct_c : DirectCall := {| direct_call := true |}.
-
-Definition dc_truncate_val {dc:DirectCall} t v :=
-  if direct_call then ok v
-  else truncate_val t v.
-
-
 Section SEM_CALL_PARAMS.
 
 Context
@@ -180,6 +161,43 @@ Proof. by case: s. Qed.
 
 End ESTATE_UTILS.
 
+Section WITHCATCH.
+Context {wc : WithCatch}.
+
+(* TODO : Should we move this and the definition of catch_core in utils ? *)
+Lemma catch_coreP {T : Type} (P : T -> Prop) (ex : exec T) (dflt t : T) :
+  (forall e, ex = Error e -> e <> ErrType -> P dflt) ->
+  (ex = ok t -> P t) ->
+  catch_core ex dflt = ok t -> P t.
+Proof.
+  rewrite /catch_core; case: ex => //.
+  by move=> e + _; case: is_ErrTypeP => // h h1 [<-];apply: h1 h.
+Qed.
+
+Lemma catchP {T : Type} (P : T -> Prop) (ex : exec T) (dflt t : T) :
+  (with_catch -> forall e, ex = Error e -> e <> ErrType -> P dflt) ->
+  (ex = ok t -> P t) ->
+  catch ex dflt = ok t -> P t.
+Proof. by case: with_catch => // /(_ erefl); apply catch_coreP. Qed.
+
+Lemma catchP2 {T1 T2 : Type} (P: T1 -> exec T2 -> Prop) (ex1 : exec T1) (ex2 : exec T2) (dflt1 t1 : T1) (dflt2 : T2) :
+  (forall e1, ex1 = Error e1 -> e1 ≠ ErrType -> P dflt1 ex2) ->
+  (forall e2, ex1 = ok t1 -> ex2 = Error e2 -> e2 ≠ ErrType -> P t1 (ok dflt2)) ->
+  (forall e1 e2, ex1 = Error e1 -> e1 ≠ ErrType -> ex2 = Error e2 -> e2 ≠ ErrType -> P dflt1 (ok dflt2)) ->
+  (ex1 = ok t1 -> P t1 ex2) ->
+  catch ex1 dflt1 = ok t1 -> P t1 (catch ex2 dflt2).
+Proof.
+  case: with_catch => //.
+  rewrite /catch_core; case heq1: ex1 => [t1' | e1].
+  + case heq2: ex2 => [| e2] //; case: is_ErrTypeP => //.
+    by move=> he2 _ h _ _ ?; apply: h he2.
+  case: is_ErrTypeP => // he1 /(_ _ erefl he1) + _ /(_ _ _ erefl he1) + _ [<-].
+  case heq2: ex2 => [t2 | e2] //.
+  by case: is_ErrTypeP => // he2 _ h; apply: h he2.
+Qed.
+
+End WITHCATCH.
+
 (* ** Starting lemmas
  * ------------------------------------------------------------------- *)
 Lemma type_of_get_global gd g v :
@@ -189,12 +207,23 @@ Proof. by move=> /get_globalI [?[]]. Qed.
 Lemma get_global_defined gd x v : get_global gd x = ok v -> is_defined v.
 Proof. by move=> /get_globalI [gv [_ -> _]]; case: gv. Qed.
 
-Lemma get_gvar_compat wdb gd vm x v : get_gvar wdb gd vm x = ok v ->
+Lemma is_defined_default_val ty : is_defined (default_val ty).
+Proof. by case: ty. Qed.
+
+Lemma compat_val_default_val ty : compat_val (eval_atype ty) (default_val ty).
+Proof. by rewrite /compat_val; case: ty. Qed.
+
+Lemma type_of_default_val ty : type_of_val (default_val ty) = eval_atype ty.
+Proof. by case: ty. Qed.
+
+Lemma get_gvar_compat {wc:WithCatch} wdb gd vm x v : get_gvar wdb gd vm x = ok v ->
    (~~wdb || is_defined v) /\ compat_val (eval_atype (vtype x.(gv))) v.
 Proof.
-  rewrite /get_gvar;case:ifP => ? heq.
-  + by apply: get_var_compat heq.
-  by rewrite /compat_val (type_of_get_global heq) (get_global_defined heq) orbT.
+  rewrite /get_gvar; case:ifP => ?.
+  + apply: (@catchP wc value (fun v => ~~ wdb || is_defined v ∧ compat_val (eval_atype (vtype (gv x))) v)).
+    + by rewrite is_defined_default_val compat_val_default_val orbT.
+    by apply: get_var_compat.
+  by move=> heq; rewrite /compat_val (type_of_get_global heq) (get_global_defined heq) orbT.
 Qed.
 
 Lemma get_var_to_word wdb vm x ws w :
@@ -215,24 +244,27 @@ Lemma to_word_get_var wdb vm x ws (w:word ws) :
 Proof. by move=> -> /=; rewrite truncate_word_u. Qed.
 
 (* Remark compat_type b = if b then subtype else eq *)
-Lemma type_of_get_gvar x gd vm v :
+Lemma type_of_get_gvar {wc:WithCatch} x gd vm v :
   get_gvar true gd vm x = ok v ->
   compat_ctype sw_allowed (type_of_val v) (eval_atype (vtype x.(gv))).
 Proof. by move=> /get_gvar_compat [/=hd]; rewrite /compat_val hd orbF. Qed.
 
-Lemma type_of_get_gvar_sub x gd vm v :
+Lemma type_of_get_gvar_sub {wc:WithCatch} x gd vm v :
   get_gvar true gd vm x = ok v ->
   subctype (type_of_val v) (eval_atype (vtype x.(gv))).
 Proof. by move=> /type_of_get_gvar /compat_ctype_subctype. Qed.
 
 (* We have a more precise result in the non-word cases. *)
-Lemma type_of_get_gvar_not_word gd vm x v :
+
+Lemma type_of_get_gvar_not_word {wc:WithCatch} gd vm x v :
   (sw_allowed -> ~ is_aword x.(gv).(vtype)) ->
   get_gvar true gd vm x = ok v ->
   type_of_val v = eval_atype x.(gv).(vtype).
 Proof.
   move=> hnword; rewrite /get_gvar; case: ifP => ?.
-  + by apply: type_of_get_var_not_word.
+  + apply: (@catchP wc value (fun v => type_of_val v = eval_atype (vtype (gv x)))).
+    + by rewrite type_of_default_val.
+    by apply: type_of_get_var_not_word.
   by apply type_of_get_global.
 Qed.
 
@@ -248,7 +280,7 @@ Proof.
   by apply: H.
 Qed.
 
-Lemma on_arr_gvarP A (f : forall n, WArray.array n -> exec A) wdb v gd s x P:
+Lemma on_arr_gvarP {wc:WithCatch} A (f : forall n, WArray.array n -> exec A) wdb v gd s x P:
   (forall n t, eval_atype (vtype x.(gv)) = carr n ->
                get_gvar wdb gd s x = ok (@Varr n t) ->
                f n t = ok v -> P) ->
@@ -260,10 +292,11 @@ Proof.
   by apply: H.
 Qed.
 
-Lemma get_gvar_glob wdb gd x vm : is_glob x -> get_gvar wdb gd vm x = get_global gd (gv x).
+Lemma get_gvar_glob {wc:WithCatch} wdb gd x vm : is_glob x -> get_gvar wdb gd vm x = get_global gd (gv x).
 Proof. by rewrite /get_gvar /is_lvar /is_glob => /eqP ->. Qed.
 
-Lemma get_gvar_nglob wdb gd x vm : ~~is_glob x -> get_gvar wdb gd vm x = get_var wdb vm (gv x).
+Lemma get_gvar_nglob {wc:WithCatch} wdb gd x vm : ~~is_glob x ->
+  get_gvar wdb gd vm x = catch (get_var wdb vm (gv x)) (default_val (vtype (gv x))).
 Proof. by rewrite /get_gvar is_lvar_is_glob => ->. Qed.
 
 Section WITH_SCS.
@@ -272,21 +305,38 @@ Section WITH_SCS.
     {asm_op syscall_state : Type}
     {ep : EstateParams syscall_state}
     {spp : SemPexprParams}
+    {wc:WithCatch}
+    {wa : WithAssert}
     (wdb : bool)
-    (gd : glob_decls)
-    (s1 : estate)
-    (scs : syscall_state).
+    (gd : glob_decls).
 
   Let P e : Prop :=
-    sem_pexpr wdb gd s1 e = sem_pexpr wdb gd (with_scs s1 scs) e.
+    forall s scs,
+    sem_pexpr wdb gd s e = sem_pexpr wdb gd (with_scs s scs) e.
 
   Let Q es : Prop :=
-    sem_pexprs wdb gd s1 es = sem_pexprs wdb gd (with_scs s1 scs) es.
+    forall s scs,
+    sem_pexprs wdb gd s es = sem_pexprs wdb gd (with_scs s scs) es.
+
+  Lemma write_var_with_scs x v s scs:
+    write_var wdb x v (with_scs s scs) = write_var wdb x v s >>= (fun s => ok (with_scs s scs)).
+  Proof. by rewrite /write_var /=; case: set_var. Qed.
 
   Lemma sem_pexpr_es_with_scs : (∀ e, P e) * (∀ es, Q es).
   Proof.
-    apply: pexprs_ind_pair; split; subst P Q => //=; rewrite /sem_pexprs => *;
-    repeat match goal with H: _ = _ |- _ => rewrite H // end.
+    apply: pexprs_ind_pair; subst P Q; rewrite /sem_pexprs; split => //=
+    [ > he > hes | > he | > he | > he | > he
+    | > he1 > he2 | > hes | > he > he1 > he2
+    | idx hidx o x body hbody start hstart len hlen
+    | > he1 he2 ] s1 scs;
+    rewrite -?he -?hes -?he1 -?he2 => //.
+    rewrite -hidx -hstart -hlen.
+    repeat apply bind_eq => // ?.
+    set v := (v in foldM _ v _ = foldM _ v _).
+    elim: ziota v => // j js /= hrec v.
+    apply bind_eq => //.
+    rewrite write_var_with_scs Let_Let.
+    by apply bind_eq => //= s2; rewrite -hbody.
   Qed.
 
   Definition sem_pexpr_with_scs := fst sem_pexpr_es_with_scs.
@@ -305,15 +355,15 @@ Context
 Lemma sopn_toutP o vs vs' : exec_sopn o vs = ok vs' ->
   List.map type_of_val vs' = map eval_atype (sopn_tout o).
 Proof.
-  rewrite /exec_sopn /sopn_tout /sopn_sem.
+  rewrite /exec_sopn /sopn_tout /sopn_sem /=.
   t_xrbindP => ? _ <- ? _ <-;apply type_of_val_ltuple.
 Qed.
 
 Lemma sopn_tinP o vs vs' : exec_sopn o vs = ok vs' ->
   all2 subctype (map eval_atype (sopn_tin o)) (List.map type_of_val vs).
 Proof.
-  rewrite /exec_sopn /sopn_tin /sopn_sem /sopn_sem_; t_xrbindP => _ _ <-.
-  case (get_instr_desc o) => /= _ tin _ tout _ _ semi _ _ _ _ _ _.
+  rewrite /exec_sopn /sopn_tin /sopn_sem /sopn_sem_ /=; t_xrbindP => _ _ <-.
+  case (get_instr_desc o) => /= _ tin _ tout _ _ semi _ _ _ _ _ _ _.
   t_xrbindP => p hp _.
   elim: tin vs semi hp => /= [ | t tin hrec] [ | v vs] // semi.
   by t_xrbindP => sv /= /of_val_subctype -> /hrec.
@@ -339,11 +389,13 @@ Definition write_get_var_Spec (wdb : bool) (x : var_i) (v : value) (s : estate)
         Let _:= assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype x)) v)
       else get_var wdb (evm s) y)].
 
-Definition write_get_gvar_Spec gd (wdb : bool) (x : var_i) (v : value) (s : estate) (s' : estate) : Prop :=
+Definition write_get_gvar_Spec {wc:WithCatch} gd (wdb : bool) (x : var_i) (v : value) (s : estate) (s' : estate) : Prop :=
   [/\ DB wdb v, truncatable wdb (eval_atype (vtype x)) v &
     (forall y, get_gvar wdb gd (evm s') y =
       if is_lvar y && (v_var x == gv y) then
-        Let _:= assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype x)) v)
+        catch
+          (Let _:= assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype x)) v))
+          (default_val (vtype x))
       else get_gvar wdb gd (evm s) y)].
 
 Lemma get_var_set wdb vm x v y :
@@ -381,16 +433,18 @@ Lemma get_var_set_eq wdb vm1 vm2 (x y : var) v:
   get_var wdb vm1.[x <- v] y = get_var wdb vm2.[x <- v] y.
 Proof. by rewrite /get_var !Vm.setP; case: eqP. Qed.
 
-Lemma get_gvar_eq wdb gd x vm v :
+Lemma get_gvar_eq {wc:WithCatch} wdb gd x vm v :
   truncatable wdb (eval_atype (vtype (gv x))) v ->
   ~ is_glob x ->
   get_gvar wdb gd vm.[x.(gv) <- v] x =
-    Let _ := assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype (gv x))) v).
+    catch 
+    (Let _ := assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype (gv x))) v))
+    (default_val (vtype (gv x))).
 Proof.
   by move=> h1 /negP h2; rewrite /get_gvar is_lvar_is_glob h2 get_var_eq.
 Qed.
 
-Lemma get_gvar_neq wdb gd (x:var) y vm v :
+Lemma get_gvar_neq {wc:WithCatch} wdb gd (x:var) y vm v :
   (~ is_glob y -> x <> (gv y)) -> get_gvar wdb gd vm.[x <- v] y = get_gvar wdb gd vm y.
 Proof.
   move=> h; rewrite /get_gvar is_lvar_is_glob.
@@ -468,27 +522,38 @@ Proof.
   exact: write_get_varP_neq x_neq_y ok_s2.
 Qed.
 
-Lemma write_get_gvarP gd wdb x v s s':
+Lemma write_get_gvarP {wc:WithCatch} gd wdb x v s s':
   write_var wdb x v s = ok s' -> write_get_gvar_Spec gd wdb x v s s'.
 Proof.
   move=> /write_get_varP [hdb htr hget]; econstructor; eauto => y.
-  by rewrite /get_gvar hget; case: is_lvar.
+  rewrite /get_gvar hget; case: is_lvar => //=.
+  by case: eqP => [-> | ].
 Qed.
 
-Lemma write_get_gvarP_eq wdb gd (x:var_i) v s s':
+Lemma write_get_gvarP_eq {wc:WithCatch} wdb gd (x:var_i) v s s':
   write_var wdb x v s = ok s' ->
   [/\ DB wdb v, truncatable wdb (eval_atype (vtype x)) v &
     get_gvar wdb gd (evm s') (mk_lvar x) =
-    Let _ := assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype x)) v)].
+    catch 
+     (Let _ := assert (~~wdb || is_defined v) ErrAddrUndef in ok (vm_truncate_val (eval_atype (vtype x)) v))
+     (default_val (vtype x))].
 Proof. by move=> /(write_get_gvarP gd) [hdb htr ->]; rewrite /= eqxx. Qed.
 
-Lemma write_get_gvarP_neq wdb gd (x:var_i) v s s' y: (is_lvar y -> v_var x != gv y) ->
+Lemma write_get_gvarP_neq {wc:WithCatch} wdb gd (x:var_i) v s s' y: (is_lvar y -> v_var x != gv y) ->
   write_var wdb x v s = ok s' -> get_gvar wdb gd (evm s') y = get_gvar wdb gd (evm s) y.
 Proof.
   move=> h /(write_get_gvarP gd) [htr hdb ->].
   by case: is_lvar h => // /(_ erefl) /negbTE ->.
 Qed.
 
+Section WITHASSERT.
+
+Context {wa : WithAssert}.
+
+Section WITHCATCH.
+
+Context {wc:WithCatch}.
+
 Lemma is_wconstP wdb gd s sz e w:
   is_wconst sz e = Some w →
   sem_pexpr wdb gd s e >>= to_word sz = ok w.
@@ -496,7 +561,7 @@ Proof.
   case: e => // - [] // sz' e /=; case: ifP => // hle /oseq.obindI [z] [h] [<-].
   have := is_constP e.
   rewrite h => {h} /is_reflect_some_inv -> {e}.
-  by rewrite /= truncate_word_le // zero_extend_wrepr.
+  by rewrite /sem_sop1 /= if_same /= truncate_word_le // zero_extend_wrepr.
 Qed.
 
 Lemma is_wconstI ws e w :
@@ -617,24 +682,19 @@ Proof. by move=> hin hvm;rewrite /get_var hvm. Qed.
 Lemma get_gvar_eq_on wdb s gd vm' vm v: Sv.Subset (read_gvar v) s -> vm =[s]  vm' ->
   get_gvar wdb gd vm v = get_gvar wdb gd vm' v.
 Proof.
-  rewrite /read_gvar /get_gvar; case: ifP => // _ hin.
-  by apply: get_var_eq_on; SvD.fsetdec.
+  rewrite /read_gvar /get_gvar; case: ifP => // _ hin heq.
+  rewrite (get_var_eq_on _ _ heq) //; SvD.fsetdec.
 Qed.
 
 Lemma on_arr_var_eq_on wdb s' X s A x (f: ∀ n, WArray.array n → exec A) :
    evm s =[X] evm s' -> Sv.In x X ->
    on_arr_var (get_var wdb (evm s) x) f = on_arr_var (get_var wdb (evm s') x) f.
-Proof.
-  by move=> Heq Hin;rewrite /on_arr_var;rewrite (get_var_eq_on _ Hin Heq).
-Qed.
+Proof. by move=> Heq Hin;rewrite (get_var_eq_on _ Hin Heq). Qed.
 
 Lemma on_arr_gvar_eq_on wdb s' gd X s A x (f: ∀ n, WArray.array n → exec A) :
    evm s =[X] evm s' -> Sv.Subset (read_gvar x) X ->
    on_arr_var (get_gvar wdb gd (evm s) x) f = on_arr_var (get_gvar wdb gd (evm s') x) f.
-Proof.
-  move=> Heq; rewrite /get_gvar /read_gvar;case:ifP => _ Hin //.
-  by apply: (on_arr_var_eq_on _ (X := X)) => //; SvD.fsetdec.
-Qed.
+Proof. by move=> heq hsub; rewrite (get_gvar_eq_on _ _ hsub heq). Qed.
 
 Lemma get_var_eq_ex wdb vm1 vm2 X x:
   ~Sv.In x X ->
@@ -647,54 +707,75 @@ Lemma get_gvar_eq_ex wdb gd vm1 vm2 X x:
   vm1 =[\ X] vm2 ->
   get_gvar wdb gd vm1 x = get_gvar wdb gd vm2 x.
 Proof.
-  rewrite /read_gvar /get_gvar; case: ifP => // _ /disjointP hin.
-  apply: get_var_eq_ex; apply hin; SvD.fsetdec.
+  rewrite /read_gvar /get_gvar; case: ifP => // _ /disjointP hin heqx.
+  rewrite (get_var_eq_ex _ _ heqx) //; apply hin; SvD.fsetdec.
 Qed.
 
 Section READ_E_ES_EQ_ON.
 
-  Context (wdb : bool) (gd : glob_decls) (s1 : estate) (vm' : Vm.t).
+  Context (wdb : bool) (gd : glob_decls).
 
   Let P e : Prop :=
-    ∀ s, evm s1 =[read_e_rec s e]  vm' →
+    ∀ s1 vm' s, evm s1 =[read_e_rec s e] vm' →
          sem_pexpr wdb gd s1 e = sem_pexpr wdb gd (with_vm s1 vm') e.
 
   Let Q es : Prop :=
-    ∀ s, evm s1 =[read_es_rec s es] vm' →
+    ∀ s1 vm' s, evm s1 =[read_es_rec s es] vm' →
          sem_pexprs wdb gd s1 es = sem_pexprs wdb gd (with_vm s1 vm') es.
 
   Lemma read_e_es_eq_on : (∀ e, P e) * (∀ es, Q es).
   Proof.
-    apply: pexprs_ind_pair; split; subst P Q => //=.
-    - move => e rec es ih s Heq /=.
+    apply: pexprs_ind_pair; split; subst P Q => //.
+    - move => e rec es ih s1 vm' s Heq /=.
       have Heq' : evm s1 =[read_e_rec s e] vm'.
-      + apply: (eq_onI _ Heq); rewrite /= read_esE; SvD.fsetdec.
-      move: rec => /(_ _ Heq') ->.
-      case: (sem_pexpr _ _ _ e) => //= v.
-      by move: ih => /(_ _ Heq) ->.
-    - by move=> x s /get_gvar_eq_on -> //; SvD.fsetdec.
-    - move=> al aa sz x e He s Heq; rewrite (He _ Heq) => {He}.
+      + by apply: (eq_onI _ Heq); rewrite /= read_esE; SvD.fsetdec.
+      apply bind_eq; first by apply: rec Heq'.
+      by move=> v; rewrite (ih _ _ _ Heq).
+    - by move=> /= x s1 vm' s /get_gvar_eq_on -> //; SvD.fsetdec.
+    - move=> /= al aa sz x e He s1 vm' s Heq; rewrite (He _ _ _ Heq) => {He}.
       rewrite (on_arr_gvar_eq_on (s' := with_vm s1 vm') _ _ _ Heq) ?read_eE //.
       by SvD.fsetdec.
-    - move=> aa sz len x e He s Heq; rewrite (He _ Heq) => {He}.
+    - move=> /= aa sz len x e He s1 vm' s Heq; rewrite (He _ _ _ Heq) => {He}.
       rewrite (on_arr_gvar_eq_on (s' := with_vm s1 vm') _ _ _ Heq) ?read_eE //.
       by SvD.fsetdec.
-    - by move=> al sz e He s Hvm; rewrite (He _ Hvm) // read_eE;SvD.fsetdec.
-    - by move=> op e He s /He ->.
-    - move => op e1 He1 e2 He2 s Heq; rewrite (He1 _ Heq) (He2 s) //.
+    - by move=> al sz e He s1 vm' s Hvm /=; rewrite (He _ _ _ Hvm) // read_eE; SvD.fsetdec.
+    - by move=> /= op e He s1 vm' s /He ->.
+    - move => /= op e1 He1 e2 He2 s1 vm' s Heq; rewrite (He1 _ _ _ Heq) (He2 _ vm' s) //.
       by move=> z Hin; apply Heq; rewrite read_eE; SvD.fsetdec.
-    - by move => op es Hes s heq; rewrite -!/(sem_pexprs wdb gd s1) (Hes _ heq).
-    move=> t e He e1 He1 e2 He2 s Heq; rewrite (He _ Heq) (He1 s) ? (He2 s) //.
-    + move=> z Hin;apply Heq;rewrite !read_eE.
+    - by move => /= op es Hes s1 vm' s heq; rewrite -!/(sem_pexprs wdb gd s1) (Hes _ _ _ heq).
+    - move=> /= t e He e1 He1 e2 He2 s1 vm' s Heq; rewrite (He _ _ _ Heq) (He1 s1 vm' s) ? (He2 s1 vm' s) //.
+      + move=> z Hin;apply Heq;rewrite !read_eE.
+        by move: Hin;rewrite read_eE;SvD.fsetdec.
+      move=> z Hin;apply Heq;rewrite !read_eE.
       by move: Hin;rewrite read_eE;SvD.fsetdec.
-    move=> z Hin;apply Heq;rewrite !read_eE.
-    by move: Hin;rewrite read_eE;SvD.fsetdec.
+    - move=> idx hidx op x body hb start hs len hlen s1 vm' s.
+      rewrite read_eE read_e_Pbig => heq /=.
+      rewrite (hs s1 vm' s); last first.
+      + move=> z Hin;apply heq.
+        by move: Hin;rewrite read_eE;SvD.fsetdec.
+      rewrite (hlen s1 vm' s); last first.
+      + move=> z Hin;apply heq.
+        by move: Hin;rewrite read_eE;SvD.fsetdec.
+      rewrite (hidx s1 vm' s); last first.
+      + move=> z Hin;apply heq.
+        by move: Hin;rewrite read_eE;SvD.fsetdec.
+      do 4! apply bind_eq => // ?.
+      apply foldM_ext => i ?; rewrite /write_var !Let_Let evm_with_vm.
+      do 2! apply bind_eq => //= ?.
+      rewrite (hb _ vm'.[x<-i] s); first by rewrite !with_vm_idem.
+      rewrite read_eE => z hz; rewrite !Vm.setP; case: eqP => // ?.
+      apply heq; SvD.fsetdec.
+    - rewrite /= /eq_on /vm_rel => x s1 vm' s /(_ x) Heq.
+      have H := (SvP.MP.FM.add_1 s Logic.eq_refl).
+      by apply Heq in H; rewrite H.
+    - move=> /= e1 e2 He1 He2 s1 vm' s Heq; rewrite (He1 _ _ _ Heq) (He2 _ vm' s) //.
+      move=> z Hin; apply Heq; rewrite read_eE; SvD.fsetdec.
   Qed.
 
 End READ_E_ES_EQ_ON.
 
 Definition read_e_eq_on wdb gd s vm' s1 e :=
-  (read_e_es_eq_on wdb gd s1 vm').1 e s.
+  (read_e_es_eq_on wdb gd).1 e s1 vm' s.
 
 Lemma read_e_eq_on_empty wdb gd vm s e :
   evm s =[ read_e_rec Sv.empty e ]  vm
@@ -702,7 +783,7 @@ Lemma read_e_eq_on_empty wdb gd vm s e :
 Proof. exact: read_e_eq_on. Qed.
 
 Definition read_es_eq_on wdb gd es s s1 vm' :=
-  (read_e_es_eq_on wdb gd s1 vm').2 es s.
+  (read_e_es_eq_on wdb gd).2 es s1 vm' s.
 
 Lemma read_es_eq_on_empty wdb gd es s vm :
   evm s =[ read_es_rec Sv.empty es ]  vm
@@ -714,7 +795,7 @@ Corollary eq_on_sem_pexpr wdb s' gd s e :
   evm s =[read_e e] evm s' →
   sem_pexpr wdb gd s e = sem_pexpr wdb gd s' e.
 Proof.
-  move=> eq_mem /read_e_eq_on ->; rewrite (sem_pexpr_with_scs _ gd _ (escs s')).
+  move=> eq_mem /read_e_eq_on ->; rewrite (sem_pexpr_with_scs _ gd _ _ (escs s')).
   by case: s' eq_mem => /= > <-.
 Qed.
 
@@ -723,7 +804,7 @@ Corollary eq_on_sem_pexprs wdb s' gd s es :
   evm s =[read_es es] evm s' →
   sem_pexprs wdb gd s es = sem_pexprs wdb gd s' es.
 Proof.
-  move=> eq_mem /read_es_eq_on ->; rewrite (sem_pexprs_with_scs _ gd _ (escs s')).
+  move=> eq_mem /read_es_eq_on ->; rewrite (sem_pexprs_with_scs _ gd _ _ (escs s')).
   by case: s' eq_mem => /= > <-.
 Qed.
 
@@ -735,17 +816,28 @@ Lemma use_memP gd e:
   ~~use_mem e ->
   sem_pexpr wdb gd s1 e = sem_pexpr wdb gd s2 e.
 Proof.
-  apply (pexpr_mut_ind (P := fun e => ~~use_mem e -> sem_pexpr wdb gd s1 e = sem_pexpr wdb gd s2 e)
-                      (Q := fun e => ~~has use_mem e -> sem_pexprs wdb gd s1 e = sem_pexprs wdb gd s2 e)).
-  split => //= {e}.
-  + by move=> e hrec es hrecs; rewrite negb_or => /andP [] /hrec -> /hrecs ->.
-  + by move=> x _; rewrite heq.
-  + by move=> ??? x e hrec /hrec ->; rewrite heq.
-  + by move=> ??? x e hrec /hrec ->; rewrite heq.
-  + by move=> ? e hrec /hrec ->.
-  + by move=> ? e1 hrec1 e2 hrec2; rewrite negb_or => /andP[] /hrec1 -> /hrec2 ->.
-  + by move=> ? es; rewrite /sem_pexprs => h/h->.
-  by move=> ty e he e1 he1 e2 he2; rewrite !negb_or=> /andP[]/andP[] /he-> /he1-> /he2->.
+  move: e s1 s2 heq; clear s1 s2 heq.
+  apply (pexpr_mut_ind (P := fun e => forall s1 s2, evm s1 = evm s2 ->
+                                ~~use_mem e -> sem_pexpr wdb gd s1 e = sem_pexpr wdb gd s2 e)
+                        (Q := fun e => forall s1 s2, evm s1 = evm s2 ->
+                                ~~has use_mem e -> sem_pexprs wdb gd s1 e = sem_pexprs wdb gd s2 e)).
+  split => //=.
+  + by move=> e hrec es hrecs s1 s2 heq; rewrite negb_or => /andP [] /(hrec _ _ heq) -> /(hrecs _ _ heq)->.
+  + by move=> x s1 s2 heq; rewrite heq.
+  + by move=> ??? x e hrec s1 s2 heq /(hrec _ _ heq) ->; rewrite heq.
+  + by move=> ??? x e hrec s1 s2 heq /(hrec _ _ heq) ->; rewrite heq.
+  + by move=> ? e hrec s1 s2 heq /(hrec _ _ heq) ->.
+  + by move=> ? e1 hrec1 e2 hrec2 s1 s2 heq; rewrite negb_or => /andP[] /(hrec1 _ _ heq) -> /(hrec2 _ _ heq) ->.
+  + by rewrite /sem_pexprs => ? es hrec s1 s2 heq /(hrec _ _ heq) ->.
+  + move=> ty e he e1 he1 e2 he2 s1 s2 heq; rewrite !negb_or.
+    by move=> /andP[]/andP[] /(he _ _ heq)-> /(he1 _ _ heq)-> /(he2 _ _ heq)->.
+  move=> idx hi ? x b hb s hs l hl s1 s2 heq; rewrite !negb_or => /andP[]/andP[]/andP[].
+  move=> /(hi _ _ heq) -> hnb /(hs _ _ heq) -> /(hl _ _ heq) ->.
+  do 4! apply bind_eq => // ?; apply foldM_ext => ??.
+  apply (bindP (R := fun s1 s2 => evm s1 = evm s2)).
+  + by rewrite /write_var heq; case: set_var.
+  + by move=> m1 m2 heq'; rewrite (hb _ _ heq' hnb).
+  by move=> ??? ->.
 Qed.
 
 End UseMem.
@@ -839,15 +931,15 @@ Proof.
   exists vm2 => //; rewrite vrvs_cons; apply: eq_onI hvm2;SvD.fsetdec.
 Qed.
 
-(* -------------------------------------------- *)
+End WITHCATCH.
 
+(* -------------------------------------------- *)
 Lemma get_gvar_uincl_at wdb x gd vm1 vm2 v1:
   (if is_lvar x then value_uincl vm1.[gv x] vm2.[gv x] else True) ->
   get_gvar wdb gd vm1 x = ok v1 ->
   exists2 v2, get_gvar wdb gd vm2 x = ok v2 & value_uincl v1 v2.
 Proof.
-  rewrite /get_gvar; case:ifP => _.
-  + exact: get_var_uincl_at.
+  rewrite /get_gvar /=; case:ifP => _; first exact: get_var_uincl_at.
   by move=> ? ->;exists v1.
 Qed.
 
@@ -910,19 +1002,6 @@ Proof.
   by rewrite !of_val_to_val /= ho.
 Qed.
 
-Lemma vuincl_sem_opN op vs v vs' :
-  List.Forall2 value_uincl vs vs' →
-  sem_opN op vs = ok v →
-  sem_opN op vs' = ok v.
-Proof.
-  rewrite /sem_opN.
-  t_xrbindP => hvs q ok_q <-{v}.
-  have -> /= := vuincl_sopn _ hvs ok_q.
-  + by eauto.
-  case: {q ok_q} op => //.
-  all: by move => *; rewrite /= all_map all_nseq orbT.
-Qed.
-
 Lemma sem_opN_truncate_val o vs v :
   sem_opN o vs = ok v ->
   exists vs',
@@ -938,7 +1017,7 @@ Qed.
 
 Lemma vuincl_exec_opn {sip : SemInstrParams asm_op syscall_state} o vs vs' v :
   List.Forall2 value_uincl vs vs' -> exec_sopn o vs = ok v ->
-  exists2 v', exec_sopn o vs' = ok v' & List.Forall2  value_uincl v v'.
+  exists2 v', exec_sopn o vs' = ok v' & List.Forall2 value_uincl v v'.
 Proof.
   rewrite /exec_sopn /sopn_sem => vs_vs'; apply rbindP => ?; apply: rbindP => ? /assertP -> /= [<-] ho.
   exact: (get_instr_desc o).(semu) vs_vs' ho.
@@ -949,7 +1028,7 @@ Lemma truncate_val_exec_sopn {sip : SemInstrParams asm_op syscall_state} o vs vs
   exec_sopn o vs' = ok v ->
   exec_sopn o vs = ok v.
 Proof.
-  move=> htr; rewrite /exec_sopn.
+  move=> htr; rewrite /exec_sopn /=.
   t_xrbindP => ? -> /=  w ok_w <-.
   by rewrite (truncate_val_app_sopn htr ok_w).
 Qed.
@@ -960,19 +1039,105 @@ Lemma exec_sopn_truncate_val {sip : SemInstrParams asm_op syscall_state} o vs v
     mapM2 ErrType truncate_val (map eval_atype (sopn_tin o)) vs = ok vs' /\
     exec_sopn o vs' = ok v.
 Proof.
-  rewrite /exec_sopn; t_xrbindP=> ? -> /= w ok_w <-.
+  rewrite /exec_sopn /=; t_xrbindP=> ? -> /= w ok_w <-.
   have [? [-> {}ok_w]] := app_sopn_truncate_val ok_w.
   eexists; split; first by reflexivity.
   by rewrite ok_w.
 Qed.
 
 (* --------------------------------------------------------- *)
-Lemma sem_pexpr_uincl_on_pair wdb gd s1 vm2 :
-  (∀ e v1,
+
+Lemma write_var_uincl_on wdb X (x : var_i) v1 v2 s1 s2 vm1 :
+  value_uincl v1 v2 ->
+  write_var wdb x v1 s1 = ok s2 ->
+  evm s1 <=[X]  vm1 ->
+  exists2 vm2,
+    write_var wdb x v2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
+    evm s2 <=[Sv.add x X] vm2.
+Proof.
+  move=> hv; rewrite /write_var;t_xrbindP => vm1' hmv1' <- /= h.
+  have /(_ (Sv.add x X) vm1) []:= uincl_on_set_var hv _ hmv1'.
+  + by apply: uincl_onI h; SvD.fsetdec.
+  by move=> -> ?; eexists; eauto.
+Qed.
+
+Lemma write_var_uincl_on1 wdb s1 s2 vm1 v1 v2 (x : var_i) :
+  value_uincl v1 v2 ->
+  write_var wdb x v1 s1 = ok s2 ->
+  exists2 vm2 : Vm.t,
+    write_var wdb x v2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
+    s2.(evm) <=[Sv.singleton x] vm2.
+Proof. by move=> hv /(write_var_uincl_on hv) -/(_ Sv.empty vm1); apply. Qed.
+
+Corollary write_var_uincl wdb s1 s2 vm1 v1 v2 (x : var_i) :
+  s1.(evm) <=1 vm1 ->
+  value_uincl v1 v2 ->
+  write_var wdb x v1 s1 = ok s2 ->
+  exists2 vm2 : Vm.t,
+    write_var wdb x v2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
+    s2.(evm) <=1 vm2.
+Proof.
+  move => Hvm hv /[dup] hw1 /(write_var_uincl_on1 vm1 hv) {hv} [] vm2 hw2 le.
+  exists vm2 => //; apply: (uincl_on_vm_uincl Hvm le); [apply: vrvP_var hw1 | apply: vrvP_var hw2].
+Qed.
+
+Lemma write_vars_uincl wdb s1 s2 vm1 vs1 vs2 xs :
+  vm_uincl (evm s1) vm1 ->
+  List.Forall2 value_uincl vs1 vs2 ->
+  write_vars wdb xs vs1 s1 = ok s2 ->
+  exists2 vm2 : Vm.t,
+    write_vars wdb xs vs2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
+    vm_uincl (evm s2) vm2.
+Proof.
+  elim: xs s1 vm1 vs1 vs2 => /= [ | x xs Hrec] s1 vm1 vs1 vs2 Hvm [] //=.
+  + by move=> [] <-;eauto.
+  move=> {vs1 vs2} v1 v2 vs1 vs2 Hv Hvs;apply: rbindP => s1'.
+  by move=> /(write_var_uincl Hvm Hv) []vm2 -> Hvm2 /(Hrec _ _ _ _ Hvm2 Hvs).
+Qed.
+
+End WITHASSERT.
+
+(* --------------------------------------------------------- *)
+
+Section NOASSERT.
+#[local] Existing Instance noassert.
+
+Lemma sem_opN_is_arr_init len vs v:
+  sem_opN (Ois_arr_init len) vs <> ok v.
+Proof.
+  rewrite /sem_opN /= /not.
+  do 3!(case: vs => //= ? vs; t_xrbindP).
+  by case: vs.
+Qed.
+
+Lemma sem_opN_is_barr_init len vs v:
+  sem_opN (Ois_barr_init len) vs <> ok v.
+Proof.
+  rewrite /sem_opN /= /not.
+  do 3!(case: vs => //= ? vs; t_xrbindP).
+  by case: vs.
+Qed.
+
+Lemma vuincl_sem_opN op vs v vs' :
+  List.Forall2 value_uincl vs vs' →
+  sem_opN op vs = ok v →
+  sem_opN op vs' = ok v.
+Proof.
+  case: op.
+  4: by move=> > _ /sem_opN_is_arr_init.
+  4: by move=> > _ /sem_opN_is_barr_init.
+  all: rewrite /sem_opN; move=> >; t_xrbindP => hvs q ok_q <-{v};
+       have /= := vuincl_sopn _ hvs ok_q.
+  3: by move=> ->.
+  all: by move=> -> //; rewrite all_map all_nseq orbT.
+Qed.
+
+Lemma sem_pexpr_uincl_on_pair wdb gd :
+  (∀ e s1 vm2 v1,
       s1.(evm) <=[read_e e] vm2 →
       sem_pexpr wdb gd s1 e = ok v1 →
       exists2 v2, sem_pexpr wdb gd (with_vm s1 vm2) e = ok v2 & value_uincl v1 v2
-  ) ∧ (∀ es vs1,
+  ) ∧ (∀ es s1 vm2 vs1,
           s1.(evm) <=[read_es es] vm2 →
           sem_pexprs wdb gd s1 es = ok vs1 →
           exists2 vs2,
@@ -982,51 +1147,52 @@ Lemma sem_pexpr_uincl_on_pair wdb gd s1 vm2 :
 Proof.
   apply: pexprs_ind_pair; split => //=;
     rewrite /read_e /= ?read_eE ?read_eE /read_gvar.
-  + by move => _ _ /ok_inj <-; exists [::].
-  + move => e rec es ih vs1.
+  + by move => ?? _ _ /ok_inj <-; exists [::].
+  + move => e rec es ih s1 vm2 vs1.
     rewrite read_es_cons => /uincl_on_union_and [] /rec{}rec /ih{}ih /=.
     by t_xrbindP => v /rec [] v' -> h vs /ih [] vs' -> hs <- /=; exists (v' :: vs'); eauto.
-  1-3: by move => > _ /ok_inj <-; eexists.
-  + move => ?? Hu; apply: get_gvar_uincl_at; move: Hu; case: ifP => // _; apply; SvD.fsetdec.
-  + move => al aa sz x e Hp v; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu.
+  1-2: by move => ? s1 vm2 _ _ /ok_inj <-; eexists.
+  + by move=> ???? v1 ??; eauto. 
+  + by move => ?? s1 vm2 Hu; apply: get_gvar_uincl_at; move: Hu; case: ifP => // _; apply; SvD.fsetdec.
+  + move => al aa sz x e Hp s1 vm2 v; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu.
     apply on_arr_gvarP => n t Htx; rewrite /on_arr_var => /get_gvar_uincl_at - /(_ vm2) [].
     * by move: Hu; case: ifP => // _; apply; SvD.fsetdec.
     t_xrbindP=> ? -> /value_uinclE [? -> /WArray.uincl_get hg] > /Hp{Hp}
       [? -> ] /[swap] /to_intI -> /value_uinclE -> ? /hg{hg} /= -> /= ->.
     by eauto.
-  + move => aa sz len x e Hp v; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu.
+  + move => aa sz len x e Hp s1 vm2 v; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu.
     apply on_arr_gvarP => n t Htx; rewrite /on_arr_var => /get_gvar_uincl_at - /(_ vm2) [].
     * by move: Hu; case: ifP => // _; apply; SvD.fsetdec.
     t_xrbindP=> ? -> /value_uinclE [? -> /WArray.uincl_get_sub h] > /Hp{Hp}
       [? -> ] /[swap] /to_intI -> /value_uinclE -> ? /h{h} /= [? -> ?] /= <-.
     by eauto.
-  + move => al sz e Hp v; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu.
+  + move => al sz e Hp s1 vm2 v; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu.
     t_xrbindP => >.
     move=> /Hp[] ? ->
       /[swap] /to_wordI[? [? [-> /word_uincl_truncate h]]]
       /value_uinclE [? [? [-> /h{h} /= ->]]] ? /= -> /= ->.
     by eauto.
-  + by move => op e Hp v1; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu; t_xrbindP =>
+  + by move => op e Hp s1 vm2 v1; rewrite read_eE => /uincl_on_union_and[] /Hp{}Hp Hu; t_xrbindP =>
       ve1 /Hp [] ve1' -> /vuincl_sem_sop1 Hvu1 /Hvu1; exists v1.
-  + by move => op e1 He1 e2 He2 v1 ; rewrite !read_eE => /uincl_on_union_and[] /He1{}He1
-      /uincl_on_union_and[] /He2{}He2 _; t_xrbindP =>
+  + by move => op e1 He1 e2 He2 s1 vm2 v1 ; rewrite !read_eE => /uincl_on_union_and[] /He1{}He1
+      /uincl_on_union_and[] /He2{} He2 _; t_xrbindP =>
       ? /He1 [? -> /vuincl_sem_sop2 h1] ? /He2 [? -> /h1 h2/h2]; exists v1.
-  + by move => op es Hes v /Hes{}Hes; t_xrbindP => vs1 /Hes[] vs2;
-    rewrite /sem_pexprs => -> /vuincl_sem_opN h{}/h; exists v.
-  move => t e He e1 He1 e2 He2 v1.
-  rewrite !read_eE => /uincl_on_union_and[] /He{}He /uincl_on_union_and[]
-    /He1{}He1 /uincl_on_union_and[] /He2{}He2 _; t_xrbindP => b
-    > /He[? ->] /[swap] /to_boolI -> /value_uinclE -> ?
-    > /He1[? ->] /value_uincl_truncate h /h{h} [? /= -> ?]
-    > /He2 [? -> /value_uincl_truncate h] /h{h} [? /= -> ?] /= <-.
-  by case: b; eauto.
+  + move => op es Hes s1 vm2 v /Hes{}Hes; t_xrbindP => vs1 /Hes[] vs2.
+    by rewrite /sem_pexprs => -> /vuincl_sem_opN h /h /= ->; exists v.
+  + move => t e He e1 He1 e2 He2 s1 vm2 v1.
+    rewrite !read_eE => /uincl_on_union_and[] /He{}He /uincl_on_union_and[]
+      /He1{}He1 /uincl_on_union_and[] /He2{}He2 _; t_xrbindP => b
+      > /He[? ->] /[swap] /to_boolI -> /value_uinclE -> ?
+      > /He1[? ->] /value_uincl_truncate h /h{h} [? /= -> ?]
+      > /He2 [? -> /value_uincl_truncate h] /h{h} [? /= -> ?] /= <-.
+    by case: b; eauto.
 Qed.
 
 Lemma sem_pexpr_uincl_on wdb gd s1 vm2 e v1 :
   s1.(evm) <=[read_e e] vm2 →
   sem_pexpr wdb gd s1 e = ok v1 →
   exists2 v2, sem_pexpr wdb gd (with_vm s1 vm2) e = ok v2 & value_uincl v1 v2.
-Proof. exact: (proj1 (sem_pexpr_uincl_on_pair wdb gd s1 vm2)). Qed.
+Proof. exact: (proj1 (sem_pexpr_uincl_on_pair wdb gd)). Qed.
 
 Corollary sem_pexpr_uincl wdb gd s1 vm2 e v1 :
   s1.(evm) <=1 vm2 →
@@ -1039,7 +1205,7 @@ Lemma sem_pexprs_uincl_on wdb gd s1 vm2 es vs1 :
   sem_pexprs wdb gd s1 es = ok vs1 →
   exists2 vs2, sem_pexprs wdb gd (with_vm s1 vm2) es = ok vs2 &
               List.Forall2 value_uincl vs1 vs2.
-Proof. exact: (proj2 (sem_pexpr_uincl_on_pair wdb gd s1 vm2)). Qed.
+Proof. exact: (proj2 (sem_pexpr_uincl_on_pair wdb gd)). Qed.
 
 Corollary sem_pexprs_uincl wdb gd s1 vm2 es vs1 :
   s1.(evm) <=1 vm2 →
@@ -1068,54 +1234,6 @@ Proof.
   by have /(_ _ h1) := sem_pexprs_uincl_on _ h2.
 Qed.
 
-Lemma write_var_uincl_on wdb X (x : var_i) v1 v2 s1 s2 vm1 :
-  value_uincl v1 v2 ->
-  write_var wdb x v1 s1 = ok s2 ->
-  evm s1 <=[X]  vm1 ->
-  exists2 vm2,
-    write_var wdb x v2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
-    evm s2 <=[Sv.add x X] vm2.
-Proof.
-  move=> hv; rewrite /write_var;t_xrbindP => vm1' hmv1' <- /= h.
-  have /(_ (Sv.add x X) vm1) []:= uincl_on_set_var hv _ hmv1'.
-  + by apply: uincl_onI h; SvD.fsetdec.
-  by move=> -> ?; eexists; eauto.
-Qed.
-
-Lemma write_var_uincl_on1 wdb s1 s2 vm1 v1 v2 (x : var_i) :
-  value_uincl v1 v2 ->
-  write_var wdb x v1 s1 = ok s2 ->
-  exists2 vm2 : Vm.t,
-    write_var wdb x v2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
-    s2.(evm) <=[Sv.singleton x] vm2.
-Proof. by move=> hv /(write_var_uincl_on hv) -/(_ Sv.empty vm1); apply. Qed.
-
-Corollary write_var_uincl wdb s1 s2 vm1 v1 v2 (x : var_i) :
-  s1.(evm) <=1 vm1 ->
-  value_uincl v1 v2 ->
-  write_var wdb x v1 s1 = ok s2 ->
-  exists2 vm2 : Vm.t,
-    write_var wdb x v2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
-    s2.(evm) <=1 vm2.
-Proof.
-  move => Hvm hv /[dup] hw1 /(write_var_uincl_on1 vm1 hv) {hv} [] vm2 hw2 le.
-  exists vm2 => //; apply: (uincl_on_vm_uincl Hvm le); [apply: vrvP_var hw1 | apply: vrvP_var hw2].
-Qed.
-
-Lemma write_vars_uincl wdb s1 s2 vm1 vs1 vs2 xs :
-  vm_uincl (evm s1) vm1 ->
-  List.Forall2 value_uincl vs1 vs2 ->
-  write_vars wdb xs vs1 s1 = ok s2 ->
-  exists2 vm2 : Vm.t,
-    write_vars wdb xs vs2 (with_vm s1 vm1) = ok (with_vm s2 vm2) &
-    vm_uincl (evm s2) vm2.
-Proof.
-  elim: xs s1 vm1 vs1 vs2 => /= [ | x xs Hrec] s1 vm1 vs1 vs2 Hvm [] //=.
-  + by move=> [] <-;eauto.
-  move=> {vs1 vs2} v1 v2 vs1 vs2 Hv Hvs;apply: rbindP => s1'.
-  by move=> /(write_var_uincl Hvm Hv) []vm2 -> Hvm2 /(Hrec _ _ _ _ Hvm2 Hvs).
-Qed.
-
 Lemma uincl_write_none wdb s2 v1 v2 s s' t:
   value_uincl v1 v2 ->
   write_none wdb s t v1 = ok s' ->
@@ -1310,6 +1428,11 @@ Proof.
   exists vm2 => //; apply: (uincl_on_union hu hu2); [ apply: vrvsP hw | apply: vrvsP hw2].
 Qed.
 
+End NOASSERT.
+
+Section WITHASSERT.
+Context {wa : WithAssert}.
+
 Lemma write_lval_undef gd l v s1 s2 sz :
   write_lval true gd l v s1 = ok s2 ->
   type_of_val v = cword sz ->
@@ -1331,13 +1454,13 @@ Qed.
 (* MOVE THIS *)
 Section Expr.
 
-Context (wdb : bool) (gd : glob_decls) (s : estate).
+Context (wdb : bool) (gd : glob_decls).
 
 Let P e : Prop :=
-  forall v, sem_pexpr true gd s e = ok v -> sem_pexpr wdb gd s e = ok v.
+  forall s v, sem_pexpr true gd s e = ok v -> sem_pexpr wdb gd s e = ok v.
 
 Let Q es : Prop :=
-  forall vs, sem_pexprs true gd s es = ok vs -> sem_pexprs wdb gd s es = ok vs.
+  forall s vs, sem_pexprs true gd s es = ok vs -> sem_pexprs wdb gd s es = ok vs.
 
 Lemma get_var_wdb vm x v : get_var true vm x = ok v -> get_var wdb vm x = ok v.
 Proof. by move=> /get_varP [-> h1 h2]; rewrite /get_var; case: wdb => //; rewrite h1. Qed.
@@ -1345,20 +1468,35 @@ Proof. by move=> /get_varP [-> h1 h2]; rewrite /get_var; case: wdb => //; rewrit
 Lemma get_gvar_wdb vm x v : get_gvar true gd vm x = ok v -> get_gvar wdb gd vm x = ok v.
 Proof. rewrite /get_gvar; case: ifP => // _; apply get_var_wdb. Qed.
 
+Lemma write_var_wdb x v s s':
+  write_var true x v s = ok s' ->
+  write_var wdb  x v s = ok s'.
+Proof.
+  move=> /write_varP [-> hdb htr]; apply write_varP; split => //.
+  + by rewrite /DB /=; apply/orP; right.
+  case: v hdb htr; rewrite /truncatable //= => ?? h; case: vtype => //.
+  by move=> ??; apply/orP;right.
+Qed.
+
 Lemma sem_pexpr_wdb_and : (forall e, P e) /\ (forall es, Q es).
 Proof.
   apply: pexprs_ind_pair; subst P Q; split => //=.
-  + by move=> e he es hes vs; t_xrbindP => ? /he -> ? /hes -> <-.
-  + by move=> x v; apply get_gvar_wdb.
-  + move=> al aa ws x e he v; apply on_arr_gvarP; t_xrbindP; rewrite /on_arr_var.
+  + by move=> e he es hes s vs; t_xrbindP => ? /he -> ? /hes -> <-.
+  + by move=> >; apply get_gvar_wdb.
+  + move=> al aa ws x e he s v; apply on_arr_gvarP; t_xrbindP; rewrite /on_arr_var.
     by move=> len a ha /get_gvar_wdb -> ?? /he -> /= -> ? /= -> <-.
-  + move=> aa ws len x e he v; apply on_arr_gvarP; t_xrbindP; rewrite /on_arr_var.
+  + move=> aa ws len x e he s v; apply on_arr_gvarP; t_xrbindP; rewrite /on_arr_var.
     by move=> ??? /get_gvar_wdb -> ?? /he -> /= -> ? /= -> <-.
   + by t_xrbindP => > he > /he -> /= -> /= > -> <-.
   + by t_xrbindP => > he > /he -> /= ->.
   + by t_xrbindP => > he1 > he2 > /he1 -> > /he2 -> /= ->.
   + by t_xrbindP => > hes > /hes; rewrite -/(sem_pexprs _ _ _) => -> /= <-.
-  by t_xrbindP => > he > he1 > he2 > /he -> /= -> > /he1 -> /= -> > /he2 -> /= -> <-.
+  + by t_xrbindP => > he > he1 > he2 > /he -> /= -> > /he1 -> /= -> > /he2 -> /= -> <-.
+  + move=> i hi op x b hb st hst l hl s v; t_xrbindP.
+    move=> -> ?? /hst -> /= -> ?? /hl  -> /= -> acc ? /hi -> /= -> //=.
+    elim: ziota acc => //= j js hrec acc; t_xrbindP.
+    by move=> ?? /write_var_wdb -> /= ? /hb -> /= -> /= /hrec.
+  by t_xrbindP => > he1 > he2 > -> /= > /he1 -> /= -> > /he2 -> /= -> <-.
 Qed.
 
 Lemma sem_pexpr_wdb e : P e.
@@ -1367,12 +1505,14 @@ Proof. by case: sem_pexpr_wdb_and. Qed.
 Lemma sem_pexprs_wdb e : Q e.
 Proof. by case: sem_pexpr_wdb_and. Qed.
 
-Lemma sem_pexpr_ext_eq e vm :
+Section WITHCATCH.
+Context {wc:WithCatch}.
+Lemma sem_pexpr_ext_eq s e vm :
   (evm s =1 vm)%vm ->
   sem_pexpr wdb gd s e = sem_pexpr wdb gd (with_vm s vm) e.
 Proof. by move=> heq; apply/read_e_eq_on_empty/vm_eq_eq_on. Qed.
 
-Lemma sem_pexprs_ext_eq es vm :
+Lemma sem_pexprs_ext_eq s es vm :
   (evm s =1 vm)%vm ->
   sem_pexprs wdb gd s es = sem_pexprs wdb gd (with_vm s vm) es.
 Proof. by move=> heq; apply/read_es_eq_on_empty/vm_eq_eq_on. Qed.
@@ -1409,17 +1549,22 @@ Proof.
   by apply: vrvsP hw2.
 Qed.
 
+End WITHCATCH.
+
 End Expr.
 
+Section WITHCATCH.
+Context {wc:WithCatch}.
+
 Lemma eq_gvarP wdb gd vm x x' : eq_gvar x x' → get_gvar wdb gd vm x = get_gvar wdb gd vm x'.
 Proof. by rewrite /eq_gvar /get_gvar /is_lvar => /andP [] /eqP -> /eqP ->. Qed.
 
-Lemma eq_exprP_pair wdb gd s :
-  (∀ e e', eq_expr e e' → sem_pexpr wdb gd s e = sem_pexpr wdb gd s e') ∧
-  (∀ es es', all2 eq_expr es es' → sem_pexprs wdb gd s es = sem_pexprs wdb gd s es').
+Lemma eq_exprP_pair wdb gd :
+  (∀ e s e', eq_expr e e' → sem_pexpr wdb gd s e = sem_pexpr wdb gd s e') ∧
+  (∀ es s es', all2 eq_expr es es' → sem_pexprs wdb gd s es = sem_pexprs wdb gd s es').
 Proof.
   apply: pexprs_ind_pair; split =>
-    [| e he es hes |?|?|??|?|????? He|????? He|??? He|?? He|?? He1 ? He2|?? hes|?? He ? He1 ? He2] [] //=.
+    [| e he es hes |?|?|??|?|????? He|????? He|??? He|?? He|?? He1 ? He2|?? hes|?? He ? He1 ? He2|? hi ??? hb ? hs ? hl|?|?? He1 He2] s [] //=.
   - by move => e' es' /andP[] /he -> /hes ->.
   1-2: by move => ? /eqP ->.
   - by move=> > /andP [/eqP -> /eqP ->].
@@ -1429,15 +1574,21 @@ Proof.
   - by move=> > /andP[]/eqP -> /He ->.
   - by move=> > /andP[]/andP[] /eqP -> /He1 -> /He2 ->.
   - by rewrite -/(sem_pexprs _ _ _) => > /andP[]/eqP-> /hes ->.
-  by move=> > /andP[]/andP[]/andP[] /eqP -> /He -> /He1 -> /He2 ->.
+  - by move=> > /andP[]/andP[]/andP[] /eqP -> /He -> /He1 -> /He2 ->.
+  - move=> > /andP[] /andP[] /andP[] /andP[] /andP[] /hi -> /eqP -> /eqP /= hv /hb{}hb /hs -> /hl ->.
+    do 4! apply bind_eq => // >.
+    apply foldM_ext => ??; apply bind_eq; first by rewrite /write_var hv.
+    by move=> ?; rewrite hb.
+  - by move=> ? /eqP ->.
+  by move=> p1 p2 /andP[/He1 -> /He2 ->].
 Qed.
 
 Lemma eq_exprP wdb gd s e1 e2 : eq_expr e1 e2 -> sem_pexpr wdb gd s e1 = sem_pexpr wdb gd s e2.
-Proof. exact: (proj1 (eq_exprP_pair wdb gd s)). Qed.
+Proof. exact: (proj1 (eq_exprP_pair wdb gd)). Qed.
 
 Lemma eq_exprsP wdb gd m es1 es2:
   all2 eq_expr es1 es2 → sem_pexprs wdb gd m es1 = sem_pexprs wdb gd m es2.
-Proof. exact: (proj2 (eq_exprP_pair wdb gd m)). Qed.
+Proof. exact: (proj2 (eq_exprP_pair wdb gd)). Qed.
 
 Lemma get_var_undef vm x v ty h :
   get_var true vm x = ok v -> v <> Vundef ty h.
@@ -1446,7 +1597,9 @@ Proof. by move=> /get_var_compat [] * ?; subst. Qed.
 Lemma get_gvar_undef gd vm x v ty h :
   get_gvar true gd vm x = ok v -> v <> Vundef ty h.
 Proof.
-  rewrite /get_gvar; case: is_lvar; first by apply get_var_undef.
+  rewrite /get_gvar; case: is_lvar.
+  apply : (@catchP wc value (fun v => v <> Vundef ty h)); last by apply get_var_undef.
+  + by move=> _ _ _ _; case: vtype.
   move=> /get_globalI [gv [_ -> _]].
   by case: gv.
 Qed.
@@ -1455,6 +1608,9 @@ Lemma get_var_is_allow_undefined vm xs :
   get_var_is false vm xs = ok [seq vm.[v_var x] | x <- xs ].
 Proof. by elim: xs => //= ?? ->. Qed.
 
+End WITHCATCH.
+End WITHASSERT.
+
 End WITH_PARAMS.
 
 End WSW.
@@ -1464,4 +1620,3 @@ Ltac t_get_var :=
     rewrite get_var_eq
     || (rewrite get_var_neq; last by [|apply/nesym])
   ).
-
diff --git a/proofs/lang/psem_defs.v b/proofs/lang/psem_defs.v
index e9aa42e02d..69905ace45 100644
--- a/proofs/lang/psem_defs.v
+++ b/proofs/lang/psem_defs.v
@@ -16,6 +16,26 @@ Open Scope vm_scope.
 (* ** Parameter expressions
  * -------------------------------------------------------------------- *)
 
+Section CATCH.
+
+Context {wc : WithCatch}.
+
+Definition default_val (t: atype) :=
+  match t with
+  | abool => Vbool false
+  | aint => Vint 0
+  | aarr ws len => Varr (WArray.fill_elem (Z.to_pos (arr_size ws len)) 0%R)
+  | aword sz => @Vword sz 0%R
+  end.
+  
+Definition catch_core {T:Type} (ev : exec T) dfv : exec T :=
+  match ev with
+  | Ok v => ev
+  | Error e => if is_ErrType e then ev else ok dfv
+  end.
+
+Notation catch ev dfv := (if with_catch then catch_core ev dfv else ev).
+  
 Definition sem_sop1 (o: sop1) (v: value) : exec value :=
   Let x := of_val _ v in
   Let r := sem_sop1_typed o x in
@@ -28,7 +48,7 @@ Definition sem_sop2 (o: sop2) (v1 v2: value) : exec value :=
   ok (to_val r).
 
 Definition sem_opN
-  {cfcd : FlagCombinationParams} (op: opN) (vs: values) : exec value :=
+  {wa : WithAssert} {cfcd : FlagCombinationParams} (op: opN) (vs: values) : exec value :=
   Let w := app_sopn _ (sem_opN_typed op) vs in
   ok (to_val w).
 
@@ -71,7 +91,7 @@ Arguments Estate {syscall_state}%_type_scope {ep} _ _ _%_vm_scope.
  * -------------------------------------------------------------------- *)
 
 Definition get_gvar (wdb : bool) (gd : glob_decls) (vm : Vm.t) (x : gvar) :=
-  if is_lvar x then get_var wdb vm x.(gv)
+  if is_lvar x then catch (get_var wdb vm x.(gv)) (default_val (vtype x.(gv)))
   else get_global gd x.(gv).
 
 Definition get_var_is wdb vm := mapM (fun x => get_var wdb vm (v_var x)).
@@ -83,6 +103,7 @@ Definition on_arr_var A (v:exec value) (f:forall n, WArray.array n -> exec A) :=
   | _ => type_error
   end.
 
+(* We don't catch the error here because if the is an error it is only a type error *)
 Notation "'Let' ( n , t ) ':=' wdb ',' s '.[' v ']' 'in' body" :=
   (@on_arr_var _ (get_var wdb s.(evm) v) (fun n (t:WArray.array n) => body)) (at level 25, s at level 0).
 
@@ -112,9 +133,14 @@ Context
   {asm_op syscall_state : Type}
   {ep : EstateParams syscall_state}
   {spp : SemPexprParams}
+  {wa : WithAssert}
   (wdb : bool)
   (gd : glob_decls).
 
+Definition write_var (x:var_i) (v:value) (s:estate) : exec estate :=
+  Let vm := set_var wdb s.(evm) x v in
+  ok (with_vm s vm).
+
 Fixpoint sem_pexpr (s:estate) (e : pexpr) : exec value :=
   match e with
   | Pconst z => ok (Vint z)
@@ -126,41 +152,58 @@ Fixpoint sem_pexpr (s:estate) (e : pexpr) : exec value :=
   | Pget al aa ws x e =>
       Let (n, t) := wdb, gd, s.[x] in
       Let i := sem_pexpr s e >>= to_int in
-      Let w := WArray.get al aa ws t i in
+      Let w := catch (WArray.get al aa ws t i) 0%R in
       ok (Vword w)
   | Psub aa ws len x e =>
     Let (n, t) := wdb, gd, s.[x] in
     Let i := sem_pexpr s e >>= to_int in
-    Let t' := WArray.get_sub aa ws len t i in
+    Let t' := catch (WArray.get_sub aa ws len t i) (WArray.fill_elem _ 0%R) in
     ok (Varr t')
   | Pload al sz e =>
     Let w2 := sem_pexpr s e >>= to_pointer in
-    Let w  := read s.(emem) al w2 sz in
+    Let w  := catch (read s.(emem) al w2 sz) 0%R in
     ok (@to_val (cword sz) w)
   | Papp1 o e1 =>
     Let v1 := sem_pexpr s e1 in
-    sem_sop1 o v1
+    catch (sem_sop1 o v1) (default_val (type_of_op1 o).2)
   | Papp2 o e1 e2 =>
     Let v1 := sem_pexpr s e1 in
     Let v2 := sem_pexpr s e2 in
-    sem_sop2 o v1 v2
+    catch (sem_sop2 o v1 v2) (default_val (type_of_op2 o).2)
   | PappN op es =>
     Let vs := mapM (sem_pexpr s) es in
-    sem_opN op vs
+    catch (sem_opN op vs) (default_val (type_of_opN op).2)
   | Pif t e e1 e2 =>
     let t := eval_atype t in
     Let b := sem_pexpr s e >>= to_bool in
     Let v1 := sem_pexpr s e1 >>= truncate_val t in
     Let v2 := sem_pexpr s e2 >>= truncate_val t in
     ok (if b then v1 else v2)
+  | Pbig idx op x body start len =>
+    Let _ := assert (assert_allowed) ErrType in
+    Let vs   := sem_pexpr s start >>= to_int in
+    Let vlen := sem_pexpr s len >>= to_int in
+    Let vidx := sem_pexpr s idx >>= truncate_val (eval_atype (type_of_op2 op).2) in
+    let l := ziota vs vlen in
+    foldM (fun i acc =>
+               Let s := write_var x (Vint i) s in
+               Let vb := sem_pexpr s body in
+               catch (sem_sop2 op acc vb) (default_val (type_of_op2 op).2))
+      vidx l
+  | Pis_var_init x =>
+    Let _ := assert (assert_allowed) ErrType in
+    let v := (evm s).[x] in
+    ok (Vbool (is_defined v))
+  | Pis_mem_init e1 e2 =>
+    Let _ := assert (assert_allowed) ErrType in
+    Let lo := sem_pexpr s e1 >>= to_pointer in
+    Let sz := sem_pexpr s e2 >>= to_int in
+    let b := all (fun i => is_ok (read s.(emem) Unaligned (lo + (wrepr Uptr i))%R U8)) (ziota 0 sz) in
+    ok (Vbool b)
   end.
 
 Definition sem_pexprs s := mapM (sem_pexpr s).
 
-Definition write_var (x:var_i) (v:value) (s:estate) : exec estate :=
-  Let vm := set_var wdb s.(evm) x v in
-  ok (with_vm s vm).
-
 Definition write_vars xs vs s :=
   fold2 ErrType write_var xs vs s.
 
@@ -176,19 +219,19 @@ Definition write_lval (l : lval) (v : value) (s : estate) : exec estate :=
   | Lmem al sz x e =>
     Let p := sem_pexpr s e >>= to_pointer in
     Let w := to_word sz v in
-    Let m := write s.(emem) al p w in
+    Let m := catch (write s.(emem) al p w) s.(emem) in
     ok (with_mem s m)
   | Laset al aa ws x i =>
     Let (n,t) := wdb, s.[x] in
     Let i := sem_pexpr s i >>= to_int in
     Let v := to_word ws v in
-    Let t := WArray.set t al aa i v in
+    Let t := catch (WArray.set t al aa i v) t in
     write_var x (@to_val (carr n) t) s
   | Lasub aa ws len x i =>
     Let (n,t) := wdb, s.[x] in
     Let i := sem_pexpr s i >>= to_int in
     Let t' := to_arr (Z.to_pos (arr_size ws len)) v in
-    Let t := @WArray.set_sub n aa ws len t i t' in
+    Let t := catch (@WArray.set_sub n aa ws len t i t') t in
     write_var x (@to_val (carr n) t) s
   end.
 
@@ -203,23 +246,99 @@ Context
   {asm_op syscall_state : Type}
   {ep : EstateParams syscall_state}
   {spp : SemPexprParams}
+  {wa : WithAssert}
   {asmop : asmOp asm_op}.
 
 Definition exec_sopn (o:sopn) (vs:values) : exec values :=
-  Let semi := sopn_sem o in
-  Let t := app_sopn _ semi vs in
-  ok (list_ltuple t).
+  catch (
+    Let semi := sopn_sem o in
+    Let t := app_sopn _ semi vs in
+    ok (list_ltuple t))
+[::].
 
 Definition sem_sopn gd o m lvs args :=
   sem_pexprs true gd m args >>= exec_sopn o >>= write_lvals true gd m lvs.
 
 End EXEC_ASM.
 
+Section CONTRA.
+
+Context
+  {asm_op syscall_state : Type}
+  {ep : EstateParams syscall_state}
+  {spp : SemPexprParams}
+  {wa : WithAssert}
+  {sip : SemInstrParams asm_op syscall_state}
+  {pT : progT}.
+
+Definition sem_cond (gd : glob_decls) (e : pexpr) (s : estate) : exec bool :=
+  (sem_pexpr true gd s e >>= to_bool)%result.
+
+Definition sem_assert (gd : glob_decls) (s : estate) (e : assertion) : exec unit :=
+  Let _ := assert (assert_allowed) ErrType in
+  Let b := sem_cond gd e.2 s in
+  Let _ := assert b (ErrAssert e.1) in
+  ok tt.
+
+Record fstate := { fscs : syscall_state_t; fmem : mem; fvals : values }.
+
+(** Switch for the semantics of function calls:
+  - when false, arguments and returned values are truncated to the declared type of the called function;
+  - when true, arguments and returned values are allowed to be undefined.
+
+Informally, “direct call” means that passing arguments and returned value does not go through an assignment;
+indeed, assignments truncate and fail on undefined values.
+*)
+Class DirectCall := {
+  direct_call : bool;
+}.
+
+Definition indirect_c : DirectCall := {| direct_call := false |}.
+Definition direct_c : DirectCall := {| direct_call := true |}.
+
+Definition dc_truncate_val {dc:DirectCall} t v :=
+  if direct_call then ok v
+  else truncate_val t v.
+
+Definition sem_pre {dc: DirectCall} (P : prog) (fn:funname) (fs: fstate) :=
+  if ~~assert_allowed then ok tt
+  else if get_fundef (p_funcs P) fn is Some f then
+    match f.(f_contra) with
+    | Some ci =>
+      Let vargs := mapM2 ErrType dc_truncate_val (map eval_atype f.(f_tyin)) fs.(fvals) in
+      Let s := write_vars (~~direct_call) ci.(f_iparams) vargs (Estate fs.(fscs) fs.(fmem) Vm.init) in
+      Let _ := mapM (sem_assert (p_globs P) s) ci.(f_pre) in
+      ok tt
+    | None => ok tt
+    end
+  else Error ErrUnknowFun.
+
+Definition sem_post {dc: DirectCall} (P : prog) (fn:funname) (vargs' : values) (fs: fstate) :=
+  if ~~assert_allowed then ok tt
+  else if get_fundef (p_funcs P) fn is Some f then
+    match f.(f_contra) with
+    | Some ci =>
+      Let _ := assert (assert_allowed) ErrType in
+      Let vargs := mapM2 ErrType dc_truncate_val (map eval_atype f.(f_tyin)) vargs' in
+      Let s := write_vars (~~direct_call) ci.(f_iparams) vargs (Estate fs.(fscs) fs.(fmem) Vm.init) in
+      Let s :=  write_vars (~~direct_call) ci.(f_ires) fs.(fvals) s in
+      Let _ := mapM (sem_assert (p_globs P) s) ci.(f_post) in
+      ok tt
+    | None => ok tt
+    end
+  else Error ErrUnknowFun.
+
+End CONTRA.
+
 End WSW.
 
+End CATCH.
+
 (* Just for extraction *)
 Definition syscall_sem__ := @syscall_sem.exec_syscall_u.
 
+Notation catch ev dfv := (if with_catch then catch_core ev dfv else ev).
+
 Notation "'Let' ( n , t ) ':=' wdb ',' s '.[' v ']' 'in' body" :=
   (@on_arr_var _ (get_var wdb s.(evm) v) (fun n (t:WArray.array n) => body)) (at level 25, s at level 0).
 
diff --git a/proofs/lang/psem_facts.v b/proofs/lang/psem_facts.v
index 0c80f521a5..53418b0fdc 100644
--- a/proofs/lang/psem_facts.v
+++ b/proofs/lang/psem_facts.v
@@ -770,14 +770,14 @@ Proof.
         subst sz.
         rewrite wrepr_signed /=.
         by apply: word_uincl_zero_ext.
-    rewrite /= /sem_sop1 /=.
-    t_xrbindP => e ih > A > B ? > /to_intI h ?; subst; case: h => ?; subst.
-    move: ih.
-    rewrite A /= B => /(_ _ erefl)[] ? -> /value_uinclE[] ? [] ? [] -> /andP[] sz_le /eqP D.
-    rewrite /= truncate_word_le // -D.
-    eexists; first reflexivity.
-    apply/andP; split; first exact: cmp_le_refl.
-    by rewrite wopp_zero_extend // zero_extend_u wrepr_opp.
+    + rewrite /= /sem_sop1 /=.
+      t_xrbindP => e ih > A > B ? > /to_intI h ?; subst; case: h => ?; subst.
+      move: ih.
+      rewrite A /= B => /(_ _ erefl)[] ? -> /value_uinclE[] ? [] ? [] -> /andP[] sz_le /eqP D.
+      rewrite /= truncate_word_le // -D.
+      eexists; first reflexivity.
+      apply/andP; split; first exact: cmp_le_refl.
+      by rewrite wopp_zero_extend // zero_extend_u wrepr_opp.
   case.
   all: try match goal with [ |- forall h : op_kind, _ ] => case end.
   all: try by move => > _ > _ > /= -> > -> /= -> /= ->; eauto.
diff --git a/proofs/lang/relational_logic.v b/proofs/lang/relational_logic.v
index fce7af338a..eda16c1238 100644
--- a/proofs/lang/relational_logic.v
+++ b/proofs/lang/relational_logic.v
@@ -415,8 +415,6 @@ Notation vm2_t := (Vm.t (wsw:=wsw2)).
 Notation estate1 := (estate (wsw:=wsw1) (ep:=ep)).
 Notation estate2 := (estate (wsw:=wsw2) (ep:=ep)).
 
-Notation isem_fun1 := (isem_fun (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1)).
-Notation isem_fun2 := (isem_fun (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2)).
 
 Notation sem_Fun1 := (sem_Fun (pT:=pT1)).
 Notation sem_Fun2 := (sem_Fun (pT:=pT2)).
@@ -507,9 +505,9 @@ End IRESULT.
 
 Section WITHASSERT.
 
-Context {wa1 wa2 : WithAssert}.
-Notation isem_fun1 := (isem_fun (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (wa:=wa1) (sip:=sip) (pT:=pT1) (scP:= scP1)).
-Notation isem_fun2 := (isem_fun (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (wa:=wa2) (sip:=sip) (pT:=pT2) (scP:= scP2)).
+Context {wc1 wc2: WithCatch} {wa1 wa2 : WithAssert}.
+Notation isem_fun1 := (isem_fun (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (wc:=wc1) (wa:=wa1) (sip:=sip) (pT:=pT1) (scP:= scP1)).
+Notation isem_fun2 := (isem_fun (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (wc:=wc2) (wa:=wa2)(sip:=sip) (pT:=pT2) (scP:= scP2)).
 
 Section WEQUIV_CORE.
 
@@ -534,17 +532,39 @@ Definition wequiv_f_ii (P : relPreF) ii1 ii2 (fn1 fn2 : funname) (Q:relPostF) :=
 Definition wequiv_f_body (P : relPreF) (fn1 fn2 : funname) (Q:relPostF) :=
   wkequiv_io
     (P fn1 fn2)
-      (isem_fun_body (wa:=wa1) (dc:=dc1) (sem_F:=sem_F1) p1 ev1 fn1)
-      (isem_fun_body (wa:=wa2) (dc:=dc2) (sem_F:=sem_F2) p2 ev2 fn2)
+      (isem_fun_body (dc:=dc1) (wc:=wc1) (wa:=wa1) (sem_F:=sem_F1) p1 ev1 fn1)
+      (isem_fun_body (dc:=dc2) (wc:=wc2) (wa:=wa2) (sem_F:=sem_F2) p2 ev2 fn2)
     (Q fn1 fn2).
 
 Definition wequiv (pre:rel_c) (c1 c2 : cmd) (post : rel_c) :=
   wkequiv
     pre
-     (isem_cmd_ (wa:=wa1) (dc:=dc1) (sem_F:=sem_F1) p1 ev1 c1)
-     (isem_cmd_ (wa:=wa2) (dc:=dc2) (sem_F:=sem_F2) p2 ev2 c2)
+     (isem_cmd_ (dc:=dc1) (wc:=wc1) (wa:=wa1) (sem_F:=sem_F1) p1 ev1 c1)
+     (isem_cmd_ (dc:=dc2) (wc:=wc2) (wa:=wa2) (sem_F:=sem_F2) p2 ev2 c2)
     post.
 
+Notation sem_pexpr1 := (sem_pexpr (wc:=wc1) (wa:=wa1)).
+Notation sem_pexpr2 := (sem_pexpr (wc:=wc2) (wa:=wa2)).
+Notation sem_pexprs1 := (sem_pexprs (wc:=wc1) (wa:=wa1)).
+Notation sem_pexprs2 := (sem_pexprs (wc:=wc2) (wa:=wa2)).
+Notation sem_cond1 := (sem_cond (wc:=wc1) (wa:=wa1)).
+Notation sem_cond2 := (sem_cond (wc:=wc2) (wa:=wa2)).
+Notation sem_bound1 := (sem_bound (wc:=wc1) (wa:=wa1)).
+Notation sem_bound2 := (sem_bound (wc:=wc2) (wa:=wa2)).
+
+Notation write_lval1 := (write_lval (wc:=wc1) (wa:=wa1)).
+Notation write_lval2 := (write_lval (wc:=wc2) (wa:=wa2)).
+Notation write_lvals1 := (write_lvals (wc:=wc1) (wa:=wa1)).
+Notation write_lvals2 := (write_lvals (wc:=wc2) (wa:=wa2)).
+
+Notation upd_estate1 := (upd_estate (wc:=wc1) (wa:=wa1)).
+Notation upd_estate2 := (upd_estate (wc:=wc2) (wa:=wa2)).
+
+Notation sem_pre1 := (sem_pre (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (dc:=dc1) (pT:=pT1)).
+Notation sem_pre2 := (sem_pre (wsw:=wsw2) (wc:=wc2) (wa:=wa2) (dc:=dc2) (pT:=pT2)).
+Notation sem_post1 := (sem_post (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (dc:=dc1) (pT:=pT1)).
+Notation sem_post2 := (sem_post (wsw:=wsw2) (wc:=wc2) (wa:=wa2) (dc:=dc2) (pT:=pT2)).
+
 Lemma wequiv_weaken P1 P2 Q1 Q2 c1 c2 :
   (forall s1 s2, P1 s1 s2 -> P2 s1 s2) ->
   (forall s1 s2, Q2 s1 s2 -> Q1 s1 s2) ->
@@ -572,7 +592,7 @@ Lemma wequiv_cons (R P Q : rel_c) (i1 i2 : instr) (c1 c2 : cmd) :
 Proof. rewrite -(cat1s i1 c1) -(cat1s i2 c2); apply wequiv_cat. Qed.
 
 Lemma wequiv_assgn_core (P Q : rel_c) ii1 x1 tg1 ty1 e1 ii2 x2 tg2 ty2 e2 :
-  wrequiv P (sem_assgn p1 x1 tg1 ty1 e1) (sem_assgn p2 x2 tg2 ty2 e2) Q ->
+  wrequiv P (sem_assgn (wc:=wc1) (wa:=wa1) p1 x1 tg1 ty1 e1) (sem_assgn (wc:=wc2) (wa:=wa2) p2 x2 tg2 ty2 e2) Q ->
   wequiv P [:: MkI ii1 (Cassgn x1 tg1 ty1 e1)] [:: MkI ii2 (Cassgn x2 tg2 ty2 e2)] Q.
 Proof.
   move=> h; rewrite /wequiv /isem_cmd_ /=.
@@ -581,11 +601,11 @@ Proof.
 Qed.
 
 Lemma wequiv_assgn (Rv Rtr: rel_v) (P Q : rel_c) ii1 x1 tg1 ty1 e1 ii2 x2 tg2 ty2 e2 :
-  wrequiv P (fun s => sem_pexpr true (p_globs p1) s e1)
-           (fun s => sem_pexpr true (p_globs p2) s e2) Rv ->
+  wrequiv P (fun s => sem_pexpr1 true (p_globs p1) s e1)
+           (fun s => sem_pexpr2 true (p_globs p2) s e2) Rv ->
   (forall s1 s2, P s1 s2 -> wrequiv Rv (truncate_val (eval_atype ty1)) (truncate_val (eval_atype ty2)) Rtr) ->
   (forall v1 v2, Rtr v1 v2 ->
-    wrequiv P (write_lval true (p_globs p1) x1 v1) (write_lval true (p_globs p2) x2 v2) Q) ->
+    wrequiv P (write_lval1 true (p_globs p1) x1 v1) (write_lval2 true (p_globs p2) x2 v2) Q) ->
   wequiv P [:: MkI ii1 (Cassgn x1 tg1 ty1 e1)] [:: MkI ii2 (Cassgn x2 tg2 ty2 e2)] Q.
 Proof.
   move=> he htr hwr; apply wequiv_assgn_core; rewrite /sem_assgn.
@@ -596,9 +616,9 @@ Proof.
 Qed.
 
 Lemma wequiv_assgn_eq (P Q : rel_c) ii1 x1 tg1 ty e1 ii2 x2 tg2 e2 :
-  wrequiv P (fun s => sem_pexpr true (p_globs p1) s e1)
-            (fun s => sem_pexpr true (p_globs p2) s e2) eq ->
-  (forall v, wrequiv P (write_lval true (p_globs p1) x1 v) (write_lval true (p_globs p2) x2 v) Q) ->
+  wrequiv P (fun s => sem_pexpr1 true (p_globs p1) s e1)
+            (fun s => sem_pexpr2 true (p_globs p2) s e2) eq ->
+  (forall v, wrequiv P (write_lval1 true (p_globs p1) x1 v) (write_lval2 true (p_globs p2) x2 v) Q) ->
   wequiv P [:: MkI ii1 (Cassgn x1 tg1 ty e1)] [:: MkI ii2 (Cassgn x2 tg2 ty e2)] Q.
 Proof.
   move=> he hx; apply wequiv_assgn with eq eq => //.
@@ -607,16 +627,16 @@ Proof.
 Qed.
 
 Lemma wequiv_assgn_uincl (P Q : rel_c) ii1 x1 tg1 ty e1 ii2 x2 tg2 e2 :
-  wrequiv P (fun s => sem_pexpr true (p_globs p1) s e1)
-            (fun s => sem_pexpr true (p_globs p2) s e2) value_uincl ->
+  wrequiv P (fun s => sem_pexpr1 true (p_globs p1) s e1)
+            (fun s => sem_pexpr2 true (p_globs p2) s e2) value_uincl ->
   (forall v1 v2, value_uincl v1 v2 ->
-    wrequiv P (write_lval true (p_globs p1) x1 v1) (write_lval true (p_globs p2) x2 v2) Q) ->
+    wrequiv P (write_lval1 true (p_globs p1) x1 v1) (write_lval2 true (p_globs p2) x2 v2) Q) ->
   wequiv P [:: MkI ii1 (Cassgn x1 tg1 ty e1)] [:: MkI ii2 (Cassgn x2 tg2 ty e2)] Q.
 Proof. move=> he; apply wequiv_assgn with value_uincl => // *; apply wrequiv_truncate_val. Qed.
 
 Lemma wequiv_assgn_esem (P Q : rel_c) ii1 x1 tg1 ty e1 c2 :
-  wrequiv P (sem_assgn p1 x1 tg1 ty e1)
-            (esem p2 ev2 c2) Q ->
+  wrequiv P (sem_assgn (wc:=wc1) (wa:=wa1) p1 x1 tg1 ty e1)
+            (esem (wc:=wc2) (wa:=wa2) p2 ev2 c2) Q ->
   wequiv P [:: MkI ii1 (Cassgn x1 tg1 ty e1)] c2 Q.
 Proof.
   move=> h s t hP /=.
@@ -629,12 +649,12 @@ Proof.
 Qed.
 
 Lemma wequiv_opn (Rve Rvo : rel_vs) P Q ii1 xs1 at1 o1 es1 ii2 xs2 at2 o2 es2 :
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s es1)
-            (fun s => sem_pexprs true (p_globs p2) s es2) Rve ->
-  (forall s1 s2, P s1 s2 -> wrequiv Rve (exec_sopn o1) (exec_sopn o2) Rvo) ->
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s es1)
+            (fun s => sem_pexprs2 true (p_globs p2) s es2) Rve ->
+  (forall s1 s2, P s1 s2 -> wrequiv Rve (exec_sopn (wc:=wc1) o1) (exec_sopn (wc:=wc2) o2) Rvo) ->
   (forall vs1 vs2,
-    Rvo vs1 vs2 -> wrequiv P (fun s1 => write_lvals true (p_globs p1) s1 xs1 vs1)
-                             (fun s2 => write_lvals true (p_globs p2) s2 xs2 vs2) Q) ->
+    Rvo vs1 vs2 -> wrequiv P (fun s1 => write_lvals1 true (p_globs p1) s1 xs1 vs1)
+                             (fun s2 => write_lvals2 true (p_globs p2) s2 xs2 vs2) Q) ->
   wequiv P [:: MkI ii1 (Copn xs1 at1 o1 es1)] [:: MkI ii2 (Copn xs2 at2 o2 es2)] Q.
 Proof.
   move=> he ho hwr; rewrite /wequiv /isem_cmd_ /=.
@@ -646,35 +666,9 @@ Proof.
   by move=> s1 s2 /ho; apply wrequiv_weaken => // > [-> ->].
 Qed.
 
-Lemma wequiv_opn_eq P Q ii1 xs1 at1 o es1 ii2 xs2 at2 es2 :
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s es1)
-           (fun s => sem_pexprs true (p_globs p2) s es2) eq ->
-  (forall vs,
-    wrequiv P (fun s1 => write_lvals true (p_globs p1) s1 xs1 vs)
-             (fun s2 => write_lvals true (p_globs p2) s2 xs2 vs) Q) ->
-  wequiv P [:: MkI ii1 (Copn xs1 at1 o es1)] [:: MkI ii2 (Copn xs2 at2 o es2)] Q.
-Proof.
-  move=> he hx; apply wequiv_opn with eq eq => //.
-  + by move=> *; apply wrequiv_eq.
-  by move=> > <-; apply hx.
-Qed.
-
-Lemma wequiv_opn_uincl P Q ii1 xs1 at1 o es1 ii2 xs2 at2 es2 :
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s es1)
-           (fun s => sem_pexprs true (p_globs p2) s es2) (Forall2 value_uincl) ->
-  (forall vs1 vs2,
-    Forall2 value_uincl vs1 vs2 ->
-    wrequiv P (fun s1 => write_lvals true (p_globs p1) s1 xs1 vs1)
-             (fun s2 => write_lvals true (p_globs p2) s2 xs2 vs2) Q) ->
-  wequiv P [:: MkI ii1 (Copn xs1 at1 o es1)] [:: MkI ii2 (Copn xs2 at2 o es2)] Q.
-Proof.
-  move=> he; apply wequiv_opn with (Forall2 value_uincl) => //.
-  move=> *; apply wrequiv_exec_sopn.
-Qed.
-
 Lemma wequiv_opn_esem (P Q : rel_c) ii1 xs1 tg1 o1 es1 c2 :
-  wrequiv P (fun s => sem_sopn (p_globs p1) o1 s xs1 es1)
-            (esem p2 ev2 c2) Q ->
+  wrequiv P (fun s => sem_sopn (wc:=wc1) (wa:=wa1) (p_globs p1) o1 s xs1 es1)
+            (esem (wc:=wc2) (wa:=wa2) p2 ev2 c2) Q ->
   wequiv P [:: MkI ii1 (Copn xs1 tg1 o1 es1)] c2 Q.
 Proof.
   move=> h s t hP /=.
@@ -687,15 +681,15 @@ Proof.
 Qed.
 
 Lemma wequiv_syscall Rv Ro P Q ii1 xs1 sc1 es1 ii2 xs2 sc2 es2 :
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s es1)
-            (fun s => sem_pexprs true (p_globs p2) s es2) Rv ->
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s es1)
+            (fun s => sem_pexprs2 true (p_globs p2) s es2) Rv ->
   (forall s1 s2, P s1 s2 ->
      wrequiv Rv (fun vs1 => fexec_syscall (scP:=scP1) sc1 (mk_fstate vs1 s1))
                 (fun vs2 => fexec_syscall sc2 (mk_fstate vs2 s2)) Ro)->
   (forall fs1 fs2,
     Ro fs1 fs2 ->
-    wrequiv P (upd_estate true (p_globs p1) xs1 fs1)
-              (upd_estate true (p_globs p2) xs2 fs2) Q) ->
+    wrequiv P (upd_estate1 true (p_globs p1) xs1 fs1)
+              (upd_estate2 true (p_globs p2) xs2 fs2) Q) ->
   wequiv P [:: MkI ii1 (Csyscall xs1 sc1 es1)] [:: MkI ii2 (Csyscall xs2 sc2 es2)] Q.
 Proof.
   move=> he ho hwr; rewrite /equiv /isem_cmd_ /=.
@@ -708,13 +702,13 @@ Qed.
 
 Lemma wequiv_syscall_eq P Q ii1 xs1 sc1 es1 ii2 sc2 xs2 es2 :
   (forall s1 s2, P s1 s2 -> escs s1 = escs s2 /\ emem s1 = emem s2) ->
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s es1)
-            (fun s => sem_pexprs true (p_globs p2) s es2) eq ->
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s es1)
+            (fun s => sem_pexprs2 true (p_globs p2) s es2) eq ->
   wrequiv eq (fexec_syscall (scP:=scP1) sc1)
              (fexec_syscall (scP:=scP2) sc2) eq ->
   (forall fs,
-    wrequiv P (upd_estate true (p_globs p1) xs1 fs)
-              (upd_estate true (p_globs p2) xs2 fs) Q) ->
+    wrequiv P (upd_estate1 true (p_globs p1) xs1 fs)
+              (upd_estate2 true (p_globs p2) xs2 fs) Q) ->
   wequiv P [:: MkI ii1 (Csyscall xs1 sc1 es1)] [:: MkI ii2 (Csyscall xs2 sc2 es2)] Q.
 Proof.
   move=> heq he hsc hx.
@@ -724,8 +718,8 @@ Proof.
 Qed.
 
 Lemma wequiv_syscall_esem (P Q : rel_c) ii1 xs1 sc1 es1 c2 :
-  wrequiv P (sem_syscall p1 xs1 sc1 es1)
-            (esem p2 ev2 c2) Q ->
+  wrequiv P (sem_syscall (wc:=wc1) (wa:=wa1) p1 xs1 sc1 es1)
+            (esem (wc:=wc2) (wa:=wa2) p2 ev2 c2) Q ->
   wequiv P [:: MkI ii1 (Csyscall xs1 sc1 es1)] c2 Q.
 Proof.
   move=> h s t hP /=.
@@ -738,8 +732,8 @@ Proof.
 Qed.
 
 Lemma wequiv_assert_esem (P Q : rel_c) ii1 a1 c2 :
-  wrequiv P (fun (s:estate1) => Let _ := sem_assert (wsw:=wsw1) (wa:=wa1) (p_globs p1) s a1 in ok s)
-            (esem (wa:=wa2) p2 ev2 c2) Q ->
+  wrequiv P (fun (s:estate1) => Let _ := sem_assert (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (p_globs p1) s a1 in ok s)
+            (esem (wc:=wc2) (wa:=wa2) p2 ev2 c2) Q ->
   wequiv P [:: MkI ii1 (Cassert a1)] c2 Q.
 Proof.
   move=> h s t hP /=; rewrite /isem_assert.
@@ -757,8 +751,8 @@ Lemma wequiv_assert (P Q : rel_c) ii1 a1 ii2 a2 :
    assert_allowed (WithAssert:=wa2) /\
    forall s1 s2,
      P s1 s2 ->
-     sem_cond (p_globs p1) a1.2 s1 = ok true ->
-     sem_cond (p_globs p2) a2.2 s2 = ok true /\ Q s1 s2) ->
+     sem_cond1 (p_globs p1) a1.2 s1 = ok true ->
+     sem_cond2 (p_globs p2) a2.2 s2 = ok true /\ Q s1 s2) ->
   wequiv P [:: MkI ii1 (Cassert a1)] [:: MkI ii2 (Cassert a2)] Q.
 Proof.
   move=> hcond; apply wequiv_assert_esem => s t s' hP /=.
@@ -768,9 +762,9 @@ Proof.
 Qed.
 
 Lemma sem_cond_uincl P e1 e2 :
-  wrequiv P (fun (s:estate1) => sem_pexpr true (p_globs p1) s e1)
-            (fun (s:estate2) => sem_pexpr true (p_globs p2) s e2) value_uincl ->
-  wrequiv P (sem_cond (p_globs p1) e1) (sem_cond (p_globs p2) e2) eq.
+  wrequiv P (fun (s:estate1) => sem_pexpr1 true (p_globs p1) s e1)
+            (fun (s:estate2) => sem_pexpr2 true (p_globs p2) s e2) value_uincl ->
+  wrequiv P (sem_cond1 (p_globs p1) e1) (sem_cond2 (p_globs p2) e2) eq.
 Proof.
   move=> he; apply: wrequiv_bind wrequiv_to_bool; apply he.
 Qed.
@@ -778,14 +772,14 @@ Qed.
 Lemma wequiv_assert_uincl (P Q : rel_c) ii1 a1 ii2 a2 :
   (assert_allowed (WithAssert:=wa1) ->
      assert_allowed (WithAssert:=wa2) /\
-     wrequiv P (fun s => sem_pexpr true (p_globs p1) s a1.2)
-               (fun s => sem_pexpr true (p_globs p2) s a2.2) value_uincl) ->
+     wrequiv P (fun s => sem_pexpr1 true (p_globs p1) s a1.2)
+               (fun s => sem_pexpr2 true (p_globs p2) s a2.2) value_uincl) ->
   (assert_allowed (WithAssert:=wa1) ->
    assert_allowed (WithAssert:=wa2) ->
    forall s1 s2,
      P s1 s2 ->
-     sem_pexpr true (p_globs p1) s1 a1.2 = ok (Vbool true) ->
-     sem_pexpr true (p_globs p2) s2 a2.2 = ok (Vbool true) ->
+     sem_pexpr1 true (p_globs p1) s1 a1.2 = ok (Vbool true) ->
+     sem_pexpr2 true (p_globs p2) s2 a2.2 = ok (Vbool true) ->
      Q s1 s2) ->
   wequiv P [:: MkI ii1 (Cassert a1)] [:: MkI ii2 (Cassert a2)] Q.
 Proof.
@@ -799,14 +793,14 @@ Qed.
 Lemma wequiv_assert_eq (P Q : rel_c) ii1 a1 ii2 a2 :
   (assert_allowed (WithAssert:=wa1) ->
      assert_allowed (WithAssert:=wa2) /\
-     wrequiv P (fun s => sem_pexpr true (p_globs p1) s a1.2)
-               (fun s => sem_pexpr true (p_globs p2) s a2.2) eq) ->
+     wrequiv P (fun s => sem_pexpr1 true (p_globs p1) s a1.2)
+               (fun s => sem_pexpr2 true (p_globs p2) s a2.2) eq) ->
   (assert_allowed (WithAssert:=wa1) ->
    assert_allowed (WithAssert:=wa2) ->
    forall s1 s2,
      P s1 s2 ->
-     sem_pexpr true (p_globs p1) s1 a1.2 = ok (Vbool true) ->
-     sem_pexpr true (p_globs p2) s2 a2.2 = ok (Vbool true) ->
+     sem_pexpr1 true (p_globs p1) s1 a1.2 = ok (Vbool true) ->
+     sem_pexpr2 true (p_globs p2) s2 a2.2 = ok (Vbool true) ->
      Q s1 s2) ->
   wequiv P [:: MkI ii1 (Cassert a1)] [:: MkI ii2 (Cassert a2)] Q.
 Proof.
@@ -867,14 +861,14 @@ Proof. split=> //; exact: values_uincl_refl. Qed.
 
 Lemma wequiv_syscall_uincl P Q ii1 xs1 sc1 es1 ii2 sc2 xs2 es2 :
   (forall s1 s2, P s1 s2 -> escs s1 = escs s2 /\ emem s1 = emem s2) ->
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s es1)
-           (fun s => sem_pexprs true (p_globs p2) s es2) (Forall2 value_uincl) ->
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s es1)
+           (fun s => sem_pexprs2 true (p_globs p2) s es2) (Forall2 value_uincl) ->
   wrequiv fs_uincl (fexec_syscall (scP:=scP1) sc1)
                   (fexec_syscall (scP:=scP2) sc2) fs_uincl ->
   (forall fs1 fs2,
     fs_uincl fs1 fs2 ->
-    wrequiv P (upd_estate true (p_globs p1) xs1 fs1)
-              (upd_estate true (p_globs p2) xs2 fs2) Q) ->
+    wrequiv P (upd_estate1 true (p_globs p1) xs1 fs1)
+              (upd_estate2 true (p_globs p2) xs2 fs2) Q) ->
   wequiv P [:: MkI ii1 (Csyscall xs1 sc1 es1)] [:: MkI ii2 (Csyscall xs2 sc2 es2)] Q.
 Proof.
   move=> heq he hsc.
@@ -883,9 +877,9 @@ Proof.
 Qed.
 
 Lemma wequiv_if_full P Q ii1 e1 c1 c1' ii2 e2 c2 c2' :
-  wrequiv P (sem_cond (p_globs p1) e1) (sem_cond (p_globs p2) e2) eq ->
+  wrequiv P (sem_cond1 (p_globs p1) e1) (sem_cond2 (p_globs p2) e2) eq ->
   (forall b, wequiv
-        (fun s1 s2 => [/\ P s1 s2, sem_cond (p_globs p1) e1 s1 = ok b & sem_cond (p_globs p2) e2 s2 = ok b])
+        (fun s1 s2 => [/\ P s1 s2, sem_cond1 (p_globs p1) e1 s1 = ok b & sem_cond2 (p_globs p2) e2 s2 = ok b])
         (if b then c1 else c1')
         (if b then c2 else c2') Q) ->
   wequiv P [:: MkI ii1 (Cif e1 c1 c1')] [:: MkI ii2 (Cif e2 c2 c2')] Q.
@@ -894,7 +888,7 @@ Proof.
   apply wkequiv_bind with Q; last by apply wkequiv_ret.
   apply wkequiv_eq_pred => s1 s2 hP.
   eapply wkequiv_read with (fun b1 b2 =>
-     [/\ b1 = b2, sem_cond (p_globs p1) e1 s1 = ok b1 & sem_cond (p_globs p2) e2 s2 = ok b2]).
+     [/\ b1 = b2, sem_cond1 (p_globs p1) e1 s1 = ok b1 & sem_cond2 (p_globs p2) e2 s2 = ok b2]).
   + apply wkequiv_iresult.
     apply wrequiv_id; apply: wrequiv_weaken he => //.
     by move=> > [-> ->].
@@ -902,7 +896,7 @@ Proof.
 Qed.
 
 Lemma wequiv_if P Q ii1 e1 c1 c1' ii2 e2 c2 c2' :
-  wrequiv P (sem_cond (p_globs p1) e1) (sem_cond (p_globs p2) e2) eq ->
+  wrequiv P (sem_cond1 (p_globs p1) e1) (sem_cond2 (p_globs p2) e2) eq ->
   (forall b, wequiv P (if b then c1 else c1') (if b then c2 else c2') Q) ->
   wequiv P [:: MkI ii1 (Cif e1 c1 c1')] [:: MkI ii2 (Cif e2 c2 c2')] Q.
 Proof.
@@ -912,8 +906,8 @@ Qed.
 
 (* Usefull for lowering *)
 Lemma wequiv_if_esem P P' Q ii1 e1 c1 c1' c ii2 e2 c2 c2':
-  (forall s t v, P s t -> sem_pexpr true (p_globs p1) s e1 = ok v ->
-     exists t', [/\ esem p2 ev2 c t = ok t', P' s t' & sem_pexpr true (p_globs p2) t' e2 = ok v]) ->
+  (forall s t v, P s t -> sem_pexpr1 true (p_globs p1) s e1 = ok v ->
+     exists t', [/\ esem p2 ev2 c t = ok t', P' s t' & sem_pexpr2 true (p_globs p2) t' e2 = ok v]) ->
   (forall b, wequiv P' (if b then c1 else c1') (if b then c2 else c2') Q) ->
   wequiv P [::MkI ii1 (Cif e1 c1 c1')] (c ++ [::MkI ii2 (Cif e2 c2 c2')]) Q.
 Proof.
@@ -930,27 +924,27 @@ Proof.
 Qed.
 
 Lemma wequiv_if_uincl P Q ii1 e1 c1 c1' ii2 e2 c2 c2' :
-  wrequiv P (fun (s:estate1) => sem_pexpr true (p_globs p1) s e1)
-            (fun (s:estate2) => sem_pexpr true (p_globs p2) s e2) value_uincl ->
+  wrequiv P (fun (s:estate1) => sem_pexpr1 true (p_globs p1) s e1)
+            (fun (s:estate2) => sem_pexpr2 true (p_globs p2) s e2) value_uincl ->
   (forall b, wequiv P (if b then c1 else c1') (if b then c2 else c2') Q) ->
   wequiv P [:: MkI ii1 (Cif e1 c1 c1')] [:: MkI ii2 (Cif e2 c2 c2')] Q.
 Proof. move=> /sem_cond_uincl; apply wequiv_if. Qed.
 
 Lemma wequiv_if_eq P Q ii1 e1 c1 c1' ii2 e2 c2 c2' :
-  wrequiv P (fun (s:estate1) => sem_pexpr true (p_globs p1) s e1)
-           (fun (s:estate2) => sem_pexpr true (p_globs p2) s e2) eq ->
+  wrequiv P (fun (s:estate1) => sem_pexpr1 true (p_globs p1) s e1)
+           (fun (s:estate2) => sem_pexpr2 true (p_globs p2) s e2) eq ->
   (forall b, wequiv P (if b then c1 else c1') (if b then c2 else c2') Q) ->
   wequiv P [:: MkI ii1 (Cif e1 c1 c1')] [:: MkI ii2 (Cif e2 c2 c2')] Q.
 Proof. by move=> he; apply wequiv_if_uincl; apply: wrequiv_weaken he => // > <-. Qed.
 
 Lemma wequiv_if_rcond P Q ii1 e1 c1 c1' c2 b :
-  (forall s1 s2 v, P s1 s2 -> sem_cond (p_globs p1) e1 s1 = ok v -> v = b) ->
+  (forall s1 s2 v, P s1 s2 -> sem_cond1 (p_globs p1) e1 s1 = ok v -> v = b) ->
   wequiv P (if b then c1 else c1') c2 Q ->
   wequiv P [:: MkI ii1 (Cif e1 c1 c1')] c2 Q.
 Proof.
   move=> he1 hc2 s1 s2 hP /=.
   rewrite /isem_cond.
-  case heq: (sem_cond (p_globs p1) e1 s1) => [b' | err] /=.
+  case heq: (sem_cond1 (p_globs p1) e1 s1) => [b' | err] /=.
   + rewrite bind_ret_r bind_ret_l.
     rewrite (he1 _ _ _ hP heq); apply: hc2 hP.
   rewrite bind_bind bind_vis.
@@ -960,7 +954,7 @@ Qed.
 
 Lemma wequiv_for P0 P Pi ii1 i1 d lo1 hi1 c1 ii2 i2 lo2 hi2 c2 :
   (forall s1 s2, P0 s1 s2 -> P s1 s2) ->
-  wrequiv P0 (sem_bound (p_globs p1) lo1 hi1) (sem_bound (p_globs p2) lo2 hi2) eq ->
+  wrequiv P0 (sem_bound1 (p_globs p1) lo1 hi1) (sem_bound2 (p_globs p2) lo2 hi2) eq ->
   (forall i : Z, wrequiv P (write_var true i1 (Vint i)) (write_var true i2 (Vint i)) Pi) ->
   wequiv Pi c1 c2 P ->
   wequiv P0 [:: MkI ii1 (Cfor i1 (d, lo1, hi1) c1)] [:: MkI ii2 (Cfor i2 (d, lo2, hi2) c2)] P.
@@ -979,9 +973,9 @@ Proof.
 Qed.
 
 Lemma wrequiv_sem_bound (P : rel_c) lo1 hi1 lo2 hi2 :
-  wrequiv P (fun s => sem_pexprs true (p_globs p1) s [::lo1; hi1])
-            (fun s => sem_pexprs true (p_globs p2) s [::lo2; hi2]) (List.Forall2 value_uincl) ->
-  wrequiv P (sem_bound (p_globs p1) lo1 hi1) (sem_bound (p_globs p2) lo2 hi2) eq.
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s [::lo1; hi1])
+            (fun s => sem_pexprs2 true (p_globs p2) s [::lo2; hi2]) (List.Forall2 value_uincl) ->
+  wrequiv P (sem_bound1 (p_globs p1) lo1 hi1) (sem_bound2 (p_globs p2) lo2 hi2) eq.
 Proof.
   move=> hbound; rewrite /sem_bound.
   move=> s1 s2 lh1 hP; t_xrbindP => ilo1 vlo1 hlo1 hvlo1 ihi1 vhi1 hhi1 hvhi1 <-.
@@ -996,8 +990,8 @@ Qed.
 
 Lemma wequiv_for_uincl P0 P Pi ii1 i1 d lo1 hi1 c1 ii2 i2 lo2 hi2 c2 :
   (forall s1 s2, P0 s1 s2 -> P s1 s2) ->
-  wrequiv P0 (fun s => sem_pexprs true (p_globs p1) s [::lo1; hi1])
-            (fun s => sem_pexprs true (p_globs p2) s [::lo2; hi2]) (List.Forall2 value_uincl) ->
+  wrequiv P0 (fun s => sem_pexprs1 true (p_globs p1) s [::lo1; hi1])
+            (fun s => sem_pexprs2 true (p_globs p2) s [::lo2; hi2]) (List.Forall2 value_uincl) ->
   (forall i : Z, wrequiv P (write_var true i1 (Vint i)) (write_var true i2 (Vint i)) Pi) ->
   wequiv Pi c1 c2 P ->
   wequiv P0 [:: MkI ii1 (Cfor i1 (d, lo1, hi1) c1)] [:: MkI ii2 (Cfor i2 (d, lo2, hi2) c2)] P.
@@ -1005,8 +999,8 @@ Proof. by move=> hP0P hbound; apply/wequiv_for/wrequiv_sem_bound. Qed.
 
 Lemma wequiv_for_eq P0 P Pi ii1 i1 d lo1 hi1 c1 ii2 i2 lo2 hi2 c2 :
   (forall s1 s2, P0 s1 s2 -> P s1 s2) ->
-  wrequiv P0 (fun s => sem_pexprs true (p_globs p1) s [::lo1; hi1])
-            (fun s => sem_pexprs true (p_globs p2) s [::lo2; hi2]) eq ->
+  wrequiv P0 (fun s => sem_pexprs1 true (p_globs p1) s [::lo1; hi1])
+            (fun s => sem_pexprs2 true (p_globs p2) s [::lo2; hi2]) eq ->
   (forall i : Z, wrequiv P (write_var true i1 (Vint i)) (write_var true i2 (Vint i)) Pi) ->
   wequiv Pi c1 c2 P ->
   wequiv P0 [:: MkI ii1 (Cfor i1 (d, lo1, hi1) c1)] [:: MkI ii2 (Cfor i2 (d, lo2, hi2) c2)] P.
@@ -1017,11 +1011,11 @@ Qed.
 
 Lemma wequiv_while_full I I' ii1 al1 e1 inf1 c1 c1' ii2 al2 e2 inf2 c2 c2' :
   wequiv I c1 c2 I' ->
-  wrequiv I' (sem_cond (p_globs p1) e1) (sem_cond (p_globs p2) e2) eq ->
+  wrequiv I' (sem_cond1 (p_globs p1) e1) (sem_cond2 (p_globs p2) e2) eq ->
   wequiv (fun s1 s2 =>
-    [/\ I' s1 s2, sem_cond (p_globs p1) e1 s1 = ok true & sem_cond (p_globs p2) e2 s2 = ok true]) c1' c2' I ->
+    [/\ I' s1 s2, sem_cond1 (p_globs p1) e1 s1 = ok true & sem_cond2 (p_globs p2) e2 s2 = ok true]) c1' c2' I ->
   wequiv I [:: MkI ii1 (Cwhile al1 c1 e1 inf1 c1')] [:: MkI ii2 (Cwhile al2 c2 e2 inf2 c2')]
-     (fun s1 s2 => [/\ I' s1 s2, sem_cond (p_globs p1) e1 s1 = ok false & sem_cond (p_globs p2) e2 s2 = ok false]).
+     (fun s1 s2 => [/\ I' s1 s2, sem_cond1 (p_globs p1) e1 s1 = ok false & sem_cond2 (p_globs p2) e2 s2 = ok false]).
 Proof.
   move=> hc hcond hc'; rewrite /wequiv /isem_cmd_ /=.
   set Q := (Q in wkequiv _ _ _ Q).
@@ -1030,7 +1024,7 @@ Proof.
   apply (wkequiv_bind hc).
   apply wkequiv_eq_pred => s1 s2 hP.
   eapply wkequiv_read with (fun b1 b2 =>
-     [/\ b1 = b2, sem_cond (p_globs p1) e1 s1 = ok b1 & sem_cond (p_globs p2) e2 s2 = ok b2]).
+     [/\ b1 = b2, sem_cond1 (p_globs p1) e1 s1 = ok b1 & sem_cond2 (p_globs p2) e2 s2 = ok b2]).
   + apply wkequiv_iresult.
     apply wrequiv_id; apply: wrequiv_weaken hcond => //.
     by move=> > [-> ->].
@@ -1042,7 +1036,7 @@ Proof.
 Qed.
 
 Lemma wequiv_while I I' ii1 al1 e1 inf1 c1 c1' ii2 al2 e2 inf2 c2 c2' :
-  wrequiv I' (sem_cond (p_globs p1) e1) (sem_cond (p_globs p2) e2) eq ->
+  wrequiv I' (sem_cond1 (p_globs p1) e1) (sem_cond2 (p_globs p2) e2) eq ->
   wequiv I c1 c2 I' ->
   wequiv I' c1' c2' I ->
   wequiv I [:: MkI ii1 (Cwhile al1 c1 e1 inf1 c1')] [:: MkI ii2 (Cwhile al2 c2 e2 inf2 c2')] I'.
@@ -1050,7 +1044,7 @@ Proof.
   move=> hcond hc hc'.
   apply wequiv_weaken with (P2 := I)
     (Q2 := fun s1 s2 =>
-      [/\ I' s1 s2, sem_cond (p_globs p1) e1 s1 = ok false & sem_cond (p_globs p2) e2 s2 = ok false]) => //.
+      [/\ I' s1 s2, sem_cond1 (p_globs p1) e1 s1 = ok false & sem_cond2 (p_globs p2) e2 s2 = ok false]) => //.
   + by move=> > [].
   apply wequiv_while_full => //.
   by apply: wequiv_weaken hc' => // > [].
@@ -1059,8 +1053,8 @@ Qed.
 (* Usefull for lowering *)
 Lemma wequiv_while_esem I I1 I' ii1 al1 e1 inf1 c1 c1' c ii2 al2 e2 inf2 c2 c2':
   wequiv I c1 c2 I1 ->
-  (forall s t v, I1 s t -> sem_pexpr true (p_globs p1) s e1 = ok v ->
-     exists t', [/\ esem p2 ev2 c t = ok t', I' s t' & sem_pexpr true (p_globs p2) t' e2 = ok v]) ->
+  (forall s t v, I1 s t -> sem_pexpr1 true (p_globs p1) s e1 = ok v ->
+     exists t', [/\ esem p2 ev2 c t = ok t', I' s t' & sem_pexpr2 true (p_globs p2) t' e2 = ok v]) ->
   wequiv I' c1' c2' I ->
   wequiv I [::MkI ii1 (Cwhile al1 c1 e1 inf1 c1')] [::MkI ii2 (Cwhile al2 (c2 ++ c) e2 inf2 c2')] I'.
 Proof.
@@ -1092,16 +1086,16 @@ Proof.
 Qed.
 
 Lemma wequiv_while_uincl I I' ii1 al1 e1 inf1 c1 c1' ii2 al2 e2 inf2 c2 c2' :
-  wrequiv I' (fun (s:estate1) => sem_pexpr true (p_globs p1) s e1)
-             (fun (s:estate2) => sem_pexpr true (p_globs p2) s e2) value_uincl ->
+  wrequiv I' (fun (s:estate1) => sem_pexpr1 true (p_globs p1) s e1)
+             (fun (s:estate2) => sem_pexpr2 true (p_globs p2) s e2) value_uincl ->
   wequiv I c1 c2 I' ->
   wequiv I' c1' c2' I ->
   wequiv I [:: MkI ii1 (Cwhile al1 c1 e1 inf1 c1')] [:: MkI ii2 (Cwhile al2 c2 e2 inf2 c2')] I'.
 Proof. move=> /sem_cond_uincl; apply wequiv_while. Qed.
 
 Lemma wequiv_while_eq I I' ii1 al1 e1 inf1 c1 c1' ii2 al2 e2 inf2 c2 c2' :
-  wrequiv I' (fun (s:estate1) => sem_pexpr true (p_globs p1) s e1)
-             (fun (s:estate2) => sem_pexpr true (p_globs p2) s e2) eq ->
+  wrequiv I' (fun (s:estate1) => sem_pexpr1 true (p_globs p1) s e1)
+             (fun (s:estate2) => sem_pexpr2 true (p_globs p2) s e2) eq ->
   wequiv I c1 c2 I' ->
   wequiv I' c1' c2' I ->
   wequiv I [:: MkI ii1 (Cwhile al1 c1 e1 inf1 c1')] [:: MkI ii2 (Cwhile al2 c2 e2 inf2 c2')] I'.
@@ -1115,70 +1109,100 @@ Proof.
   by move=> /= h s1 s2 hP; rewrite isem_cmd_while; apply h.
 Qed.
 
-Lemma wequiv_call_core (Pf : relPreF) (Qf : relPostF) Rv P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
-  wrequiv P (fun s => sem_pexprs (~~ (@direct_call dc1)) (p_globs p1) s es1)
-            (fun s => sem_pexprs (~~ (@direct_call dc2)) (p_globs p2) s es2) Rv ->
+Lemma wequiv_call_core_wa (Pf : relPreF) (Qf : relPostF) Rv P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  wrequiv P (fun s => sem_pexprs1 (~~ (@direct_call dc1)) (p_globs p1) s es1)
+            (fun s => sem_pexprs2 (~~ (@direct_call dc2)) (p_globs p2) s es2) Rv ->
+  (forall s1 s2 vs1 vs2, P s1 s2 -> Rv vs1 vs2 ->
+     sem_pre1 p1 fn1 (mk_fstate vs1 s1) = ok tt ->
+     sem_pre2 p2 fn2 (mk_fstate vs2 s2) = ok tt) ->
   (forall s1 s2 vs1 vs2,
      P s1 s2 -> Rv vs1 vs2 -> Pf fn1 fn2 (mk_fstate vs1 s1) (mk_fstate vs2 s2)) ->
   wequiv_f_ii Pf ii1 ii2 fn1 fn2 Qf ->
+  (forall fs1 fs2 fr1 fr2,
+     Pf fn1 fn2 fs1 fs2 -> Qf fn1 fn2 fs1 fs2 fr1 fr2 ->
+    sem_post1 p1 fn1 fs1.(fvals) fr1 = ok () ->
+    sem_post2 p2 fn2 fs2.(fvals) fr2 = ok ()) ->
   (forall fs1 fs2 fr1 fr2,
     Pf fn1 fn2 fs1 fs2 -> Qf fn1 fn2 fs1 fs2 fr1 fr2 ->
     wrequiv
       (fun s1 s2 => [/\ P s1 s2, escs s1 = fscs fs1, escs s2 = fscs fs2
                       , emem s1 = fmem fs1, emem s2 = fmem fs2
                       & Rv (fvals fs1) (fvals fs2)])
-        (upd_estate (~~ (@direct_call dc1)) (p_globs p1) xs1 fr1)
-        (upd_estate (~~ (@direct_call dc2)) (p_globs p2) xs2 fr2)
+        (upd_estate1 (~~ (@direct_call dc1)) (p_globs p1) xs1 fr1)
+        (upd_estate2 (~~ (@direct_call dc2)) (p_globs p2) xs2 fr2)
       Q) ->
   wequiv P [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] Q.
 Proof.
-  move=> hes hPPf hCall hPQf; rewrite /wequiv /isem_cmd_ /=.
+  move=> hes hpre hPPf hCall hpost hPQf; rewrite /wequiv /isem_cmd_ /=.
   apply wkequiv_bind with Q; last by apply wkequiv_ret.
   apply wkequiv_read with Rv.
   + by apply wkequiv_iresult.
   move=> vs1 vs2 hvs.
   apply wkequiv_eq_pred => s1 s2 hP.
   set fs1 := mk_fstate vs1 s1; set fs2 := mk_fstate vs2 s2.
+  apply wkequiv_read with (fun u1 u2 => sem_pre1 p1 fn1 fs1 = ok tt /\ sem_pre2 p2 fn2 fs2 = ok tt).
+  + by apply wkequiv_iresult => _ _ [] [-> ->] he; have ?:= hpre _ _ _ _ hP hvs he; exists tt.
+  move=> _ _ [hpre1 hpre2].
   apply wkequiv_read with (Qf fn1 fn2 fs1 fs2).
   + by move=> _ _ [-> ->]; apply/hCall/hPPf.
-  move=> fr1 fr2 hQf; apply wkequiv_iresult.
+  move=> fr1 fr2 hQf.
+  apply wkequiv_read with (fun u1 u2 => sem_post1 p1 fn1 fs1.(fvals) fr1 = ok tt /\ sem_post2 p2 fn2 fs2.(fvals) fr2 = ok tt).
+  + apply wkequiv_iresult => _ _ [] _ hpost1.
+    have hpost2 := hpost _ _ _ _ (hPPf _ _ _ _ hP hvs) hQf hpost1.
+    by exists tt.
+  move=> _ _ _; apply wkequiv_iresult.
   eapply wrequiv_weaken; last apply (hPQf fs1 fs2); eauto.
   by move=> ?? [-> ->].
 Qed.
 
-Lemma wequiv_call (Pf : relPreF) (Qf : relPostF) Rv P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
-  wrequiv P (fun s => sem_pexprs (~~ (@direct_call dc1)) (p_globs p1) s es1)
-            (fun s => sem_pexprs (~~ (@direct_call dc2)) (p_globs p2) s es2) Rv ->
+Lemma wequiv_call_wa (Pf : relPreF) (Qf : relPostF) Rv P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  wrequiv P (fun s => sem_pexprs1 (~~ (@direct_call dc1)) (p_globs p1) s es1)
+            (fun s => sem_pexprs2 (~~ (@direct_call dc2)) (p_globs p2) s es2) Rv ->
+  (forall s1 s2 vs1 vs2, P s1 s2 -> Rv vs1 vs2 ->
+     sem_pre1 p1 fn1 (mk_fstate vs1 s1) = ok tt ->
+     sem_pre2 p2 fn2 (mk_fstate vs2 s2) = ok tt) ->
   (forall s1 s2 vs1 vs2,
      P s1 s2 -> Rv vs1 vs2 -> Pf fn1 fn2 (mk_fstate vs1 s1) (mk_fstate vs2 s2)) ->
+  (forall fs1 fs2 fr1 fr2,
+     Pf fn1 fn2 fs1 fs2 -> Qf fn1 fn2 fs1 fs2 fr1 fr2 ->
+    sem_post1 p1 fn1 fs1.(fvals) fr1 = ok () ->
+    sem_post2 p2 fn2 fs2.(fvals) fr2 = ok ()) ->
   wequiv_f_ii Pf ii1 ii2 fn1 fn2 Qf ->
   (forall fs1 fs2 fr1 fr2,
     Pf fn1 fn2 fs1 fs2 -> Qf fn1 fn2 fs1 fs2 fr1 fr2 ->
-    wrequiv P (upd_estate (~~ (@direct_call dc1)) (p_globs p1) xs1 fr1)
-              (upd_estate (~~ (@direct_call dc2)) (p_globs p2) xs2 fr2) Q) ->
+    wrequiv P (upd_estate1 (~~ (@direct_call dc1)) (p_globs p1) xs1 fr1)
+              (upd_estate2 (~~ (@direct_call dc2)) (p_globs p2) xs2 fr2) Q) ->
   wequiv P [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] Q.
 Proof.
-  move=> hes hPPf hCall hPQf.
-  apply wequiv_call_core with Pf Qf Rv => //.
+  move=> hes hpre hPPf hpost hCall hPQf.
+  apply wequiv_call_core_wa with Pf Qf Rv => //.
   move=> > hPf hQf; apply wrequiv_weaken with P Q => //.
   + by move=> > [].
   apply: hPQf hPf hQf.
 Qed.
 
-Lemma wequiv_call_eq P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
-  wrequiv P (fun s => sem_pexprs (~~ (@direct_call dc1)) (p_globs p1) s es1)
-            (fun s => sem_pexprs (~~ (@direct_call dc2)) (p_globs p2) s es2) eq ->
+Lemma wequiv_call_eq_wa P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  wrequiv P (fun s => sem_pexprs1 (~~ (@direct_call dc1)) (p_globs p1) s es1)
+            (fun s => sem_pexprs2 (~~ (@direct_call dc2)) (p_globs p2) s es2) eq ->
+  (forall s1 s2 vs, P s1 s2 ->
+     sem_pre1 p1 fn1 (mk_fstate vs s1) = ok tt ->
+     sem_pre2 p2 fn2 (mk_fstate vs s2) = ok tt) ->
   (forall s1 s2 vs,
      P s1 s2 -> rpreF (eS:=eq_spec) fn1 fn2 (mk_fstate vs s1) (mk_fstate vs s2)) ->
   wequiv_f_ii (rpreF (eS:=eq_spec)) ii1 ii2 fn1 fn2 (rpostF (eS:=eq_spec)) ->
+  (forall vs fr,
+    sem_post1 p1 fn1 vs fr = ok () ->
+    sem_post2 p2 fn1 vs fr = ok ()) ->
   (forall fs,
-    wrequiv P (upd_estate (~~ (@direct_call dc1)) (p_globs p1) xs1 fs)
-              (upd_estate (~~ (@direct_call dc2)) (p_globs p2) xs2 fs) Q) ->
+    wrequiv P (upd_estate1 (~~ (@direct_call dc1)) (p_globs p1) xs1 fs)
+              (upd_estate2 (~~ (@direct_call dc2)) (p_globs p2) xs2 fs) Q) ->
   wequiv P [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] Q.
 Proof.
-  move=> he hfs hfn hupd.
-  apply wequiv_call with (Pf:=rpreF (eS:=eq_spec)) (Qf:= rpostF (eS:=eq_spec)) (Rv:=eq) => //.
+  move=> he hpre hfs hfn hpost hupd.
+  apply wequiv_call_wa with (Pf:=rpreF (eS:=eq_spec)) (Qf:= rpostF (eS:=eq_spec)) (Rv:=eq) => //.
+  + by move=> s1 s2 vs1 vs2 hP ->; apply hpre.
   + by move=> s1 s2 vs1 _ hP <-; apply hfs.
+  + by move=> fs1 fs2 fr1 fr2 [<- <-] <-; apply hpost.
   move=> fs1 fs2 ft1 ft2 [<- <-] /= <-; apply hupd.
 Qed.
 
@@ -1187,6 +1211,8 @@ Definition wequiv_fun_body_hyp' (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
   RPreF fn1 fn2 fs1 fs2 ->
   forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
   exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
+    sem_pre1 p1 fn1 fs1 = ok tt ->
+    sem_pre2 p2 fn2 fs2 = ok tt /\
     forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
      exists2 s21,
        initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
@@ -1195,7 +1221,9 @@ Definition wequiv_fun_body_hyp' (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
           , fd2.(f_body) = tbody ++ epilogue
           , wequiv P fd1.(f_body) tbody Q
           , ∀ s₀, wequiv (λ s t, s = s₀ ∧ Q s t ∧ ∃ fs, finalize_funcall (dc := dc1) fd1 s = ok fs) [::] epilogue (λ s t, s = s₀ ∧ Q s t)
-          & wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)].
+          , wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)
+          & forall fr1 fr2, RPostF fn1 fn2 fs1 fs2 fr1 fr2 ->
+                             sem_post1 p1 fn1 fs1.(fvals) fr1 = ok () -> sem_post2 p2 fn2 fs2.(fvals) fr2 = ok ()].
 
 Lemma wequiv_fun_body' RPreF fn1 fn2 RPostF :
   wequiv_fun_body_hyp' RPreF fn1 fn2 RPostF ->
@@ -1213,66 +1241,63 @@ Proof.
     by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
   move=> fd1 fd2 [+ hfd2].
   move=> {}/hf [fd2']; rewrite hfd2 => -[?] hf; subst fd2'.
-  apply wkequiv_bind with (fun s1 s2 => initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1 /\
-                                        initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s2).
-  + by apply wkequiv_iresult => ?? s1 [-> ->] /[dup] hinit1 /hf [s2] hinit2 _; exists s2.
-  apply wkequiv_eq_pred => s1 s2 [hinit1 hinit2].
-  have := hf _ hinit1.
-  rewrite hinit2 => -[_] [<-] [P] [Q] [tbody] [epilogue] [hP htbody hbody hepilogue hres].
-  apply wkequiv_eutt_r with (F2 := (λ t : estate2, s0 <- isem_cmd_ p2 ev2 tbody t;; s1 <- isem_cmd_ p2 ev2 epilogue s0;; iresult s1 (finalize_funcall fd2 s1))).
-  + move => _ ? [] _ ->; rewrite htbody isem_cmd_cat Monad.bind_bind; reflexivity.
-  apply wkequiv_bind with Q.
-  + by apply: wequiv_weaken hbody => // > [] -> ->.
-  move => s1' s2' hQ.
-  move: hres => /(_ s1').
-  move: hepilogue => /(_ s1' s1' s2').
+  apply wkequiv_read with (fun _ _ => sem_pre1 p1 fn1 fs1 = ok ()).
+  + by apply wkequiv_iresult => ?? [] [-> ->] h; have [-> ?] := hf h; eauto.
+  move=> _ _ /hf [hpre2 {}hf].
+  move=> _ _ [-> ->].
+  apply xrutt_bind with (fun s1 s2 =>
+     [/\ initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1 &
+         initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s2]).
+  + apply (wkequiv_iresult (P:= eq_init fs1 fs2)) => //.
+    by move=> ?? s1 [-> ->] /[dup] hinit1 /hf [s2]  hinit2 _; exists s2.
+  move=> s1 s2 [hs1 hs2].
+  have [s2' {hf}] := hf _ hs1.
+  rewrite hs2 => -[?] [P] [Q] [tbody] [epilogue] [hP htbody hbody hepilogue hfin hpost]; subst s2'.
+  rewrite htbody isem_cmd_cat Monad.bind_bind.
+  apply xrutt_bind with Q; first by apply: hbody hP.
+  move=> s1' s2' hQ. 
+  move: (hepilogue s1' s1' s2') (hfin s1') => {hfin hepilogue}.
   case: finalize_funcall => [ fs1' | err1 ]; last first.
-  + move => _ _; apply: xrutt_CutL => //.
+  + move=> _ _; rewrite /=.
+    rewrite /Exception.throw bind_vis; apply xrutt_CutL => //.
     by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
   move => /(_ (conj erefl (conj hQ (ex_intro _ _ erefl)))) /= hepilogue /(_ _ _ _ erefl) hres.
-  setoid_rewrite <- (bind_ret_l s1' (λ _, Ret fs1')).
-  apply: (xrutt_bind hepilogue).
-  move => _ s2'' [] -> /hres[] ? ->.
-  apply: xrutt_Ret.
+  setoid_rewrite <- (bind_ret_l s1' (λ _, Ret fs1')); rewrite bind_bind.
+  apply (xrutt_bind hepilogue) => _ r2 [-> /hres [fs2' -> hRP]].
+  rewrite /= !bind_ret_l /=.
+  apply xrutt_bind with (fun _ _ => true).
+  + by apply rutt_iresult => -[] /(hpost _ _ hRP) ->; exists tt.
+  by move=> _ _ _;  apply xrutt_Ret.
 Qed.
 
-Definition wequiv_fun_body_hyp (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
+Definition wequiv_fun_body_hyp_wa (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
   forall fs1 fs2,
   RPreF fn1 fn2 fs1 fs2 ->
   forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
   exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
+    sem_pre1 p1 fn1 fs1 = ok tt ->
+    sem_pre2 p2 fn2 fs2 = ok tt /\
     forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
-     exists2 s21,
-       initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
-       exists (P Q : rel_c),
-        [/\ P s11 s21
+    exists2 s21,
+      initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
+      exists (P Q : rel_c),
+       [/\ P s11 s21
           , wequiv P fd1.(f_body) fd2.(f_body) Q
-          & wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)].
+          , wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)
+          & (forall fr1 fr2, RPostF fn1 fn2 fs1 fs2 fr1 fr2 ->
+                             sem_post1 p1 fn1 fs1.(fvals) fr1 = ok () -> sem_post2 p2 fn2 fs2.(fvals) fr2 = ok ())
+        ].
 
-Lemma wequiv_fun_body RPreF fn1 fn2 RPostF :
-  wequiv_fun_body_hyp RPreF fn1 fn2 RPostF ->
+Lemma wequiv_fun_body_wa RPreF fn1 fn2 RPostF :
+  wequiv_fun_body_hyp_wa RPreF fn1 fn2 RPostF ->
   wequiv_f_body RPreF fn1 fn2 RPostF.
 Proof.
-  move=> hf; rewrite /wequiv_f_body /isem_fun_body.
-  apply wkequiv_ioP => fs1 fs2 hPf.
-  have {}hf:= hf _ _ hPf.
-  apply wkequiv_read with (fun fd1 fd2 => get_fundef (p_funcs p1) fn1 = Some fd1 /\
-                                          get_fundef (p_funcs p2) fn2 = Some fd2).
-  + rewrite /kget_fundef => ??.
-    case: get_fundef hf => /= [fd1 |].
-    + by move=> /(_ _ erefl) [fd2 ] -> _ _; apply xrutt_Ret.
-    move=> _ _; apply xrutt_CutL.
-    by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
-  move=> fd1 fd2 [+ hfd2].
-  move=> {}/hf [fd2']; rewrite hfd2 => -[?] hf; subst fd2'.
-  apply wkequiv_bind with (fun s1 s2 => initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1 /\
-                                        initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s2).
-  + by apply wkequiv_iresult => ?? s1 [-> ->] /[dup] hinit1 /hf [s2] hinit2 _; exists s2.
-  apply wkequiv_eq_pred => s1 s2 [hinit1 hinit2].
-  have := hf _ hinit1; rewrite hinit2 => -[_] [<-] [P] [Q] [hP hbody hres].
-  apply wkequiv_bind with Q.
-  + by apply: wequiv_weaken hbody => // > [-> ->].
-  by apply wkequiv_iresult.
+  move=> h.
+  apply wequiv_fun_body' => fs1 fs2 hpre1 fd1 hget1.
+  have [fd2 hget2 {}h] := h fs1 fs2 hpre1 fd1 hget1.
+  exists fd2 => // {}/h [hpre2 h]; split => // s11 {}/h [s21 hini2 [P] [Q] [hP hbody hfin hpost]].
+  exists s21 => //; exists P, Q, (f_body fd2), [::]; rewrite cats0; split => //.
+  by move=> s0; apply wequiv_nil => s1 s2 [? []].
 Qed.
 
 (* One sided rules *)
@@ -1286,7 +1311,7 @@ Proof.
 Qed.
 
 Lemma wequiv_assign_left P Q ii x tg ty e :
-  (forall s s' t, P s t -> sem_assgn p1 x tg ty e s = ok s' ->  Q s' t) ->
+  (forall s s' t, P s t -> sem_assgn (wc:=wc1) (wa:=wa1) p1 x tg ty e s = ok s' ->  Q s' t) ->
   wequiv P [::MkI ii (Cassgn x tg ty e)] [::] Q.
 Proof.
   move=> h; rewrite /wequiv /=.
@@ -1295,7 +1320,7 @@ Qed.
 
 Lemma wequiv_assert_left P Q ii a :
   (assert_allowed (WithAssert:=wa1) ->
-   forall s t, P s t -> sem_pexpr true (p_globs p1) s a.2 = ok (Vbool true) -> Q s t) ->
+   forall s t, P s t -> sem_pexpr1 true (p_globs p1) s a.2 = ok (Vbool true) -> Q s t) ->
   wequiv P [::MkI ii (Cassert a)] [::] Q.
 Proof.
   move=> h; rewrite /wequiv /=.
@@ -1310,6 +1335,26 @@ Proof.
   by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
 Qed.
 
+Lemma wequiv_asserts_left P Q ii (a_s : list assertion) :
+  assert_allowed (WithAssert:=wa1) ->
+  (forall s t, P s t -> (forall a, List.In a a_s -> sem_pexpr1 true (p_globs p1) s a.2 = ok (Vbool true)) -> Q s t) ->
+  wequiv P [seq MkI ii (Cassert a) | a <- a_s] [::] Q.
+Proof.
+  rewrite -{1}(app_nil_l a_s) => hwa1 hPQ.
+  apply wequiv_weaken with
+    (fun s t => P s t /\
+       (forall a, List.In a (@nil assertion) -> sem_pexpr1 true (p_globs p1) s a.2 = ok (Vbool true)))
+    Q => //.
+  elim: a_s (@nil assertion) hPQ => [ | a0 a_s hrec] /= a_s0 hPQ.
+  + by apply wequiv_nil => s t [hP ha_s0]; apply hPQ => //; rewrite app_nil_r.
+  rewrite -(cat0s [::]) -cat1s.
+  apply wequiv_cat with
+    (fun s t => P s t /\
+       (forall a, List.In a (a0::a_s0) -> sem_pexpr1 true (p_globs p1) s a.2 = ok (Vbool true))).
+  + by apply wequiv_assert_left => _ s t [hP ha_s0] ha0; split => //= a [<- // | hin]; apply ha_s0.
+  apply hrec => s t hP h; apply hPQ => // a /in_app_iff /= [hin|[<-|hin]]; apply h; rewrite in_app_iff /=; auto.
+Qed.
+
 Section REL.
 
 Context {D:Type}.
@@ -1339,15 +1384,15 @@ Class Checker_uincl :=
    forall wdb1 wdb2 d es1 es2 d',
      wdb_ok wdb1 wdb2 ->
      check_es d es1 es2 d' ->
-     wrequiv (R d) ((sem_pexprs wdb1 (p_globs p1))^~ es1) ((sem_pexprs wdb2 (p_globs p2))^~ es2)
+     wrequiv (R d) ((sem_pexprs1 wdb1 (p_globs p1))^~ es1) ((sem_pexprs2 wdb2 (p_globs p2))^~ es2)
        (List.Forall2 value_uincl)
  ; ucheck_lvalsP :
    forall wdb1 wdb2 d xs1 xs2 d',
      wdb_ok wdb1 wdb2 ->
      check_lvals d xs1 xs2 d' ->
      forall vs1 vs2, List.Forall2 value_uincl vs1 vs2 ->
-     wrequiv (R d) (λ s1 : estate, write_lvals wdb1 (p_globs p1) s1 xs1 vs1)
-                          (λ s2 : estate, write_lvals wdb2 (p_globs p2) s2 xs2 vs2) ( R d')
+     wrequiv (R d) (λ s1 : estate, write_lvals1 wdb1 (p_globs p1) s1 xs1 vs1)
+                          (λ s2 : estate, write_lvals2 wdb2 (p_globs p2) s2 xs2 vs2) ( R d')
  }.
 
 Class Checker_eq :=
@@ -1355,14 +1400,14 @@ Class Checker_eq :=
    forall (wdb1 wdb2 : bool) d es1 es2 d',
      wdb_ok wdb1 wdb2 ->
      check_es d es1 es2 d' ->
-     wrequiv (R d) ((sem_pexprs wdb1 (p_globs p1))^~ es1) ((sem_pexprs wdb2 (p_globs p2))^~ es2) eq
+     wrequiv (R d) ((sem_pexprs1 wdb1 (p_globs p1))^~ es1) ((sem_pexprs2 wdb2 (p_globs p2))^~ es2) eq
  ; echeck_lvalsP :
    forall (wdb1 wdb2 : bool) d xs1 xs2 d',
      wdb_ok wdb1 wdb2 ->
      check_lvals d xs1 xs2 d' ->
      forall vs,
-     wrequiv (R d) (λ s1 : estate, write_lvals wdb1 (p_globs p1) s1 xs1 vs)
-                          (λ s2 : estate, write_lvals wdb2 (p_globs p2) s2 xs2 vs) (R d')
+     wrequiv (R d) (λ s1 : estate, write_lvals1 wdb1 (p_globs p1) s1 xs1 vs)
+                          (λ s2 : estate, write_lvals2 wdb2 (p_globs p2) s2 xs2 vs) (R d')
  }.
 
 Section UINCL.
@@ -1371,7 +1416,7 @@ Context {cu:Checker_uincl}.
 
 Lemma ucheck_eP d e1 e2 d' :
   check_es d [::e1] [::e2] d' ->
-  wrequiv (R d) ((sem_pexpr true (p_globs p1))^~ e1) ((sem_pexpr true (p_globs p2))^~ e2) value_uincl.
+  wrequiv (R d) ((sem_pexpr1 true (p_globs p1))^~ e1) ((sem_pexpr2 true (p_globs p2))^~ e2) value_uincl.
 Proof.
   move=> /ucheck_esP -/(_ _ _ wdb_ok_true) h s t v hst he.
   have [|vs]:= h s t [::v] hst.
@@ -1382,8 +1427,8 @@ Qed.
 Lemma ucheck_lvalP d x1 x2 d' :
   check_lvals d [::x1] [::x2] d' ->
   forall v1 v2, value_uincl v1 v2 ->
-   wrequiv (R d) (λ s1 : estate, write_lval true (p_globs p1) x1 v1 s1)
-                        (λ s2 : estate, write_lval true (p_globs p2) x2 v2 s2) (R d').
+   wrequiv (R d) (λ s1 : estate, write_lval1 true (p_globs p1) x1 v1 s1)
+                        (λ s2 : estate, write_lval2 true (p_globs p2) x2 v2 s2) (R d').
 Proof.
   move=> /ucheck_lvalsP  -/(_ _ _ wdb_ok_true) h v1 v2 hu s t s' hst hx.
   have [||/=]:= h [::v1] [::v2] _ s t s' hst.
@@ -1405,19 +1450,6 @@ Proof.
   apply: ucheck_lvalP hxs v1 v2 hu.
 Qed.
 
-Lemma wequiv_opn_rel_uincl d de d' ii1 xs1 tg1 o es1  ii2 xs2 tg2 es2 :
-  check_es d es1 es2 de →
-  check_lvals de xs1 xs2 d' →
-  wequiv (R d) [:: MkI ii1 (Copn xs1 tg1 o es1)] [:: MkI ii2 (Copn xs2 tg2 o es2)] (R d').
-Proof.
-  move=> hes hxs.
-  apply wequiv_opn_uincl.
-  + by apply: ucheck_esP hes.
-  move=> v1 v2 hu; apply wrequiv_weaken with (R de) (R d') => //.
-  + by apply: check_esP_rel hes.
-  by apply: ucheck_lvalsP hxs v1 v2 hu.
-Qed.
-
 Lemma wequiv_assert_rel_uincl d de ii1 a1 ii2 a2 :
   (assert_allowed (WithAssert:=wa1) → assert_allowed (WithAssert:=wa2)) ->
   check_es d [::a1.2] [::a2.2] de ->
@@ -1494,19 +1526,26 @@ Proof.
   apply: check_esP_rel hes s1 s2 hR.
 Qed.
 
-Lemma wequiv_call_rel_uincl_R d de de' d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+Lemma wequiv_call_rel_uincl_R_wa d de de' d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
   (∀ d s1 s2, R d s1 s2 → escs s1 = escs s2 ∧ emem s1 = emem s2) →
   (forall scs mem s1 s2, R de s1 s2 ->
      R de' (with_scs (with_mem s1 mem) scs) (with_scs (with_mem s2 mem) scs)) →
   check_es d es1 es2 de →
   check_lvals de' xs1 xs2 d' →
+  (∀ s1 s2 vs1 vs2, R d s1 s2 → List.Forall2 value_uincl vs1 vs2 →
+     sem_pre1 p1 fn1 (mk_fstate vs1 s1) = ok () → sem_pre2 p2 fn2 (mk_fstate vs2 s2) = ok ()) →
   wequiv_f_ii (fun _ _ => fs_uincl) ii1 ii2 fn1 fn2 (fun _ _ _ _ => fs_uincl) →
+  (∀ vs1 vs2 fr1 fr2,
+    List.Forall2 value_uincl vs1 vs2 → fs_uincl fr1 fr2 →
+    sem_post1 p1 fn1 vs1 fr1 = ok () → sem_post2 p2 fn2 vs2 fr2 = ok ()) →
   wequiv (R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (R d').
 Proof.
-  move=> hsm hwith hes hxs hf.
-  apply wequiv_call with (fun _ _ => fs_uincl) (fun _ _ _ _ => fs_uincl) (List.Forall2 value_uincl).
+  move=> hsm hwith hes hxs hpre hf hpost.
+  apply wequiv_call_wa with (fun _ _ => fs_uincl) (fun _ _ _ _ => fs_uincl) (List.Forall2 value_uincl).
   + by apply: ucheck_esP hes.
+  + by apply hpre.
   + by rewrite /mk_fstate; move=> > /hsm [-> ->] ?.
+  + by move=> > [_ _]; apply hpost.
   + by apply hf.
   move=> fs1 fs2 fr1 fr2 _ [hscs hmem hu]; rewrite /upd_estate.
   move=> s1 s2 s1' hR.
@@ -1523,7 +1562,7 @@ Context {cu:Checker_eq}.
 
 Lemma echeck_eP d e1 e2 d' :
   check_es d [::e1] [::e2] d' ->
-  wrequiv (R d) ((sem_pexpr true (p_globs p1))^~ e1) ((sem_pexpr true (p_globs p2))^~ e2) eq.
+  wrequiv (R d) ((sem_pexpr1 true (p_globs p1))^~ e1) ((sem_pexpr2 true (p_globs p2))^~ e2) eq.
 Proof.
   move=> /echeck_esP -/(_ _ _ wdb_ok_true) h s t v hst he.
   have [|vs]:= h s t [::v] hst.
@@ -1534,8 +1573,8 @@ Qed.
 Lemma echeck_lvalP d x1 x2 d' :
   check_lvals d [::x1] [::x2] d' ->
   forall v,
-  wrequiv (R d) (λ s1 : estate, write_lval true (p_globs p1) x1 v s1)
-                        (λ s2 : estate, write_lval true (p_globs p2) x2 v s2) (R d').
+  wrequiv (R d) (λ s1 : estate, write_lval1 true (p_globs p1) x1 v s1)
+                        (λ s2 : estate, write_lval2 true (p_globs p2) x2 v s2) (R d').
 Proof.
   move=> /echeck_lvalsP  -/(_ _ _ wdb_ok_true) h v s t s' hst hx.
   have [|/=]:= h [::v] s t s' hst.
@@ -1556,19 +1595,6 @@ Proof.
   apply: echeck_lvalP hxs v.
 Qed.
 
-Lemma wequiv_opn_rel_eq d de d' ii1 xs1 tg1 o es1 ii2 xs2 tg2 es2 :
-  check_es d es1 es2 de →
-  check_lvals de xs1 xs2 d' →
-  wequiv (R d) [:: MkI ii1 (Copn xs1 tg1 o es1)] [:: MkI ii2 (Copn xs2 tg2 o es2)] (R d').
-Proof.
-  move=> hes hxs.
-  apply wequiv_opn_eq.
-  + by apply: echeck_esP hes.
-  move=> v; apply wrequiv_weaken with (R de) (R d') => //.
-  + by apply: check_esP_rel hes.
-  by apply: echeck_lvalsP hxs v.
-Qed.
-
 Lemma wequiv_assert_rel_eq d de ii1 a1 ii2 a2 :
   (assert_allowed (WithAssert:=wa1) → assert_allowed (WithAssert:=wa2)) ->
   check_es d [::a1.2] [::a2.2] de ->
@@ -1646,19 +1672,25 @@ Proof.
   apply: check_esP_rel hes s1 s2 hR.
 Qed.
 
-Lemma wequiv_call_rel_eq_R d de de' d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+Lemma wequiv_call_rel_eq_R_wa d de de' d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
   (∀ d s1 s2, R d s1 s2 → escs s1 = escs s2 ∧ emem s1 = emem s2) →
   (forall scs mem s1 s2, R de s1 s2 ->
      R de' (with_scs (with_mem s1 mem) scs) (with_scs (with_mem s2 mem) scs)) →
   check_es d es1 es2 de →
   check_lvals de' xs1 xs2 d' →
+  (∀ s1 s2 vs, R d s1 s2 →
+     sem_pre1 p1 fn1 (mk_fstate vs s1) = ok () → sem_pre2 p2 fn2 (mk_fstate vs s2) = ok ()) →
   wequiv_f_ii (fun _ _ => eq) ii1 ii2 fn1 fn2 (fun _ _ _ _ => eq) →
+  (∀ vs fr,
+    sem_post1 p1 fn1 vs fr = ok () → sem_post2 p2 fn2 vs fr = ok ()) →
   wequiv (R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (R d').
 Proof.
-  move=> hsm hwith hes hxs hf.
-  apply wequiv_call with (fun _ _ => eq) (fun _ _ _ _ => eq) eq.
+  move=> hsm hwith hes hxs hpre hf hpost.
+  apply wequiv_call_wa with (fun _ _ => eq) (fun _ _ _ _ => eq) eq.
   + by apply: echeck_esP hes.
+  + by move=> > hR <-; apply hpre.
   + by rewrite /mk_fstate; move=> > /hsm [-> ->] ->.
+  + by move=> > <- <-; apply hpost.
   + by apply hf.
   move=> > h1 <-; rewrite /upd_estate.
   move=> s1 s2 s1' hR.
@@ -1717,13 +1749,19 @@ Proof.
   by move=> scs mem s1 s2 [???].
 Qed.
 
-Lemma wequiv_call_rel_uincl d de d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+Lemma wequiv_call_rel_uincl_wa d de d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
   check_es d es1 es2 de →
   check_lvals de xs1 xs2 d' →
+  (∀ s1 s2 vs1 vs2,
+     st_rel R d s1 s2 → Forall2 value_uincl vs1 vs2 →
+     sem_pre1 p1 fn1 (mk_fstate vs1 s1) = ok () → sem_pre2 p2 fn2 (mk_fstate vs2 s2) = ok ()) →
   wequiv_f_ii (fun _ _ => fs_uincl) ii1 ii2 fn1 fn2 (fun _ _ _ _ => fs_uincl) →
+  (∀ vs1 vs2 fr1 fr2,
+     List.Forall2 value_uincl vs1 vs2 → fs_uincl fr1 fr2 →
+     sem_post1 p1 fn1 vs1 fr1 = ok () → sem_post2 p2 fn2 vs2 fr2 = ok ()) →
   wequiv (st_rel R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (st_rel R d').
 Proof.
-  apply wequiv_call_rel_uincl_R => //.
+  apply wequiv_call_rel_uincl_R_wa => //.
   + by move=> > [-> ->].
   by move=> scs mem s1 s2 [???].
 Qed.
@@ -1769,13 +1807,18 @@ Proof.
   by move=> scs mem s1 s2 [???].
 Qed.
 
-Lemma wequiv_call_rel_eq d de d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+Lemma wequiv_call_rel_eq_wa d de d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
   check_es d es1 es2 de →
   check_lvals de xs1 xs2 d' →
+  (∀ s1 s2 vs,
+     st_rel R d s1 s2 →
+     sem_pre1 p1 fn1 (mk_fstate vs s1) = ok () → sem_pre2 p2 fn2 (mk_fstate vs s2) = ok ()) →
   wequiv_f_ii (fun _ _ => eq) ii1 ii2 fn1 fn2 (fun _ _ _ _ => eq) →
+  (∀ vs fr,
+     sem_post1 p1 fn1 vs fr = ok () → sem_post2 p2 fn2 vs fr = ok ()) →
   wequiv (st_rel R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (st_rel R d').
 Proof.
-  apply wequiv_call_rel_eq_R => //.
+  apply wequiv_call_rel_eq_R_wa => //.
   + by move=> > [-> ->].
   by move=> scs mem s1 s2 [???].
 Qed.
@@ -1830,7 +1873,7 @@ Definition EventRels_and2 : EventRels E0 :=
 
 Lemma whoare_wequiv1 (P Q : rel_c) (P1 Q1 : Pred_c (wsw:=wsw1)) c1 c2:
   (forall s1 s2, P s1 s2 -> P1 s1) ->
-  hoare (wsw:=wsw1) (wa:=wa1) (dc:=dc1) (iEr := invErrT) p1 ev1 P1 c1 Q1 ->
+  hoare (wc:=wc1) (wa:=wa1) (wsw:=wsw1) (dc:=dc1) (iEr := invErrT) p1 ev1 P1 c1 Q1 ->
   wequiv p1 p2 ev1 ev2 P c1 c2 Q ->
   wequiv (rE0 := EventRels_and1) p1 p2 ev1 ev2 P c1 c2 (fun s1 s2 => Q1 s1 /\ Q s1 s2).
 Proof.
@@ -1881,7 +1924,7 @@ Lemma wequiv_write1 (P Q : rel_c) c1 c2:
      (fun s1 s2 => s1_.(evm) =[\ write_c c1] s1.(evm) /\ Q s1 s2)).
 Proof.
   move=> /wkequivP' h s1_; apply/wkequivP' => s1__ s2_.
-  have /(_ s1_) hw := [elaborate it_writeP (wa:=wa1) (dc:=dc1) p1 ev1 c1 ].
+  have /(_ s1_) hw := [elaborate it_writeP (wc:=wc1) (wa:=wa1) (dc:=dc1) p1 ev1 c1 ].
   have h_ : forall s1 s2, (s1 = s1_ /\ s2 = s2_) /\ P s1 s2 -> s1 = s1_.
   + by move=> ?? [] [].
   have {h_ h}:= whoare_wequiv1 h_ hw (h s1_ s2_).
@@ -1910,8 +1953,8 @@ Qed.
 
 End WEQUIV_WRITE.
 
-Notation sem_fun_full1 := (sem_fun_full (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1)).
-Notation sem_fun_full2 := (sem_fun_full (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2)).
+Notation sem_fun_full1 := (sem_fun_full (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (wc:=wc1) (wa:=wa1) (sip:=sip) (pT:=pT1) (scP:= scP1)).
+Notation sem_fun_full2 := (sem_fun_full (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (wc:=wc2) (wa:=wa2) (sip:=sip) (pT:=pT2) (scP:= scP2)).
 
 Section WEQUIV_FUN.
 
@@ -1932,6 +1975,8 @@ Definition wequiv_fun_body_hyp_rec' (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
   RPreF fn1 fn2 fs1 fs2 ->
   forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
   exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
+    sem_pre (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (dc:=dc1) (pT:=pT1) p1 fn1 fs1 = ok tt ->
+    sem_pre (wsw:=wsw2) (wc:=wc2) (wa:=wa2) (dc:=dc2) (pT:=pT2) p2 fn2 fs2 = ok tt /\
     forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
     exists2 s21,
       initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
@@ -1940,7 +1985,28 @@ Definition wequiv_fun_body_hyp_rec' (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
           , fd2.(f_body) = tbody ++ epilogue
           , wequiv (sem_F1 := sem_F1 fn1) (sem_F2 := sem_F2 fn2) (rE0:=relEvent_recCall spec) p1 p2 ev1 ev2 P fd1.(f_body) tbody Q
           , ∀ s₀, wequiv (sem_F1 := sem_F1 fn1) (sem_F2 := sem_F2 fn2) (rE0:=relEvent_recCall spec) p1 p2 ev1 ev2 (λ s t, s = s₀ ∧ Q s t ∧ ∃ fs, finalize_funcall (dc := dc1) fd1 s = ok fs) [::] epilogue (λ s t, s = s₀ ∧ Q s t)
-          & wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)].
+          , wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)
+          & forall fr1 fr2, RPostF fn1 fn2 fs1 fs2 fr1 fr2 ->
+               sem_post (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (dc:=dc1) (pT:=pT1) p1 fn1 fs1.(fvals) fr1 = ok () -> 
+               sem_post (wsw:=wsw2) (wc:=wc2) (wa:=wa2) (dc:=dc2) (pT:=pT2) p2 fn2 fs2.(fvals) fr2 = ok ()].
+
+Definition wequiv_fun_body_hyp_rec_wa (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
+  forall fs1 fs2,
+  RPreF fn1 fn2 fs1 fs2 ->
+  forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
+  exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
+    sem_pre (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (dc:=dc1) (pT:=pT1) p1 fn1 fs1 = ok tt ->
+    sem_pre (wsw:=wsw2) (wc:=wc2) (wa:=wa2) (dc:=dc2) (pT:=pT2) p2 fn2 fs2 = ok tt /\
+    forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
+      exists2 s21,
+        initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
+        exists (P Q : rel_c),
+          [/\ P s11 s21
+            , wequiv (sem_F1 := sem_F1 fn1) (sem_F2 := sem_F2 fn2) (rE0:=relEvent_recCall spec) p1 p2 ev1 ev2 P fd1.(f_body) fd2.(f_body) Q
+            , wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)
+            & (forall fr1 fr2, RPostF fn1 fn2 fs1 fs2 fr1 fr2 ->
+               sem_post (wsw:=wsw1) (wc:=wc1) (wa:=wa1) (dc:=dc1) (pT:=pT1) p1 fn1 fs1.(fvals) fr1 = ok () ->
+               sem_post (wsw:=wsw2) (wc:=wc2) (wa:=wa2) (dc:=dc2) (pT:=pT2) p2 fn2 fs2.(fvals) fr2 = ok ())].
 
 #[local]
 Lemma xrutt_weaken_aux post (sem1 : itree (recCall +' E) fstate) (sem2 : itree (recCall +' E) fstate) :
@@ -1963,9 +2029,9 @@ Proof.
   by case: mfun1 => // ?; case: mfun1.
 Qed.
 
-Notation isem_fun_def1 := (isem_fun_def (wsw:=wsw1) (wa:=wa1) (dc:=dc1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1) (sem_F:=sem_F1)).
+Notation isem_fun_def1 := (isem_fun_def (wsw:=wsw1) (dc:=dc1) (wc:=wc1) (wa:=wa1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1) (sem_F:=sem_F1)).
 
-Notation isem_fun_def2 := (isem_fun_def (wsw:=wsw2) (wa:=wa2) (dc:=dc2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2) (sem_F:=sem_F2)).
+Notation isem_fun_def2 := (isem_fun_def (wsw:=wsw2) (dc:=dc2) (wc:=wc2) (wa:=wa2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2) (sem_F:=sem_F2)).
 
 Notation wiequiv_f rpreF fn1 fn2 rpostF :=
    (wkequiv_io (rpreF fn1 fn2) (isem_fun_def1 p1 ev1 fn1) (isem_fun_def2 p2 ev2 fn2) (rpostF fn1 fn2)).
@@ -1990,35 +2056,8 @@ Proof.
   apply xrutt_weaken_aux.
 Qed.
 
-End REC'.
-
-Section REC.
-
-Context (sem_F1 : funname -> sem_Fun1 (recCall +' E)).
-Context (sem_F2 : funname -> sem_Fun2 (recCall +' E)).
-
-Definition wequiv_fun_body_hyp_rec (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
-  forall fs1 fs2,
-  RPreF fn1 fn2 fs1 fs2 ->
-  forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
-  exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
-    forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
-    exists2 s21,
-      initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
-      exists (P Q : rel_c),
-        [/\ P s11 s21
-          , wequiv (sem_F1 := sem_F1 fn1) (sem_F2 := sem_F2 fn2) (rE0:=relEvent_recCall spec) p1 p2 ev1 ev2 P fd1.(f_body) fd2.(f_body) Q
-          & wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)].
-
-Notation isem_fun_def1 := (isem_fun_def (wsw:=wsw1) (wa:=wa1) (dc:=dc1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1) (sem_F:=sem_F1)).
-
-Notation isem_fun_def2 := (isem_fun_def (wsw:=wsw2) (wa:=wa2) (dc:=dc2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2) (sem_F:=sem_F2)).
-
-Notation wiequiv_f rpreF fn1 fn2 rpostF :=
-   (wkequiv_io (rpreF fn1 fn2) (isem_fun_def1 p1 ev1 fn1) (isem_fun_def2 p2 ev2 fn2) (rpostF fn1 fn2)).
-
-Lemma wequiv_fun_ind :
-  (forall fn1 fn2, wequiv_fun_body_hyp_rec rpreF fn1 fn2 rpostF) ->
+Lemma wequiv_fun_ind_wa :
+  (forall fn1 fn2, wequiv_fun_body_hyp_rec_wa rpreF fn1 fn2 rpostF) ->
   forall fn1 fn2,
   wiequiv_f rpreF fn1 fn2 rpostF.
 Proof.
@@ -2027,13 +2066,13 @@ Proof.
                                (RPostInv := (@RPostD spec)).
   + move=> {hpre fn1 fn2 fs1 fs2}.
     move=> _ _ [ii1 fn1 fs1] [ii2 fn2 fs2] hpre.
-    have := wequiv_fun_body (hbody fn1 fn2) hpre.
+    have := wequiv_fun_body_wa (hbody fn1 fn2) hpre.
     by apply xrutt_weaken_aux.
-  have := wequiv_fun_body (hbody fn1 fn2) hpre.
+  have := wequiv_fun_body_wa (hbody fn1 fn2) hpre.
   apply xrutt_weaken_aux.
 Qed.
 
-End REC.
+End REC'.
 
 Definition wequiv_rec P c1 c2 Q :=
   wequiv (rE0:=relEvent_recCall spec) p1 p2 ev1 ev2 P c1 c2 Q.
@@ -2045,27 +2084,33 @@ Definition wequiv_rec_ir P i1 ii1 i2 ii2 Q :=
 
 Definition wiequiv_f rpreF fn1 fn2 rpostF :=
    (wkequiv_io (rpreF fn1 fn2)
-      (isem_fun1 p1 ev1 fn1)
-      (isem_fun2 p2 ev2 fn2)
+      (isem_fun (wsw:=wsw1) (dc:=dc1) (wc:=wc1) (wa:=wa1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1) p1 ev1 fn1)
+      (isem_fun (wsw:=wsw2) (dc:=dc2) (wc:=wc2) (wa:=wa2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2) p2 ev2 fn2)
      (rpostF fn1 fn2)).
 
-Lemma wequiv_fun_get fn1 fn2 Pf Qf :
+Lemma wequiv_fun_get_wa fn1 fn2 Pf Qf :
   (forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
     wiequiv_f (fun fn1 fn2 fs1 fs2 =>
-      Pf fn1 fn2 fs1 fs2 /\
-      exists s1, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1)
+      [/\ Pf fn1 fn2 fs1 fs2
+        , sem_pre (dc:=dc1) (wsw:=wsw1) (wc:=wc1) (wa:=wa1) p1 fn1 fs1 = ok tt
+        & exists s1, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1])
       fn1 fn2 Qf) ->
   wiequiv_f Pf fn1 fn2 Qf.
 Proof.
   move=> hfd fs1 fs2 hpre /=.
   rewrite !isem_call_unfold /isem_fun_body /kget_fundef.
   case heq : get_fundef => [fd1 | ].
-  + rewrite /= bind_ret_l.
-    case heq1 : initialize_funcall => [s1 | e].
-    + have hpre' : Pf fn1 fn2 fs1 fs2 /\ exists s1, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1.
-      + by split => //; exists s1.
-      have /= := hfd _ heq _ _ hpre'.
-      by rewrite !isem_call_unfold /isem_fun_body /kget_fundef heq /= bind_ret_l heq1.
+  + rewrite /= bind_ret_l /isem_pre.
+    case heq0 : (sem_pre p1 fn1 fs1) => [ [] | ].
+    + case heq1 : initialize_funcall => [s1 | e].
+      + have hpre' :
+          [/\ Pf fn1 fn2 fs1 fs2, sem_pre (dc:=dc1) (wsw:=wsw1) (wc:=wc1) (wa:=wa1) p1 fn1 fs1 = ok tt
+            & exists s1, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s1].
+        + by split => //; exists s1.
+        have /= := hfd _ heq _ _ hpre'.
+        by rewrite !isem_call_unfold /isem_fun_body /kget_fundef heq /= bind_ret_l /isem_pre heq0 heq1.
+      rewrite bind_ret_l /= bind_vis; apply xrutt_CutL.
+      by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
     rewrite /= bind_vis; apply xrutt_CutL.
     by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
   rewrite /= bind_vis; apply xrutt_CutL.
@@ -2076,13 +2121,101 @@ End WEQUIV_FUN.
 
 End WITHASSERT.
 
+Section CONTEXT.
+Context {wa1 wa2: WithAssert}.
+Context {E E0 : Type -> Type} {sem_F1 : sem_Fun1 E} {sem_F2 : sem_Fun2 E}
+    {wE: with_Error E E0} {rE0 : EventRels E0}.
+Context (p1 : prog1) (p2 : prog2) (ev1: extra_val_t1) (ev2 : extra_val_t2).
+
+Notation sem_pexprs1 := (sem_pexprs (wa:=wa1)).
+Notation sem_pexprs2 := (sem_pexprs (wa:=wa2)).
+Notation write_lvals1 := (write_lvals (wa:=wa1)).
+Notation write_lvals2 := (write_lvals (wa:=wa2)).
+
+Lemma wequiv_opn_eq {wc:WithCatch} P Q ii1 xs1 at1 o es1 ii2 xs2 at2 es2 :
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s es1)
+           (fun s => sem_pexprs2 true (p_globs p2) s es2) eq ->
+  (forall vs,
+    wrequiv P (fun s1 => write_lvals1 true (p_globs p1) s1 xs1 vs)
+             (fun s2 => write_lvals2 true (p_globs p2) s2 xs2 vs) Q) ->
+  wequiv (wa1:=wa1) p1 p2 ev1 ev2 P [:: MkI ii1 (Copn xs1 at1 o es1)] [:: MkI ii2 (Copn xs2 at2 o es2)] Q.
+Proof.
+  move=> he hx; apply wequiv_opn with eq eq => //.
+  + by move=> *; apply wrequiv_eq.
+  by move=> > <-; apply hx.
+Qed.
+
+Lemma wequiv_opn_uincl P Q ii1 xs1 at1 o es1 ii2 xs2 at2 es2 :
+  wrequiv P (fun s => sem_pexprs1 true (p_globs p1) s es1)
+           (fun s => sem_pexprs2 true (p_globs p2) s es2) (Forall2 value_uincl) ->
+  (forall vs1 vs2,
+    Forall2 value_uincl vs1 vs2 ->
+    wrequiv P (fun s1 => write_lvals1 true (p_globs p1) s1 xs1 vs1)
+             (fun s2 => write_lvals2 true (p_globs p2) s2 xs2 vs2) Q) ->
+  wequiv (wa1:=wa1) p1 p2 ev1 ev2 P [:: MkI ii1 (Copn xs1 at1 o es1)] [:: MkI ii2 (Copn xs2 at2 o es2)] Q.
+Proof.
+  move=> he; apply wequiv_opn with (Forall2 value_uincl) => //.
+  move=> *; apply wrequiv_exec_sopn.
+Qed.
+
+Section UINCL.
+Context {D:Type}.
+Context (R : D -> estate1 -> estate2 -> Prop).
+Context {ce : Checker_e R}.
+Context {cu: (Checker_uincl p1 p2 (wa1:=wa1)) R ce }.
+
+Lemma wequiv_opn_rel_uincl d de d' ii1 xs1 tg1 o es1  ii2 xs2 tg2 es2 :
+  check_es d es1 es2 de →
+  check_lvals de xs1 xs2 d' →
+  wequiv (wa1:=wa1) p1 p2 ev1 ev2 (R d) [:: MkI ii1 (Copn xs1 tg1 o es1)] [:: MkI ii2 (Copn xs2 tg2 o es2)] (R d').
+Proof.
+  move=> hes hxs.
+  apply wequiv_opn_uincl.
+  + apply: ucheck_esP hes; apply wdb_ok_true.
+  move=> v1 v2 hu; apply wrequiv_weaken with (R de) (R d') => //.
+  + by apply: check_esP_rel hes.
+  apply: ucheck_lvalsP hxs v1 v2 hu; apply wdb_ok_true.
+Qed.
+End UINCL.
+
+Section EQ.
+Context {D:Type} {wc: WithCatch}.
+Context (R : D -> estate1 -> estate2 -> Prop).
+Context {ce : Checker_e R}.
+Context {cu: (Checker_eq p1 p2 (wa1:=wa1)) R ce}.
+
+Lemma wequiv_opn_rel_eq d de d' ii1 xs1 tg1 o es1 ii2 xs2 tg2 es2 :
+  check_es d es1 es2 de →
+  check_lvals de xs1 xs2 d' →
+  wequiv (wa1:=wa1) p1 p2 ev1 ev2 (R d) [:: MkI ii1 (Copn xs1 tg1 o es1)] [:: MkI ii2 (Copn xs2 tg2 o es2)] (R d').
+Proof.
+  move=> hes hxs.
+  apply wequiv_opn_eq.
+  + by apply: echeck_esP hes; apply wdb_ok_true.
+  move=> v; apply wrequiv_weaken with (R de) (R d') => //.
+  + by apply: check_esP_rel hes.
+  by apply: echeck_lvalsP hxs v; apply wdb_ok_true.
+Qed.
+
+End EQ.
+
+End CONTEXT.
+
 Section NOASSERT.
 
+Notation isem_fun1 := (isem_fun (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1)).
+Notation isem_fun2 := (isem_fun (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2)).
+
+Section WEQUIV_CORE.
+
 Context {E E0 : Type -> Type} {sem_F1 : sem_Fun1 E} {sem_F2 : sem_Fun2 E}
     {wE: with_Error E E0} {rE0 : EventRels E0}.
 
 Context (p1 : prog1) (p2 : prog2) (ev1: extra_val_t1) (ev2 : extra_val_t2).
 
+Notation sem_fun1 := (sem_fun (pT := pT1) (sem_Fun := sem_F1)).
+Notation sem_fun2 := (sem_fun (pT := pT2) (sem_Fun := sem_F2)).
+
 Lemma wequiv_noassert ii a c P Q :
   wequiv p1 p2 ev1 ev2 P [:: MkI ii (Cassert a)] c Q.
 Proof.
@@ -2091,13 +2224,165 @@ Proof.
   by rewrite /errcutoff /is_error /subevent /resum /fromErr mid12.
 Qed.
 
+Lemma wequiv_call (Pf : relPreF) (Qf : relPostF) Rv P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  wrequiv P (fun s => sem_pexprs (~~ (@direct_call dc1)) (p_globs p1) s es1)
+            (fun s => sem_pexprs (~~ (@direct_call dc2)) (p_globs p2) s es2) Rv ->
+  (forall s1 s2 vs1 vs2,
+     P s1 s2 -> Rv vs1 vs2 -> Pf fn1 fn2 (mk_fstate vs1 s1) (mk_fstate vs2 s2)) ->
+  wequiv_f_ii p1 p2 ev1 ev2 Pf ii1 ii2 fn1 fn2 Qf ->
+  (forall fs1 fs2 fr1 fr2,
+    Pf fn1 fn2 fs1 fs2 -> Qf fn1 fn2 fs1 fs2 fr1 fr2 ->
+    wrequiv P (upd_estate (~~ (@direct_call dc1)) (p_globs p1) xs1 fr1)
+              (upd_estate (~~ (@direct_call dc2)) (p_globs p2) xs2 fr2) Q) ->
+  wequiv p1 p2 ev1 ev2 P [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] Q.
+Proof.
+  by move=> hes hPf hf; apply: (wequiv_call_wa hes _ hPf _ hf).
+Qed.
+
+Lemma wequiv_call_eq P Q ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  wrequiv P (fun s => sem_pexprs (~~ (@direct_call dc1)) (p_globs p1) s es1)
+            (fun s => sem_pexprs (~~ (@direct_call dc2)) (p_globs p2) s es2) eq ->
+  (forall s1 s2 vs,
+     P s1 s2 -> rpreF (eS:=eq_spec) fn1 fn2 (mk_fstate vs s1) (mk_fstate vs s2)) ->
+  wequiv_f_ii p1 p2 ev1 ev2 (rpreF (eS:=eq_spec)) ii1 ii2 fn1 fn2 (rpostF (eS:=eq_spec)) ->
+  (forall fs,
+    wrequiv P (upd_estate (~~ (@direct_call dc1)) (p_globs p1) xs1 fs)
+              (upd_estate (~~ (@direct_call dc2)) (p_globs p2) xs2 fs) Q) ->
+  wequiv p1 p2 ev1 ev2 P [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] Q.
+Proof.
+  by move=> hes hPf hf; apply: (wequiv_call_eq_wa hes _ hPf hf).
+Qed.
+
+Definition wequiv_fun_body_hyp (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
+  forall fs1 fs2,
+  RPreF fn1 fn2 fs1 fs2 ->
+  forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
+  exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
+    exists (P Q : rel_c),
+      forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
+      exists s21,
+        [/\ initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21
+          , P s11 s21
+          , wequiv p1 p2 ev1 ev2 P fd1.(f_body) fd2.(f_body) Q
+          & wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)
+        ].
+
+Lemma wequiv_fun_body RPreF fn1 fn2 RPostF :
+  wequiv_fun_body_hyp RPreF fn1 fn2 RPostF ->
+  wequiv_f_body p1 p2 ev1 ev2 RPreF fn1 fn2 RPostF.
+Proof.
+  move=> h; apply wequiv_fun_body_wa => fs1 fs2 hpre fd1 hfd1.
+  have [fd2 hfd2 [P] [Q] {}h]:= h fs1 fs2 hpre fd1 hfd1.
+  rewrite /sem_pre /sem_post /=; exists fd2 => // _; split => //.
+  by move=> s1 /h [s2] [*]; exists s2 => //; exists P, Q.
+Qed.
+
+Lemma wequiv_call_rel_uincl_R
+  {D : Type} [R : D → estate1 → estate2 → Prop] {ce : Checker_e R} {cu : Checker_uincl p1 p2 (R:=R)}
+  d de de' d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  (∀ d s1 s2, R d s1 s2 → escs s1 = escs s2 ∧ emem s1 = emem s2) →
+  (forall scs mem s1 s2, R de s1 s2 ->
+     R de' (with_scs (with_mem s1 mem) scs) (with_scs (with_mem s2 mem) scs)) →
+  check_es d es1 es2 de →
+  check_lvals de' xs1 xs2 d' →
+  wequiv_f_ii p1 p2 ev1 ev2 (fun _ _ => fs_uincl) ii1 ii2 fn1 fn2 (fun _ _ _ _ => fs_uincl) →
+  wequiv p1 p2 ev1 ev2 (R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (R d').
+Proof.
+  move=> hscm hde' hes hxs hf.
+  by apply: (wequiv_call_rel_uincl_R_wa (cu:=cu) hscm hde' hes hxs _ hf).
+Qed.
+
+Lemma wequiv_call_rel_eq_R
+  {D : Type} [R : D → estate1 → estate2 → Prop] {ce : Checker_e R} {cu : Checker_eq p1 p2 (R:=R)}
+  d de de' d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  (∀ d s1 s2, R d s1 s2 → escs s1 = escs s2 ∧ emem s1 = emem s2) →
+  (forall scs mem s1 s2, R de s1 s2 ->
+     R de' (with_scs (with_mem s1 mem) scs) (with_scs (with_mem s2 mem) scs)) →
+  check_es d es1 es2 de →
+  check_lvals de' xs1 xs2 d' →
+  wequiv_f_ii p1 p2 ev1 ev2 (fun _ _ => eq) ii1 ii2 fn1 fn2 (fun _ _ _ _ => eq) →
+  wequiv p1 p2 ev1 ev2 (R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (R d').
+Proof.
+  move=> hscm hde' hes hxs hf.
+  by apply: (wequiv_call_rel_eq_R_wa (cu:=cu) hscm hde' hes hxs _ hf).
+Qed.
+
+Lemma wequiv_call_rel_uincl
+  {D : Type} [R : D → vm1_t → vm2_t → Prop] {ce : Checker_e (st_rel R)} {cu : Checker_uincl p1 p2 (R:=st_rel R)}
+  d de d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  check_es d es1 es2 de →
+  check_lvals de xs1 xs2 d' →
+  wequiv_f_ii p1 p2 ev1 ev2 (fun _ _ => fs_uincl) ii1 ii2 fn1 fn2 (fun _ _ _ _ => fs_uincl) →
+  wequiv p1 p2 ev1 ev2 (st_rel R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (st_rel R d').
+Proof.
+  move=> hes hxs hf.
+  by apply: (wequiv_call_rel_uincl_wa (cu:=cu) hes hxs _ hf).
+Qed.
+
+Lemma wequiv_call_rel_eq
+  {D : Type} [R : D → vm1_t → vm2_t → Prop] {ce : Checker_e (st_rel R)} {cu : Checker_eq p1 p2 (R:=st_rel R)}
+  d de d' ii1 xs1 fn1 es1 ii2 xs2 fn2 es2 :
+  check_es d es1 es2 de →
+  check_lvals de xs1 xs2 d' →
+  wequiv_f_ii p1 p2 ev1 ev2 (fun _ _ => eq) ii1 ii2 fn1 fn2 (fun _ _ _ _ => eq) →
+  wequiv p1 p2 ev1 ev2 (st_rel R d) [:: MkI ii1 (Ccall xs1 fn1 es1)] [:: MkI ii2 (Ccall xs2 fn2 es2)] (st_rel R d').
+Proof.
+  move=> hes hxs hf.
+  by apply: (wequiv_call_rel_eq_wa (cu:=cu) hes hxs _ hf).
+Qed.
+
+End WEQUIV_CORE.
+
+Notation sem_fun_full1 := (sem_fun_full (wsw:=wsw1) (dc:=dc1) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT1) (scP:= scP1)).
+Notation sem_fun_full2 := (sem_fun_full (wsw:=wsw2) (dc:=dc2) (ep:=ep) (spp:=spp) (sip:=sip) (pT:=pT2) (scP:= scP2)).
+
+Notation wiequiv_f_ii := (wequiv_f_ii (sem_F1 := sem_fun_full1) (sem_F2 := sem_fun_full2)).
+Notation wiequiv   := (wequiv (sem_F1 := sem_fun_full1) (sem_F2 := sem_fun_full2)).
+
+Section WEQUIV_FUN.
+
+Context {E E0 : Type -> Type} {wE: with_Error E E0} {rE0 : EventRels E0}.
+
+Context (p1 : prog1) (p2 : prog2) (ev1: extra_val_t1) (ev2 : extra_val_t2)  (spec : EquivSpec).
+
+Definition wequiv_fun_body_hyp_rec (RPreF:relPreF) fn1 fn2 (RPostF:relPostF) :=
+  forall fs1 fs2,
+  RPreF fn1 fn2 fs1 fs2 ->
+  forall fd1, get_fundef (p_funcs p1) fn1 = Some fd1 ->
+  exists2 fd2, get_fundef (p_funcs p2) fn2 = Some fd2 &
+    forall s11, initialize_funcall (dc:=dc1) p1 ev1 fd1 fs1 = ok s11 ->
+      exists2 s21,
+        initialize_funcall (dc:=dc2) p2 ev2 fd2 fs2 = ok s21 &
+        exists (P Q : rel_c),
+        [/\ P s11 s21
+          , wequiv_rec p1 p2 ev1 ev2 spec P fd1.(f_body) fd2.(f_body) Q
+          & wrequiv Q (finalize_funcall (dc:=dc1) fd1) (finalize_funcall (dc:=dc2) fd2) (RPostF fn1 fn2 fs1 fs2)].
+
+Lemma wequiv_fun_ind :
+  (forall fn1 fn2, wequiv_fun_body_hyp_rec rpreF fn1 fn2 rpostF) ->
+  forall fn1 fn2,
+  wiequiv_f p1 p2 ev1 ev2 rpreF fn1 fn2 rpostF.
+Proof.
+  move=> hrec.
+  apply wequiv_fun_ind_wa => fn1 fn2 fs1 fs2 /hrec{}h fd1 {}/h [fd2 hfd2 h].
+  exists fd2 => // _; split => // s1 {}/h [s2 ? [P] [Q] [*]]; exists s2 => //.
+  by exists P, Q.
+Qed.
+
+End WEQUIV_FUN.
+
 End NOASSERT.
 
 End RELATIONAL.
 
 Arguments wequiv_fun_rec {_ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _}.
 
-(* Notation wiequiv_f := (wequiv_f (sem_F1 := sem_fun_full) (sem_F2 := sem_fun_full)). *)
+Notation wiequiv_f_wa wc1 wc2 wa1 wa2 :=
+  (wiequiv_f (wc1 := wc1) (wc2 := wc2) (wa1 := wa1) (wa2 := wa2) ).
+
+Notation wiequiv_wa wc1 wc2 wa1 wa2 :=
+  (wequiv (sem_F1 := sem_fun_full (wc:=wc1) (wa:=wa1)) (sem_F2 := sem_fun_full (wc:=wc2) (wa:=wa2))).
+
 Notation wiequiv   := (wequiv (sem_F1 := sem_fun_full) (sem_F2 := sem_fun_full)).
 
 Lemma st_relP {syscall_state : Type} {ep : EstateParams syscall_state} {wsw : WithSubWord}
@@ -2114,6 +2399,8 @@ Context
   {syscall_state : Type}
   {ep : EstateParams syscall_state}
   {spp : SemPexprParams}
+  {wc : WithCatch }
+  {wa : WithAssert}
   {asm_op: Type}
   {sip : SemInstrParams asm_op syscall_state}
   {pT : progT}
@@ -2161,13 +2448,12 @@ Qed.
 
 End SYSCALL.
 
-Arguments Checker_eq {syscall_state} {ep spp} {asm_op} {sip pT1 pT2 wsw1 wsw2 dc1 dc2}
+Arguments Checker_eq {syscall_state} {ep spp} {asm_op} {sip pT1 pT2 wsw1 wsw2 dc1 dc2 wc1 wc2 wa1 wa2}
   _ _ {D} [R] ce.
 
-Arguments Checker_uincl {syscall_state} {ep spp} {asm_op} {sip pT1 pT2 wsw1 wsw2 dc1 dc2}
+Arguments Checker_uincl {syscall_state} {ep spp} {asm_op} {sip pT1 pT2 wsw1 wsw2 dc1 dc2 wc1 wc2 wa1 wa2}
   _ _ {D} [R] ce.
 
-
 Class EventRels_trans {E0 : Type -> Type} (rE12 rE23 rE13 : EventRels E0) :=
   { ERpre_trans : forall T1 T2 T3 (e1 : E0 T1) (e2 : E0 T2) (e3 : E0 T3),
        EPreRel0 (rE0:=rE12) e1 e2 → EPreRel0 (rE0:=rE23) e2 e3 → EPreRel0 (rE0:=rE13) e1 e3;
@@ -2187,6 +2473,7 @@ Context
   {E E0 : Type -> Type}
   {wE : with_Error E E0}
   {wsw1 wsw2 wsw3 : WithSubWord}
+  {wc1 wc2 wc3 : WithCatch }
   {wa1 wa2 wa3 : WithAssert}
   {scP1 : semCallParams (wsw := wsw1) (pT := pT1)}
   {scP2 : semCallParams (wsw := wsw2) (pT := pT2)}
@@ -2213,18 +2500,21 @@ Notation EPost13 := (EPostRel (rE0 := rE13)).
 Notation wiequiv_f12 :=
   (wiequiv_f
      (scP1 := scP1) (scP2 := scP2)
+     (wc1 := wc1) (wc2:= wc2)
      (wa1 := wa1) (wa2 := wa2)
      (dc1 := dc1) (dc2 := dc2)
      (rE0 := rE12)).
 Notation wiequiv_f23 :=
   (wiequiv_f
      (scP1 := scP2) (scP2 := scP3)
+     (wc1 := wc2) (wc2:= wc3)
      (wa1 := wa2) (wa2 := wa3)
      (dc1 := dc2) (dc2 := dc3)
      (rE0 := rE23)).
 Notation wiequiv_f13 :=
   (wiequiv_f
      (scP1 := scP1) (scP2 := scP3)
+     (wc1 := wc1) (wc2:= wc3)
      (wa1 := wa1) (wa2 := wa3)
      (dc1 := dc1) (dc2 := dc3)
      (rE0 := rE13)).
diff --git a/proofs/lang/safety.v b/proofs/lang/safety.v
new file mode 100644
index 0000000000..399d3c300d
--- /dev/null
+++ b/proofs/lang/safety.v
@@ -0,0 +1,381 @@
+From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
+Require Import expr compiler_util word.
+Require Export safety_shared.
+
+Module Import E.
+
+  Definition pass : string := "safety".
+
+  Definition ierror msg := {|
+    pel_msg      := PPEstring msg;
+    pel_fn       := None;
+    pel_fi       := None;
+    pel_ii       := None;
+    pel_vi       := None;
+    pel_pass     := Some pass;
+    pel_internal := true
+  |}.
+
+End E.
+
+Section SAFETY.
+Context `{asmop:asmOp} {pd: PointerData} {msfsz : MSFsize}.
+
+Definition sc_var (x:var_i) :=
+  if is_aarr (vtype x) then [::]
+  else [:: Pis_var_init x].
+
+Definition sc_gvar x :=
+  if is_lvar x then sc_var (gv x)
+  else [::].
+
+Definition sc_is_aligned_if al aa sz e :=
+  if (al == Unaligned) || (aa == AAscale) then [::]
+  else [:: eis_aligned e sz].
+
+Definition efalse := Pbool false.
+Definition sc_false := [:: efalse].
+
+(* FIXME : find better name *)
+Definition sc_in_bound' ty e1 e2 :=
+  match ty with
+  | aarr ws len =>
+    [:: eand (elei ezero e1) (elei (eaddi e1 e2) (Pconst (arr_size ws len)))]
+  | _ => sc_false
+  end.
+
+Definition sc_in_bound ty aa sz e elen :=
+  sc_in_bound' ty (emk_scale aa sz e) elen.
+
+Definition type_of_expr (e:pexpr) : atype :=
+  match e with
+  | Pconst _ => aint
+  | Pbool _ => abool
+  | Parr_init ws len => aarr ws len
+  | Pvar x => vtype (gv x)
+  | Pget al aa ws x e => aword ws
+  | Psub al ws len x e => aarr ws len
+  | Pload al ws e => aword ws
+  | Papp1 o e => (type_of_op1 o).2
+  | Papp2 o e1 e2 => (type_of_op2 o).2
+  | PappN o es => (type_of_opN o).2
+  | Pif ty e1 e2 e3 => ty
+  | Pbig ei o v e es el => (type_of_op2 o).2
+  | Pis_var_init _ => abool
+  | Pis_mem_init _ _ => abool
+  end.
+
+Definition sc_arr_init ty x aa sz e :=
+  match ty with
+  | aarr ws len =>
+    if is_lvar x then
+      let lo := emk_scale aa sz e in
+      [:: PappN (Ois_arr_init (Z.to_pos (arr_size ws len))) [:: Pvar x; lo; Pconst (wsize_size sz)]]
+    else
+      [::]
+  | _ => sc_false
+  end.
+
+Definition sc_arr_get (x:gvar) al aa sz e :=
+  let ty := vtype (gv x) in
+  sc_is_aligned_if al aa sz e ++
+  sc_in_bound ty aa sz e (Pconst (wsize_size sz)) ++
+  sc_arr_init ty (Pvar x) aa sz e.
+
+Definition sc_mem_valid (e: pexpr) sz := [:: Pis_mem_init e (wsize_size sz)].
+
+(* Req: Pointer Data*)
+Definition eint_of_word (sg:signedness) sz e := Papp1 (Oint_of_word sg sz) e.
+
+Definition sc_is_aligned_if_m al sz e :=
+  if (al == Unaligned) then [::]
+  else [:: eis_aligned (eint_of_word Unsigned Uptr e) sz].
+(* ----- *)
+
+Definition toint sg sz e := Papp1 (Owi1 sg (WIint_of_wint sz)) e.
+
+Definition sc_op1 := sc_op1 toint.
+
+Definition sc_op2 o e1 e2 :=
+match is_wi2 o with
+| Some (sg, sz, o) =>
+  let e1 := toint sg sz e1 in
+  let e2 := match o with
+            | WIshl | WIshr => toint Unsigned U8 e2
+            | _ => toint sg sz e2
+            end in
+  sc_wiop2 sg sz o e1 e2
+| _ => match o with
+  | Odiv sg (Op_w sz) => sc_divmod sg sz (eint_of_word sg sz e1) (eint_of_word sg sz e2)
+  | Omod sg (Op_w sz) => sc_divmod sg sz (eint_of_word sg sz e1) (eint_of_word sg sz e2)
+  | _ => [::]
+  end
+end.
+
+Definition sc_op2_big (o : sop2) :=
+  match o with
+  | Odiv sg (Op_w sz) => false
+  | Omod sg (Op_w sz) => false
+  | Owi2 _ _ o' =>
+      match o' with
+      | WIadd | WImul | WIsub | WIdiv | WImod
+      | WIshl => false
+      | WIshr | WIeq | WIneq | WIlt | WIle
+      | WIgt | WIge => true
+      end
+  | Obeq | Oand | Oor | Oadd _ | Omul _ | Osub _
+  | Oland _ | Olor _ | Olxor _ |  Olsr _ | Olsl _
+  | Oasr _ | Oror _ | Orol _ | Oeq _ | Oneq _
+  | Olt _ | Ole _ | Ogt _ | Oge _
+  | Ovadd _ _ | Ovsub _ _ | Ovmul _ _
+  | Ovlsr _ _ | Ovlsl _ _ | Ovasr _ _
+  | Odiv _ _ | Omod _ _ => true
+  end.
+
+Definition isOarray op :=
+  if op is Oarray _ then true else false.
+
+Fixpoint sc_pexpr (e : pexpr) : safety_cond :=
+  match e with
+  | Pconst _ | Pbool _  | Parr_init _ _ => [::]
+  | Pvar x => sc_gvar x
+
+  | Pget al aa ws x e =>
+    let sc_e := sc_pexpr e in
+    let sc_arr := sc_arr_get x al aa ws e in
+    sc_e ++ sc_arr
+
+  | Psub aa ws len x e =>
+    let sc_e := sc_pexpr e in
+    let sc_arr := sc_in_bound (vtype (gv x)) aa ws e (Pconst (arr_size ws len)) in
+    sc_e ++ sc_arr
+
+  | Pload al ws e =>
+    let sc_e := sc_pexpr e in
+    let sc_al := sc_is_aligned_if_m al ws e in
+    let sc_load := sc_mem_valid e ws in
+    sc_e ++ sc_al ++ sc_load
+
+  | Papp1 op e =>
+    let sc_e := sc_pexpr e in
+    let sc_op := sc_op1 op e in
+    sc_e ++ sc_op
+
+  | Papp2 op e1 e2 =>
+    let sce1 := sc_pexpr e1 in
+    let sce2 := sc_pexpr e2 in
+    let sco := sc_op2 op e1 e2 in
+    sce1 ++ sce2 ++ sco
+
+  | PappN op es =>
+    let scs := conc_map sc_pexpr es in
+    scs
+
+  | Pif ty e e1 e2 =>
+    let sc_e := sc_pexpr e in
+    let sc_e1 := sc_pexpr e1 in
+    let sc_e2 := sc_pexpr e2 in
+    sc_e ++ sc_e1 ++ sc_e2
+
+  | Pbig idx op x body start len  =>
+    let scidx := sc_pexpr idx in
+    let scstart := sc_pexpr start in
+    let sclen := sc_pexpr len in
+    let scbody := sc_pexpr body in
+    let scop := Pbool (sc_op2_big op) in
+    let scbody := Pbig etrue Oand x (eands scbody) start len in
+    scidx ++ scstart ++ sclen ++ [:: scop ; scbody]
+
+  | Pis_var_init x => [::]
+
+  | Pis_mem_init e1 e2 =>
+    let sc_e1 := sc_pexpr e1 in
+    let sc_e2 := sc_pexpr e2 in
+    sc_e1 ++ sc_e2
+  end.
+
+Definition sc_arr_set (x:var_i) al aa sz e :=
+  sc_is_aligned_if al aa sz e ++
+  sc_in_bound (vtype x) aa sz e (Pconst (wsize_size sz)).
+
+Definition sc_lval (lv : lval) : safety_cond :=
+  match lv with
+  | Lnone _ _ => [::]
+  | Lvar x => [::]
+  | Lmem al ws x e =>
+    let sc_e := sc_pexpr e in
+    let sc_al := sc_is_aligned_if_m al ws e in
+    let sc_load := sc_mem_valid e ws in
+    sc_e ++ sc_al ++ sc_load
+  | Laset al aa ws x e =>
+    let sc_e := sc_pexpr e in
+    let sc_arr := sc_arr_set x al aa ws e in
+    sc_e ++ sc_arr
+  | Lasub aa ws len x e =>
+    let sc_e := sc_pexpr e in
+    let sc_arr := sc_in_bound (vtype x) aa ws e (Pconst (arr_size ws len)) in
+    sc_e ++ sc_arr
+  end.
+
+Definition sc_lvals (lvs:lvals) okmem : safety_cond :=
+  let scs := map sc_lval lvs in
+   (Pbool (check_xs okmem Sv.empty lvs scs)) :: flatten scs.
+
+Definition safe_cond_to_e vs sc: pexpr :=
+  match sc with
+  | NotZero ws k =>
+      match List.nth_error vs k with
+      | Some x => eneqi (eint_of_word Unsigned ws x) (Pconst 0)
+      | None => efalse
+      end
+  | InRangeMod32 ws i j k =>
+      match List.nth_error vs k with
+      | Some x =>
+        let e := emodi Unsigned (eint_of_word Unsigned ws x) (Pconst 32) in
+        let e1 := elei (Pconst i) e in
+        let e2 := elei e (Pconst j) in
+        eand e1 e2
+      | None => efalse
+      end
+  | ULt ws k z =>
+      match List.nth_error vs k with
+      | Some x => elti (eint_of_word Unsigned ws x) (Pconst z)
+      | None => efalse
+      end
+  | UGe ws z k =>
+      match List.nth_error vs k with
+      | Some x => elei (Pconst z) (eint_of_word Unsigned ws x)
+      | None => efalse
+      end
+  | UaddLe ws k1 k2 z =>
+      match List.nth_error vs k1 with
+      | Some x =>
+        match List.nth_error vs k2 with
+        | Some y => elei (eaddi (eint_of_word Unsigned ws x) (eint_of_word Unsigned ws y)) (Pconst z)
+        | None => efalse
+        end
+      | None => efalse
+      end
+  | AllInit ws p k =>
+      match List.nth_error vs k with
+      | Some e =>
+        let len := arr_size ws p in
+        PappN (Ois_arr_init (Z.to_pos len)) [:: e; Pconst 0; Pconst len]
+      | _ => efalse
+      end
+  | X86Division sz sign =>
+    match vs,sign with
+      | hi :: lo :: dv :: _, Signed =>
+        let hi := eint_of_word Signed sz hi in
+        let lo := eint_of_word Unsigned sz lo in
+        let szi := wbase sz in
+        let dd := eaddi (emuli (Pconst szi) (hi)) lo in
+        let dv := eint_of_word Signed sz dv in
+        let q  := edivi Signed dd dv in
+        let r  := emodi Signed dd dv in
+        let ov := eor (elti q (Pconst (wmin_signed sz)))
+                      (elti (Pconst (wmax_signed sz)) q) in
+        eand (eneqi dv ezero) (enot ov)
+      | hi :: lo :: dv :: _, Unsigned =>
+        let hi := eint_of_word Unsigned sz hi in
+        let lo := eint_of_word Unsigned sz lo in
+        let szi := wbase sz in
+        let dd := eaddi (emuli (Pconst szi) (hi)) lo in
+        let dv := eint_of_word Unsigned sz dv in
+        let q  := edivi Unsigned dd dv in
+        let r  := emodi Unsigned dd dv in
+        let ov := elti (Pconst (wmax_unsigned sz)) q in
+        eand (eneqi dv ezero) (enot ov)
+      | _,_ => efalse
+    end
+  | ScFalse => efalse
+  end.
+
+Definition get_sopn_safe_conds (es: pexprs) (o: sopn) :=
+  let instr_descr := get_instr_desc o in
+  map (safe_cond_to_e es) instr_descr.(i_safe).
+
+Definition get_sopn_wt (es: pexprs) (o: sopn) :=
+  let instr_descr := get_instr_desc o in
+  Pbool (all2 (fun ty e => convertible (type_of_expr e) ty) instr_descr.(tin) es).
+
+Fixpoint sc_instr_ir ii (ir : instr_r) : (safety_cond *  instr_r) :=
+  match ir with
+  | Cassgn lv _ _ e =>
+    let sc_lv := sc_lval lv in
+    let sc_e := sc_pexpr e in
+    (sc_lv ++ sc_e, ir)
+  | Copn lvs _ o es  =>
+    let sc_wt := get_sopn_wt es o in
+    let sc_lvs := sc_lvals lvs true in
+    let sc_op := get_sopn_safe_conds es o in
+    let sc_es := conc_map sc_pexpr es in
+    (sc_wt :: sc_lvs ++ sc_op ++ sc_es, ir)
+  | Csyscall lvs _ es =>
+    let sc_lvs := sc_lvals lvs true in
+    let sc_es := conc_map sc_pexpr es in
+    (sc_lvs ++ sc_es, ir)
+  | Ccall lvs _ es =>
+    let sc_lvs := sc_lvals lvs false in
+    let sc_es := conc_map sc_pexpr es in
+    (sc_lvs ++ sc_es, ir)
+  | Cif e c1 c2 =>
+    let sc_e := sc_pexpr e in
+    let sc_c1 := conc_map sc_instr c1 in
+    let sc_c2 := conc_map sc_instr c2 in
+    let ir := Cif e sc_c1 sc_c2 in
+    (sc_e, ir)
+  | Cfor x (d,e1,e2) c =>
+    let sc_c := conc_map sc_instr c in
+    let sc_e := sc_pexpr e1 ++ sc_pexpr e2 in
+    let ir := Cfor x (d,e1,e2) sc_c in
+    (sc_e, ir)
+  | Cwhile a c1 e ii_w c2 =>
+    let sc_e := safe_assert ii (sc_pexpr e) in
+    let sc_c1 := conc_map sc_instr c1 ++ sc_e in
+    let sc_c2 := conc_map sc_instr c2 in
+    let ir := Cwhile a sc_c1 e ii_w sc_c2 in
+    ([::] ,ir)
+  | Cassert a =>
+    let sc_e := sc_pexpr a.2 in
+    (sc_e, ir)
+  end
+with sc_instr (i:instr) : cmd :=
+  let (ii,ir) := i in
+  let ir := sc_instr_ir ii ir in
+  (rcons (safe_assert ii ir.1) (MkI ii ir.2)).
+
+Definition sc_a_and (a : assertion) :=
+  let sc_e := sc_pexpr a.2 in
+  (a.1, eands (rcons sc_e a.2)).
+
+Definition sc_ci ci :=
+  let ci_pre := map sc_a_and ci.(f_pre) in
+  let ci_post := map sc_a_and ci.(f_post) in
+  MkContra ci.(f_iparams) ci.(f_ires) ci_pre ci_post.
+
+Definition sc_fun (f: ufundef) :=
+  let 'MkFun ii ci tin p c tout r ev := f in
+  let ci :=
+    match ci with
+    | None => None
+    | Some ci => Some (sc_ci ci)
+    end
+  in
+  let c := conc_map sc_instr c in
+  let es := conc_map sc_var r in
+  let sc_res := safe_assert dummy_instr_info es  in
+  let c := c ++ sc_res in
+  MkFun ii ci tin p c tout r ev.
+
+Definition check_glob (gd : glob_decl) :=
+  match gd.2 with
+  | Gword _ _ => true
+  | Garr len t =>  all (WArray.is_init t) (ziota 0 len)
+  end.
+
+Definition sc_prog (p:_uprog) : result pp_error_loc _uprog :=
+  Let _ := assert (all check_glob p.(p_globs)) (E.ierror "global arrays not fully initialised"%string) in
+  ok (map_prog sc_fun p).
+
+End SAFETY.
diff --git a/proofs/lang/safety_proof.v b/proofs/lang/safety_proof.v
new file mode 100644
index 0000000000..b31d8b5220
--- /dev/null
+++ b/proofs/lang/safety_proof.v
@@ -0,0 +1,904 @@
+From HB Require Import structures.
+From Coq Require Import ZArith.
+From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssralg word_ssrZ.
+Require Import compiler_util psem psem_facts safety safety_shared_proof.
+Import Utf8.
+
+Local Open Scope Z_scope.
+Local Open Scope seq_scope.
+
+Section SAFETY_PROOF.
+#[local] Existing Instance progUnit.
+
+Context
+  {asm_op syscall_state : Type}
+  {ep : EstateParams syscall_state}
+  {spp : SemPexprParams}
+  {sip : SemInstrParams asm_op syscall_state}.
+
+#[local] Existing Instance sCP_unit.
+#[local] Existing Instance nosubword.
+#[local] Existing Instance indirect_c.
+#[local] Existing Instance withassert.
+Context {E E0: Type -> Type} {wE : with_Error E E0} {rE : EventRels E0}.
+
+Variable (p :uprog) (ev:extra_val_t).
+
+Notation gd := (p_globs p).
+Notation sem_pexpr_wc := (sem_pexpr (wc:=withcatch)).
+Notation sem_pexprs_wc := (sem_pexprs (wc:=withcatch)).
+Notation sem_cond_wc := (sem_cond (wc:=withcatch)).
+Notation write_lvals_wc := (write_lvals (wc:=withcatch)).
+
+(* ----- Aux Lemmas ----- *)
+Lemma gvar_init_arr s x ws len :
+  vtype (gv x) = aarr ws len ->
+  sem_cond gd (eands (sc_gvar x)) s = ok true.
+Proof. by move=> h; rewrite /sc_gvar /sc_var h; case: ifP. Qed.
+
+Lemma var_init_arr s (x: var_i) ws len :
+  vtype x = aarr ws len ->
+  sem_cond gd (eands (sc_var x)) s = ok true.
+Proof. by move=> h; rewrite /sc_var h. Qed.
+
+Lemma sc_is_aligned_ifP s (i : sem_t cint) al aa sz e :
+  sem_pexpr_wc true gd s e = ok (to_val i) ->
+  sem_cond_wc gd (eands (sc_is_aligned_if al aa sz e)) s = ok true ->
+  is_aligned_if (Pointer := WArray.PointerZ) al (i * mk_scale aa sz) sz.
+Proof.
+  rewrite /sc_is_aligned_if /is_aligned_if => hi.
+  case: al => //=.
+  case: aa => /=.
+  + rewrite Z.mul_1_r /sem_cond /=.
+     by rewrite hi.
+  by move=> _; apply WArray.is_align_scale.
+Qed.
+
+Lemma eval_atype_carr ty n : 
+  eval_atype ty = carr n -> 
+  exists ws len, ty = aarr ws len /\ n = Z.to_pos (arr_size ws len).
+Proof. by case: ty => // ws len [<-]; exists ws, len. Qed.
+
+Lemma sc_in_boundP s ty n (i ilen : sem_t cint) aa sz (e elen : pexpr) :
+  eval_atype ty = carr n ->
+  sem_pexpr_wc true gd s e = ok (to_val i) ->
+  sem_pexpr_wc true gd s elen = ok (to_val ilen) ->
+  sem_cond_wc gd (eands (sc_in_bound ty aa sz e elen)) s = ok true ->
+  (0 <= i * mk_scale aa sz /\ i * mk_scale aa sz + ilen <= n)%Z.
+Proof.
+  rewrite /sc_in_bound /= /emk_scale /emuli /sem_cond => /eval_atype_carr [ws [len [-> ?]]] he helen; subst n.
+  case: aa; rewrite /= helen he /arr_size => /= -[]/andP [/ZleP h1 /ZleP h2]; Lia.lia.
+Qed.
+
+Lemma sc_in_boundP_all s ty n (t : sem_t (carr n)) (i: sem_t cint) aa sz e :
+  eval_atype ty = carr n -> 
+  sem_pexpr_wc true gd s e = ok (to_val i) ->
+  sem_cond_wc gd (eands(sc_in_bound ty aa sz e (Pconst(wsize_size sz)))) s = ok true ->
+  all (fun j => WArray.in_bound t (i * mk_scale aa sz + j)) (ziota 0 (wsize_size sz)).
+Proof.
+  move=> /[dup] hty /eval_atype_carr [ws [len [? ?]]] he hscs; subst ty n.
+  have helen : sem_pexpr (wc:=withcatch) true gd s (Pconst (wsize_size sz)) =
+                 ok (to_val (t:=cint) (wsize_size sz)) by done.
+  have [h1 h2] := sc_in_boundP hty he helen hscs.
+  apply /allP => j /in_ziotaP ?; apply/WArray.in_boundP; Lia.lia.
+Qed.
+
+Lemma sc_in_sub_boundP s ty n (t : sem_t (carr n)) a e1 e2 (ve1 ve2: Z) :
+  eval_atype ty = carr n -> 
+  sem_pexpr_wc true gd s e1 = ok (Vint ve1) ->
+  sem_pexpr_wc true gd s e2 = ok (Vint ve2) ->
+  0 <= a < ve2 ->
+  sem_cond_wc gd (eands (sc_in_bound' ty e1 e2)) s = ok true ->
+  WArray.in_bound t ((ve1 + a)).
+Proof.
+  move=> /[dup] hty /eval_atype_carr [ws [len [? ?]]] he1 he2 hb; subst ty n.
+  have {}hb : ve1 <= ve1 + a < ve1 + ve2 by Lia.lia.
+  rewrite /sem_cond /= he1 he2 /=.
+  move=> []/andP [/Z.leb_le hlo /Z.leb_le hhi].
+  rewrite/ WArray.in_bound; apply/andP; split.
+  + apply/Z.leb_le; Lia.lia.
+  rewrite /arr_size /= in hhi.
+  apply/Z.ltb_lt; Lia.lia.
+Qed.
+
+Section GLOBALS.
+
+(* FIXME : this require a check *)
+Hypothesis get_global_arr_init :
+  forall x len (t:WArray.array len) ,
+  get_global gd x = ok (Varr t) →
+  all (WArray.is_init t) (ziota 0 len).
+
+Opaque wsize_size.
+
+Lemma sc_arr_initP s ty n (t : WArray.array n) (i : sem_t cint) x aa sz e :
+  eval_atype ty = carr n -> 
+  sem_pexpr_wc true gd s e = ok (to_val i) ->
+  get_gvar true gd (evm s) x = ok (Varr t) ->
+  sem_cond_wc gd (eands (sc_arr_init ty x aa sz e)) s = ok true ->
+  all (fun j => WArray.in_bound t (i * mk_scale aa sz + j)) (ziota 0 (wsize_size sz)) ->
+  all (fun j => WArray.is_init t (i * mk_scale aa sz + j)) (ziota 0 (wsize_size sz)).
+Proof.
+  move=> /eval_atype_carr [ws [len [? ?]]]; subst ty n.
+  rewrite /sem_cond.
+  rewrite /sc_arr_init /get_gvar /emk_scale /emuli /= /get_gvar /= => hi.
+  case: ifP => /= hloc.
+  + rewrite /get_gvar hloc => -> /= + _.
+    case: aa; rewrite /= hi /= /sem_opN /= WArray.castK /= => -[] /allP h;
+    by apply/allP => j /in_ziotaP ?; apply/h/in_ziotaP; Lia.nia.
+  move=> /get_global_arr_init /allP hinit _ /allP hbound.
+  apply/allP => j h; have /in_ziotaP ? := h.
+  apply/hinit/in_ziotaP. have /WArray.in_boundP := hbound j h; Lia.lia.
+Qed.
+
+Lemma arr_isdef s x len : eval_atype (vtype (gv x)) = carr len -> is_defined (evm s).[gv x].
+Proof.
+  move=> hty; have := Vm.getP (evm s) (gv x).
+  by rewrite hty => /compat_valEl [? ->].
+Qed.
+
+Lemma arr_catch_get_gvar {n} s x (t: WArray.array n) :
+  eval_atype (vtype (gv x)) = carr n ->
+  get_gvar (wc:=withcatch) true gd (evm s) x = ok (Varr t) ->
+  get_gvar true gd (evm s) x = ok (Varr t).
+Proof. by rewrite /get_gvar /get_var => /(arr_isdef s) ->. Qed.
+
+Lemma is_wi1P o :
+  match is_wi1 o with
+  | Some(s, oi) => o = Owi1 s oi
+  | None =>
+     let t := etype_of_op1 o in
+     sign_of_etype t.1 = None /\ sign_of_etype t.2 = None
+  end.
+Proof. by case: o => // -[]. Qed.
+
+Lemma estate_eq:
+  forall s s', st_rel (λ _ : unit, eq) tt s s' ->
+  s = s'.
+Proof. by move=> [???][>][] /= *; subst. Qed.
+
+(* ----- Aux Lemmas ----- *)
+
+(* Safety Lemma: pexpr *)
+Let Pe e :=
+  forall s v,
+  sem_cond_wc gd (eands (sc_pexpr e)) s = ok true ->
+  sem_pexpr_wc true gd s e = ok v ->
+  sem_pexpr true gd s e = ok v.
+
+Let Qe es :=
+  forall s vs,
+  sem_cond_wc gd (eands (conc_map sc_pexpr es)) s = ok true ->
+  sem_pexprs_wc true gd s es = ok vs ->
+  sem_pexprs true gd s es = ok vs .
+
+(*
+Lemma eval_atype_arr n t :  eval_atype t = carr n -> exists ws, exists2 len, t = aarr ws len & n = Z.to_pos (arr_size ws len).
+Proof.
+*)
+
+Lemma sc_pexprP_aux: (forall e, Pe e) /\ (forall es, Qe es).
+Proof.
+  apply: pexprs_ind_pair; subst Pe Qe; split => //=; t_xrbindP => //.
+  + by move=> e he es hes s vs /eandsE_cat[/he{}he] /hes{}hes v {}/he -> vs' /hes -> <- /=.
+
+  (* Gvar *)
+  + move=> x s v.
+    rewrite /sc_gvar /get_gvar /sem_cond /=.
+    case: (is_lvar x) => //.
+    rewrite /sc_var /get_var /=.
+    case harr: is_aarr.
+    + move: harr => /is_aarrP[ws [len htx]].
+      have /(_ x (Z.to_pos (arr_size ws len))) -> // := arr_isdef s.
+      by rewrite htx.
+    by t_xrbindP => z /= [] <- /= [] ->.
+
+  (* Array access *)
+  + move=> al aa sz x e he s v /eandsE_cat[/he{}he].
+    rewrite /sc_arr_get => /eandsE_cat[+ /eandsE_cat[]].
+    move=> hal hbound hinit; apply on_arr_gvarP => n r htx.
+    have xdef := arr_isdef s htx; move=> /(arr_catch_get_gvar htx) hgvr /=.
+    t_xrbindP=> zi z hewc /to_intI ? w wcatch <-; subst z.
+    have {}he := he _ hewc; rewrite he hgvr /=.
+    move: wcatch; rewrite /WArray.get /read /=.
+    have -> /= := sc_is_aligned_ifP hewc hal.
+    move: hbound.
+    move=> /(sc_in_boundP_all r htx hewc) hbound.
+    have {}hinit := sc_arr_initP htx hewc hgvr hinit hbound.
+    have : exists l, mapM (λ k : Z,
+      WArray.get8 r (add (zi * mk_scale aa sz) k)) (ziota 0 (wsize_size sz)) = ok l;
+    last first.
+    + by move=> [l -> /=] [->].
+    elim: (ziota 0 (wsize_size sz)) hbound hinit => //=; eauto.
+    move=> j js hrec /andP [h1 h2] /andP [h3 h4].
+    rewrite {2}/WArray.get8 WArray.addE h1 /= h3 /=.
+    by have [l -> /=] := hrec h2 h4; eauto.
+
+  (* Subarray access *)
+  + move=> aa sz len x e he s v /eandsE_cat[/he {}he].
+    move=> hbound; apply on_arr_gvarP => n r htx.
+    have xdef := arr_isdef s htx; move=> /(arr_catch_get_gvar htx) hgvr /=.
+    t_xrbindP=> zi z hewc /to_intI ? w wcatch <-; subst z.
+    have {}he := he _ hewc; rewrite he hgvr /=.
+    move: wcatch; rewrite /WArray.get /read /=.
+    have helen : sem_pexpr_wc true gd s (Pconst (arr_size sz len)) =
+                   ok (to_val (t:=cint) (arr_size sz len)) by done.
+    move: hbound => /(sc_in_boundP htx hewc helen) []/ZleP h1 /ZleP h2.
+    by rewrite /WArray.get_sub h1 h2 /= => [][->].
+
+  (* Memory read *)
+  + move=> al sz e he s v /eandsE_cat[/he{}he].
+    move=> /eandsE_cat[hal hmem] w wv hewc.
+    have {}he := he _ hewc; rewrite /read he => /= topow w2.
+    move: hmem; rewrite /sem_cond /=.
+    t_xrbindP => z w3 w3v; rewrite hewc => -[]?; subst w3v.
+    rewrite topow => /= -[]?; subst w3 => <- [] + + <-.
+    have -> /= : is_aligned_if al w sz.
+    + move: hal; rewrite /sc_is_aligned_if_m /sem_cond; case: al=>//=.
+      rewrite /sem_sop2 /sem_sop1 /is_align /= p_to_zE; t_xrbindP.
+      by rewrite hewc=> ???? [<-] /=; rewrite topow /= => -[ <-] /= [<-] /=.
+    elim: ziota => [|k ks hrec] /=; first by move=> _ [->].
+    rewrite (get_read8 _ Unaligned) addE.
+    move=> /andP[] /is_okP[w8 ->] /hrec{}hrec /=.
+    case h: (mapM _ ks) hrec => //=.
+    by move=> hrec [] ->.
+
+  (* Unary operator *)
+  + move=> op e he s v /eandsE_cat[/he{}he].
+    move=> hop v1 hewc; have {}he := he _ hewc.
+    rewrite he /= /sem_sop1.
+    have {}hdef := sem_pexpr_defined he.
+    case hval: of_val=> [a|e0] /=; last first.
+    + by have -> := isdef_errtype hdef hval.
+
+    move: hop; rewrite /sc_op1 /sc_wiop1.
+    case: is_wi1 (is_wi1P op); last first.
+    + case: op a hval=> //=; first by case.
+      by move=> sg +++ []; case.
+    t_xrbindP; case=> sg wop ?; subst op.
+
+    case: wop a hval => //=.
+    + move=> ws z /to_intI ?; subst.
+      by move=> /(sc_wi_range_of_int hewc) ->.
+    move=> ws w /to_wordI [ws2 [w2] [? htr]]; subst v1 => /=.
+    rewrite /signed /safety_shared.sc_op1 /=.
+
+    case: sg; rewrite /sem_cond /= hewc /=;
+      rewrite /sem_sop1 /= htr => -[] /ZeqbP.
+    + rewrite /wint_of_int /in_wint_range /in_sint_range /=.
+      move=> /wsigned_opp -> /=.
+      by have [/ZleP -> /ZleP ->] := wsigned_range (-w).
+    by move=> ->.
+
+  (* Binary operator *)
+  + move=> op e1 he1 e2 he2 s v /eandsE_cat[/he1{}he1].
+    move=> /eandsE_cat[/he2{}he2] hop v2 he1wc v3 he2wc.
+    have {}he1 := he1 _ he1wc.
+    have {}he2 := he2 _ he2wc.
+    rewrite he1 he2 /sem_sop2 /=.
+    have {}hdef1 := sem_pexpr_defined he1.
+    have {}hdef2 := sem_pexpr_defined he2.
+    case hval2: of_val=> [a2|er2];
+    case hval1: of_val=> [a1|er1] //=; last first.
+    1,3: by have -> := isdef_errtype hdef1 hval1.
+    + by have -> := isdef_errtype hdef2 hval2.
+
+    case: op hop a1 hval1 a2 hval2=> //=; try by case.
+    1-2: by move=> sg; case=>// ws hsc;
+      move=> w1' /to_wordI[ws1] [w1] [? tr1]; subst v2;
+      move=> w2' /to_wordI[ws2] [w2] [? tr2]; subst v3;
+      rewrite /mk_sem_divmod (sem_sc_divmod _ _ hsc) //=;
+      rewrite /sem_sop1 /sem_sop2 /of_val; t_simpl_rewrites.
+
+    move=> sg ws; case=> //= hsc;
+    move=> w1' /to_wordI[ws1] [w1] [? tr1]; subst v2;
+    move=> w2' /to_wordI[ws2] [w2] [? tr2]; subst v3.
+    1-3:
+      by move: hsc; rewrite /mk_sem_wiop2 /sc_wi_range_op2 => hsc;
+      rewrite (sc_wi_range_of_int _ hsc) //=;
+      rewrite /sem_sop1 /sem_sop2; t_simpl_rewrites.
+    1-2:
+      by rewrite /mk_sem_divmod (sem_sc_divmod _ _ hsc) //=;
+      rewrite /sem_sop1 /sem_sop2; t_simpl_rewrites.
+    + rewrite /mk_sem_wishift /wint_of_int.
+      rewrite (sc_wi_rangeP (wc:=withcatch) (gd:=gd) (s:=s) (e := (elsli (toint sg ws e1) (toint Unsigned U8 e2)))) //=.
+      by rewrite /elsli /= he1wc he2wc /= /sem_sop1 /sem_sop2 /= tr1 /= tr2 /=.
+    by rewrite /mk_sem_wishift /wint_of_int in_wint_range_zasr.
+
+  (* N-ary opertors *)
+  + move => op es he s v.
+    move=> /he{}he v2 {}/he.
+    rewrite /sem_pexprs /sem_opN => he; rewrite he /=.
+    have := [elaborate sem_opN_typed_ok op].
+    move: (type_of_opN op) (sem_opN_typed op)=> [tin tout] /=.
+    elim: tin v2 es he => [| tin tins hrec] [|v' vs'] es he semop //=.
+    + by case/is_okP => semtout ->.
+    move: es he=> [| e es] //= + hok.
+    t_xrbindP=> z /sem_pexpr_defined v'def zs hes ? ? ; subst z zs.
+    case hval: (of_val _ v')=> [semtin|] //=;
+    last by rewrite (isdef_errtype v'def hval).
+    exact: hrec _ _ hes _ (hok semtin).
+
+  (* Conditional expression *)
+  + move=> ty e he e1 he1 e2 he2 s v /eandsE_cat[/he{}he].
+    move=> /eandsE_cat[/he1{}he1] /he2{}he2.
+    by move=> v2 v3 {}/he -> /= -> v5 v6 {}/he1 -> /= -> v7 v8 {}/he2 -> /= -> <-.
+
+  (* Big expression *)
+  + move=> idx hidx op vi body hbody start hstart len hlen s v.
+    move=> /eandsE_cat[/hidx{}hidx] /eandsE_cat[/hstart{}hstart].
+    move=> /eandsE_cat[/hlen{}hlen] /eandsE_cons[] hop hbig.
+    move=> zstart z0 hstartwc /to_intI ? zlen z1 hlenwc /to_intI ?.
+    subst z0 z1; move=> vacc vidx hidxwc htruidx.
+    have {}hstart := hstart _ hstartwc.
+    have {}hlen := hlen _ hlenwc.
+    have {}hidx := hidx _ hidxwc.
+    rewrite hstart hlen hidx /= htruidx /=.
+    have hdef1 := truncate_val_defined htruidx; clear htruidx.
+
+    move: hbig=> /eandsE_cons[] /=.
+    rewrite /sem_cond /= hstartwc hlenwc => /= + _.
+    t_xrbindP => z0 + /to_boolI ?; subst z0.
+
+    elim: ziota vacc hdef1 => [| k ks hrec] //= vacc hdef1.
+    t_xrbindP => vw s1 -> vscbody h1 op2; rewrite /sem_sop2 in op2; move: op2 => /=.
+    case heq: to_bool => [vb | er] /=; last first.
+    + by have -> := (isdef_errtype (t:=cbool) (sem_pexpr_defined h1)) heq.
+    move=> [?] hfold v2 s2 [?] vbody h2; subst vw s2 => /=.
+
+    have: vb = (Vbool true).
+    + move: hfold; clear k hrec heq; elim: ks vb => /=.
+      + by move=> ? [->].
+    t_xrbindP => k ks hrec init v1 vf fok vp pok.
+    rewrite /sem_sop2 /=.
+    case heq: to_bool => [vpb | er] /=; last first.
+    + by have -> := (isdef_errtype (t:=cbool) (sem_pexpr_defined pok)) heq.
+    by move=> [?]; subst v1 => /hrec /andb_prop[].
+    move: heq => /to_boolI ? ?; subst vscbody vb.
+
+    move: hfold => /hrec{}hrec hcatch /hrec{}hrec.
+    move: hbody; rewrite /sem_cond => /(_ s1 vbody); rewrite h1 h2 /=.
+    move=> /(_ erefl erefl) {}h2; rewrite h2 /=.
+    move: hcatch; rewrite /sem_sop2 /=.
+    have hdef2 := sem_pexpr_defined h2.
+
+    case hval2: of_val=> [a2|er2];
+    case hval1: of_val=> [a1|er1] //=; last first.
+    1,3: by have -> := isdef_errtype hdef1 hval1.
+    + by have -> := isdef_errtype hdef2 hval2.
+
+    case: op hop hrec a1 hval1 a2 hval2 => //=.
+    1-3: by move=> _ hrec a1 /to_boolI ? a2 /to_boolI ? [?]; subst vacc vbody v2; apply hrec.
+    1-3: case; first by move=> _ hrec a1 /to_intI ? a2 /to_intI ? [?]; subst vacc vbody v2; apply hrec.
+      1-3: by move=> ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+    1-2: by move=> sg; case=> //=; first by move=> _ hrec a1 /to_intI ? a2 /to_intI ? [?]; subst vacc vbody v2; apply hrec.
+    1-4: by move=> ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+    1-2: case=> //=; first by move=> _ hrec a1 /to_intI ? a2 /to_intI ? [?]; subst vacc vbody v2; apply hrec.
+      1-2: by move=> ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+    1-2: by move=> ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+    1-2: case=> //=; first by move=> _ hrec a1 /to_intI ? a2 /to_intI ? [?]; subst vacc vbody v2; apply hrec.
+      1-2: by move=> ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+    1-4: case=> //=; first by move=> _ hrec a1 /to_intI ? a2 /to_intI ? [?]; subst vacc vbody v2; apply hrec.
+      1-4: by move=> sg ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+    1-6: by move=> ? ws _ hrec a1 /to_wordI[ws1][w1][? _] a2 /to_wordI[ws2][w2][? _] [?]; subst vacc vbody v2; apply hrec.
+
+    move=> sg ws; case=> //= hsc hrec;
+    move=> w1' /to_wordI[ws1] [w1] [? tr1]; subst vacc;
+    move=> w2' /to_wordI[ws2] [w2] [? tr2]; subst vbody.
+    + by rewrite /mk_sem_wishift /wint_of_int in_wint_range_zasr => /= -[?]; subst v2; apply hrec.
+    1-6: by move=> [?]; subst v2; apply hrec.
+
+  (* Pis_mem_init*)
+  move=> e1 e2 he1 he2 s v /eandsE_cat[/he1{}he1] /he2{}he2.
+  by move=> w1 v1 {}/he1 -> /= -> w2 v2 {}/he2 -> /= -> <-.
+Qed.
+
+Lemma sc_pexprP : forall e, Pe e.
+Proof. by case sc_pexprP_aux. Qed.
+
+Lemma sc_pexprsP : forall es, Qe es.
+Proof. by case sc_pexprP_aux. Qed.
+
+(* ---- ---- *)
+
+Lemma DB_to_val ty (v : sem_t ty) wdb : DB wdb (to_val v).
+Proof. by case: ty v; rewrite /DB /= orbT. Qed.
+
+Lemma compat_val_to_val ty (v : sem_t ty) : compat_val ty (to_val v).
+Proof. by case: ty v => *; rewrite /compat_val /= eq_refl. Qed.
+
+Local Lemma all_get_read8 mem al wlo sz :
+  all (λ i : Z,
+       is_ok (read mem al (wlo + wrepr Uptr i)%R U8))
+      (ziota 0 sz)
+  =
+  all (λ i : Z,
+       is_ok (get mem (wlo + wrepr Uptr i)%R))
+      (ziota 0 sz).
+Proof.
+  elim: ziota => [| k ks hrec] //=.
+  by rewrite -get_read8 hrec.
+Qed.
+
+Local Lemma set_allgetok ks mem mem' q w wlo :
+  all (fun i => is_ok (get mem (wlo + wrepr Uptr i)%R)) ks ->
+  set mem q w = ok mem' ->
+  all (fun i => is_ok (get mem' (wlo + wrepr Uptr i)%R)) ks.
+Proof.
+  move=> + hset.
+  elim: ks => [// | k ks hind].
+  move=> /andP[h1 h2] /=.
+  rewrite hind //= (setP _ hset).
+  case: eqP => //; by rewrite h1.
+Qed.
+
+(* Safety Lemma: lval *)
+Lemma sc_lvalP l v s s':
+  sem_cond_wc gd (eands (sc_lval l)) s = ok true ->
+  write_lval (wc:=withcatch) true gd l v s = ok s' ->
+  write_lval true gd l v s = ok s'.
+Proof.
+  case: l => [vi tynone | x | al sz x e | al aa sz x e | aa sz pos x e ] //=.
+  + (* Lmem *)
+    t_xrbindP => /eandsE_cat[] /sc_pexprP he /eandsE_cat[hal hmem] wpt vpt hewc.
+    have {}he := he _ hewc.
+    rewrite he => /to_wordI[sz2 [w2]] [? htr2]; subst vpt.
+    move=> w /to_wordI[sz3[w3]] [? htr3] me + ?; subst v s'.
+    rewrite /= htr2 htr3 /= /write.
+    have -> /= : is_aligned_if al wpt sz.
+      + move: hal; rewrite /sc_is_aligned_if_m /sem_cond; case: al => //=.
+        by rewrite hewc /= /sem_sop2 /sem_sop1 /= htr2.
+    suff : [elaborate exists l, foldM
+         (λ (k : Z) (m : mem),
+            set m (add wpt k) (LE.wread8 w k))
+         (emem s) (ziota 0 (wsize_size sz)) = ok l].
+    + by move=> [l -> /=] [->].
+    move: hmem; rewrite /sem_cond /=.
+    rewrite hewc /= htr2 => /= -[].
+    set m' := (emem s).
+    rewrite all_get_read8.
+    elim: ziota m' => [| k ks hrec m'] /=; first by eauto.
+    move=> /andP[] /is_okP [gv okg] okgs.
+    apply (getok_setok (LE.wread8 w k)) in okg.
+    move: okg => [fmem hset] /=.
+    have {}okgs := set_allgetok okgs hset.
+    have {}hrec := hrec fmem okgs.
+    by rewrite hset /=.
+
+  + (* Laset *)
+    rewrite /sc_arr_set => /eandsE_cat[] /sc_pexprP he /eandsE_cat[hal hbound].
+    rewrite /on_arr_var; t_xrbindP => v1 getx; rewrite getx /=.
+    case: v1 getx => //= len r; t_xrbindP => /get_varI htx z v2 hewc.
+    have {}he := he _ hewc.
+    rewrite he => /= /to_intI ?; subst v2 => w -> r2 + <- /=.
+    rewrite /WArray.set /write /=.
+    have -> /= := sc_is_aligned_ifP hewc hal.
+    move: hbound => /(sc_in_boundP_all r htx hewc) hbound.
+    have : exists l, foldM (λ (k : Z) (m : WArray.array len),
+                       WArray.set8 m (add (z * mk_scale aa sz) k)
+                         (LE.wread8 w k)) r (ziota 0 (wsize_size sz)) = ok l; last first.
+  + by move=> [rf ->] /= [->].
+    elim: (ziota 0 (wsize_size sz)) r hbound  => //=; eauto.
+    move=> j js hrec r /andP [h1 h2].
+    rewrite {2}/WArray.set8 WArray.addE h1 /=.
+    have [l -> /=] := hrec {| WArray.arr_data :=
+                             Mz.set (WArray.arr_data r) (z * mk_scale aa sz + j)
+                              (LE.wread8 w j) |} h2.
+    by eauto.
+
+  + (* Lasub *)
+    move=> /eandsE_cat[] /sc_pexprP he hbound.
+    rewrite /on_arr_var; t_xrbindP => v1 getx; rewrite getx /=.
+    case: v1 getx => //= len r; t_xrbindP => /get_varI htx z v2 hewc.
+    have {}he := he _ hewc.
+    rewrite he => /= /to_intI ?; subst v2 => w -> r2 + <- /=.
+    rewrite /WArray.set_sub /=.
+    have [//|] := sc_in_boundP htx hewc _ hbound (aa:=aa) (ilen:=arr_size sz pos).
+    move=> /ZleP -> /ZleP -> /=.
+    rewrite /write_var /set_var /= htx eq_refl => -[<-] /=.
+    by eauto.
+Qed.
+
+Lemma sc_lvalsP ls vs s0 s s' okmem:
+  sem_cond_wc gd (eands (sc_lvals ls okmem)) s0 = ok true ->
+  (evm s0 = evm s) ->
+  (okmem -> emem s0 = emem s) ->
+  write_lvals_wc true gd s ls vs = ok s' ->
+  write_lvals true gd s ls vs = ok s'.
+Proof.
+  move=> hscs hvm.
+  have {}hvm : evm s0 =[\Sv.empty] evm s by rewrite hvm.
+  move: hscs hvm; rewrite /sc_lvals => /eandsE_cons[].
+  rewrite {1}/sem_cond /= => -[].
+  elim: ls vs s Sv.empty okmem => [|l ls hrec] [|v vs] s W okmem //=.
+  rewrite Bool.andb_assoc => /= /andP[] /andP[] hmemok hdisj hcheck.
+  t_xrbindP => /eandsE_cat[] hsc hscs hvm hokm sf hw hws.
+  rewrite (check_scP _ s hmemok hdisj hvm hokm) in hsc.
+  have -> /= := sc_lvalP hsc hw.
+  apply: (hrec _ _ _ _ hcheck) hws => //.
+  + rewrite vrv_recE.
+    apply (eq_exT (vm2:= evm s)).
+    + by apply: eq_exI hvm; SvD.fsetdec.
+    by apply: eq_exI (vrvP hw); SvD.fsetdec.
+  by move=> /andP [/hokm -> hlv]; apply: lv_write_memP hw.
+Qed.
+
+Let pi := (map_prog sc_fun p).
+
+Lemma sem_pre_sc fn fs :
+  sem_pre (wc:=withcatch) pi fn fs = ok tt ->
+  sem_pre p fn fs = ok tt.
+Proof.
+  rewrite /sem_pre get_map_prog /=.
+  case: get_fundef=> [fd | //] /=.
+  case: fd => /= _ [] // func funty _ _ _ _ _.
+  t_xrbindP=> vst -> /= s -> /= us + _.
+  elim: (f_pre func) us => [|a l] //=.
+  t_xrbindP => hrec us hsca us' /hrec{}hrec ?; subst us.
+  move: hsca; rewrite /sem_assert /= -cats1.
+  t_xrbindP; case=> // /eandsE_cat[] hsce /=.
+  rewrite /sem_cond; t_xrbindP => v hewc /to_boolI ? _ _; subst v.
+  have he := sc_pexprP hsce hewc; rewrite he /=.
+  move: hrec; rewrite /sem_assert /sem_cond /=.
+  elim: l => [| a' as' hrec'] //=.
+  t_xrbindP=> us1 b v -> /to_boolI ?; subst v; case:b=> // _ _ us2.
+  by move=> -> ? _; subst us1.
+Qed.
+
+Lemma sem_post_sc fn vs fs :
+  sem_post (wc:=withcatch) pi fn vs fs = ok tt ->
+  sem_post p fn vs fs = ok tt.
+Proof.
+  rewrite /sem_post get_map_prog /=.
+  case: get_fundef=> [fd | //] /=.
+  case: fd => /= _ [] // func funty _ _ _ _ _.
+  t_xrbindP=> vst -> /= s1 -> /= s2 -> /= s3 + _.
+  elim: (f_post func) s3 => [|a l] //=.
+  t_xrbindP => hrec us hsca us' /hrec{}hrec ?; subst us.
+  move: hsca; rewrite /sem_assert /= -cats1.
+  t_xrbindP; case=> // /eandsE_cat[] hsce /=.
+  rewrite /sem_cond; t_xrbindP => v hewc /to_boolI ? _ _; subst v.
+  have he := sc_pexprP hsce hewc; rewrite he /=.
+  move: hrec; rewrite /sem_assert /sem_cond /=.
+  elim: l => [| a' as' hrec'] //=.
+  t_xrbindP=> us1 b v -> /to_boolI ?; subst v; case:b=> // _ _ us2.
+  by move=> -> ? _; subst us1.
+Qed.
+
+Opaque eands.
+
+Lemma nth_sem_pexprs gd s es pos e vs :
+  List.nth_error es pos = Some e →
+  sem_pexprs_wc true gd s es = ok vs →
+  sem_pexpr_wc true gd s e = ok (nth undef_b vs pos).
+Proof.
+  elim: pos es vs => [ | n hrec] [ | e0 es] //=; t_xrbindP.
+  + by move=> ? [->] ve -> ? _ <-.
+  by move=> ? hnth v0 he0 vs hes <- /=; apply: hrec hes.
+Qed.
+
+Lemma sem_cond_interp_safe gd s es vs sc:
+  sem_pexprs_wc true gd s es = ok vs →
+  sem_cond_wc gd (safe_cond_to_e es sc) s = ok true →
+  interp_safe_cond vs sc.
+Proof.
+  case: sc => //=.
+  + move=> ws pos hes.
+    case heq: List.nth_error => [e|//].
+    rewrite /sem_cond /= (nth_sem_pexprs heq hes) /=.
+    move=> + w hw.
+    by rewrite /sem_sop1 /= hw /= => -[] /eqP.
+
+  + move=> ws signedness; case: es => // hi [] // lo [] // dv l /=; t_xrbindP.
+    move=> vhi hhi ? vlo hlo ? vdv hdv ? _ <- <- <- /=; t_xrbindP.
+    move=> + whi wlo wdv ? hwhi ?? hwlo ?? hwdv ? _ <- <- ? [] ???; subst.
+Opaque wbase.
+    case: signedness => /eandE [] /=;
+      rewrite /sem_cond /= hhi hlo hdv /= /sem_sop1 /sem_sop2 /=
+        hwhi hwlo hwdv /= => -[] /eqP /eqP /negPf -> [].
+    + rewrite negb_or /wdwords => /andP [/negbTE -> /negbTE].
+      by rewrite Z.gtb_ltb => ->.
+    by rewrite Z.gtb_ltb => /negbTE ->.
+Transparent wbase.
+
+  + move=> ws zmin zmax pos hes.
+    case heq: List.nth_error => [e|//] + w hw.
+    rewrite /sem_cond /= (nth_sem_pexprs heq hes) /=.
+    by rewrite /sem_sop1 /sem_sop2 /= hw /= => -[] /andP [] /ZleP ? /ZleP.
+
+  + move=> ws pos z hes.
+    case heq: List.nth_error => [e|//] + w hw.
+    by rewrite /sem_cond /= (nth_sem_pexprs heq hes) /= /sem_sop1 /= hw /= => -[] /ZltP.
+
+  + move=> ws pos z hes.
+    case heq: List.nth_error => [e|//] + w hw.
+    by rewrite /sem_cond /= (nth_sem_pexprs heq hes) /= /sem_sop1 /= hw /= => -[] /ZleP.
+
+  + move=> ws pos0 pos1 z hes.
+    case heq0: List.nth_error => [e0|//].
+    case heq1: List.nth_error => [e1|//] + w0 w1 hw0 hw1.
+    rewrite /sem_cond /= (nth_sem_pexprs heq0 hes) /= (nth_sem_pexprs heq1 hes) /=.
+    by rewrite /sem_sop1 /sem_sop2 /= hw0 hw1 /= => -[] /ZleP.
+
+  move=> ws len pos hes.
+  case heq: List.nth_error => [e|//] + t hw i hi.
+  rewrite /sem_cond /= (nth_sem_pexprs heq hes) /= /sem_opN /= hw /= => -[].
+  move=> /allP his_init.
+  rewrite /WArray.get readE /is_aligned_if WArray.is_align_scale /=.
+  suff : [elaborate exists l, mapM (λ k : Z, read t Aligned (add (i * wsize_size ws) k) U8) (ziota 0 (wsize_size ws)) = ok l].
+  + by move=> [l ->] /=; eexists; eauto.
+  apply ziota_ind => [ | j j_s hj /= [l ->]] /=.
+  + by exists [::].
+  rewrite -get_read8 /get /=.
+  have hin : add (i * wsize_size ws) j \in ziota 0 (arr_size ws len).
+  + by rewrite WArray.addE /arr_size; apply/in_ziotaP; Lia.nia.
+  have := his_init (add (i * wsize_size ws) j) hin.
+  rewrite /WArray.get8 /WArray.is_init ; case: Mz.get => // w _.
+  have -> /=: WArray.in_bound t (add (i * wsize_size ws) j).
+  + by apply /WArray.in_boundP/in_ziotaP/hin.
+  by eexists;eauto.
+Qed.
+
+Lemma sem_cond_interp_safes gd s es vs sc :
+  sem_pexprs_wc true gd s es = ok vs →
+  sem_cond_wc gd (eands [seq safe_cond_to_e es i | i <- sc]) s = ok true →
+  List.Forall (interp_safe_cond vs) sc.
+Proof.
+  move=> hes; elim: sc => [ | sc scs hrec] /=.
+  + by move=> _; constructor.
+  move=> /eandsE_cons [hsc hscs]; constructor; last exact: hrec.
+  by apply: sem_cond_interp_safe hsc.
+Qed.
+
+(* FIXME : move this *)
+Lemma type_of_val_to_val v ty v' :
+  type_of_val v = ty →
+  is_defined v →
+  of_val ty v = ok v' →
+  to_val v' = v.
+Proof.
+  move=> hty; case: (ty) v' (type_of_valI hty) => /=.
+  1,2: by move=> ? [|[?]] -> // _ [->].
+  + by move=> ?? [t ->] _ /to_arrI [->].
+  by move=> ?? [|[?]] -> // _ /=; rewrite truncate_word_u => -[->].
+Qed.
+
+(* FIXME : move this *)
+Lemma sem_pexpr_type_of gd s e v :
+  sem_pexpr true gd s e = ok v ->
+  type_of_val v = eval_atype (type_of_expr e).
+Proof.
+  case: e => /=.
+  1-3: by move=> > [<-].
+  + by move=> x /type_of_get_gvar /eqP.
+  1-2: by move=> >; apply on_arr_gvarP; t_xrbindP => > _ _ > _ _ > _ <-.
+  + by move=> >; t_xrbindP => > _ _ > _ <-.
+  + by move=> >; t_xrbindP => > _ /sem_sop1I [?] [?] [_ _ ->]; apply type_of_to_val.
+  + by move=> >; t_xrbindP => > _ > _ /sem_sop2I [?] [?] [?] [_ _ _ ->]; apply type_of_to_val.
+  + by rewrite /sem_opN => >; t_xrbindP => > _ > _ <-; apply type_of_to_val.
+  + t_xrbindP => > _ _ > _ ht1 > _ ht2 <-; case: ifP => ?.
+    + by apply: truncate_val_has_type ht1.
+    by apply: truncate_val_has_type ht2.
+  + t_xrbindP => > _ _ > _ _ v0 > _ htr.
+    have := truncate_val_has_type htr.
+    move=> {htr}; elim: ziota v0 => [ | j js ih] v0 /=.
+    + by move=> ? [<-].
+    by t_xrbindP => _ > _ > _ /sem_sop2I [?] [?] [?] [_ _ _ ->]; apply/ih/type_of_to_val.
+  + by move=> > [<-].
+  by t_xrbindP => > _ _ > _ _ <-.
+Qed.
+
+(* Safety Lemma: instructions *)
+Lemma safety_callP_aux fn :
+  wiequiv_f_wa withcatch nocatch withassert withassert
+    pi p ev ev (rpreF (eS:= eq_spec)) fn fn (rpostF (eS:= eq_spec)).
+Proof.
+  apply wequiv_fun_ind_wa => {}fn _ fs _ [<- <-] fd hgetsc.
+  have : exists fd', get_fundef (p_funcs p) fn = Some fd' /\
+                     fd = sc_fun fd'.
+  + move: hgetsc; rewrite /sc_prog compiler_util.get_map_prog /=.
+    by case heq: get_fundef => [fd'|] //= [?]; subst fd; eauto.
+
+  move=> [fd'] [hget ?]; rewrite hget; subst fd; exists fd'=> // hpre; split.
+  + by apply sem_pre_sc. (* NOTE: we dont need to rewrite hget hgetsc*)
+  move=> s1 hinit; exists s1 => //.
+  + move: hinit hpre; rewrite /initialize_funcall /sem_pre /sc_fun /= hgetsc /=.
+    by clear hget hgetsc; case: fd' => //=.
+
+  exists (st_rel (fun _ => eq) tt), (st_rel (fun _ => eq) tt); split => //.
+  + rewrite /sc_fun /=; clear hget hinit hgetsc.
+    case: fd' => //= finf fcont ftin ftparam fbody ftout fres _.
+
+    set Pi := (fun i =>
+                 wequiv_rec (wc1 := withcatch) (wc2 := nocatch)
+                   (wa1 := withassert) (wa2 := withassert)
+                   pi p ev ev eq_spec (st_rel (λ _ : unit, eq) tt)
+                   (sc_instr i) [::i] (st_rel (λ _ : unit, eq) tt)).
+
+    set Pc := (fun c =>
+                 wequiv_rec (wc1 := withcatch) (wc2 := nocatch)
+                   (wa1 := withassert) (wa2 := withassert)
+                   pi p ev ev eq_spec (st_rel (λ _ : unit, eq) tt)
+                   (conc_map sc_instr c) c (st_rel (λ _ : unit, eq) tt)).
+
+    set Pi_r := (fun ir => forall ii,
+                 wequiv_rec (wc1 := withcatch) (wc2 := nocatch)
+                   (wa1 := withassert) (wa2 := withassert)
+                   pi p ev ev eq_spec
+                   (fun si s => st_rel (λ _ : unit, eq) tt si s /\
+                     sem_cond (wc:=withcatch) (p_globs p) (eands (sc_instr_ir ii ir).1) si = ok true)
+                   ([:: MkI ii (sc_instr_ir ii ir).2]) ([::MkI ii ir])
+                   (st_rel (λ _ : unit, eq) tt)).
+
+    rewrite -{2}(cats0 fbody).
+    apply wequiv_cat with (st_rel (λ _ : unit, eq) tt); last first.
+    + rewrite /safe_assert.
+      have -> : [seq MkI dummy_instr_info (Cassert (safety_lbl, e)) | e <- conc_map sc_var fres] =
+                [seq MkI dummy_instr_info (Cassert a) | a <- [seq (safety_lbl, e) | e <- conc_map sc_var fres]].
+      + by rewrite -map_comp.
+      by apply wequiv_asserts_left.
+    apply (cmd_rect (Pr := Pi_r) (Pi:=Pi) (Pc:=Pc)) => //;
+      subst Pi_r Pi Pc => /= {fn fs hpre s1 finf fcont ftin ftparam fbody ftout}.
+
+    + move=> ir ii hi; rewrite -(cat0s [:: MkI _ _]) -cats1.
+      apply wequiv_cat with (fun si s => st_rel (λ _ : unit, eq) tt si s /\
+           sem_cond (wc:=withcatch) (p_globs pi) (eands (sc_instr_ir ii ir).1) si = ok true).
+      + by apply safe_assertP.
+      by apply hi.
+
+    + by apply wequiv_nil.
+
+    + move=> i c hi hc; rewrite /conc_map /= -cat1s.
+      by apply wequiv_cat with (st_rel (λ _ : unit, eq) tt).
+
+    + move=> x tg ty e ii.
+      apply wequiv_assgn_core.
+      move=> si s si' [/estate_eq ->] /eandsE_cat [hscx1 hsce1].
+      rewrite /sem_assgn; t_xrbindP=> vei hvei vei' htri hwi.
+      have {}hvei := sc_pexprP hsce1 hvei.
+      have {}hwi := sc_lvalP hscx1 hwi.
+      by rewrite hvei /= htri /= hwi; eexists.
+
+    + move=> xs tg o es ii.
+      apply wkequiv_eq_pred; move=> s _ [/estate_eq <-].
+      move=> /eandsE_cons[] hwt /eandsE_cons[] hmem /eandsE_cat[] hscx /eandsE_cat[] hsco hsce.
+      apply wequiv_opn with (fun vs1 vs2 => [/\ vs1=vs2,
+                                  sem_pexprs_wc true gd s es = ok vs1 &
+                                  sem_pexprs true gd s es = ok vs2]) eq.
+      + by move=> s1 s2 sf [] ??; subst s1 s2 => he; have -> := sc_pexprsP hsce he; exists sf.
+      + move=> s1 s2 [] ??; subst s1 s2 => vs _ vf [] <- hewc he.
+        rewrite /exec_sopn /sopn_sem /=; case h: i_valid=> //=.
+        have := i_semi_safe h.
+        have := sem_cond_interp_safes hewc hsco.
+        have := sem_pexprs_defined he.
+        have : List.Forall2 (fun ty vs => type_of_val vs = eval_atype ty) (tin (get_instr_desc o)) vs.
+        + move: hwt he => [] {hewc hsco hsce}.
+          elim: (tin _) es vs => [ | ty tys ih] [ | e es] //=.
+          + by move=> vs _ [<-]; constructor.
+          move=> vs' /andP [hty htys].
+          t_xrbindP => v he vs hes <-; constructor.
+          + rewrite -(convertible_eval_atype hty).
+            by apply: sem_pexpr_type_of he.
+          by apply: ih htys hes.
+        rewrite -{3}(cat0s vs) /sopn_sem_ /interp_safe_cond_ty.
+        move=> {hewc he}.
+        elim: (tin (get_instr_desc o)) (semi (get_instr_desc o)) {1 2}[::] vs.
+        + move=> semi vs1 [] //=; rewrite cats0 => _ _ hall /(_ hall) [vr] -> /= [<-].
+          by exists (list_ltuple vr).
+        move=> ty tys ih semi vs1 [] //= v vs /List.Forall2_cons_iff [hty htys] /andP [hv hvs].
+        rewrite -cat_rcons => hall_safe hinterp.
+        case hof: of_val => [v' /= | e]; last by rewrite (isdef_errtype hv hof).
+        apply: ih => //.
+        by rewrite (type_of_val_to_val hty hv hof).
+
+      move=> vs _ <- s1 s2 sf [] ??; subst s1 s2 => hws.
+      have := sc_lvalsP _ _ _ hws; have /eandsE_cons {}hmem := conj hmem hscx.
+      by move=> /(_ _ _ hmem erefl (fun _ => erefl)) ->; exists sf.
+
+    + move => xs o es ii.
+      apply wkequivP' => si0 s0.
+      apply wequiv_syscall with
+      eq (fun fs1 fs2 => [/\ fs1 = fs2, emem si0 = fmem fs1
+                          & map type_of_val fs1.(fvals) = map eval_atype (scs_tout (syscall_sig_u o))]).
+      + apply wrequiv_weaken with
+          (fun t s => t = s /\
+            sem_cond_wc gd (eands (conc_map sc_pexpr es)) t =
+           ok true) eq => //.
+        + by move=> ??[ [-> ->] []] /estate_eq -> /= /eandsE_cons [] _ /eandsE_cat [_].
+        move=> s1 s2 vs [? hwc] h; subst s2.
+        by rewrite (sc_pexprsP hwc h); exists vs.
+      + move=> s s' [][] ?? [] /estate_eq ?; subst si0 s0 s'.
+        move=> hcond vs vs' fs ?; subst vs' => hex.
+        by have /= [-> <-] := syscall_u_toutP hex; exists fs.
+      move=> fs1 _ [] <- efmem htyof si s sf [][] ?? [] /estate_eq ?.
+      rewrite /upd_estate; subst si0 s0 si => + hws.
+      move=> /eandsE_cons[] hmem /eandsE_cat[] hscx hsce.
+      have := sc_lvalsP _ _ _ hws; have /eandsE_cons {}hmem := conj hmem hscx.
+      by move=> /(_ _ _ hmem erefl (fun _ => efmem)) ->; exists sf.
+
+    + move=> a ii; apply wequiv_assert => /= _; split => //.
+      move=> si s [/estate_eq ? hsce]; subst si.
+      rewrite /sem_cond; t_xrbindP => v he /to_boolI ?; subst v.
+      by have -> := sc_pexprP hsce he; eexists.
+
+    + move=> e c1 c2 hc1 hc2 ii.
+      apply wequiv_if.
+      + move=> si s b [/estate_eq ? hsce]; subst si.
+        rewrite /sem_cond; t_xrbindP => v he /to_boolI ?; subst v.
+        by have -> := sc_pexprP hsce he; eexists.
+        move=> b; apply wequiv_weaken with (st_rel (λ _ : unit, eq) tt)
+          (st_rel (λ _ : unit, eq) tt) => //; first by move=> ??[/estate_eq ->].
+      by case: b.
+
+    + move=> x dir lo hi c hc ii.
+      apply wequiv_for_eq with (st_rel (λ _ : unit, eq) tt) => //.
+      + by move=> > [].
+      + move=> s1 s2 vs [/estate_eq ->] /eandsE_cat[hsclo hschi] /=.
+        t_xrbindP => vlo hlo z0 vhi hhi ? ?; subst z0 vs.
+        have -> := sc_pexprP hsclo hlo.
+        have -> := sc_pexprP hschi hhi.
+        by eexists.
+      move=> i si s si' /estate_eq -> hw.
+      by exists si'.
+
+    + move=> al c e ii' c' hc hc' ii.
+      apply wequiv_weaken with (st_rel (λ _ : unit, eq) tt)
+                        (fun si s => st_rel (λ _ : unit, eq) tt si s /\
+                  sem_cond_wc (p_globs pi) (eands (sc_pexpr e)) si = ok true).
+      1-2: by move=> > [].
+      apply wequiv_while.
+      + move=> s s' b []/estate_eq ?; subst s'=> /sc_pexprP he.
+        by rewrite /sem_cond; t_xrbindP=> v /he -> /to_boolI ?; subst v; exists b.
+      + rewrite -{2}(cats0 c); apply wequiv_cat with (st_rel (λ _ : unit, eq) tt) => //.
+        by apply safe_assertP.
+      by apply wequiv_weaken with (st_rel (λ _ : unit, eq) tt)
+                                  (st_rel (λ _ : unit, eq) tt) => // > [].
+
+    + move=> xs f es ii.
+      apply wequiv_call_wa with (rpreF (eS:=eq_spec)) (rpostF (eS:=eq_spec)) eq.
+      + move=> s s' vs [] /estate_eq ?; subst s'.
+        move=> /eandsE_cons[] hmem /eandsE_cat[] hscx hsce hewc.
+        by have -> := sc_pexprsP hsce hewc; eauto.
+      + move=> s s' vs vs' [] /estate_eq ? + ?; subst s' vs'.
+        move=> /eandsE_cons[] hmem /eandsE_cat[] hscx hsce.
+        by apply sem_pre_sc.
+      + move=> s s' vs vs' [] /estate_eq ? + ?; subst s' vs'.
+        by move=> /eandsE_cons[] hmem /eandsE_cat[] hscx hsce.
+      + move=> fs fs' fr fr' [_ ?]; subst fs' => /= ?; subst fr'.
+        by apply sem_post_sc.
+      + move=> ???;exact/wequiv_fun_rec.
+      move=> fs fs' fr fr' [_ ?]; subst fs' => /= ?; subst fr'.
+      move=> s s' sf [] /estate_eq ?; subst s'.
+      rewrite /upd_estate=> /eandsE_cons[] hmem /eandsE_cat[] hscx hsce hw; exists sf=> //.
+      have := sc_lvalsP; have /eandsE_cons {}hmem := conj hmem hscx.
+      have falseP : forall p, false -> p by[].
+      move=> /(_ _ _ _ _ _ _ _ _ _ hw).
+      by move=> /(_ _ _ hmem erefl (falseP _ )).
+
+    + move=> s s' fs' /estate_eq ?; subst s'.
+      case: fd' hgetsc hget hinit => //.
+      rewrite get_map_prog /finalize_funcall /=.
+      case: get_fundef => //= > -[] <- [] -> /= ?.
+      by t_xrbindP => vs -> /= vs' -> /= <-; eauto.
+    by move=> ?? ->; apply sem_post_sc.
+Qed.
+
+End GLOBALS.
+
+Lemma safety_callP pi:
+  sc_prog p = ok pi ->
+  forall fn,
+  wiequiv_f_wa withcatch nocatch withassert withassert
+    pi p ev ev (rpreF (eS:= eq_spec)) fn fn (rpostF (eS:= eq_spec)).
+Proof.
+  rewrite /sc_prog; t_xrbindP => hall <-.
+  apply safety_callP_aux.
+  move=> x len t /get_globalI [gv] [hget hgv hty].
+Opaque ziota.
+  elim: gd hget hall => // -[y yd] gd ih /=.
+  case: eqP => // heq; last by move=> + /andP [_ ].
+  move=> [->] /andP [] {ih}.
+  by case: gv hgv => //= len' t' /Varr_inj [?] ?; subst len' t'.
+Qed.
+
+End SAFETY_PROOF.
diff --git a/proofs/lang/safety_shared.v b/proofs/lang/safety_shared.v
new file mode 100644
index 0000000000..2cf9c440b8
--- /dev/null
+++ b/proofs/lang/safety_shared.v
@@ -0,0 +1,189 @@
+From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
+From mathcomp Require Import word_ssrZ.
+Require Import expr.
+Import Utf8.
+
+Section DEFS.
+Context `{asmop:asmOp}.
+Context (m: var -> option (signedness * var)).
+
+Definition safety_cond := seq pexpr.
+
+Definition esubtype (ty1 ty2 : extended_type positive) :=
+ match ty1, ty2 with
+ | ETword None w, ETword None w' => (w ≤ w')%CMP
+ | ETword (Some sg) w, ETword (Some sg') w' => (sg == sg') && (w == w')
+ | ETint, ETint => true
+ | ETbool, ETbool => true
+ | ETarr ws l, ETarr ws' l' => arr_size ws l == arr_size ws' l'
+ | _, _ => false
+ end.
+
+Definition etrue := Pbool true.
+
+Fixpoint eands es :=
+  match es with
+  | [::] => etrue
+  | [::e] => e
+  | e::es => eand e (eands es)
+  end.
+
+Definition to_etype sg (t:atype) : extended_type positive:=
+  match t with
+  | abool    => tbool
+  | aint     => tint
+  | aarr ws l => tarr ws l
+  | aword ws => ETword _ sg ws
+  end.
+
+Definition sign_of_var x := Option.map fst (m x).
+
+Definition etype_of_var x : extended_type positive :=
+  to_etype (sign_of_var x) (vtype x).
+
+Definition sign_of_gvar (x : gvar) :=
+  if is_lvar x then sign_of_var (gv x)
+  else None.
+
+Definition etype_of_gvar x := to_etype (sign_of_gvar x) (vtype (gv x)).
+
+Definition sign_of_etype (ty: extended_type positive) : option signedness :=
+  match ty with
+  | ETword (Some s) _ => Some s
+  | _ => None
+  end.
+
+Fixpoint etype_of_expr (e:pexpr) : extended_type positive :=
+  match e with
+  | Pconst _ => tint
+  | Pbool _ => tbool
+  | Parr_init ws len => tarr ws len
+  | Pvar x => etype_of_gvar x
+  | Pget al aa ws x e => tword ws
+  | Psub al ws len x e => tarr ws len
+  | Pload al ws e => tword ws
+  | Papp1 o e => (etype_of_op1 o).2
+  | Papp2 o e1 e2 => (etype_of_op2 o).2
+  | PappN o es => to_etype None (type_of_opN o).2
+  | Pif ty e1 e2 e3 => to_etype (sign_of_etype (etype_of_expr e2)) ty
+  | Pbig ei o v e es el => (etype_of_op2 o).2
+  | Pis_var_init _ => tbool
+  | Pis_mem_init _ _ => tbool
+  end.
+
+Definition sign_of_expr (e:pexpr) : option signedness :=
+  sign_of_etype (etype_of_expr e).
+
+(* Op1: Casts*)
+
+Definition eint_of_word (sg:signedness) sz e := Papp1 (Oint_of_word sg sz) e.
+Definition word_of_int (sg:signedness) sz i := Papp1 (Oword_of_int sz) (Pconst i).
+
+(* Op2: Logics *)
+Definition elti e1 e2 := Papp2 (Olt Cmp_int) e1 e2.
+Definition elei e1 e2 := Papp2 (Ole Cmp_int) e1 e2.
+Definition eeqi e1 e2 := Papp2 (Oeq Op_int) e1 e2.
+Definition eneqi e1 e2 := Papp2 (Oneq Op_int) e1 e2.
+Definition elsli e1 e2 := Papp2 (Olsl Op_int) e1 e2.
+
+(* Op2: Arithmetics *)
+Definition eaddi e1 e2 := Papp2 (Oadd Op_int) e1 e2.
+Definition emuli e1 e2 := Papp2 (Omul Op_int) e1 e2.
+Definition edivi sg e1 e2 := Papp2 (Odiv sg Op_int) e1 e2.
+Definition emodi sg e1 e2 := Papp2 (Omod sg Op_int) e1 e2.
+
+(* Consts *)
+Definition ezero := Pconst 0.
+Definition ewsize sz := Pconst (wsize_size sz).
+Definition emin_signed sz := Pconst (wmin_signed sz).
+Definition emax_signed sz := Pconst (wmax_signed sz).
+Definition emax_unsigned sz := Pconst (wmax_unsigned sz).
+
+Definition emk_scale aa sz e :=
+  if (aa == AAdirect) then e
+  else emuli e (Pconst (wsize_size sz)).
+
+Definition eis_aligned e sz := eeq (emodi Unsigned e (ewsize sz)) (Pconst 0).
+
+Definition safety_lbl := "safety"%string.
+
+Definition safe_assert ii (sc:safety_cond) : cmd :=
+  map (fun e => MkI ii (Cassert (safety_lbl, e))) sc.
+
+(* ------ SC_OPS ------ *)
+
+Definition sc_in_range lo hi e := eand (elei lo e) (elei e hi).
+Definition sc_uint_range sz e := sc_in_range ezero (emax_unsigned sz) e.
+Definition sc_sint_range sz e := sc_in_range (emin_signed sz) (emax_signed sz) e.
+Definition sc_wi_range sg sz e := signed (sc_uint_range sz) (sc_sint_range sz) sg e.
+
+Definition is_wi1 (o: sop1) :=
+  if o is Owi1 s op then Some (s, op) else None.
+
+Definition is_wi2 (o: sop2) :=
+  if o is Owi2 s sw op then Some (s, sw, op) else None.
+
+Definition sc_wiop1 (toint : signedness -> wsize -> pexpr -> pexpr)
+  sg (o : wiop1) (e: pexpr) :=
+  match o with
+  | WIwint_of_int sz => [:: sc_wi_range sg sz e]
+  | WIint_of_wint sz => [::]
+  | WIword_of_wint sz => [::]
+  | WIwint_of_word sz => [::]
+  | WIwint_ext szo szi => [::]
+  | WIneg sz =>
+      signed  [::eeqi (toint sg sz e) ezero ]
+              [::eneqi (toint sg sz e) (emin_signed sz)] sg
+  end.
+
+(* [op : int -> int -> int] [e1 e2 : int] *)
+Definition sc_wi_range_op2 sg sz op e1 e2 :=
+  sc_wi_range sg sz (Papp2 op e1 e2).
+
+(* [e1 e2 : int] *)
+Definition sc_divmod sg sz e1 e2 :=
+ let sc := signed [::]
+                  [:: enot (eand (eeqi e1 (emin_signed sz)) (eeqi e2 (Pconst (-1)))) ] sg in
+ [:: eneqi e2 ezero & sc].
+
+Definition sc_wiop2 sg sz o e1 e2 :=
+  match o with
+  | WIadd => [:: sc_wi_range_op2 sg sz (Oadd Op_int) e1 e2]
+  | WImul => [:: sc_wi_range_op2 sg sz (Omul Op_int) e1 e2]
+  | WIsub => [:: sc_wi_range_op2 sg sz (Osub Op_int) e1 e2]
+  | WIdiv => sc_divmod sg sz e1 e2
+  | WImod => sc_divmod sg sz e1 e2
+  | WIshl => [:: sc_wi_range sg sz (elsli e1 e2) ]
+  | WIshr => [::]
+  | WIeq | WIneq | WIlt | WIle | WIgt | WIge  => [::]
+  end.
+
+Definition sc_op1 (toint : signedness -> wsize -> pexpr -> pexpr)
+  (op1 : sop1) e :=
+  match is_wi1 op1 with
+  | Some (sg, o) => sc_wiop1 toint sg o e
+  | None => [::]
+  end.  
+
+Fixpoint get_var_contract (v: var_i) (vs: seq var_i) (vs': seq var_i) : option var_i :=
+    match vs, vs' with
+      | x::vs, x'::vs' =>
+        if var_beq v x then Some x' else get_var_contract v vs vs'
+      | _, _ => None
+    end.
+    
+Definition sc_all cond v start len :=
+  if cond is nil then [::]
+  else [:: Pbig etrue Oand v (eands cond) start len].
+
+Fixpoint check_xs (okmem : bool) W xs scs :=
+  match xs, scs with
+  | [::], [::] => true
+  | x :: xs, sc :: scs =>
+    [&& okmem || (~~has (fun e => use_mem e) sc)
+      , disjoint (read_es sc) W
+      & check_xs (okmem && ~~lv_write_mem x) (vrv_rec W x) xs scs]
+  | _, _ => false (* Should never occurs *)
+  end.
+
+End DEFS.
diff --git a/proofs/lang/safety_shared_proof.v b/proofs/lang/safety_shared_proof.v
new file mode 100644
index 0000000000..a8f608613e
--- /dev/null
+++ b/proofs/lang/safety_shared_proof.v
@@ -0,0 +1,424 @@
+From mathcomp Require Import ssreflect ssrfun ssrbool ssralg eqtype word_ssrZ.
+Require Import psem safety_shared.
+Import Utf8.
+
+Section LEMMAS.
+Context
+  {asm_op syscall_state : Type}
+  {ep : EstateParams syscall_state}
+  {spp : SemPexprParams}.
+
+#[local] Existing Instance nosubword.
+#[local] Existing Instance withassert.
+
+Lemma to_val_defined t (x : sem_t t) v : to_val x = v -> is_defined v.
+Proof. by move=>/to_valI; case: v. Qed.
+
+Lemma sem_pexpr_defined {wc: WithCatch} s gd e v : sem_pexpr true gd s e = ok v -> is_defined v.
+Proof.
+  case: e => /=; t_xrbindP; try by move=> *; subst.
+  + by move=> > /get_gvar_compat /= [].
+  + by move=> >; apply: on_arr_gvarP => ????; t_xrbindP => *; subst.
+  + by move=> >; apply: on_arr_gvarP => ????; t_xrbindP => *; subst.
+  + move=> > _; rewrite /sem_sop1; case: wc => -[] /=; first last.
+    + by t_xrbindP => ????; apply to_val_defined.
+    case: of_val=> ? /=; first case: sem_sop1_typed => ? /=.
+    + by move=> [] /to_val_defined.
+    1-2: by case: ifP => //= _ [] <-; apply /is_defined_default_val.
+  + move=> > _ > _ >; rewrite /sem_sop2; case: wc => -[] /=; first last.
+    + by t_xrbindP => ??????; apply to_val_defined.
+    case: of_val=> ? /=; case: of_val=> ? /=; first case: sem_sop2_typed => ? /=.
+    + by move=> [] /to_val_defined.
+    1-4: by case: ifP => //= _ [] <-; apply /is_defined_default_val.
+  + move=> > _; rewrite /sem_opN; case: wc => -[] /=; first last.
+    + by t_xrbindP => ??; apply to_val_defined.
+    case: app_sopn=> ? /=; first by move=> [] /to_val_defined.
+    by case: ifP => //= _ [] <-; apply /is_defined_default_val.
+  + by move=> > _ _ > _ /truncate_val_defined ? > _ /truncate_val_defined ? <-; case: ifP.
+  + move=> > _ _ > _ _ vid > _ /truncate_val_defined.
+    elim: ziota vid => //=.
+    + by move=> ?? [<-].
+    move=> ?? hrec vid _; t_xrbindP => > _ > _ hop2; apply hrec.
+    move: hop2; rewrite /sem_sop2; case: wc hrec => -[] /= hrec; first last.
+    + by t_xrbindP => ??????; apply to_val_defined.
+    + case: of_val => ? /=; case: of_val => ? /=; first case: sem_sop2_typed => ? /=.
+      + by move=> [] /to_val_defined.
+      1-4: by case: ifP => //= _ [] <-; apply /is_defined_default_val.
+  all: by move=> >; apply: on_arr_varP; t_xrbindP => *; subst.
+Qed.
+
+Lemma sem_pexprs_defined s gd es vs : sem_pexprs true gd s es = ok vs -> all is_defined vs.
+Proof.
+  elim : es vs => /= [ | e es hrec] vs; t_xrbindP.
+  + by move=> <-.
+  by move=> ? /sem_pexpr_defined he ? /hrec hes <- /=; rewrite he hes.
+Qed.
+
+Lemma isdef_errtype v t e:
+  is_defined v ->
+  of_val t v = Error e ->
+  e = ErrType.
+Proof.
+  case: t; case: v => //=; rewrite /type_error;
+  try by move=> > ? > ? [].
+  by rewrite /WArray.cast=> > _; case: ifP => // _ [].
+  by move=> > _ /truncate_word_errP[].
+Qed.
+
+Lemma etrueE {wc:WithCatch} gd s : sem_cond gd etrue s = ok true.
+Proof. done. Qed.
+
+Opaque of_val.
+Lemma enotE {wc:WithCatch} gd s e b:
+  sem_cond gd (enot e) s = ok b <-> sem_cond gd e s = ok (~~b).
+Proof.
+  rewrite /sem_cond /= /sem_sop1 /=; split; t_xrbindP.
+  + rewrite /with_catch; case: wc => -[] >.
+    + move=> he; rewrite he /=.
+      have hdef := isdef_errtype (sem_pexpr_defined he).
+      case heq : of_val => /=.
+      + by move=> [<-] /to_boolI[<-]; rewrite Bool.negb_involutive.
+      by have -> := hdef cbool _ heq.
+    t_xrbindP => -> ? /to_boolI -> <- /to_boolI[<-] /=.
+    by rewrite Bool.negb_involutive.
+  move=> z -> /= /to_boolI ?; subst z.
+  rewrite /with_catch; case: wc => -[].
+  + case heq : of_val => //=.
+    + by move: heq => /to_boolI[<-]; rewrite Bool.negb_involutive.
+  by rewrite of_val_to_val /= Bool.negb_involutive.
+Qed.
+
+Lemma eandE {wc:WithCatch} gd s e1 e2 :
+  sem_cond gd (eand e1 e2) s = ok true <->
+    sem_cond gd e1 s = ok true /\ sem_cond gd e2 s = ok true.
+Proof.
+  rewrite /eand /sem_cond /= /sem_sop2 /=; split.
+  + t_xrbindP => z z1 he1 z2 he2; rewrite he1 he2 /=.
+    case: wc he1 he2 => -[] /= /sem_pexpr_defined he1 /sem_pexpr_defined he2.
+    + move=> + /to_boolI ?; subst z.
+      case h2: of_val=> [?|e] /=; case h1: of_val => [?|e']/=.
+      + by move: h1 h2 => /= /to_boolI -> /to_boolI -> [] /andP[-> ->].
+        1,3: by case: ifP => //; have:=isdef_errtype (t:=sbool) he1 h1; move=> ->.
+      by case: ifP => //; have:=isdef_errtype (t:=sbool) he2 h2; move=> ->.
+  + by t_xrbindP=> b1 /to_boolI -> b2 /to_boolI -> <-; case: b1 b2 => -[].
+  move=> []; t_xrbindP => z -> /to_boolI ?; subst z.
+  move=> z -> /to_boolI ?; subst z => /=.
+  by case: with_catch.
+Qed.
+Transparent of_val.
+
+Lemma eandsE_nil {wc: WithCatch} gd s : sem_cond gd (eands [::]) s = ok true.
+Proof. done. Qed.
+
+Lemma eandsE_1 {wc: WithCatch} gd s e : sem_cond gd (eands [::e]) s = sem_cond gd e s.
+Proof. done. Qed.
+
+Lemma eandsE_cons {wc: WithCatch} gd s e es :
+  sem_cond gd (eands (e::es)) s = ok true <-> sem_cond gd e s = ok true /\ sem_cond gd (eands es) s = ok true.
+Proof.
+  rewrite /=; case: es => /=.
+  + rewrite etrueE; tauto.
+  by move=> ??; rewrite eandE.
+Qed.
+
+Lemma read_etrue : read_e etrue = Sv.empty.
+Proof. done. Qed.
+
+Lemma read_eands es : Sv.Equal (read_e (eands es)) (read_es es).
+Proof.
+  elim: es => //= e l hrec; rewrite read_es_cons -hrec => {hrec}.
+  case: l.
+  + rewrite /= read_etrue; SvD.fsetdec.
+  move=> a l; move: (a::l) => {a} {}l.
+  by rewrite read_e_Papp2.
+Qed.
+
+Lemma use_mem_eands es :
+  use_mem (eands es) = has (fun e => use_mem e) es.
+Proof.
+  elim: es => //=.
+  move=> a [ /= | a' l] hl.
+  + by rewrite orbF.
+  by move: (a'::l) hl => {a'} {}l <-.
+Qed.
+
+Opaque eands.
+
+Lemma eandsE_cat {wc:WithCatch} gd s es1 es2 :
+   sem_cond gd (eands (es1 ++ es2)) s = ok true <->
+   sem_cond gd (eands es1) s = ok true /\ sem_cond gd (eands es2) s = ok true.
+Proof.
+  elim: es1 => //=.
+  + by rewrite etrueE; tauto.
+  move=> e es1 hrec; rewrite !eandsE_cons hrec; tauto.
+Qed.
+
+Lemma wmin_signed_neg ws : (wmin_signed ws < 0)%Z.
+Proof. rewrite /wmin_signed; have := half_modulus_pos ws; Lia.lia. Qed.
+
+Lemma wmax_signed_pos ws : (0 < wmax_signed ws)%Z.
+Proof. by case: ws. Qed.
+
+Lemma in_wint_range_zasr sg sz (w1 : word sz) (w2 : u8) :
+  in_wint_range sg sz (zasr (int_of_word sg w1) (int_of_word Unsigned w2)) = ok tt.
+Proof.
+  rewrite /in_wint_range /zasr /zlsl /assert; case: ifPn => // /negP.
+  have [h1 h2] := wunsigned_range w2.
+  rewrite /int_of_word /=; elim; case: ZleP => ?.
+  + have -> /= : wunsigned w2 = 0%Z by Lia.lia.
+    rewrite Z.mul_1_r; case: (sg) => /=;
+    [have [??] := wsigned_range w1 | have [??] := wunsigned_range w1];
+    apply/andP; split; apply /ZleP => //.
+    rewrite /wmax_unsigned; Lia.lia.
+  have ? : (0 < 2 ^ wunsigned w2)%Z by Lia.nia.
+  rewrite Z.opp_involutive; case: (sg) => /=.
+  + have ? := wmin_signed_neg sz; have ? := wmax_signed_pos sz.
+    have [??] := wsigned_range w1.
+    apply/andP;split;apply/ZleP.
+    + by apply Z.div_le_lower_bound => //; Lia.nia.
+    by apply Z.div_le_upper_bound => //; Lia.nia.
+  have ? : (1 <= wmax_unsigned sz)%Z.
+  + by case sz.
+  have [??] := wunsigned_range w1.
+  have ? : (0 < 2 ^ wunsigned w1)%Z by Lia.nia.
+  apply/andP;split;apply/ZleP.
+  + apply Z.div_le_lower_bound => //; Lia.nia.
+  apply Z.div_le_upper_bound => //; rewrite /wmax_unsigned; Lia.nia.
+Qed.
+
+Lemma wsigned_opp sz (w:word sz) : wsigned w ≠ wmin_signed sz → (- wsigned w)%Z = wsigned (- w).
+Proof.
+  rewrite !wsigned_alt.
+  rewrite !wunsigned_add_if wunsigned_opp_if.
+  have h1 := half_modulus_pos sz.
+  have h2 := wbase_twice_half sz.
+  have -> : wunsigned (wrepr sz (half_modulus sz)) = half_modulus sz.
+  + by apply wunsigned_repr_small; Lia.lia.
+  case: eqP => [-> | ? ].
+  + rewrite Z.add_0_l; have -> : (half_modulus sz <? wbase sz)%Z.
+    + by apply /ZltP; Lia.lia.
+    by move=> _; ring.
+  rewrite /wmin_signed; case: ZltP => ?; case: ZltP => ?; Lia.lia.
+Qed.
+
+Section SC.
+
+Context (gd : glob_decls) (s : estate).
+
+Lemma eleiP {wc: WithCatch} e1 e2 i1 i2 :
+  sem_pexpr true gd s e1 = ok (Vint i1) →
+  sem_pexpr true gd s e2 = ok (Vint i2) →
+  sem_cond gd (elei e1 e2) s = ok (i1 <=? i2)%Z.
+Proof. by rewrite /sem_cond /= => -> ->; case: wc => -[]. Qed.
+
+Lemma eltiP e1 e2 i1 i2 :
+  sem_pexpr true gd s e1 = ok (Vint i1) →
+  sem_pexpr true gd s e2 = ok (Vint i2) →
+  sem_cond gd (elti e1 e2) s = ok (i1 <? i2)%Z.
+Proof. by rewrite /sem_cond /= => -> ->. Qed.
+
+Lemma eeqiP {wc:WithCatch} e1 e2 i1 i2 :
+  sem_pexpr true gd s e1 = ok (Vint i1) →
+  sem_pexpr true gd s e2 = ok (Vint i2) →
+  sem_cond gd (eeqi e1 e2) s = ok (i1 == i2).
+Proof. by rewrite /sem_cond /= => -> ->; case: wc => -[]. Qed.
+
+Lemma eneqiP {wc: WithCatch} e1 e2 i1 i2 :
+  sem_pexpr true gd s e1 = ok (Vint i1) →
+  sem_pexpr true gd s e2 = ok (Vint i2) →
+  sem_cond gd (eneqi e1 e2) s = ok (i1 != i2).
+Proof. by rewrite /sem_cond /= => -> ->; case: wc => -[]. Qed.
+
+Lemma sc_sint_rangeP {wc:WithCatch} e i sz :
+  sem_pexpr true gd s e = ok (Vint i) →
+  sem_cond gd (sc_sint_range sz e) s = ok true →
+  in_sint_range sz i.
+Proof.
+  rewrite /sc_sint_range /sc_in_range eandE => he.
+  rewrite (eleiP (i1 := wmin_signed sz) _ he) => //.
+  by rewrite (eleiP (i2 := wmax_signed sz) he) /in_sint_range => // -[[->] [->]].
+Qed.
+
+Lemma sc_uint_rangeP {wc:WithCatch} e i sz :
+  sem_pexpr true gd s e = ok (Vint i) →
+  sem_cond gd (sc_uint_range sz e) s = ok true →
+  in_uint_range sz i.
+Proof.
+  rewrite /sc_uint_range /sc_in_range eandE => he.
+  rewrite (eleiP (i1 := 0%Z) _ he) => //.
+  by rewrite (eleiP (i2 := wmax_unsigned sz) he) /in_uint_range => // -[[->] [->]].
+Qed.
+
+Lemma sc_wi_rangeP {wc:WithCatch} e i sg sz :
+  sem_pexpr true gd s e = ok (Vint i) →
+  sem_cond gd (sc_wi_range sg sz e) s = ok true →
+  in_wint_range sg sz i = ok tt.
+Proof.
+  rewrite /sc_wi_range /in_wint_range.
+  case: sg => /= he hc.
+  + by rewrite (sc_sint_rangeP he hc).
+  by rewrite (sc_uint_rangeP he hc).
+Qed.
+
+Lemma int_of_word_wrepr sg sz z :
+  in_wint_range sg sz z = ok tt ->
+  int_of_word sg (wrepr sz z) = z.
+Proof.
+  case: sg => /assertP /andP[] /ZleP ? /ZleP; rewrite /wmax_unsigned => ?.
+  + exact: wsigned_repr.
+  apply wunsigned_repr_small; Lia.lia.
+Qed.
+
+Lemma wint_of_int_of_word sg sz (w : word sz) :
+  wint_of_int sg sz (int_of_word sg w) = ok w.
+Proof.
+  rewrite /wint_of_int /int_of_word /in_wint_range /signed.
+  case: sg.
+  + rewrite wrepr_signed /in_sint_range.
+    by have [/ZleP -> /ZleP ->]:= wsigned_range w.
+  rewrite wrepr_unsigned /in_uint_range.
+  have [/ZleP -> h]:= wunsigned_range w.
+  have /ZleP -> //: (wunsigned w <= wmax_unsigned sz)%Z.
+  by rewrite /wmax_unsigned; Lia.lia.
+Qed.
+
+Lemma sc_int_of_word_wrepr {wc:WithCatch} e i sg sz:
+  sem_pexpr true gd s e = ok (Vint i) →
+  sem_cond gd (sc_wi_range sg sz e) s = ok true →
+  int_of_word sg (wrepr sz i) = i.
+Proof.
+  move=> he hsc; apply int_of_word_wrepr.
+  apply: sc_wi_rangeP he hsc.
+Qed.
+
+Lemma sc_wi_range_of_int {wc:WithCatch} e i sg sz :
+  sem_pexpr true gd s e = ok (Vint i) →
+  sem_cond gd (sc_wi_range sg sz e) s = ok true →
+  wint_of_int sg sz i = ok (wrepr sz i).
+Proof. by move=> he hsc; rewrite -{1}(sc_int_of_word_wrepr he hsc) wint_of_int_of_word. Qed.
+
+Lemma sc_allE body start len (xi:var_i) sti leni:
+  vtype xi = aint ->
+  sem_pexpr true gd s start = ok (Vint sti) ->
+  sem_pexpr true gd s len = ok (Vint leni) ->
+  sem_cond gd (eands (sc_all body xi start len)) s = ok true ->
+  List.Forall (fun (j : Z) =>
+    (Let s := write_var true xi j s in
+     sem_cond gd (eands body) s) = ok true) (ziota sti leni).
+Proof.
+  move=> hxi hst hlen; rewrite /sc_all.
+  case: body.
+  + move=> _; elim: ziota => // j js hrec; constructor => //.
+    by rewrite (write_var_eq_type (x:=xi) (v:=Vint j)) //= hxi.
+  move=> a l; move: (a :: l) => body {a l}.
+  rewrite eandsE_1 /sem_cond /= hst hlen /=; t_xrbindP.
+  move=> z + /to_boolI ?; subst z.
+  elim: ziota => //= j js hrec; t_xrbindP.
+  move=> v s1 hw v2 hv2 hand hfold.
+  move: hand; rewrite /sem_sop2 /=; t_xrbindP => b hb ?; subst v.
+  case: b hfold hb; last first.
+  + move=> hfold _; have //: False.
+    elim: (js) hfold => //= j' js' hrec'; rewrite {2}/sem_sop2 /= /mk_sem_sop2; t_xrbindP => /=.
+    by move=> > _ > _ > _ <-.
+  move=> hfold /to_boolI ?; subst v2; constructor => //.
+  + by rewrite hw /= hv2.
+  by apply hrec.
+Qed.
+
+Lemma int_of_word0 sg sz : int_of_word (sz:=sz) sg 0 = 0%Z.
+Proof. by case: sg => /=; rewrite ?wsigned0 ?wunsigned0. Qed.
+
+Lemma sem_sc_divmod {wc: WithCatch} sz sg (w1 w2 : word sz) e1 e2 :
+  sem_pexpr true gd s e1 = ok (Vint (int_of_word sg w1)) →
+  sem_pexpr true gd s e2 = ok (Vint (int_of_word sg w2)) →
+  sem_cond gd (eands (sc_divmod sg sz e1 e2)) s = ok true →
+  ((w2 == 0%R) || [&& sg == Signed, wsigned w1 == wmin_signed sz & w2 == (-1)%R]) = false.
+Proof.
+  move=> h1 h2; rewrite /sc_divmod eandsE_cons.
+  rewrite (eneqiP (i2:=0%Z) h2) // => -[[/eqP h0] hsc].
+  apply/negbTE/negP => /orP [ /eqP ?| /and3P [/eqP ? /eqP hw1 /eqP ?]].
+  + by subst w2; apply/h0/int_of_word0.
+  subst w2 sg; move: hsc => /=; rewrite eandsE_1 enotE.
+  have -> // : sem_cond gd (eand (eeqi e1 (emin_signed sz)) (eeqi e2 (-1)%Z)) s = ok true.
+  by rewrite eandE (eeqiP (i2:= wmin_signed sz) h1) // (eeqiP (i2:= -1) h2) // -hw1 eqxx /= wsignedN1 eqxx.
+Qed.
+
+Lemma sem_pexpr_tovI e v t :
+  sem_pexpr true gd s e = ok v ->
+  type_of_val v = t ->
+  match t with
+  | cbool => ∃ b : bool, v = b
+  | cint => ∃ i : Z, v = i
+  | carr len => ∃ a : WArray.array len, v = Varr a
+  | cword ws => ∃ w : word ws, v = Vword w
+  end.
+Proof.
+  move=> /sem_pexpr_defined hd /type_of_valI h.
+  by case: t h hd => // [||ws] [->| ].
+Qed.
+
+Lemma check_scP {wc: WithCatch} sc s1 s2 okmem W:
+  okmem || ~~has use_mem sc ->
+  disjoint (read_es sc) W ->
+  evm s1 =[\W] evm s2 ->
+  (okmem → emem s1 = emem s2) ->
+  sem_cond gd (eands sc) s1 = sem_cond gd (eands sc) s2.
+Proof.
+  rewrite -read_eands -use_mem_eands /sem_cond.
+  move: (eands _) => e hokm /Sv.is_empty_spec hdisj hvm hmem.
+  suff : [elaborate sem_pexpr true gd s1 e = sem_pexpr true gd s2 e].
+  + by move=> ->.
+  have ? : evm s1 =[read_e e] evm s2.
+  + by move=> x hx; apply hvm; SvD.fsetdec.
+  case: okmem hokm hmem => /=.
+  + by move=> _ /(_ erefl) hmem; apply: (eq_on_sem_pexpr true gd hmem).
+  by move=> huse _; apply use_memP_eq_on.
+Qed.
+
+End SC.
+
+(* FIXME: move this in relationnal, and generalize to wequiv, safe_assert should be move in expr *)
+Section SafeAssert.
+Context {sip : SemInstrParams asm_op syscall_state}.
+#[local] Existing Instance progUnit.
+#[local] Existing Instance indirect_c.
+
+Context {E E0: Type -> Type} {wE : with_Error E E0} {rE : EventRels E0}.
+Variable (p1 p2:uprog) (ev:extra_val_t).
+
+Notation gd := (p_globs p1).
+
+Lemma safe_assertP {wc1 wc2: WithCatch} R spec ii scs :
+  wequiv_rec (wc1:=wc1) (wc2:=wc2) p1 p2 ev ev spec R (safe_assert ii scs) [::]
+    (λ s1 s2 : estate, R s1 s2 ∧ sem_cond (wc:=wc1) gd (eands scs) s1 = ok true).
+Proof.
+  apply wkequiv_eq_pred => s1 s2 hR.
+  apply wequiv_weaken with
+    (eq_init s1 s2) (λ s1' s2' : estate, eq_init s1 s2 s1' s2' ∧ sem_cond (wc:=wc1) gd (eands scs) s1 = ok true) => //.
+  + by move=> _ _ [[-> ->] ?].
+  elim : scs => [| sc scs hrec].
+  + by apply wequiv_nil => ?? [-> ->]; rewrite eandsE_nil.
+  rewrite /= -(cats0 [::]) -cat1s.
+  apply wequiv_cat with (λ s1' s2' : estate, eq_init s1 s2 s1' s2' ∧ sem_cond (wc:=wc1) gd sc s1 = ok true).
+  + apply wequiv_assert_left =>  _ _ _ [-> ->] /=; rewrite /sem_cond.
+    + by move=> ->.
+  apply wkequiv_eq_pred => _ _ [[-> ->] hsc].
+  apply wequiv_weaken with (eq_init s1 s2)
+      (λ s1' s2' : estate, (s1' = s1 ∧ s2' = s2) ∧ sem_cond (wc:=wc1) gd (eands scs) s1 = ok true) => //.
+  by move => ?? [[-> ->]]; rewrite eandsE_cons.
+Qed.
+
+Lemma syscall_u_toutP o fs fs' :
+  fexec_syscall o fs = ok fs' ->
+  fmem fs = fmem fs' /\ List.map type_of_val fs'.(fvals) = map eval_atype (scs_tout (syscall_sig_u o)).
+Proof.
+  rewrite /fexec_syscall; t_xrbindP => -[[scs m_] vs_] + [<-] /=.
+  case: o => ws len /=.
+  rewrite /exec_getrandom_u.
+  case: (fvals fs) => // v [] //; t_xrbindP.
+  by move=> ?? _ ? _ <- /= _ <- <-.
+Qed.
+
+End SafeAssert.
+
+End LEMMAS.
diff --git a/proofs/lang/sem_op_typed.v b/proofs/lang/sem_op_typed.v
index 6304b979e4..4fa3414023 100644
--- a/proofs/lang/sem_op_typed.v
+++ b/proofs/lang/sem_op_typed.v
@@ -2,7 +2,7 @@
 From mathcomp Require Import ssreflect ssrfun ssrbool eqtype div ssralg.
 From mathcomp Require Import word_ssrZ.
 Require Export type expr sem_type.
-Require Export flag_combination.
+Require Export flag_combination sem_params.
 Import Utf8.
 
 Definition mk_sem_sop1 (t1 t2 : Type) (o:t1 -> t2) v1 : exec t2 :=
@@ -180,7 +180,7 @@ Context {cfcd : FlagCombinationParams}.
 Definition sem_combine_flags (cf : combine_flags) (b0 b1 b2 b3 : bool) : bool :=
   cf_xsem negb andb orb (fun x y => x == y) b0 b1 b2 b3 cf.
 
-Definition sem_opN_typed (o: opN) :
+Definition sem_opN_typed {wa:WithAssert} (o: opN) :
   let t := type_of_opN o in
   let t := (map eval_atype t.1, eval_atype t.2) in
   sem_prod t.1 (exec (sem_t t.2)) :=
@@ -193,10 +193,18 @@ Definition sem_opN_typed (o: opN) :
       ecast l (sem_prod l _) (esym (map_nseq _ _ _)) ty
   | Ocombine_flags cf =>
       fun b0 b1 b2 b3 => ok (sem_combine_flags cf b0 b1 b2 b3)
+  | Ois_arr_init alen =>
+      fun (a:WArray.array alen) (lo:Z) (len:Z) =>
+        Let _ := assert assert_allowed ErrType in
+        ok (all (WArray.is_init a) (ziota lo len))
+  | Ois_barr_init alen =>
+      fun (a:WArray.array alen) (lo:Z) (len:Z) =>
+        Let _ := assert assert_allowed ErrType in
+        ok (all (WArray.is_initb a) (ziota lo len))
   end.
 
 Lemma sem_opN_typed_ok (op: opN) :
-  sem_forall (@is_ok _ _) _ (sem_opN_typed op).
+  sem_forall (@is_ok _ _) _ (sem_opN_typed (wa := withassert) op).
 Proof.
   case: op => // [ ws pe | len ] /=; rewrite -> map_nseq => /=.
   + by case: ws pe => - [].
diff --git a/proofs/lang/sem_params.v b/proofs/lang/sem_params.v
index b715c05a24..96c5df6513 100644
--- a/proofs/lang/sem_params.v
+++ b/proofs/lang/sem_params.v
@@ -62,3 +62,9 @@ Definition noassert : WithAssert := {| assert_allowed := false |}.
 Definition withassert : WithAssert := {| assert_allowed := true |}.
 
 #[global] Existing Instances noassert | 1000.
+
+Class WithCatch := { with_catch : bool }.
+Definition nocatch : WithCatch := {| with_catch := false |}.
+Definition withcatch : WithCatch := {| with_catch := true |}.
+
+#[global] Existing Instances nocatch | 1000.
diff --git a/proofs/lang/sopn.v b/proofs/lang/sopn.v
index 3ea734c652..fc6a45943f 100644
--- a/proofs/lang/sopn.v
+++ b/proofs/lang/sopn.v
@@ -4,6 +4,7 @@ From mathcomp Require Import ssreflect ssrfun ssrbool seq eqtype ssralg.
 
 Require Import
   pseudo_operator
+  operators
   sem_type
   shift_kind
   strings
@@ -47,6 +48,7 @@ Record instruction_desc := mkInstruction {
   *)
   i_valid  : bool;
   i_safe   : seq safe_cond;
+  i_init  : seq init_cond;
   (* Extra properties ensuring that previous information are consistent *)
   i_safe_wf    : all (fun sc => ssrnat.leq (sc_needed_args sc) (size tin)) i_safe;
     (* id_semi does not generates type error *)
@@ -57,7 +59,7 @@ Record instruction_desc := mkInstruction {
 
 Arguments semu _ [vs vs' v] _ _.
 
-Notation mk_instr_desc str tin i_in tout i_out semi safe valid semi_errty semi_safe :=
+Notation mk_instr_desc str tin i_in tout i_out semi safe init valid semi_errty semi_safe :=
   {| str          := str;
      tin          := tin;
      i_in         := i_in;
@@ -67,14 +69,15 @@ Notation mk_instr_desc str tin i_in tout i_out semi safe valid semi_errty semi_s
      semi         := semi;
      semu         := @vuincl_app_sopn_v (map eval_atype tin) (map eval_atype tout) semi refl_equal;
      i_safe       := safe;
+     i_init       := init;
      i_valid      := valid;
      i_safe_wf    := refl_equal;
      i_semi_errty := semi_errty;
      i_semi_safe  := semi_safe;
   |}.
 
-Notation mk_instr_desc_safe str tin i_in tout i_out semi valid :=
-  (mk_instr_desc str tin i_in tout i_out (sem_prod_ok (map eval_atype tin) semi) [::] valid
+Notation mk_instr_desc_safe str tin i_in tout i_out semi valid init :=
+  (mk_instr_desc str tin i_in tout i_out (sem_prod_ok (map eval_atype tin) semi) [::] init valid
      (fun _ => (@sem_prod_ok_error _ (map eval_atype tin) semi ErrType))
      (fun _ => (@sem_prod_ok_safe _ (map eval_atype tin) semi)))
   (only parsing).
@@ -225,6 +228,7 @@ Definition Ocopy_instr ws p :=
      semu     := @vuincl_copy ws p;
      i_valid  := true;
      i_safe   := [:: AllInit ws p 0];
+     i_init   := [:: IBool true];
      i_safe_wf    := refl_equal;
      i_semi_errty := fun _ => (@array_copy_errty ws p);
      i_semi_safe  := fun _ => (@array_copy_safe ws p);
@@ -256,6 +260,7 @@ Definition Odeclassify_instr ty :=
     semi     := fun=> ok tt;
     semu     := @declassify_semu cty;
     i_safe   := [:: ];
+    i_init   := [:: ];
     i_valid  := true;
     i_safe_wf    := refl_equal;
     i_semi_errty := fun _ => (@sem_prod_ok_error _ [:: cty ] _ ErrType);
@@ -274,6 +279,7 @@ Definition Odeclassify_mem_instr len :=
     semi     := fun=> ok tt;
     semu     := @declassify_semu cty;
     i_safe   := [:: ];
+    i_init   := [:: ];
     i_valid  := true;
     i_safe_wf    := refl_equal;
     i_semi_errty := fun _ => (@sem_prod_ok_error _ [:: cty ] _ ErrType);
@@ -285,7 +291,7 @@ Definition Onop_instr :=
            [::] [::]
            [::] [::]
            tt
-           true.
+           true [::].
 
 Definition Omulu_instr sz :=
   mk_instr_desc_safe (pp_sz "mulu" sz)
@@ -293,7 +299,7 @@ Definition Omulu_instr sz :=
            [:: E 0; E 1] (* this info is irrelevant *)
            [:: aword sz; aword sz]
            [:: E 2; E 3] (* this info is irrelevant *)
-           (@wumul sz) true.
+           (@wumul sz) true [:: IBool true; IBool true].
 
 Definition Oaddcarry_instr sz :=
   mk_instr_desc_safe (pp_sz "adc" sz)
@@ -302,7 +308,7 @@ Definition Oaddcarry_instr sz :=
            [:: abool; aword sz]
            [:: E 3; E 4]      (* this info is irrelevant *)
            (fun x y c => let p := @waddcarry sz x y c in (Some p.1, p.2))
-           true.
+           true [:: IBool true; IBool true].
 
 Definition Osubcarry_instr sz :=
   mk_instr_desc_safe (pp_sz "sbb" sz)
@@ -311,7 +317,7 @@ Definition Osubcarry_instr sz :=
            [:: abool; aword sz]
            [:: E 3; E 4]      (* this info is irrelevant *)
            (fun x y c => let p := @wsubcarry sz x y c in (Some p.1, p.2))
-           true.
+           true [:: IBool true; IBool true].
 
 Fixpoint spill_semi (tys: seq ctype) : sem_prod tys (sem_tuple [::]):=
   match tys as tys0 return sem_prod tys0 (sem_tuple [::]) with
@@ -344,6 +350,7 @@ Definition Ospill_instr o (tys:seq atype) :=
      semi     := sem_prod_ok ctys semi;
      semu     := @spill_semu ctys;
      i_safe   := [:: ];
+     i_init   := [::];
      i_valid  := true;
      i_safe_wf    := refl_equal;
      i_semi_errty := fun _ => (@sem_prod_ok_error _ ctys semi ErrType);
@@ -363,6 +370,7 @@ Definition Oswap_instr ty :=
      semi   := sem_prod_ok ctys semi;
      semu   := @swap_semu cty;
      i_safe := [::];
+     i_init := [:: IBool true; IBool true];
      i_valid := true;
      i_safe_wf    := refl_equal;
      i_semi_errty := fun _ => (@sem_prod_ok_error _ ctys semi ErrType);
@@ -412,7 +420,8 @@ Definition SLHinit_instr :=
       [:: ty_msf ]
       [:: E 0 ]      (* this info is irrelevant *)
       se_init_sem
-      true.
+      true
+      [:: IBool true].
 
 Definition SLHupdate_str := "update_msf"%string.
 Definition SLHupdate_instr :=
@@ -422,7 +431,8 @@ Definition SLHupdate_instr :=
       [:: ty_msf ]
       [:: E 2 ]      (* this info is irrelevant *)
       se_update_sem
-      true.
+      true
+      [:: IBool true].
 
 Definition SLHmove_str := "mov_msf"%string.
 Definition SLHmove_instr :=
@@ -432,7 +442,8 @@ Definition SLHmove_instr :=
       [:: ty_msf ]
       [:: E 1 ]      (* this info is irrelevant *)
       se_move_sem
-      true.
+      true
+      [:: IBool true].
 
 Definition SLHprotect_str := "protect"%string.
 Definition SLHprotect_instr ws :=
@@ -442,7 +453,8 @@ Definition SLHprotect_instr ws :=
       [:: aword ws ]
       [:: E 2 ]      (* this info is irrelevant *)
       (@se_protect_sem ws)
-      true.
+      true
+      [:: IBool true].
 
 Lemma protect_ptr_semu p vs vs' v:
   List.Forall2 value_uincl vs vs' ->
@@ -472,6 +484,7 @@ Definition SLHprotect_ptr_instr ws p :=
      semi     := sem_prod_ok ctin semi;
      semu     := @protect_ptr_semu (Z.to_pos (arr_size ws p));
      i_safe   := [::];
+     i_init   := [:: IBool true];
      i_valid  := true;
      i_safe_wf    := refl_equal;
      i_semi_errty := fun _ => (@sem_prod_ok_error _ ctin semi ErrType);
@@ -522,6 +535,7 @@ Definition SLHprotect_ptr_fail_instr ws p :=
      semi     := @se_protect_ptr_fail_sem len;
      semu     := @protect_ptr_fail_semu len;
      i_safe   := [:: ScFalse]; (* See remark on protect_ptr_fail_safe *)
+     i_init   := [:: IBool true];
      i_valid  := true;
      i_safe_wf    := refl_equal;
      i_semi_errty := fun _ => (@protect_ptr_fail_errty len);
diff --git a/proofs/lang/utils.v b/proofs/lang/utils.v
index b71ddee515..a4fc263644 100644
--- a/proofs/lang/utils.v
+++ b/proofs/lang/utils.v
@@ -189,6 +189,21 @@ Lemma bindA eT aT bT cT (f : aT -> result eT bT) (g: bT -> result eT cT) m:
   m >>= f >>= g = m >>= (fun a => f a >>= g).
 Proof. case:m => //=. Qed.
 
+Definition Rerror eT aT1 aT2 (R : aT1 -> aT2 -> Prop) (r1 : result eT aT1) (r2 : result eT aT2) :=
+  match r1, r2 with
+  | Ok a1, Ok a2 => R a1 a2
+  | Error s1, Error s2 => s1 = s2
+  | _, _ => False
+  end.
+
+Lemma bindP eT aT rT (R : aT -> aT -> Prop) (f1 f2 : aT -> result eT rT) m1 m2 :
+  Rerror R m1 m2 -> (forall a1 a2, R a1 a2 -> f1 a1 = f2 a2) ->
+  m1 >>= f1 = m2 >>= f2.
+Proof.
+  case: m1 m2 => [a1 | s1] [a2 | s2] //=; last by move=> ->.
+  by move=> h /(_ _ _ h).
+Qed.
+
 Lemma bind_eq eT aT rT (f1 f2 : aT -> result eT rT) m1 m2 :
    m1 = m2 -> f1 =1 f2 -> m1 >>= f1 = m2 >>= f2.
 Proof. move=> <- Hf; case m1 => //=. Qed.
@@ -218,7 +233,13 @@ Definition assertion_label := string.
 
 Variant error :=
  | ErrOob | ErrAddrUndef | ErrAddrInvalid | ErrStack | ErrType | ErrArith | ErrSemUndef
- | ErrAssert of assertion_label.
+ | ErrUnknowFun | ErrAssert of assertion_label.
+
+Definition is_ErrType e :=
+  if e is ErrType then true else false.
+
+Lemma is_ErrTypeP e : reflect (e = ErrType) (is_ErrType e).
+Proof. by case: e => /=; constructor. Qed.
 
 Definition exec t := result error t.
 
@@ -530,6 +551,14 @@ Section FOLDM.
 
 End FOLDM.
 
+Lemma foldM_ext [eT aT bT : Type]: forall  (f g: aT -> bT -> result eT bT) s v,
+    (f =2 g) -> foldM f v s = foldM g v s.
+Proof.
+  move => f g s.
+  induction s => v H //=.
+  rewrite H; case (g a v) => //=; auto.
+Qed.
+
 Section FOLD2.
 
   Variable A B E R:Type.
@@ -1747,6 +1776,14 @@ Proof.
   rewrite in_nil;symmetry;apply /negP => /andP [/ZleP ? /ZltP ?]; Lia.lia.
 Qed.
 
+Lemma in_ziotaP i n m : reflect (n <= i < n + m)%Z (i \in ziota n m).
+Proof.
+  rewrite in_ziota.
+  case: (ZleP n i) => /=.
+  + case: (ZltP i (n + m)); constructor; Lia.lia.
+  move=> ?; constructor; Lia.lia.
+Qed.
+
 Lemma size_ziota p z: size (ziota p z) = Z.to_nat z.
 Proof. by rewrite ziotaE size_map size_iota. Qed.
 
@@ -1972,13 +2009,13 @@ Ltac is_simpl e :=
 
 #[local]
 Ltac simpl_rewrite h lhs rhs :=
-  (is_simpl lhs; rewrite -!h) || (is_simpl rhs; rewrite !h).
+  (is_simpl lhs; rewrite -!h /=) || (is_simpl rhs; rewrite !h /=).
 
 Ltac t_simpl_rewrites := t_do_rewrites simpl_rewrite.
 
 #[local]
 Ltac eq_rewrite h _ _ :=
-  (rewrite !h || rewrite -!h); clear h.
+  (rewrite !h /= || rewrite -!h /=); clear h.
 
 Ltac t_eq_rewrites := t_do_rewrites eq_rewrite.
 
diff --git a/proofs/lang/warray_.v b/proofs/lang/warray_.v
index 7e2ec74e0a..9d4c482b45 100644
--- a/proofs/lang/warray_.v
+++ b/proofs/lang/warray_.v
@@ -84,6 +84,12 @@ Module WArray.
       | None   => false
       end.
 
+    Definition is_initb (m:array s) (i:pointer) :=
+      match Mz.get m.(arr_data) i with
+      | Some w => (w == wrepr U8 (-1))
+      | None   => false
+      end.
+
     Definition get8 (m:array s) (i:pointer) :=
       Let _ := assert (in_bound m i) ErrOob in
       Let _ := assert (is_init m i) ErrAddrUndef in
@@ -152,6 +158,9 @@ Module WArray.
   Definition copy ws p (a:array (Z.to_pos (arr_size ws p))) :=
     fcopy ws a (WArray.empty _) 0 p.
 
+  Definition fill_elem_aux len (x:u8) : exec (array len) :=
+    foldM (fun i pt => set pt Aligned AAscale i x) (empty len) (ziota 0 len).
+
   Definition fill_aux len : seq u8 → exec (pointer * array len) :=
     foldM (λ w pt,
         Let t := set pt.2 Aligned AAscale pt.1 w in
@@ -254,6 +263,37 @@ Module WArray.
     by move => /= ? /ok_inj <-.
   Qed.
 
+  Lemma fill_elem_ok (n: positive) (el: word U8) : is_ok (fill_elem_aux n el).
+  Proof.
+    rewrite /fill_elem_aux.
+    set acc := empty n.
+    have : forall z, (z \in ziota 0 n) -> (0 <= z < n).
+            by move=> z /in_ziotaP.
+
+    elim: ziota acc => [| a l hrec acc] hbound //=.
+    rewrite /set -set_write8 /= /set8 /=.
+    have -> /= : (in_bound acc (a * wsize_size U8)).
+    rewrite /in_bound.
+    move: (hbound a)=> [].
+    + by rewrite mem_head.
+      rewrite Z.mul_1_r => /Z.leb_le hlo /ZltP hhi.
+      by rewrite hlo hhi.
+    have := hrec {| arr_data := Mz.set (arr_data acc)
+                                  (a * wsize_size U8) el |}.
+    have h2 : (forall z, z \in l → 0 <= z < n).
+    + by move=> z hz; apply hbound; rewrite in_cons hz orbT.
+    by move=> /(_ h2).
+  Qed.
+
+  Definition fill_elem len (x:u8) : array len.
+  Proof.
+    assert (H := fill_elem_ok len x).
+    generalize H.
+    case (fill_elem_aux len x).
+    + move=> t _; exact t.
+    done.
+  Defined.
+
   Lemma castK len (a:array len) : WArray.cast len a = ok a.
   Proof. by rewrite /cast eqxx; case: a. Qed.
 
diff --git a/proofs/lang/word.v b/proofs/lang/word.v
index d5a7dbc6f0..63e29ba0b9 100644
--- a/proofs/lang/word.v
+++ b/proofs/lang/word.v
@@ -519,7 +519,7 @@ Lemma wsigned_range_m szi szo:
   (wmin_signed szo <= wmin_signed szi /\ wmax_signed szi <= wmax_signed szo)%Z.
 Proof. by case: szi; case: szo. Qed.
 
-Lemma half_modulues_pos sz : (0 < half_modulus sz)%Z.
+Lemma half_modulus_pos sz : (0 < half_modulus sz)%Z.
 Proof. by case: sz. Qed.
 
 Lemma wsar_alt sz (x: word sz) n :