Add beginning to memory generation proof

22 files changed, 6810 insertions, 2671 deletions

diff --git a/driver/VericertDriver.ml b/driver/VericertDriver.ml
index ac358fe..87ce2c6 100644
--- a/driver/VericertDriver.ml
+++ b/driver/VericertDriver.ml
@@ -68,6 +68,7 @@ let compile_c_file sourcename ifile ofile =
   set_dest Vericert.PrintGibleSeq.destination option_dgblseq ".gblseq";
   set_dest Vericert.PrintGiblePar.destination option_dgblpar ".gblpar";
   set_dest Vericert.PrintHTL.destination option_dhtl ".htl";
+  set_dest Vericert.PrintDHTL.destination option_ddhtl ".dhtl";
   set_dest Vericert.Regalloc.destination_alloctrace option_dalloctrace ".alloctrace";
   set_dest Vericert.PrintLTL.destination option_dltl ".ltl";
   set_dest Vericert.PrintMach.destination option_dmach ".mach";
@@ -97,6 +98,7 @@ let compile_c_file sourcename ifile ofile =
                         then Vericert.Compiler0.transf_hls_temp
                         else Vericert.Compiler0.transf_hls
       in
+      let _ = Vericert.Smtpredicate.check_smt (Vericert.Predicate0.Pimp ((Vericert.Predicate0.Pbase (Vericert.Camlcoq.P.of_int 2)),(Vericert.Predicate0.Pbase (Vericert.Camlcoq.P.of_int 2)))) in
       match translation csyntax with
       | Vericert.Errors.OK v ->
         if !Vericert.Cohpred.cohpred_counter > 0 then Printf.fprintf stderr "OK\n"; v
@@ -396,6 +398,7 @@ let cmdline_actions =
   Exact "-dgblseq", Set option_dgblseq;
   Exact "-dgblpar", Set option_dgblpar;
   Exact "-dhtl", Set option_dhtl;
+  Exact "-ddhtl", Set option_ddhtl;
   Exact "-dltl", Set option_dltl;
   Exact "-dalloctrace", Set option_dalloctrace;
   Exact "-dmach", Set option_dmach;
@@ -410,6 +413,7 @@ let cmdline_actions =
     option_dgblseq := true;
     option_dgblpar := true;
     option_dhtl := true;
+    option_ddhtl := true;
     option_dltl := true;
     option_dalloctrace := true;
     option_dmach := true;
diff --git a/src/Compiler.v b/src/Compiler.v
index 49464c0..a674866 100644
--- a/src/Compiler.v
+++ b/src/Compiler.v
@@ -65,6 +65,7 @@ Require vericert.hls.GibleSeq.
 Require vericert.hls.GibleSeqgen.
 Require vericert.hls.GiblePargen.
 Require vericert.hls.HTLPargen.
+Require vericert.hls.DVeriloggen.
 (*Require vericert.hls.Pipeline.*)
 Require vericert.hls.IfConversion.
 Require vericert.hls.CondElim.
@@ -72,6 +73,7 @@ Require vericert.hls.DeadBlocks.
 (*Require vericert.hls.PipelineOp.*)
 Require vericert.HLSOpts.
 Require vericert.hls.Memorygen.
+Require vericert.hls.DMemorygen.
 
 Require Import vericert.hls.HTLgenproof.
 
@@ -86,6 +88,7 @@ intermediate steps in the compilation, such as ``print_RTL``, ``print_HTL`` and
 
 Parameter print_RTL: Z -> RTL.program -> unit.
 Parameter print_HTL: Z -> HTL.program -> unit.
+Parameter print_DHTL: Z -> DHTL.program -> unit.
 Parameter print_GibleSeq: Z -> GibleSeq.GibleSeq.program -> unit.
 Parameter print_GiblePar: Z -> GiblePar.GiblePar.program -> unit.
 
@@ -292,8 +295,10 @@ Definition transf_hls_temp (p : Csyntax.program) : res Verilog.program :=
   @@@ GiblePargen.transl_program
    @@ print (print_GiblePar 0)
   @@@ HTLPargen.transl_program
-   @@ print (print_HTL 0)
-   @@ Veriloggen.transl_program.
+   @@ print (print_DHTL 0)
+   @@ DMemorygen.transf_program
+   @@ print (print_DHTL 0)
+   @@ DVeriloggen.transl_program.
 
 (*|
 Correctness Proof
diff --git a/src/VericertClflags.ml b/src/VericertClflags.ml
index 9dccb53..83a1871 100644
--- a/src/VericertClflags.ml
+++ b/src/VericertClflags.ml
@@ -4,6 +4,7 @@ let option_hls = ref true
 let option_debug_hls = ref false
 let option_initial = ref false
 let option_dhtl = ref false
+let option_ddhtl = ref false
 let option_dgblseq = ref false
 let option_dgblpar = ref false
 let option_drtlparfu = ref false
diff --git a/src/common/Monad.v b/src/common/Monad.v
index cf3180b..41a57e9 100644
--- a/src/common/Monad.v
+++ b/src/common/Monad.v
@@ -43,12 +43,13 @@ Module MonadExtra(M : Monad).
 
   Module Import MonadNotation.
 
-    Notation "'do' X <- A ; B" :=
-      (bind (fun X => B) A)
-        (at level 200, X name, A at level 100, B at level 200) : monad_scope.
-    Notation "'do' ( X , Y ) <- A ; B" :=
-      (bind2 (fun X Y => B) A)
-        (at level 200, X name, Y name, A at level 100, B at level 200) : monad_scope.
+Notation "'do' X <- A ; B" := (bind (fun X => B) A)
+ (at level 200, X ident, A at level 100, B at level 200)
+ : monad_scope.
+
+Notation "'do' ( X , Y ) <- A ; B" := (bind2 (fun X Y => B) A)
+ (at level 200, X ident, Y ident, A at level 100, B at level 200)
+ : monad_scope.
 
   End MonadNotation.
 
@@ -66,7 +67,7 @@ Module MonadExtra(M : Monad).
   Fixpoint collectlist {A : Type} (f : A -> mon unit) (l : list A) {struct l} : mon unit :=
     match l with
     | nil => ret tt
-    | x::xs => do _ <- f x; collectlist f xs
+    | x::xs => do y <- f x; collectlist f xs
     end.
 
   Definition mfold_left {A B} (f: A -> B -> mon A) (l: list B) (s: mon A): mon A :=
diff --git a/src/extraction/Extraction.v b/src/extraction/Extraction.v
index b65bc41..0a83f02 100644
--- a/src/extraction/Extraction.v
+++ b/src/extraction/Extraction.v
@@ -152,6 +152,7 @@ Extract Constant Compiler.print_RTL => "PrintRTL.print_if".
 Extract Constant Compiler.print_GibleSeq => "PrintGibleSeq.print_if".
 Extract Constant Compiler.print_GiblePar => "PrintGiblePar.print_if".
 Extract Constant Compiler.print_HTL => "PrintHTL.print_if".
+Extract Constant Compiler.print_DHTL => "PrintDHTL.print_if".
 Extract Constant Compiler.print_LTL => "PrintLTL.print_if".
 Extract Constant Compiler.print_Mach => "PrintMach.print_if".
 Extract Constant Compiler.print => "fun (f: 'a -> unit) (x: 'a) -> f x; x".
diff --git a/src/hls/AssocMap.v b/src/hls/AssocMap.v
index ee39e8e..0c9242c 100644
--- a/src/hls/AssocMap.v
+++ b/src/hls/AssocMap.v
@@ -243,6 +243,7 @@ Ltac unfold_merge :=
   rewrite AssocMapExt.merge_base_1.
 
 Declare Scope assocmap.
+
 Notation "a ! b" := (AssocMap.get b a) (at level 1) : assocmap.
 Notation "a # ( b , c )" := (find_assocmap c b a) (at level 1) : assocmap.
 Notation "a # b" := (find_assocmap 32 b a) (at level 1) : assocmap.
diff --git a/src/hls/DHTL.v b/src/hls/DHTL.v
new file mode 100644
index 0000000..b80123c
--- /dev/null
+++ b/src/hls/DHTL.v
@@ -0,0 +1,344 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2020-2023 Yann Herklotz <yann@yannherklotz.com>
+ *               2020 James Pollard <j@mes.dev>
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ *)
+
+Require Import Coq.FSets.FMapPositive.
+Require Import Coq.micromega.Lia.
+
+Require compcert.common.Events.
+Require compcert.common.Globalenvs.
+Require compcert.common.Smallstep.
+Require compcert.common.Values.
+Require Import compcert.lib.Integers.
+Require Import compcert.lib.Maps.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.ValueInt.
+Require Import vericert.hls.AssocMap.
+Require Import vericert.hls.Array.
+Require vericert.hls.Verilog.
+
+Local Open Scope positive.
+
+(** The purpose of the hardware transfer language (HTL) is to create a more
+hardware-like layout that is still similar to the register transfer language
+(RTL) that it came from. The main change is that function calls become module
+instantiations and that we now describe a state machine instead of a
+control-flow graph. *)
+
+Local Open Scope assocmap.
+
+Definition reg := positive.
+Definition node := positive.
+
+Definition datapath := PTree.t Verilog.stmnt.
+Definition controllogic := PTree.t Verilog.stmnt.
+
+Definition map_well_formed {A : Type} (m : PTree.t A) : Prop :=
+  forall p0 : positive,
+    In p0 (map fst (Maps.PTree.elements m)) ->
+    (Z.pos p0 <= Integers.Int.max_unsigned)%Z.
+
+Record ram := mk_ram {
+  ram_size: nat;
+  ram_mem: reg;
+  ram_en: reg;
+  ram_u_en: reg;
+  ram_addr: reg;
+  ram_wr_en: reg;
+  ram_d_in: reg;
+  ram_d_out: reg;
+  ram_ordering: (ram_addr < ram_en
+                 /\ ram_en < ram_d_in
+                 /\ ram_d_in < ram_d_out
+                 /\ ram_d_out < ram_wr_en
+                 /\ ram_wr_en < ram_u_en)
+}.
+
+Definition module_ordering a b c d e f g := a < b < c /\ c < d < e /\ e < f < g.
+
+Record module: Type :=
+  mkmodule {
+    mod_params : list reg;
+    mod_datapath : datapath;
+    mod_entrypoint : node;
+    mod_st : reg;
+    mod_stk : reg;
+    mod_stk_len : nat;
+    mod_finish : reg;
+    mod_return : reg;
+    mod_start : reg;
+    mod_reset : reg;
+    mod_clk : reg;
+    mod_scldecls : AssocMap.t (option Verilog.io * Verilog.scl_decl);
+    mod_arrdecls : AssocMap.t (option Verilog.io * Verilog.arr_decl);
+    mod_ram : option ram;
+    mod_wf : map_well_formed mod_datapath;
+    mod_ordering_wf : module_ordering mod_st mod_finish mod_return mod_stk mod_start mod_reset mod_clk;
+    mod_ram_wf : forall r', mod_ram = Some r' -> mod_clk < ram_addr r';
+    mod_params_wf : Forall (Pos.gt mod_st) mod_params;
+  }.
+
+Definition fundef := AST.fundef module.
+
+Definition program := AST.program fundef unit.
+
+Fixpoint init_regs (vl : list value) (rl : list reg) {struct rl} :=
+  match rl, vl with
+  | r :: rl', v :: vl' => AssocMap.set r v (init_regs vl' rl')
+  | _, _ => empty_assocmap
+  end.
+
+Definition empty_stack (m : module) : Verilog.assocmap_arr :=
+  (AssocMap.set m.(mod_stk) (Array.arr_repeat None m.(mod_stk_len)) (AssocMap.empty Verilog.arr)).
+
+(** * Operational Semantics *)
+
+Definition genv := Globalenvs.Genv.t fundef unit.
+
+Inductive stackframe : Type :=
+  Stackframe :
+    forall  (res : reg)
+            (m : module)
+            (pc : node)
+            (reg_assoc : Verilog.assocmap_reg)
+            (arr_assoc : Verilog.assocmap_arr),
+      stackframe.
+
+Inductive state : Type :=
+| State :
+    forall (stack : list stackframe)
+           (m : module)
+           (st : node)
+           (reg_assoc : Verilog.assocmap_reg)
+           (arr_assoc : Verilog.assocmap_arr), state
+| Returnstate :
+    forall (res : list stackframe)
+           (v : value), state
+| Callstate :
+    forall (stack : list stackframe)
+           (m : module)
+           (args : list value), state.
+
+Inductive exec_ram:
+  Verilog.reg_associations -> Verilog.arr_associations -> option ram ->
+  Verilog.reg_associations -> Verilog.arr_associations -> Prop :=
+| exec_ram_Some_idle:
+    forall ra ar r,
+      Int.eq (Verilog.assoc_blocking ra)#(ram_en r, 32)
+             (Verilog.assoc_blocking ra)#(ram_u_en r, 32) = true ->
+      exec_ram ra ar (Some r) ra ar
+| exec_ram_Some_write:
+    forall ra ar r d_in addr en wr_en u_en,
+      Int.eq en u_en = false ->
+      Int.eq wr_en (ZToValue 0) = false ->
+      (Verilog.assoc_blocking ra)#(ram_en r, 32) = en ->
+      (Verilog.assoc_blocking ra)!(ram_u_en r) = Some u_en ->
+      (Verilog.assoc_blocking ra)!(ram_wr_en r) = Some wr_en ->
+      (Verilog.assoc_blocking ra)!(ram_d_in r) = Some d_in ->
+      (Verilog.assoc_blocking ra)!(ram_addr r) = Some addr ->
+      exec_ram ra ar (Some r) (Verilog.nonblock_reg (ram_en r) ra u_en)
+               (Verilog.nonblock_arr (ram_mem r) (valueToNat addr) ar d_in)
+| exec_ram_Some_read:
+    forall ra ar r addr v_d_out en u_en,
+      Int.eq en u_en = false ->
+      (Verilog.assoc_blocking ra)#(ram_en r, 32) = en ->
+      (Verilog.assoc_blocking ra)!(ram_u_en r) = Some u_en ->
+      (Verilog.assoc_blocking ra)!(ram_wr_en r) = Some (ZToValue 0) ->
+      (Verilog.assoc_blocking ra)!(ram_addr r) = Some addr ->
+      Verilog.arr_assocmap_lookup (Verilog.assoc_blocking ar)
+                                  (ram_mem r) (valueToNat addr) = Some v_d_out ->
+      exec_ram ra ar (Some r) (Verilog.nonblock_reg (ram_en r)
+                               (Verilog.nonblock_reg (ram_d_out r) ra v_d_out) u_en) ar
+| exec_ram_None:
+    forall r a,
+      exec_ram r a None r a.
+
+Inductive step : genv -> state -> Events.trace -> state -> Prop :=
+| step_module :
+    forall g m st sf data
+        asr asa
+        basr2 basa2 nasr2 nasa2
+        basr3 basa3 nasr3 nasa3
+        asr' asa'
+        f pstval,
+      asr!(mod_reset m) = Some (ZToValue 0) ->
+      asr!(mod_finish m) = Some (ZToValue 0) ->
+      asr!(m.(mod_st)) = Some (posToValue st) ->
+      m.(mod_datapath)!st = Some data ->
+      Verilog.stmnt_runp f
+        (Verilog.mkassociations asr empty_assocmap)
+        (Verilog.mkassociations asa (empty_stack m))
+        data
+        (Verilog.mkassociations basr2 nasr2)
+        (Verilog.mkassociations basa2 nasa2) ->
+      exec_ram
+        (Verilog.mkassociations (Verilog.merge_regs nasr2 basr2) empty_assocmap)
+        (Verilog.mkassociations (Verilog.merge_arrs nasa2 basa2) (empty_stack m))
+        (mod_ram m)
+        (Verilog.mkassociations basr3 nasr3)
+        (Verilog.mkassociations basa3 nasa3) ->
+      asr' = Verilog.merge_regs nasr3 basr3 ->
+      asa' = Verilog.merge_arrs nasa3 basa3 ->
+      asr'!(m.(mod_st)) = Some (posToValue pstval) ->
+      (Z.pos pstval <= Integers.Int.max_unsigned)%Z ->
+      step g (State sf m st asr asa) Events.E0 (State sf m pstval asr' asa')
+| step_finish :
+    forall g m st asr asa retval sf,
+    asr!(m.(mod_finish)) = Some (ZToValue 1) ->
+    asr!(m.(mod_return)) = Some retval ->
+    step g (State sf m st asr asa) Events.E0 (Returnstate sf retval)
+| step_call :
+    forall g m args res,
+      step g (Callstate res m args) Events.E0
+           (State res m m.(mod_entrypoint)
+             (AssocMap.set (mod_reset m) (ZToValue 0)
+              (AssocMap.set (mod_finish m) (ZToValue 0)
+               (AssocMap.set (mod_st m) (posToValue m.(mod_entrypoint))
+                (init_regs args m.(mod_params)))))
+             (empty_stack m))
+| step_return :
+    forall g m asr asa i r sf pc mst,
+      mst = mod_st m ->
+      step g (Returnstate (Stackframe r m pc asr asa :: sf) i) Events.E0
+           (State sf m pc ((asr # mst <- (posToValue pc)) # r <- i) asa).
+#[export] Hint Constructors step : htl.
+
+Inductive initial_state (p: program): state -> Prop :=
+  | initial_state_intro: forall b m0 m,
+      let ge := Globalenvs.Genv.globalenv p in
+      Globalenvs.Genv.init_mem p = Some m0 ->
+      Globalenvs.Genv.find_symbol ge p.(AST.prog_main) = Some b ->
+      Globalenvs.Genv.find_funct_ptr ge b = Some (AST.Internal m) ->
+      initial_state p (Callstate nil m nil).
+
+Inductive final_state : state -> Integers.int -> Prop :=
+| final_state_intro : forall retval retvali,
+    retvali = valueToInt retval ->
+    final_state (Returnstate nil retval) retvali.
+
+Definition semantics (m : program) :=
+  Smallstep.Semantics step (initial_state m) final_state
+                      (Globalenvs.Genv.globalenv m).
+
+Definition max_pc_function (m: module) :=
+  List.fold_left Pos.max (List.map fst (PTree.elements m.(mod_datapath))) 1.
+
+Definition max_list := fold_right Pos.max 1.
+
+Definition max_stmnt_tree t :=
+  PTree.fold (fun i _ st => Pos.max (Verilog.max_reg_stmnt st) i) t 1.
+
+Definition max_reg_ram r :=
+  match r with
+  | None => 1
+  | Some ram => Pos.max (ram_mem ram)
+                (Pos.max (ram_en ram)
+                 (Pos.max (ram_addr ram)
+                  (Pos.max (ram_addr ram)
+                   (Pos.max (ram_wr_en ram)
+                    (Pos.max (ram_d_in ram)
+                     (Pos.max (ram_d_out ram) (ram_u_en ram)))))))
+  end.
+
+Definition max_reg_module m :=
+  Pos.max (max_list (mod_params m))
+   (Pos.max (max_stmnt_tree (mod_datapath m))
+     (Pos.max (mod_st m)
+      (Pos.max (mod_stk m)
+       (Pos.max (mod_finish m)
+        (Pos.max (mod_return m)
+         (Pos.max (mod_start m)
+          (Pos.max (mod_reset m)
+           (Pos.max (mod_clk m) (max_reg_ram (mod_ram m)))))))))).
+
+Lemma max_fold_lt :
+  forall m l n, m <= n -> m <= (fold_left Pos.max l n).
+Proof. induction l; crush; apply IHl; lia. Qed.
+
+Lemma max_fold_lt2 :
+  forall (l: list (positive * Verilog.stmnt)) v n,
+    v <= n ->
+    v <= fold_left (fun a p => Pos.max (Verilog.max_reg_stmnt (snd p)) a) l n.
+Proof. induction l; crush; apply IHl; lia. Qed.
+
+Lemma max_fold_lt3 :
+  forall (l: list (positive * Verilog.stmnt)) v v',
+    v <= v' ->
+    fold_left (fun a0 p => Pos.max (Verilog.max_reg_stmnt (snd p)) a0) l v
+    <= fold_left (fun a0 p => Pos.max (Verilog.max_reg_stmnt (snd p)) a0) l v'.
+Proof. induction l; crush; apply IHl; lia. Qed.
+
+Lemma max_fold_lt4 :
+  forall (l: list (positive * Verilog.stmnt)) (a: positive * Verilog.stmnt),
+    fold_left (fun a0 p => Pos.max (Verilog.max_reg_stmnt (snd p)) a0) l 1
+    <= fold_left (fun a0 p => Pos.max (Verilog.max_reg_stmnt (snd p)) a0) l
+                 (Pos.max (Verilog.max_reg_stmnt (snd a)) 1).
+Proof. intros; apply max_fold_lt3; lia. Qed.
+
+Lemma max_reg_stmnt_lt_stmnt_tree':
+  forall l (i: positive) v,
+    In (i, v) l ->
+    list_norepet (map fst l) ->
+    Verilog.max_reg_stmnt v <= fold_left (fun a p => Pos.max (Verilog.max_reg_stmnt (snd p)) a) l 1.
+Proof.
+  induction l; crush. inv H; inv H0; simplify. apply max_fold_lt2. lia.
+  transitivity (fold_left (fun (a : positive) (p : positive * Verilog.stmnt) =>
+                             Pos.max (Verilog.max_reg_stmnt (snd p)) a) l 1).
+  eapply IHl; eauto. apply max_fold_lt4.
+Qed.
+
+Lemma max_reg_stmnt_le_stmnt_tree :
+  forall d i v,
+    d ! i = Some v ->
+    Verilog.max_reg_stmnt v <= max_stmnt_tree d.
+Proof.
+  intros. unfold max_stmnt_tree. rewrite PTree.fold_spec.
+  apply PTree.elements_correct in H.
+  eapply max_reg_stmnt_lt_stmnt_tree'; eauto.
+  apply PTree.elements_keys_norepet.
+Qed.
+
+Lemma max_reg_stmnt_lt_stmnt_tree :
+  forall d i v,
+    d ! i = Some v ->
+    Verilog.max_reg_stmnt v < max_stmnt_tree d + 1.
+Proof. intros. apply max_reg_stmnt_le_stmnt_tree in H; lia. Qed.
+
+Lemma max_stmnt_lt_module :
+  forall m d i,
+    (mod_datapath m) ! i = Some d ->
+    Verilog.max_reg_stmnt d < max_reg_module m + 1.
+Proof.
+  intros * Hv.
+  unfold max_reg_module;
+  apply max_reg_stmnt_le_stmnt_tree in Hv; lia.
+Qed.
+
+Lemma max_list_correct l st : st > max_list l -> Forall (Pos.gt st) l.
+Proof. induction l; crush; constructor; [|apply IHl]; lia. Qed.
+
+Definition max_list_dec (l: list reg) (st: reg) : {Forall (Pos.gt st) l} + {True}.
+  refine (
+      match bool_dec (max_list l <? st) true with
+      | left _ => left _
+      | _ => _
+      end
+    ); auto.
+  apply max_list_correct. apply Pos.ltb_lt in e. lia.
+Qed.
diff --git a/src/hls/DMemorygen.v b/src/hls/DMemorygen.v
new file mode 100644
index 0000000..6251162
--- /dev/null
+++ b/src/hls/DMemorygen.v
@@ -0,0 +1,3308 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2021 Yann Herklotz <yann@yannherklotz.com>
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ *)
+
+Require Import Coq.micromega.Lia.
+
+Require Import compcert.backend.Registers.
+Require Import compcert.common.AST.
+Require Import compcert.common.Globalenvs.
+Require compcert.common.Memory.
+Require Import compcert.common.Values.
+Require Import compcert.lib.Floats.
+Require Import compcert.lib.Integers.
+Require Import compcert.lib.Maps.
+Require compcert.common.Smallstep.
+Require compcert.verilog.Op.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.ValueInt.
+Require Import vericert.hls.Verilog.
+Require Import vericert.hls.DHTL.
+Require Import vericert.hls.AssocMap.
+Require Import vericert.hls.Array.
+
+Local Open Scope positive.
+Local Open Scope assocmap.
+
+#[local] Hint Resolve max_reg_stmnt_le_stmnt_tree : mgen.
+#[local] Hint Resolve max_reg_stmnt_lt_stmnt_tree : mgen.
+#[local] Hint Resolve max_stmnt_lt_module : mgen.
+
+Lemma int_eq_not_false : forall x, Int.eq x (Int.not x) = false.
+Proof.
+  intros. unfold Int.eq.
+  rewrite Int.unsigned_not.
+  replace Int.max_unsigned with 4294967295%Z by crush.
+  assert (X: forall x, (x <> 4294967295 - x)%Z) by lia.
+  specialize (X (Int.unsigned x)). apply zeq_false; auto.
+Qed.
+
+Definition opt_eqb {A} (eqb: A -> A -> bool) (a b: option A): bool :=
+  match a, b with
+  | Some a', Some b' => eqb a' b'
+  | None, None => true
+  | _, _ => false
+  end.
+
+Definition unop_eqb (e1 e2: unop): bool :=
+  match e1, e2 with
+  | Vneg, Vneg => true
+  | Vnot, Vnot => true
+  | _, _ => false
+  end.
+
+Definition binop_eqb (e1 e2: binop): bool :=
+  match e1, e2 with
+  | Vadd, Vadd => true
+  | Vsub, Vsub => true
+  | Vmul, Vmul => true
+  | Vdiv, Vdiv => true
+  | Vdivu, Vdivu => true
+  | Vmod, Vmod => true
+  | Vmodu, Vmodu => true
+  | Vlt, Vlt => true
+  | Vltu, Vltu => true
+  | Vgt, Vgt => true
+  | Vgtu, Vgtu => true
+  | Vle, Vle => true
+  | Vleu, Vleu => true
+  | Vge, Vge => true
+  | Vgeu, Vgeu => true
+  | Veq, Veq => true
+  | Vne, Vne => true
+  | Vand, Vand => true
+  | Vor, Vor => true
+  | Vxor, Vxor => true
+  | Vshl, Vshl => true
+  | Vshr, Vshr => true
+  | Vshru, Vshru => true
+  | _, _ => false
+  end.
+
+Fixpoint expr_eqb (e1 e2: expr): bool :=
+  match e1, e2 with
+  | Vlit v, Vlit v' => Int.eq v v'
+  | Vvar r, Vvar r' => Pos.eqb r r'
+  | Vvari r e, Vvari r' e' => Pos.eqb r r' && expr_eqb e e'
+  | Vrange r e1 e2, Vrange r' e1' e2' => 
+    Pos.eqb r r' && expr_eqb e1 e1' && expr_eqb e2 e2'
+  | Vinputvar r, Vinputvar r' => Pos.eqb r r'
+  | Vbinop b e1 e2, Vbinop b' e1' e2' =>
+    binop_eqb b b' && expr_eqb e1 e1' && expr_eqb e2 e2'
+  | Vunop b e1, Vunop b' e1' =>
+    unop_eqb b b' && expr_eqb e1 e1'
+  | Vternary e1 e2 e3, Vternary e1' e2' e3' =>
+    expr_eqb e1 e1' && expr_eqb e2 e2' && expr_eqb e3 e3'
+  | _, _ => false
+  end.
+
+Fixpoint stmnt_eqb (s1 s2: stmnt): bool :=
+  match s1, s2 with
+  | Vskip, Vskip => true
+  | Vseq s1 s2, Vseq s1' s2' => stmnt_eqb s1 s1' && stmnt_eqb s2 s2'
+  | Vcond e st sf, Vcond e' st' sf' => 
+    expr_eqb e e'
+    && stmnt_eqb st st'
+    && stmnt_eqb sf sf'
+  | Vcase e sl os, Vcase e' sl' os' =>
+    expr_eqb e e'
+    && stmnt_expr_list_eqb sl sl'
+    && opt_eqb stmnt_eqb os os'
+  | Vblock e1 e2, Vblock e1' e2' =>
+    expr_eqb e1 e1' && expr_eqb e2 e2'
+  | Vnonblock e1 e2, Vnonblock e1' e2' =>
+    expr_eqb e1 e1' && expr_eqb e2 e2'
+  | _, _ => false
+  end
+with stmnt_expr_list_eqb (s1 s2: stmnt_expr_list): bool :=
+  match s1, s2 with 
+  | Stmntnil, Stmntnil => true
+  | Stmntcons e s sl, Stmntcons e' s' sl' =>
+    expr_eqb e e'
+    && stmnt_eqb s s'
+    && stmnt_expr_list_eqb sl sl'
+  | _, _ => false
+  end.
+
+Fixpoint replace_stmnt (base r b: stmnt): stmnt :=
+  match base with
+  | Vskip as st | Vblock _ _ as st | Vnonblock _ _ as st => 
+    if stmnt_eqb st r then b else st
+  | Vseq s1 s2 =>
+    Vseq (replace_stmnt s1 r b) (replace_stmnt s2 r b)
+  | Vcond c s1 s2 =>
+    Vcond c (replace_stmnt s1 r b) (replace_stmnt s2 r b)
+  | Vcase e sl (Some os) =>
+    Vcase e (replace_stmnt_expr_list sl r b) (Some (replace_stmnt os r b))
+  | Vcase e sl None =>
+    Vcase e (replace_stmnt_expr_list sl r b) None
+  end
+with replace_stmnt_expr_list (base: stmnt_expr_list) (r b: stmnt) :=
+  match base with
+  | Stmntnil => Stmntnil
+  | Stmntcons e s sl => 
+    Stmntcons e (replace_stmnt s r b) (replace_stmnt_expr_list sl r b)
+  end.
+
+Definition transf_maps state ram in_ (d: PTree.t stmnt) :=
+  match in_ with
+  | (i, n) =>
+    match PTree.get i d with
+    | Some (Vseq ((Vblock (Vvar _) _) as rest) (Vblock (Vvari r e1) e2)) =>
+      if r =? (ram_mem ram) then
+        let nd := Vseq (Vblock (Vvar (ram_u_en ram)) (Vunop Vnot (Vvar (ram_u_en ram))))
+                       (Vseq (Vblock (Vvar (ram_wr_en ram)) (Vlit (ZToValue 1)))
+                             (Vseq (Vblock (Vvar (ram_d_in ram)) e2)
+                                   (Vblock (Vvar (ram_addr ram)) e1)))
+        in
+        PTree.set i (Vseq rest nd) d
+      else d
+    | Some (Vseq (Vblock (Vvar st') e3) (Vblock (Vvar e1) (Vvari r e2))) =>
+      if (r =? (ram_mem ram)) && (st' =? state) && (Z.pos n <=? Int.max_unsigned)%Z
+         && (e1 <? state) && (max_reg_expr e2 <? state) && (max_reg_expr e3 <? state)
+      then
+        let nd :=
+            Vseq (Vblock (Vvar (ram_u_en ram)) (Vunop Vnot (Vvar (ram_u_en ram))))
+                 (Vseq (Vblock (Vvar (ram_wr_en ram)) (Vlit (ZToValue 0)))
+                       (Vblock (Vvar (ram_addr ram)) e2))
+        in
+        let aout := Vblock (Vvar e1) (Vvar (ram_d_out ram)) in
+        let redirect := Vblock (Vvar state) (Vlit (posToValue n)) in
+        (PTree.set i (Vseq redirect nd) (PTree.set n (Vseq (Vblock (Vvar st') e3) aout) d))
+      else d
+    | _ => d
+    end
+  end.
+
+Lemma transf_maps_wf :
+  forall state ram d d' i,
+    map_well_formed d ->
+    transf_maps state ram i d = d' ->
+    map_well_formed d'.
+Proof.
+  unfold transf_maps; intros; repeat destruct_match; try destruct i;
+  try match goal with
+  | H: (_, _) = (_, _) |- _ => inv H
+  end; auto.
+  unfold map_well_formed.
+  simplify; intros.
+  destruct (Pos.eq_dec p0 p1); subst; auto.
+  destruct (Pos.eq_dec p p1); subst. unfold map_well_formed in *.
+  apply AssocMap.elements_correct in Heqo.
+  eapply in_map with (f := fst) in Heqo. simplify.
+  apply H1 in Heqo. auto.
+  apply AssocMapExt.elements_iff in H3. inv H3.
+  repeat rewrite AssocMap.gso in H8 by lia.
+  apply AssocMap.elements_correct in H8.
+  eapply in_map with (f := fst) in H8. simplify.
+  unfold map_well_formed in *. apply H0 in H8. auto.
+  apply AssocMapExt.elements_iff in H3. inv H3.
+  destruct (Pos.eq_dec p0 p1); subst; auto.
+  destruct (Pos.eq_dec p p1); subst. unfold map_well_formed in *.
+  apply AssocMap.elements_correct in Heqo.
+  eapply in_map with (f := fst) in Heqo. simplify.
+  apply H1 in Heqo. auto.
+  repeat rewrite AssocMap.gso in H8 by lia.
+  apply AssocMap.elements_correct in H8.
+  eapply in_map with (f := fst) in H8. simplify.
+  unfold map_well_formed in *. apply H1 in H8. auto.
+  unfold map_well_formed in *; simplify; intros.
+  destruct (Pos.eq_dec p0 p1); subst; auto.
+  destruct (Pos.eq_dec p p1); subst. unfold map_well_formed in *.
+  apply AssocMap.elements_correct in Heqo.
+  eapply in_map with (f := fst) in Heqo. simplify.
+  apply H1 in Heqo. auto.
+  apply AssocMapExt.elements_iff in H. inv H.
+  repeat rewrite AssocMap.gso in H2 by lia.
+  apply AssocMap.elements_correct in H2.
+  eapply in_map with (f := fst) in H2. simplify.
+  unfold map_well_formed in *. apply H1 in H2. auto.
+  Qed.
+
+Definition max_pc {A: Type} (m: PTree.t A) :=
+  fold_right Pos.max 1%positive (map fst (PTree.elements m)).
+
+Fixpoint zip_range {A: Type} n (l: list A) {struct l} :=
+  match l with
+  | nil => nil
+  | a :: b => (a, n) :: zip_range (n+1) b
+  end.
+
+Lemma zip_range_fst_idem : forall A (l: list A) a, map fst (zip_range a l) = l.
+Proof. induction l; crush. Qed.
+
+Lemma zip_range_not_in_snd :
+  forall A (l: list A) a n, a < n -> ~ In a (map snd (zip_range n l)).
+Proof.
+  unfold not; induction l; crush.
+  inv H0; try lia. eapply IHl.
+  assert (X: a0 < n + 1) by lia. apply X; auto. auto.
+Qed.
+
+Lemma zip_range_snd_no_repet :
+  forall A (l: list A) a, list_norepet (map snd (zip_range a l)).
+Proof.
+  induction l; crush; constructor; auto; [].
+  apply zip_range_not_in_snd; lia.
+Qed.
+
+Lemma zip_range_in :
+  forall A (l: list A) a n i, In (a, i) (zip_range n l) -> In a l.
+Proof.
+  induction l; crush. inv H. inv H0. auto. right. eapply IHl; eauto.
+Qed.
+
+Lemma zip_range_not_in :
+  forall A (l: list A) a i n, ~ In a l -> ~ In (a, i) (zip_range n l).
+Proof.
+  unfold not; induction l; crush. inv H0. inv H1. apply H. left. auto.
+  apply H. right. eapply zip_range_in; eauto.
+Qed.
+
+Lemma zip_range_no_repet :
+  forall A (l: list A) a, list_norepet l -> list_norepet (zip_range a l).
+Proof.
+  induction l; simplify; constructor;
+  match goal with H: list_norepet _ |- _ => inv H end;
+  [apply zip_range_not_in|]; auto.
+Qed.
+
+Definition transf_code state ram d :=
+  fold_right (transf_maps state ram) d
+             (zip_range (max_pc d + 1)
+                        (map fst (PTree.elements d))).
+
+Lemma transf_code_wf' :
+  forall l d state ram d',
+    map_well_formed d ->
+    fold_right (transf_maps state ram) d l = d' ->
+    map_well_formed d'.
+Proof.
+  induction l; intros; simpl in *. inv H0; auto.
+  remember (fold_right (transf_maps state ram) d l). (* destruct p. *)
+(*   apply transf_maps_wf in H0. auto. eapply IHl; eauto. *)
+(* Qed. *) Admitted.
+
+Lemma transf_code_wf :
+  forall d state ram d',
+    map_well_formed d ->
+    transf_code state ram d = d' ->
+    map_well_formed d'.
+Proof. eauto using transf_code_wf'. Qed.
+
+Lemma ram_wf :
+  forall x,
+    x + 1 < x + 2 /\ x + 2 < x + 3 /\ x + 3 < x + 4 /\ x + 4 < x + 5 /\ x + 5 < x + 6.
+Proof. lia. Qed.
+
+Lemma module_ram_wf' :
+  forall m addr,
+    addr = max_reg_module m + 1 ->
+    mod_clk m < addr.
+Proof. unfold max_reg_module; lia. Qed.
+
+Definition transf_module (m: module): module.
+  refine (
+  let max_reg := max_reg_module m in
+  let addr := max_reg+1 in
+  let en := max_reg+2 in
+  let d_in := max_reg+3 in
+  let d_out := max_reg+4 in
+  let wr_en := max_reg+5 in
+  let u_en := max_reg+6 in
+  let new_size := (mod_stk_len m) in
+  let ram := mk_ram new_size (mod_stk m) en u_en addr wr_en d_in d_out ltac:(eauto using ram_wf) in
+  let tc := transf_code (mod_st m) ram (mod_datapath m) in
+  match mod_ram m with
+  | None =>
+    mkmodule m.(mod_params)
+                 tc
+                 (mod_entrypoint m)
+                 (mod_st m)
+                 (mod_stk m)
+                 (mod_stk_len m)
+                 (mod_finish m)
+                 (mod_return m)
+                 (mod_start m)
+                 (mod_reset m)
+                 (mod_clk m)
+                 (AssocMap.set u_en (None, VScalar 1)
+                  (AssocMap.set en (None, VScalar 1)
+                   (AssocMap.set wr_en (None, VScalar 1)
+                    (AssocMap.set d_out (None, VScalar 32)
+                     (AssocMap.set d_in (None, VScalar 32)
+                      (AssocMap.set addr (None, VScalar 32) m.(mod_scldecls)))))))
+                       (AssocMap.set m.(mod_stk)
+                                 (None, VArray 32 (2 ^ Nat.log2_up new_size))%nat m.(mod_arrdecls))
+                 (Some ram)
+                 _ (mod_ordering_wf m) _ (mod_params_wf m)
+  | _ => m
+  end).
+  eapply transf_code_wf. apply (mod_wf m). destruct tc eqn:?; simpl.
+  rewrite <- Heqt. intuition. intuition.
+  inversion 1; subst. auto using module_ram_wf'.
+Defined.
+
+Definition transf_fundef := transf_fundef transf_module.
+
+Definition transf_program (p : program) :=
+  transform_program transf_fundef p.
+
+Inductive match_assocmaps : positive -> assocmap -> assocmap -> Prop :=
+  match_assocmap: forall p rs rs',
+    (forall r, r < p -> rs!r = rs'!r) ->
+    match_assocmaps p rs rs'.
+
+Inductive match_arrs : assocmap_arr -> assocmap_arr -> Prop :=
+| match_assocmap_arr_intro: forall ar ar',
+    (forall s arr,
+        ar ! s = Some arr ->
+        exists arr',
+          ar' ! s = Some arr'
+          /\ (forall addr,
+                 array_get_error addr arr = array_get_error addr arr')
+          /\ arr_length arr = arr_length arr')%nat ->
+    (forall s, ar ! s = None -> ar' ! s = None) ->
+    match_arrs ar ar'.
+
+Inductive match_arrs_size : assocmap_arr -> assocmap_arr -> Prop :=
+  match_arrs_size_intro :
+    forall nasa basa,
+      (forall s arr,
+          nasa ! s = Some arr ->
+          exists arr',
+            basa ! s = Some arr' /\ arr_length arr = arr_length arr') ->
+      (forall s arr,
+          basa ! s = Some arr ->
+          exists arr',
+            nasa ! s = Some arr' /\ arr_length arr = arr_length arr') ->
+      (forall s, basa ! s = None <-> nasa ! s = None) ->
+      match_arrs_size nasa basa.
+
+Definition match_empty_size (m : module) (ar : assocmap_arr) : Prop :=
+  match_arrs_size (empty_stack m) ar.
+#[local] Hint Unfold match_empty_size : mgen.
+
+Definition disable_ram (ram: option ram) (asr : assocmap_reg) : Prop :=
+  match ram with
+  | Some r => Int.eq (asr # ((ram_en r), 32)) (asr # ((ram_u_en r), 32)) = true
+  | None => True
+  end.
+
+Inductive match_stackframes : stackframe -> stackframe -> Prop :=
+  match_stackframe_intro :
+    forall r m pc asr asa asr' asa'
+      (DISABLE_RAM: disable_ram (mod_ram (transf_module m)) asr')
+      (MATCH_ASSOC: match_assocmaps (max_reg_module m + 1) asr asr')
+      (MATCH_ARRS: match_arrs asa asa')
+      (MATCH_EMPT1: match_empty_size m asa)
+      (MATCH_EMPT2: match_empty_size m asa')
+      (MATCH_RES: r < mod_st m),
+      match_stackframes (Stackframe r m pc asr asa)
+                        (Stackframe r (transf_module m) pc asr' asa').
+
+Inductive match_states : state -> state -> Prop :=
+| match_state :
+    forall res res' m st asr asr' asa asa'
+           (ASSOC: match_assocmaps (max_reg_module m + 1) asr asr')
+           (ARRS: match_arrs asa asa')
+           (STACKS: list_forall2 match_stackframes res res')
+           (ARRS_SIZE: match_empty_size m asa)
+           (ARRS_SIZE2: match_empty_size m asa')
+           (DISABLE_RAM: disable_ram (mod_ram (transf_module m)) asr'),
+      match_states (State res m st asr asa)
+                   (State res' (transf_module m) st asr' asa')
+| match_returnstate :
+    forall res res' i
+           (STACKS: list_forall2 match_stackframes res res'),
+      match_states (Returnstate res i) (Returnstate res' i)
+| match_initial_call :
+    forall m,
+      match_states (Callstate nil m nil)
+                   (Callstate nil (transf_module m) nil).
+#[local] Hint Constructors match_states : htlproof.
+
+Definition empty_stack_ram r :=
+  AssocMap.set (ram_mem r) (Array.arr_repeat None (ram_size r)) (AssocMap.empty arr).
+
+Definition empty_stack' len st :=
+  AssocMap.set st (Array.arr_repeat None len) (AssocMap.empty arr).
+
+Definition match_empty_size' l s (ar : assocmap_arr) : Prop :=
+  match_arrs_size (empty_stack' l s) ar.
+#[local] Hint Unfold match_empty_size : mgen.
+
+Definition merge_reg_assocs r :=
+  Verilog.mkassociations (Verilog.merge_regs (assoc_nonblocking r) (assoc_blocking r)) empty_assocmap.
+
+Definition merge_arr_assocs st len r :=
+  Verilog.mkassociations (Verilog.merge_arrs (assoc_nonblocking r) (assoc_blocking r)) (empty_stack' len st).
+
+Inductive match_reg_assocs : positive -> reg_associations -> reg_associations -> Prop :=
+  match_reg_association:
+    forall p rab rab' ran ran',
+      match_assocmaps p rab rab' ->
+      match_assocmaps p ran ran' ->
+      match_reg_assocs p (mkassociations rab ran) (mkassociations rab' ran').
+
+Inductive match_arr_assocs : arr_associations -> arr_associations -> Prop :=
+  match_arr_association:
+    forall rab rab' ran ran',
+      match_arrs rab rab' ->
+      match_arrs ran ran' ->
+      match_arr_assocs (mkassociations rab ran) (mkassociations rab' ran').
+
+Ltac mgen_crush := crush; eauto with mgen.
+
+Lemma match_assocmaps_equiv : forall p a, match_assocmaps p a a.
+Proof. constructor; auto. Qed.
+#[local] Hint Resolve match_assocmaps_equiv : mgen.
+
+Lemma match_arrs_equiv : forall a, match_arrs a a.
+Proof. econstructor; mgen_crush. Qed.
+#[local] Hint Resolve match_arrs_equiv : mgen.
+
+Lemma match_reg_assocs_equiv : forall p a, match_reg_assocs p a a.
+Proof. destruct a; constructor; mgen_crush. Qed.
+#[local] Hint Resolve match_reg_assocs_equiv : mgen.
+
+Lemma match_arr_assocs_equiv : forall a, match_arr_assocs a a.
+Proof. destruct a; constructor; mgen_crush. Qed.
+#[local] Hint Resolve match_arr_assocs_equiv : mgen.
+
+Lemma match_arrs_size_equiv : forall a, match_arrs_size a a.
+Proof. intros; repeat econstructor; eauto. Qed.
+#[local] Hint Resolve match_arrs_size_equiv : mgen.
+
+Lemma match_stacks_equiv :
+  forall m s l,
+    mod_stk m = s ->
+    mod_stk_len m = l ->
+    empty_stack' l s = empty_stack m.
+Proof. unfold empty_stack', empty_stack; mgen_crush. Qed.
+#[local] Hint Rewrite match_stacks_equiv : mgen.
+
+Lemma match_assocmaps_max1 :
+  forall p p' a b,
+    match_assocmaps (Pos.max p' p) a b ->
+    match_assocmaps p a b.
+Proof.
+  intros. inv H. constructor. intros.
+  apply H0. lia.
+Qed.
+#[local] Hint Resolve match_assocmaps_max1 : mgen.
+
+Lemma match_assocmaps_max2 :
+  forall p p' a b,
+    match_assocmaps (Pos.max p p') a b ->
+    match_assocmaps p a b.
+Proof.
+  intros. inv H. constructor. intros.
+  apply H0. lia.
+Qed.
+#[local] Hint Resolve match_assocmaps_max2 : mgen.
+
+Lemma match_assocmaps_ge :
+  forall p p' a b,
+    match_assocmaps p' a b ->
+    p <= p' ->
+    match_assocmaps p a b.
+Proof.
+  intros. inv H. constructor. intros.
+  apply H1. lia.
+Qed.
+#[local] Hint Resolve match_assocmaps_ge : mgen.
+
+Lemma match_reg_assocs_max1 :
+  forall p p' a b,
+    match_reg_assocs (Pos.max p' p) a b ->
+    match_reg_assocs p a b.
+Proof. intros; inv H; econstructor; mgen_crush. Qed.
+#[local] Hint Resolve match_reg_assocs_max1 : mgen.
+
+Lemma match_reg_assocs_max2 :
+  forall p p' a b,
+    match_reg_assocs (Pos.max p p') a b ->
+    match_reg_assocs p a b.
+Proof. intros; inv H; econstructor; mgen_crush. Qed.
+#[local] Hint Resolve match_reg_assocs_max2 : mgen.
+
+Lemma match_reg_assocs_ge :
+  forall p p' a b,
+    match_reg_assocs p' a b ->
+    p <= p' ->
+    match_reg_assocs p a b.
+Proof. intros; inv H; econstructor; mgen_crush. Qed.
+#[local] Hint Resolve match_reg_assocs_ge : mgen.
+
+Definition forall_ram (P: reg -> Prop) ram :=
+  P (ram_en ram)
+  /\ P (ram_u_en ram)
+  /\ P (ram_addr ram)
+  /\ P (ram_wr_en ram)
+  /\ P (ram_d_in ram)
+  /\ P (ram_d_out ram).
+
+Lemma forall_ram_lt :
+  forall m r,
+    (mod_ram m) = Some r ->
+    forall_ram (fun x => x < max_reg_module m + 1) r.
+Proof.
+  assert (X: forall a b c, a < b + 1 -> a < Pos.max c b + 1) by lia.
+  (* unfold forall_ram; simplify; unfold HTL.max_reg_module; repeat apply X; *)
+  (* unfold HTL.max_reg_ram; rewrite H; try lia. *)
+Admitted.
+#[local] Hint Resolve forall_ram_lt : mgen.
+
+Definition exec_all d_s c_s rs1 ar1 rs3 ar3 :=
+  exists f rs2 ar2,
+    stmnt_runp f rs1 ar1 c_s rs2 ar2
+    /\ stmnt_runp f rs2 ar2 d_s rs3 ar3.
+
+Definition exec_all_ram r d_s c_s rs1 ar1 rs4 ar4 :=
+  exists f rs2 ar2 rs3 ar3,
+    stmnt_runp f rs1 ar1 c_s rs2 ar2
+    /\ stmnt_runp f rs2 ar2 d_s rs3 ar3
+    /\ exec_ram (merge_reg_assocs rs3) (merge_arr_assocs (ram_mem r) (ram_size r) ar3) (Some r) rs4 ar4.
+
+(* Lemma merge_reg_idempotent : *)
+(*   forall rs p,  *)
+(*     match_reg_assocs p (merge_reg_assocs (merge_reg_assocs rs)) (merge_reg_assocs rs). *)
+(* Proof. intros. unfold merge_reg_assocs. cbn. unfold merge_regs.  *)
+(* #[global] Hint Rewrite merge_reg_idempotent : mgen. *)
+
+Lemma merge_arr_idempotent :
+  forall ar st len v v',
+    (assoc_nonblocking ar)!st = Some v ->
+    (assoc_blocking ar)!st = Some v' ->
+    arr_length v' = len ->
+    arr_length v = len ->
+    (assoc_blocking (merge_arr_assocs st len (merge_arr_assocs st len ar)))!st
+    = (assoc_blocking (merge_arr_assocs st len ar))!st
+    /\ (assoc_nonblocking (merge_arr_assocs st len (merge_arr_assocs st len ar)))!st
+       = (assoc_nonblocking (merge_arr_assocs st len ar))!st.
+Proof.
+  split; simplify; eauto.
+  unfold merge_arrs.
+  rewrite AssocMap.gcombine by reflexivity.
+  unfold empty_stack'.
+  (* rewrite AssocMap.gss. *)
+  (* setoid_rewrite merge_arr_empty2; auto. *)
+  (* rewrite AssocMap.gcombine by reflexivity. *)
+  (* unfold merge_arr, arr. *)
+  (* rewrite H. rewrite H0. auto. *)
+  (* unfold combine. *)
+  (* simplify. *)
+  (* rewrite list_combine_length. *)
+  (* rewrite (arr_wf v). rewrite (arr_wf v'). *)
+  (* lia. *)
+(* Qed. *) Admitted.
+
+Lemma empty_arr :
+  forall m s,
+    (exists l, (empty_stack m) ! s = Some (arr_repeat None l))
+    \/ (empty_stack m) ! s = None.
+Proof.
+  unfold empty_stack. simplify.
+  destruct (Pos.eq_dec s (mod_stk m)); subst.
+  left. eexists. apply AssocMap.gss.
+  right. rewrite AssocMap.gso; auto.
+Qed.
+
+Lemma merge_arr_empty':
+  forall m ar s v,
+    match_empty_size m ar ->
+    (merge_arrs (empty_stack m) ar) ! s = v ->
+    ar ! s = v.
+Proof.
+  inversion 1; subst.
+  pose proof (empty_arr m s).
+  simplify.
+  destruct (merge_arrs (empty_stack m) ar) ! s eqn:?; subst.
+  - inv H3. inv H4.
+    learn H3 as H5. apply H0 in H5. inv H5. simplify.
+    unfold merge_arrs in *. (* rewrite AssocMap.gcombine in Heqo; auto. *)
+  (*   rewrite H3 in Heqo. erewrite merge_arr_empty2 in Heqo. auto. eauto. *)
+  (*   rewrite list_repeat_len in H6. auto. *)
+  (*   learn H4 as H6. apply H2 in H6. *)
+  (*   unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. *)
+  (*   rewrite H4 in Heqo. unfold Verilog.arr in *. rewrite H6 in Heqo. *)
+  (*   discriminate. *)
+  (* - inv H3. inv H4. learn H3 as H4. apply H0 in H4. inv H4. simplify. *)
+  (*   rewrite list_repeat_len in H6. *)
+  (*   unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. rewrite H3 in Heqo. *)
+  (*   unfold Verilog.arr in *. rewrite H4 in Heqo. *)
+  (*   discriminate. *)
+  (*   apply H2 in H4; auto. *)
+(* Qed. *) Admitted.
+
+Lemma merge_arr_empty :
+  forall m ar ar',
+    match_empty_size m ar ->
+    match_arrs ar ar' ->
+    match_arrs (merge_arrs (empty_stack m) ar) ar'.
+Proof.
+  inversion 1; subst; inversion 1; subst;
+  econstructor; intros; apply merge_arr_empty' in H6; auto.
+Qed.
+#[local] Hint Resolve merge_arr_empty : mgen.
+
+Lemma merge_arr_empty'':
+  forall m ar s v,
+    match_empty_size m ar ->
+    ar ! s = v ->
+    (merge_arrs (empty_stack m) ar) ! s = v.
+Proof.
+  inversion 1; subst.
+  pose proof (empty_arr m s).
+  simplify.
+  destruct (merge_arrs (empty_stack m) ar) ! s eqn:?; subst.
+  - inv H3. inv H4.
+    learn H3 as H5. apply H0 in H5. inv H5. simplify.
+    unfold merge_arrs in *. (* rewrite AssocMap.gcombine in Heqo; auto. *)
+(*     rewrite H3 in Heqo. erewrite merge_arr_empty2 in Heqo. auto. eauto. *)
+(*     rewrite list_repeat_len in H6. auto. *)
+(*     learn H4 as H6. apply H2 in H6. *)
+(*     unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. *)
+(*     rewrite H4 in Heqo. unfold Verilog.arr in *. rewrite H6 in Heqo. *)
+(*     discriminate. *)
+(*   - inv H3. inv H4. learn H3 as H4. apply H0 in H4. inv H4. simplify. *)
+(*     rewrite list_repeat_len in H6. *)
+(*     unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. rewrite H3 in Heqo. *)
+(*     unfold Verilog.arr in *. rewrite H4 in Heqo. *)
+(*     discriminate. *)
+(*     apply H2 in H4; auto. *)
+(* Qed. *) Admitted.
+
+Lemma merge_arr_empty_match :
+  forall m ar,
+    match_empty_size m ar ->
+    match_empty_size m (merge_arrs (empty_stack m) ar).
+Proof.
+  inversion 1; subst.
+  constructor; simplify.
+  learn H3 as H4. apply H0 in H4. inv H4. simplify.
+  eexists; split; eauto. apply merge_arr_empty''; eauto.
+  apply merge_arr_empty' in H3; auto.
+  split; simplify.
+  unfold merge_arrs in H3. (* rewrite AssocMap.gcombine in H3; auto. *)
+(*   unfold merge_arr in *. *)
+(*   destruct (empty_stack m) ! s eqn:?; *)
+(*            destruct ar ! s; try discriminate; eauto. *)
+(*   apply merge_arr_empty''; auto. apply H2 in H3; auto. *)
+(* Qed. *) Admitted.
+#[local] Hint Resolve merge_arr_empty_match : mgen.
+
+Definition ram_present {A: Type} ar r v v' :=
+  (assoc_nonblocking ar)!(ram_mem r) = Some v
+  /\ @arr_length A v = ram_size r
+  /\ (assoc_blocking ar)!(ram_mem r) = Some v'
+  /\ arr_length v' = ram_size r.
+
+Lemma find_assoc_get :
+  forall rs r trs,
+    rs ! r = trs ! r ->
+    rs # r = trs # r.
+Proof.
+  intros; unfold find_assocmap, AssocMapExt.get_default; rewrite H; auto.
+Qed.
+#[local] Hint Resolve find_assoc_get : mgen.
+
+Lemma find_assoc_get2 :
+  forall rs p r v trs,
+    (forall r, r < p -> rs ! r = trs ! r) ->
+    r < p ->
+    rs # r = v ->
+    trs # r = v.
+Proof.
+  intros; unfold find_assocmap, AssocMapExt.get_default; rewrite <- H; auto.
+Qed.
+#[local] Hint Resolve find_assoc_get2 : mgen.
+
+Lemma get_assoc_gt :
+  forall A (rs : AssocMap.t A) p r v trs,
+    (forall r, r < p -> rs ! r = trs ! r) ->
+    r < p ->
+    rs ! r = v ->
+    trs ! r = v.
+Proof. intros. rewrite <- H; auto. Qed.
+#[local] Hint Resolve get_assoc_gt : mgen.
+
+Lemma expr_runp_matches :
+  forall f rs ar e v,
+    expr_runp f rs ar e v ->
+    forall trs tar,
+      match_assocmaps (max_reg_expr e + 1) rs trs ->
+      match_arrs ar tar ->
+      expr_runp f trs tar e v.
+Proof.
+  induction 1.
+  - intros. econstructor.
+  - intros. econstructor. inv H0. symmetry.
+    apply find_assoc_get.
+    apply H2. crush.
+  - intros. econstructor. apply IHexpr_runp; eauto.
+    inv H1. constructor. simplify.
+    assert (forall a b c, a < b + 1 -> a < Pos.max c b + 1) by lia.
+    eapply H4 in H1. eapply H3 in H1. auto.
+    inv H2.
+    unfold arr_assocmap_lookup in *.
+    destruct (stack ! r) eqn:?; [|discriminate].
+    inv H1.
+    inv H0.
+    eapply H3 in Heqo. inv Heqo. inv H0.
+    unfold arr in *. rewrite H1. inv H5.
+    rewrite H0. auto.
+  - intros. econstructor; eauto. eapply IHexpr_runp1; eauto.
+    econstructor. inv H2. intros.
+    assert (forall a b c, a < b + 1 -> a < Pos.max b c + 1) by lia.
+    simplify.
+    eapply H5 in H2. apply H4 in H2. auto.
+    apply IHexpr_runp2; eauto.
+    econstructor. inv H2. intros.
+    assert (forall a b c, a < b + 1 -> a < Pos.max c b + 1) by lia.
+    simplify. eapply H5 in H2. apply H4 in H2. auto.
+  - intros. econstructor; eauto.
+  - intros. econstructor; eauto. apply IHexpr_runp1; eauto.
+    constructor. inv H2. intros. simplify.
+    assert (forall a b c, a < b + 1 -> a < Pos.max b c + 1) by lia.
+    eapply H5 in H2. apply H4 in H2. auto.
+    apply IHexpr_runp2; eauto. simplify.
+    assert (forall a b c d, a < b + 1 -> a < Pos.max c (Pos.max b d) + 1) by lia.
+    constructor. intros. eapply H4 in H5. inv H2. apply H6 in H5. auto.
+  - intros. eapply erun_Vternary_false. apply IHexpr_runp1; eauto. constructor. inv H2.
+    intros. simplify. assert (forall a b c, a < b + 1 -> a < Pos.max b c + 1) by lia.
+    eapply H5 in H2. apply H4 in H2. auto.
+    apply IHexpr_runp2; eauto. econstructor. inv H2. simplify.
+    assert (forall a b c d, a < b + 1 -> a < Pos.max c (Pos.max d b) + 1) by lia.
+    eapply H5 in H2. apply H4 in H2. auto. auto.
+Qed.
+#[local] Hint Resolve expr_runp_matches : mgen.
+
+Lemma expr_runp_matches2 :
+  forall f rs ar e v p,
+    expr_runp f rs ar e v ->
+    max_reg_expr e < p ->
+    forall trs tar,
+      match_assocmaps p rs trs ->
+      match_arrs ar tar ->
+      expr_runp f trs tar e v.
+Proof.
+  intros. eapply expr_runp_matches; eauto.
+  assert (max_reg_expr e + 1 <= p) by lia.
+  mgen_crush.
+Qed.
+#[local] Hint Resolve expr_runp_matches2 : mgen.
+
+Lemma match_assocmaps_gss :
+  forall p rab rab' r rhsval,
+    match_assocmaps p rab rab' ->
+    match_assocmaps p rab # r <- rhsval rab' # r <- rhsval.
+Proof.
+  intros. inv H. econstructor.
+  intros.
+  unfold find_assocmap. unfold AssocMapExt.get_default.
+  destruct (Pos.eq_dec r r0); subst.
+  repeat rewrite PTree.gss; auto.
+  repeat rewrite PTree.gso; auto.
+Qed.
+#[local] Hint Resolve match_assocmaps_gss : mgen.
+
+Lemma match_assocmaps_gt :
+  forall p s ra ra' v,
+    p <= s ->
+    match_assocmaps p ra ra' ->
+    match_assocmaps p ra (ra' # s <- v).
+Proof.
+  intros. inv H0. constructor.
+  intros. rewrite AssocMap.gso; try lia. apply H1; auto.
+Qed.
+#[local] Hint Resolve match_assocmaps_gt : mgen.
+
+Lemma match_reg_assocs_block :
+  forall p rab rab' r rhsval,
+    match_reg_assocs p rab rab' ->
+    match_reg_assocs p (block_reg r rab rhsval) (block_reg r rab' rhsval).
+Proof. inversion 1; econstructor; eauto with mgen. Qed.
+#[local] Hint Resolve match_reg_assocs_block : mgen.
+
+Lemma match_reg_assocs_nonblock :
+  forall p rab rab' r rhsval,
+    match_reg_assocs p rab rab' ->
+    match_reg_assocs p (nonblock_reg r rab rhsval) (nonblock_reg r rab' rhsval).
+Proof. inversion 1; econstructor; eauto with mgen. Qed.
+#[local] Hint Resolve match_reg_assocs_nonblock : mgen.
+
+Lemma some_inj :
+  forall A (x: A) y,
+    Some x = Some y ->
+    x = y.
+Proof. inversion 1; auto. Qed.
+
+Lemma arrs_present :
+  forall r i v ar arr,
+    (arr_assocmap_set r i v ar) ! r = Some arr ->
+    exists b, ar ! r = Some b.
+Proof.
+  intros. unfold arr_assocmap_set in *.
+  destruct ar!r eqn:?.
+  rewrite AssocMap.gss in H.
+  inv H. eexists. auto. rewrite Heqo in H. discriminate.
+Qed.
+
+Ltac inv_exists :=
+  match goal with
+  | H: exists _, _ |- _ => inv H
+  end.
+
+Lemma array_get_error_bound_gt :
+  forall A i (a : Array A),
+    (i >= arr_length a)%nat ->
+    array_get_error i a = None.
+Proof.
+  intros. unfold array_get_error.
+  apply nth_error_None. destruct a. simplify.
+  lia.
+Qed.
+#[local] Hint Resolve array_get_error_bound_gt : mgen.
+
+Lemma array_get_error_each :
+  forall A addr i (v : A) a x,
+    arr_length a = arr_length x ->
+    array_get_error addr a = array_get_error addr x ->
+    array_get_error addr (array_set i v a) = array_get_error addr (array_set i v x).
+Proof.
+  intros.
+  destruct (Nat.eq_dec addr i); subst.
+  destruct (lt_dec i (arr_length a)).
+  repeat rewrite array_get_error_set_bound; auto.
+  rewrite <- H. auto.
+  apply Nat.nlt_ge in n.
+  repeat rewrite array_get_error_bound_gt; auto.
+  rewrite <- array_set_len. rewrite <- H. lia.
+  repeat rewrite array_gso; auto.
+Qed.
+#[local] Hint Resolve array_get_error_each : mgen.
+
+Lemma match_arrs_gss :
+  forall ar ar' r v i,
+    match_arrs ar ar' ->
+    match_arrs (arr_assocmap_set r i v ar) (arr_assocmap_set r i v ar').
+Proof.
+  Ltac mag_tac :=
+    match goal with
+    | H: ?ar ! _ = Some _, H2: forall s arr, ?ar ! s = Some arr -> _ |- _ =>
+      let H3 := fresh "H" in
+      learn H as H3; apply H2 in H3; inv_exists; simplify
+    | H: ?ar ! _ = None, H2: forall s, ?ar ! s = None -> _ |- _ =>
+      let H3 := fresh "H" in
+      learn H as H3; apply H2 in H3; inv_exists; simplify
+    | H: ?ar ! _ = _ |- context[match ?ar ! _ with _ => _ end] =>
+      unfold Verilog.arr in *; rewrite H
+    | H: ?ar ! _ = _, H2: context[match ?ar ! _ with _ => _ end] |- _ =>
+      unfold Verilog.arr in *; rewrite H in H2
+    | H: context[(_ # ?s <- _) ! ?s] |- _ => rewrite AssocMap.gss in H
+    | H: context[(_ # ?r <- _) ! ?s], H2: ?r <> ?s |- _ => rewrite AssocMap.gso in H; auto
+    | |- context[(_ # ?s <- _) ! ?s] => rewrite AssocMap.gss
+    | H: ?r <> ?s |- context[(_ # ?r <- _) ! ?s] => rewrite AssocMap.gso; auto
+    end.
+  intros.
+  inv H. econstructor; simplify.
+  destruct (Pos.eq_dec r s); subst.
+  - unfold arr_assocmap_set, Verilog.arr in *.
+    destruct ar!s eqn:?.
+    mag_tac.
+    econstructor; simplify.
+    repeat mag_tac; auto.
+    intros. repeat mag_tac. simplify.
+    apply array_get_error_each; auto.
+    repeat mag_tac; crush.
+    repeat mag_tac; crush.
+  - unfold arr_assocmap_set in *.
+    destruct ar ! r eqn:?. rewrite AssocMap.gso in H; auto.
+    apply H0 in Heqo. apply H0 in H. repeat inv_exists. simplify.
+    econstructor. unfold Verilog.arr in *. rewrite H3. simplify.
+    rewrite AssocMap.gso; auto. eauto. intros. auto. auto.
+    apply H1 in Heqo. apply H0 in H. repeat inv_exists; simplify.
+    econstructor. unfold Verilog.arr in *. rewrite Heqo. simplify; eauto.
+  - destruct (Pos.eq_dec r s); unfold arr_assocmap_set, Verilog.arr in *; simplify; subst.
+    destruct ar!s eqn:?; repeat mag_tac; crush.
+    apply H1 in H. mag_tac; crush.
+    destruct ar!r eqn:?; repeat mag_tac; crush.
+    apply H1 in Heqo. repeat mag_tac; auto.
+Qed.
+#[local] Hint Resolve match_arrs_gss : mgen.
+
+Lemma match_arr_assocs_block :
+  forall rab rab' r i rhsval,
+    match_arr_assocs rab rab' ->
+    match_arr_assocs (block_arr r i rab rhsval) (block_arr r i rab' rhsval).
+Proof. inversion 1; econstructor; eauto with mgen. Qed.
+#[local] Hint Resolve match_arr_assocs_block : mgen.
+
+Lemma match_arr_assocs_nonblock :
+  forall rab rab' r i rhsval,
+    match_arr_assocs rab rab' ->
+    match_arr_assocs (nonblock_arr r i rab rhsval) (nonblock_arr r i rab' rhsval).
+Proof. inversion 1; econstructor; eauto with mgen. Qed.
+#[local] Hint Resolve match_arr_assocs_nonblock : mgen.
+
+Lemma match_states_same :
+  forall f rs1 ar1 c rs2 ar2 p,
+    stmnt_runp f rs1 ar1 c rs2 ar2 ->
+    max_reg_stmnt c < p ->
+    forall trs1 tar1,
+      match_reg_assocs p rs1 trs1 ->
+      match_arr_assocs ar1 tar1 ->
+      exists trs2 tar2,
+        stmnt_runp f trs1 tar1 c trs2 tar2
+        /\ match_reg_assocs p rs2 trs2
+        /\ match_arr_assocs ar2 tar2.
+Proof.
+  Ltac match_states_same_facts :=
+    match goal with
+    | H: match_reg_assocs _ _ _ |- _ =>
+      let H2 := fresh "H" in
+      learn H as H2; inv H2
+    | H: match_arr_assocs _ _ |- _ =>
+      let H2 := fresh "H" in
+      learn H as H2; inv H2
+    | H1: context[exists _, _], H2: context[exists _, _] |- _ =>
+      learn H1; learn H2;
+      exploit H1; mgen_crush; exploit H2; mgen_crush
+    | H1: context[exists _, _] |- _ =>
+      learn H1; exploit H1; mgen_crush
+    end.
+  Ltac match_states_same_tac :=
+    match goal with
+    | |- exists _, _ => econstructor
+    | |- _ < _ => lia
+    | H: context[_ <> _] |- stmnt_runp _ _ _ (Vcase _ (Stmntcons _ _ _) _) _ _ =>
+      eapply stmnt_runp_Vcase_nomatch
+    | |- stmnt_runp _ _ _ (Vcase _ (Stmntcons _ _ _) _) _ _ =>
+      eapply stmnt_runp_Vcase_match
+    | H: valueToBool _ = false |- stmnt_runp _ _ _ _ _ _ =>
+      eapply stmnt_runp_Vcond_false
+    | |- stmnt_runp _ _ _ _ _ _ => econstructor
+    | |- expr_runp _ _ _ _ _ => eapply expr_runp_matches2
+    end; mgen_crush; try lia.
+  induction 1; simplify; repeat match_states_same_facts;
+    try destruct_match; try solve [repeat match_states_same_tac].
+  - inv H. exists (block_reg r {| assoc_blocking := rab'; assoc_nonblocking := ran' |} rhsval);
+      repeat match_states_same_tac; econstructor.
+  - exists (nonblock_reg r {| assoc_blocking := rab'; assoc_nonblocking := ran' |} rhsval);
+      repeat match_states_same_tac; inv H; econstructor.
+  - econstructor. exists (block_arr r i {| assoc_blocking := rab'0; assoc_nonblocking := ran'0 |} rhsval).
+    simplify; repeat match_states_same_tac. inv H. econstructor.
+    repeat match_states_same_tac. eauto. mgen_crush.
+  - econstructor. exists (nonblock_arr r i {| assoc_blocking := rab'0; assoc_nonblocking := ran'0 |} rhsval).
+    simplify; repeat match_states_same_tac. inv H. econstructor.
+    repeat match_states_same_tac. eauto. mgen_crush.
+Qed.
+
+Lemma match_reg_assocs_merge :
+  forall p rs rs',
+    match_reg_assocs p rs rs' ->
+    match_reg_assocs p (merge_reg_assocs rs) (merge_reg_assocs rs').
+Proof.
+  inversion 1.
+  econstructor; econstructor; crush. inv H3.  inv H.
+  inv H7. inv H9.
+  unfold merge_regs.
+  destruct (ran!r) eqn:?; destruct (rab!r) eqn:?.
+  erewrite AssocMapExt.merge_correct_1; eauto.
+  erewrite AssocMapExt.merge_correct_1; eauto.
+  rewrite <- H2; eauto.
+  erewrite AssocMapExt.merge_correct_1; eauto.
+  erewrite AssocMapExt.merge_correct_1; eauto.
+  rewrite <- H2; eauto.
+  erewrite AssocMapExt.merge_correct_2; eauto.
+  erewrite AssocMapExt.merge_correct_2; eauto.
+  rewrite <- H2; eauto.
+  rewrite <- H; eauto.
+  erewrite AssocMapExt.merge_correct_3; eauto.
+  erewrite AssocMapExt.merge_correct_3; eauto.
+  rewrite <- H2; eauto.
+  rewrite <- H; eauto.
+Qed.
+#[local] Hint Resolve match_reg_assocs_merge : mgen.
+
+Lemma transf_not_changed :
+  forall state ram n d i d_s,
+    (forall e1 e2 r, d_s <> Vnonblock (Vvari r e1) e2) ->
+    (forall e1 e2 r, d_s <> Vnonblock e1 (Vvari r e2)) ->
+    d!i = Some d_s ->
+    transf_maps state ram (i, n) d = d.
+Proof. intros; unfold transf_maps; repeat destruct_match; mgen_crush. Admitted.
+
+(* Lemma transf_not_changed_neq : *)
+(*   forall state ram n d c d' c' i a d_s c_s, *)
+(*     transf_maps state ram (a, n) (d, c) = (d', c') -> *)
+(*     d!i = Some d_s -> *)
+(*     c!i = Some c_s -> *)
+(*     a <> i -> n <> i -> *)
+(*     d'!i = Some d_s /\ c'!i = Some c_s. *)
+(* Proof. *)
+(*   unfold transf_maps; intros; repeat destruct_match; mgen_crush; *)
+(*   match goal with [ H: (_, _) = (_, _) |- _ ] => inv H end; *)
+(*   repeat (rewrite AssocMap.gso; auto). *)
+(* Qed. *)
+
+(* Lemma forall_gt : *)
+(*   forall l, Forall (Pos.ge (fold_right Pos.max 1 l)) l. *)
+(* Proof. *)
+(*   induction l; auto. *)
+(*   constructor. inv IHl; simplify; lia. *)
+(*   simplify. destruct (Pos.max_dec a (fold_right Pos.max 1 l)). *)
+(*   rewrite e. apply Pos.max_l_iff in e. apply Pos.le_ge in e. *)
+(*   apply Forall_forall. rewrite Forall_forall in IHl. *)
+(*   intros. *)
+(*   assert (X: forall a b c, a >= c -> c >= b -> a >= b) by lia. *)
+(*   apply X with (b := x) in e; auto. *)
+(*   rewrite e; auto. *)
+(* Qed. *)
+
+(* Lemma max_index_list : *)
+(*   forall A (l : list (positive * A)) i d_s, *)
+(*     In (i, d_s) l -> *)
+(*     list_norepet (map fst l) -> *)
+(*     i <= fold_right Pos.max 1 (map fst l). *)
+(* Proof. *)
+(*   induction l; crush. *)
+(*   inv H. inv H0. simplify. lia. *)
+(*   inv H0. *)
+(*   let H := fresh "H" in *)
+(*   assert (H: forall a b c, c <= b -> c <= Pos.max a b) by lia; *)
+(*   apply H; eapply IHl; eauto. *)
+(* Qed. *)
+
+(* Lemma max_index : *)
+(*   forall A d i (d_s: A), d ! i = Some d_s -> i <= max_pc d. *)
+(* Proof. *)
+(*   unfold max_pc; *)
+(*   eauto using max_index_list, *)
+(*   PTree.elements_correct, PTree.elements_keys_norepet. *)
+(* Qed. *)
+
+(* Lemma max_index_2' : *)
+(*   forall l i, i > fold_right Pos.max 1 l -> Forall (Pos.gt i) l. *)
+(* Proof. induction l; crush; constructor; [|apply IHl]; lia. Qed. *)
+
+(* Lemma max_index_2'' : *)
+(*   forall l i, Forall (Pos.gt i) l -> ~ In i l. *)
+(* Proof. *)
+(*   induction l; crush. unfold not in *. *)
+(*   intros. inv H0. inv H. lia. eapply IHl. *)
+(*   inv H. apply H4. auto. *)
+(* Qed. *)
+
+(* Lemma elements_correct_none : *)
+(*   forall A am k, *)
+(*     ~ List.In k (List.map (@fst _ A) (AssocMap.elements am)) -> *)
+(*     AssocMap.get k am = None. *)
+(* Proof. *)
+(*   intros. apply AssocMapExt.elements_correct' in H. unfold not in *. *)
+(*   destruct am ! k eqn:?; auto. exfalso. apply H. eexists. auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve elements_correct_none : assocmap. *)
+
+(* Lemma max_index_2 : *)
+(*   forall A (d: AssocMap.t A) i, i > max_pc d -> d ! i = None. *)
+(* Proof. *)
+(*   intros. unfold max_pc in *. apply max_index_2' in H. *)
+(*   apply max_index_2'' in H. apply elements_correct_none. auto. *)
+(* Qed. *)
+
+Definition match_prog (p: program) (tp: program) :=
+  Linking.match_program (fun cu f tf => tf = transf_fundef f) eq p tp.
+
+Lemma transf_program_match:
+  forall p, match_prog p (transf_program p).
+Proof.
+  intros. unfold transf_program, match_prog.
+  apply Linking.match_transform_program.
+Qed.
+
+Lemma exec_all_Vskip :
+  forall rs ar,
+    exec_all Vskip Vskip rs ar rs ar.
+Proof.
+  unfold exec_all.
+  intros. repeat econstructor.
+  Unshelve. unfold fext. exact tt.
+Qed.
+
+Lemma match_assocmaps_trans:
+  forall p rs1 rs2 rs3,
+    match_assocmaps p rs1 rs2 ->
+    match_assocmaps p rs2 rs3 ->
+    match_assocmaps p rs1 rs3.
+Proof.
+  intros. inv H. inv H0. econstructor; eauto.
+  intros. rewrite H1 by auto. auto.
+Qed.
+
+Lemma match_reg_assocs_trans:
+  forall p rs1 rs2 rs3,
+    match_reg_assocs p rs1 rs2 ->
+    match_reg_assocs p rs2 rs3 ->
+    match_reg_assocs p rs1 rs3.
+Proof.
+  intros. inv H. inv H0.
+  econstructor; eapply match_assocmaps_trans; eauto.
+Qed.
+
+Lemma empty_arrs_match :
+  forall m,
+    match_arrs (empty_stack m) (empty_stack (transf_module m)).
+Proof.
+  intros;
+  unfold empty_stack, transf_module; repeat destruct_match; mgen_crush.
+Qed.
+#[local] Hint Resolve empty_arrs_match : mgen.
+
+(* Lemma max_module_stmnts : *)
+(*   forall m, *)
+(*     Pos.max (max_stmnt_tree (mod_controllogic m)) *)
+(*             (max_stmnt_tree (mod_datapath m)) < max_reg_module m + 1. *)
+(* Proof. intros. unfold max_reg_module. lia. Qed. *)
+(* #[local] Hint Resolve max_module_stmnts : mgen. *)
+
+(* Lemma transf_module_code : *)
+(*   forall m, *)
+(*     mod_ram m = None -> *)
+(*     transf_code (mod_st m) *)
+(*                 {| ram_size := mod_stk_len m; *)
+(*                    ram_mem := mod_stk m; *)
+(*                    ram_en := max_reg_module m + 2; *)
+(*                    ram_addr := max_reg_module m + 1; *)
+(*                    ram_wr_en := max_reg_module m + 5; *)
+(*                    ram_d_in := max_reg_module m + 3; *)
+(*                    ram_d_out := max_reg_module m + 4; *)
+(*                    ram_u_en := max_reg_module m + 6; *)
+(*                    ram_ordering := ram_wf (max_reg_module m) |} *)
+(*                 (mod_datapath m) (mod_controllogic m) *)
+(*     = ((mod_datapath (transf_module m)), mod_controllogic (transf_module m)). *)
+(* Proof. unfold transf_module; intros; repeat destruct_match; crush. *)
+(*        apply surjective_pairing. Qed. *)
+(* #[local] Hint Resolve transf_module_code : mgen. *)
+
+(* Lemma transf_module_code_ram : *)
+(*   forall m r, mod_ram m = Some r -> transf_module m = m. *)
+(* Proof. unfold transf_module; intros; repeat destruct_match; crush. Qed. *)
+(* #[local] Hint Resolve transf_module_code_ram : mgen. *)
+
+(* Lemma mod_reset_lt : forall m, mod_reset m < max_reg_module m + 1. *)
+(* Proof. intros; unfold max_reg_module; lia. Qed. *)
+(* #[local] Hint Resolve mod_reset_lt : mgen. *)
+
+(* Lemma mod_finish_lt : forall m, mod_finish m < max_reg_module m + 1. *)
+(* Proof. intros; unfold max_reg_module; lia. Qed. *)
+(* #[local] Hint Resolve mod_finish_lt : mgen. *)
+
+(* Lemma mod_return_lt : forall m, mod_return m < max_reg_module m + 1. *)
+(* Proof. intros; unfold max_reg_module; lia. Qed. *)
+(* #[local] Hint Resolve mod_return_lt : mgen. *)
+
+(* Lemma mod_start_lt : forall m, mod_start m < max_reg_module m + 1. *)
+(* Proof. intros; unfold max_reg_module; lia. Qed. *)
+(* #[local] Hint Resolve mod_start_lt : mgen. *)
+
+(* Lemma mod_stk_lt : forall m, mod_stk m < max_reg_module m + 1. *)
+(* Proof. intros; unfold max_reg_module; lia. Qed. *)
+(* #[local] Hint Resolve mod_stk_lt : mgen. *)
+
+(* Lemma mod_st_lt : forall m, mod_st m < max_reg_module m + 1. *)
+(* Proof. intros; unfold max_reg_module; lia. Qed. *)
+(* #[local] Hint Resolve mod_st_lt : mgen. *)
+
+(* Lemma mod_reset_modify : *)
+(*   forall m ar ar' v, *)
+(*     match_assocmaps (max_reg_module m + 1) ar ar' -> *)
+(*     ar ! (mod_reset m) = Some v -> *)
+(*     ar' ! (mod_reset (transf_module m)) = Some v. *)
+(* Proof. *)
+(*   inversion 1. intros. *)
+(*   unfold transf_module; repeat destruct_match; simplify; *)
+(*   rewrite <- H0; eauto with mgen. *)
+(* Qed. *)
+(* #[local] Hint Resolve mod_reset_modify : mgen. *)
+
+(* Lemma mod_finish_modify : *)
+(*   forall m ar ar' v, *)
+(*     match_assocmaps (max_reg_module m + 1) ar ar' -> *)
+(*     ar ! (mod_finish m) = Some v -> *)
+(*     ar' ! (mod_finish (transf_module m)) = Some v. *)
+(* Proof. *)
+(*   inversion 1. intros. *)
+(*   unfold transf_module; repeat destruct_match; simplify; *)
+(*   rewrite <- H0; eauto with mgen. *)
+(* Qed. *)
+(* #[local] Hint Resolve mod_finish_modify : mgen. *)
+
+(* Lemma mod_return_modify : *)
+(*   forall m ar ar' v, *)
+(*     match_assocmaps (max_reg_module m + 1) ar ar' -> *)
+(*     ar ! (mod_return m) = Some v -> *)
+(*     ar' ! (mod_return (transf_module m)) = Some v. *)
+(* Proof. *)
+(*   inversion 1. intros. *)
+(*   unfold transf_module; repeat destruct_match; simplify; *)
+(*   rewrite <- H0; eauto with mgen. *)
+(* Qed. *)
+(* #[local] Hint Resolve mod_return_modify : mgen. *)
+
+(* Lemma mod_start_modify : *)
+(*   forall m ar ar' v, *)
+(*     match_assocmaps (max_reg_module m + 1) ar ar' -> *)
+(*     ar ! (mod_start m) = Some v -> *)
+(*     ar' ! (mod_start (transf_module m)) = Some v. *)
+(* Proof. *)
+(*   inversion 1. intros. *)
+(*   unfold transf_module; repeat destruct_match; simplify; *)
+(*   rewrite <- H0; eauto with mgen. *)
+(* Qed. *)
+(* #[local] Hint Resolve mod_start_modify : mgen. *)
+
+(* Lemma mod_st_modify : *)
+(*   forall m ar ar' v, *)
+(*     match_assocmaps (max_reg_module m + 1) ar ar' -> *)
+(*     ar ! (mod_st m) = Some v -> *)
+(*     ar' ! (mod_st (transf_module m)) = Some v. *)
+(* Proof. *)
+(*   inversion 1. intros. *)
+(*   unfold transf_module; repeat destruct_match; simplify; *)
+(*   rewrite <- H0; eauto with mgen. *)
+(* Qed. *)
+(* #[local] Hint Resolve mod_st_modify : mgen. *)
+
+(* Lemma match_arrs_read : *)
+(*   forall ra ra' addr v mem, *)
+(*     arr_assocmap_lookup ra mem addr = Some v -> *)
+(*     match_arrs ra ra' -> *)
+(*     arr_assocmap_lookup ra' mem addr = Some v. *)
+(* Proof. *)
+(*   unfold arr_assocmap_lookup. intros. destruct_match; destruct_match; try discriminate. *)
+(*   inv H0. eapply H1 in Heqo0. inv Heqo0. simplify. unfold arr in *. *)
+(*   rewrite H in Heqo. inv Heqo. *)
+(*   rewrite H0. auto. *)
+(*   inv H0. eapply H1 in Heqo0. inv Heqo0. inv H0. unfold arr in *. *)
+(*   rewrite H3 in Heqo. discriminate. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_arrs_read : mgen. *)
+
+(* Lemma match_reg_implies_equal : *)
+(*   forall ra ra' p a b c, *)
+(*     Int.eq (ra # a) (ra # b) = c -> *)
+(*     a < p -> b < p -> *)
+(*     match_assocmaps p ra ra' -> *)
+(*     Int.eq (ra' # a) (ra' # b) = c. *)
+(* Proof. *)
+(*   unfold find_assocmap, AssocMapExt.get_default; intros. *)
+(*   inv H2. destruct (ra ! a) eqn:?; destruct (ra ! b) eqn:?; *)
+(*   repeat rewrite <- H3 by lia; rewrite Heqo; rewrite Heqo0; auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_reg_implies_equal : mgen. *)
+
+(* Lemma exec_ram_same : *)
+(*   forall rs1 ar1 ram rs2 ar2 p, *)
+(*     exec_ram rs1 ar1 (Some ram) rs2 ar2 -> *)
+(*     forall_ram (fun x => x < p) ram -> *)
+(*     forall trs1 tar1, *)
+(*       match_reg_assocs p rs1 trs1 -> *)
+(*       match_arr_assocs ar1 tar1 -> *)
+(*       exists trs2 tar2, *)
+(*         exec_ram trs1 tar1 (Some ram) trs2 tar2 *)
+(*         /\ match_reg_assocs p rs2 trs2 *)
+(*         /\ match_arr_assocs ar2 tar2. *)
+(* Proof. *)
+(*   Ltac exec_ram_same_facts := *)
+(*     match goal with *)
+(*     | H: match_reg_assocs _ _ _ |- _ => let H2 := fresh "H" in learn H as H2; inv H2 *)
+(*     | H: match_assocmaps _ _ _ |- _ => let H2 := fresh "H" in learn H as H2; inv H2 *)
+(*     | H: match_arr_assocs _ _ |- _ => let H2 := fresh "H" in learn H as H2; inv H2 *)
+(*     | H: match_arrs _ _ |- _ => let H2 := fresh "H" in learn H as H2; inv H2 *)
+(*     end. *)
+(*   inversion 1; subst; destruct ram; unfold forall_ram; simplify; repeat exec_ram_same_facts. *)
+(*   - repeat (econstructor; mgen_crush). *)
+(*   - do 2 econstructor; simplify; *)
+(*       [eapply exec_ram_Some_write; [ apply H1 | apply H2 | | | | | ] | | ]; *)
+(*       mgen_crush. *)
+(*   - do 2 econstructor; simplify; [eapply exec_ram_Some_read | | ]; *)
+(*       repeat (try econstructor; mgen_crush). *)
+(* Qed. *)
+
+(* Lemma match_assocmaps_merge : *)
+(*   forall p nasr basr nasr' basr', *)
+(*     match_assocmaps p nasr nasr' -> *)
+(*     match_assocmaps p basr basr' -> *)
+(*     match_assocmaps p (merge_regs nasr basr) (merge_regs nasr' basr'). *)
+(* Proof. *)
+(*   unfold merge_regs. *)
+(*   intros. inv H. inv H0. econstructor. *)
+(*   intros. *)
+(*   destruct nasr ! r eqn:?; destruct basr ! r eqn:?. *)
+(*   erewrite AssocMapExt.merge_correct_1; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_1; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_1; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_1; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_2; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_2; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_3; mgen_crush. *)
+(*   erewrite AssocMapExt.merge_correct_3; mgen_crush. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_assocmaps_merge : mgen. *)
+
+(* Lemma list_combine_nth_error1 : *)
+(*   forall l l' addr v, *)
+(*     length l = length l' -> *)
+(*     nth_error l addr = Some (Some v) -> *)
+(*     nth_error (list_combine merge_cell l l') addr = Some (Some v). *)
+(* Proof. induction l; destruct l'; destruct addr; crush. Qed. *)
+
+(* Lemma list_combine_nth_error2 : *)
+(*   forall l' l addr v, *)
+(*     length l = length l' -> *)
+(*     nth_error l addr = Some None -> *)
+(*     nth_error l' addr = Some (Some v) -> *)
+(*     nth_error (list_combine merge_cell l l') addr = Some (Some v). *)
+(* Proof. induction l'; try rewrite nth_error_nil in *; destruct l; destruct addr; crush. Qed. *)
+
+(* Lemma list_combine_nth_error3 : *)
+(*   forall l l' addr, *)
+(*     length l = length l' -> *)
+(*     nth_error l addr = Some None -> *)
+(*     nth_error l' addr = Some None -> *)
+(*     nth_error (list_combine merge_cell l l') addr = Some None. *)
+(* Proof. induction l; destruct l'; destruct addr; crush. Qed. *)
+
+(* Lemma list_combine_nth_error4 : *)
+(*   forall l l' addr, *)
+(*     length l = length l' -> *)
+(*     nth_error l addr = None -> *)
+(*     nth_error (list_combine merge_cell l l') addr = None. *)
+(* Proof. induction l; destruct l'; destruct addr; crush. Qed. *)
+
+(* Lemma list_combine_nth_error5 : *)
+(*   forall l l' addr, *)
+(*     length l = length l' -> *)
+(*     nth_error l' addr = None -> *)
+(*     nth_error (list_combine merge_cell l l') addr = None. *)
+(* Proof. induction l; destruct l'; destruct addr; crush. Qed. *)
+
+(* Lemma array_get_error_merge1 : *)
+(*   forall a a0 addr v, *)
+(*     arr_length a = arr_length a0 -> *)
+(*     array_get_error addr a = Some (Some v) -> *)
+(*     array_get_error addr (combine merge_cell a a0) = Some (Some v). *)
+(* Proof. *)
+(*   unfold array_get_error, combine in *; intros; *)
+(*   apply list_combine_nth_error1; destruct a; destruct a0; crush. *)
+(* Qed. *)
+
+(* Lemma array_get_error_merge2 : *)
+(*   forall a a0 addr v, *)
+(*     arr_length a = arr_length a0 -> *)
+(*     array_get_error addr a0 = Some (Some v) -> *)
+(*     array_get_error addr a = Some None -> *)
+(*     array_get_error addr (combine merge_cell a a0) = Some (Some v). *)
+(* Proof. *)
+(*   unfold array_get_error, combine in *; intros; *)
+(*   apply list_combine_nth_error2; destruct a; destruct a0; crush. *)
+(* Qed. *)
+
+(* Lemma array_get_error_merge3 : *)
+(*   forall a a0 addr, *)
+(*     arr_length a = arr_length a0 -> *)
+(*     array_get_error addr a0 = Some None -> *)
+(*     array_get_error addr a = Some None -> *)
+(*     array_get_error addr (combine merge_cell a a0) = Some None. *)
+(* Proof. *)
+(*   unfold array_get_error, combine in *; intros; *)
+(*   apply list_combine_nth_error3; destruct a; destruct a0; crush. *)
+(* Qed. *)
+
+(* Lemma array_get_error_merge4 : *)
+(*   forall a a0 addr, *)
+(*     arr_length a = arr_length a0 -> *)
+(*     array_get_error addr a = None -> *)
+(*     array_get_error addr (combine merge_cell a a0) = None. *)
+(* Proof. *)
+(*   unfold array_get_error, combine in *; intros; *)
+(*   apply list_combine_nth_error4; destruct a; destruct a0; crush. *)
+(* Qed. *)
+
+(* Lemma array_get_error_merge5 : *)
+(*   forall a a0 addr, *)
+(*     arr_length a = arr_length a0 -> *)
+(*     array_get_error addr a0 = None -> *)
+(*     array_get_error addr (combine merge_cell a a0) = None. *)
+(* Proof. *)
+(*   unfold array_get_error, combine in *; intros; *)
+(*   apply list_combine_nth_error5; destruct a; destruct a0; crush. *)
+(* Qed. *)
+
+(* Lemma match_arrs_merge' : *)
+(*   forall addr nasa basa arr s x x0 a a0 nasa' basa', *)
+(*     (AssocMap.combine merge_arr nasa basa) ! s = Some arr -> *)
+(*     nasa ! s = Some a -> *)
+(*     basa ! s = Some a0 -> *)
+(*     nasa' ! s = Some x0 -> *)
+(*     basa' ! s = Some x -> *)
+(*     arr_length x = arr_length x0 -> *)
+(*     array_get_error addr a0 = array_get_error addr x -> *)
+(*     arr_length a0 = arr_length x -> *)
+(*     array_get_error addr a = array_get_error addr x0 -> *)
+(*     arr_length a = arr_length x0 -> *)
+(*     array_get_error addr arr = array_get_error addr (combine merge_cell x0 x). *)
+(* Proof. *)
+(*   intros. rewrite AssocMap.gcombine in H by auto. *)
+(*   unfold merge_arr in H. *)
+(*   rewrite H0 in H. rewrite H1 in H. inv H. *)
+(*   destruct (array_get_error addr a0) eqn:?; destruct (array_get_error addr a) eqn:?. *)
+(*   destruct o; destruct o0. *)
+(*   erewrite array_get_error_merge1; eauto. erewrite array_get_error_merge1; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(*   erewrite array_get_error_merge2; eauto. erewrite array_get_error_merge2; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(*   erewrite array_get_error_merge1; eauto. erewrite array_get_error_merge1; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(*   erewrite array_get_error_merge3; eauto. erewrite array_get_error_merge3; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(*   erewrite array_get_error_merge4; eauto. erewrite array_get_error_merge4; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(*   erewrite array_get_error_merge5; eauto. erewrite array_get_error_merge5; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(*   erewrite array_get_error_merge5; eauto. erewrite array_get_error_merge5; eauto. *)
+(*   rewrite <- H6 in H4. rewrite <- H8 in H4. auto. *)
+(* Qed. *)
+
+(* Lemma match_arrs_merge : *)
+(*   forall nasa nasa' basa basa', *)
+(*     match_arrs_size nasa basa -> *)
+(*     match_arrs nasa nasa' -> *)
+(*     match_arrs basa basa' -> *)
+(*     match_arrs (merge_arrs nasa basa) (merge_arrs nasa' basa'). *)
+(* Proof. *)
+(*   unfold merge_arrs. *)
+(*   intros. inv H. inv H0. inv H1. econstructor. *)
+(*   - intros. destruct nasa ! s eqn:?; destruct basa ! s eqn:?; unfold Verilog.arr in *. *)
+(*     + pose proof Heqo. apply H in Heqo. pose proof Heqo0. apply H0 in Heqo0. *)
+(*       repeat inv_exists. simplify. *)
+(*       eexists. simplify. rewrite AssocMap.gcombine; eauto. *)
+(*       unfold merge_arr. unfold Verilog.arr in *. rewrite H11. rewrite H12. auto. *)
+(*       intros. eapply match_arrs_merge'; eauto. eapply H2 in H7; eauto. *)
+(*       inv_exists. simplify. congruence. *)
+(*       rewrite AssocMap.gcombine in H1; auto. unfold merge_arr in H1. *)
+(*       rewrite H7 in H1. rewrite H8 in H1. inv H1. *)
+(*       repeat rewrite combine_length; auto. *)
+(*       eapply H2 in H7; eauto. inv_exists; simplify; congruence. *)
+(*       eapply H2 in H7; eauto. inv_exists; simplify; congruence. *)
+(*     + apply H2 in Heqo; inv_exists; crush. *)
+(*     + apply H3 in Heqo0; inv_exists; crush. *)
+(*     + rewrite AssocMap.gcombine in H1 by auto. unfold merge_arr in *. *)
+(*       rewrite Heqo in H1. rewrite Heqo0 in H1. discriminate. *)
+(*   - intros. rewrite AssocMap.gcombine in H1 by auto. unfold merge_arr in H1. *)
+(*     repeat destruct_match; crush. *)
+(*     rewrite AssocMap.gcombine by auto; unfold merge_arr. *)
+(*     apply H5 in Heqo. apply H6 in Heqo0. *)
+(*     unfold Verilog.arr in *. *)
+(*     rewrite Heqo. rewrite Heqo0. auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_arrs_merge : mgen. *)
+
+(* Lemma match_empty_size_merge : *)
+(*   forall nasa2 basa2 m, *)
+(*   match_empty_size m nasa2 -> *)
+(*   match_empty_size m basa2 -> *)
+(*   match_empty_size m (merge_arrs nasa2 basa2). *)
+(* Proof. *)
+(*   intros. inv H. inv H0. constructor. *)
+(*   simplify. unfold merge_arrs. rewrite AssocMap.gcombine by auto. *)
+(*   pose proof H0 as H6. apply H1 in H6. inv_exists; simplify. *)
+(*   pose proof H0 as H9. apply H in H9. inv_exists; simplify. *)
+(*   eexists. simplify. unfold merge_arr. unfold Verilog.arr in *. rewrite H6. *)
+(*   rewrite H9. auto. rewrite H8. symmetry. apply combine_length. congruence. *)
+(*   intros. *)
+(*   destruct (nasa2 ! s) eqn:?; destruct (basa2 ! s) eqn:?. *)
+(*   unfold merge_arrs in H0. rewrite AssocMap.gcombine in H0 by auto. *)
+(*   unfold merge_arr in *. setoid_rewrite Heqo in H0. setoid_rewrite Heqo0 in H0. inv H0. *)
+(*   apply H2 in Heqo. apply H4 in Heqo0. repeat inv_exists; simplify. *)
+(*   eexists. simplify. eauto. rewrite list_combine_length. *)
+(*   rewrite (arr_wf a). rewrite (arr_wf a0). lia. *)
+(*   unfold merge_arrs in H0. rewrite AssocMap.gcombine in H0 by auto. *)
+(*   unfold merge_arr in *.  setoid_rewrite Heqo in H0. setoid_rewrite Heqo0 in H0. *)
+(*   apply H2 in Heqo. inv_exists; simplify. *)
+(*   econstructor; eauto. *)
+(*   unfold merge_arrs in H0. rewrite AssocMap.gcombine in H0 by auto. *)
+(*   unfold merge_arr in *.  setoid_rewrite Heqo in H0. setoid_rewrite Heqo0 in H0. *)
+(*   inv H0. apply H4 in Heqo0. inv_exists; simplify. econstructor; eauto. *)
+(*   unfold merge_arrs in H0. rewrite AssocMap.gcombine in H0 by auto. *)
+(*   unfold merge_arr in *.  setoid_rewrite Heqo in H0. setoid_rewrite Heqo0 in H0. *)
+(*   discriminate. *)
+(*   split; intros. *)
+(*   unfold merge_arrs in H0. rewrite AssocMap.gcombine in H0 by auto. *)
+(*   unfold merge_arr in *. repeat destruct_match; crush. apply H5 in Heqo0; auto. *)
+(*   pose proof H0. *)
+(*   apply H5 in H0. *)
+(*   apply H3 in H6. unfold merge_arrs. rewrite AssocMap.gcombine by auto. *)
+(*   setoid_rewrite H0. setoid_rewrite H6. auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_empty_size_merge : mgen. *)
+
+(* Lemma match_empty_size_match : *)
+(*   forall m nasa2 basa2, *)
+(*     match_empty_size m nasa2 -> *)
+(*     match_empty_size m basa2 -> *)
+(*     match_arrs_size nasa2 basa2. *)
+(* Proof. *)
+(*   Ltac match_empty_size_match_solve := *)
+(*     match goal with *)
+(*     | H: context[forall s arr, ?ar ! s = Some arr -> _], H2: ?ar ! _ = Some _ |- _ => *)
+(*       let H3 := fresh "H" in *)
+(*       learn H; pose proof H2 as H3; apply H in H3; repeat inv_exists *)
+(*     | H: context[forall s, ?ar ! s = None <-> _], H2: ?ar ! _ = None |- _ => *)
+(*       let H3 := fresh "H" in *)
+(*       learn H; pose proof H2 as H3; apply H in H3 *)
+(*     | H: context[forall s, _ <-> ?ar ! s = None], H2: ?ar ! _ = None |- _ => *)
+(*       let H3 := fresh "H" in *)
+(*       learn H; pose proof H2 as H3; apply H in H3 *)
+(*     | |- exists _, _ => econstructor *)
+(*     | |- _ ! _ = Some _ => eassumption *)
+(*     | |- _ = _ => congruence *)
+(*     | |- _ <-> _ => split *)
+(*     end; simplify. *)
+(*   inversion 1; inversion 1; constructor; simplify; repeat match_empty_size_match_solve. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_empty_size_match : mgen. *)
+
+(* Lemma match_get_merge : *)
+(*   forall p ran ran' rab rab' s v, *)
+(*     s < p -> *)
+(*     match_assocmaps p ran ran' -> *)
+(*     match_assocmaps p rab rab' -> *)
+(*     (merge_regs ran rab) ! s = Some v -> *)
+(*     (merge_regs ran' rab') ! s = Some v. *)
+(* Proof. *)
+(*   intros. *)
+(*   assert (X: match_assocmaps p (merge_regs ran rab) (merge_regs ran' rab')) by auto with mgen. *)
+(*   inv X. rewrite <- H3; auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_get_merge : mgen. *)
+
+(* Ltac masrp_tac := *)
+(*   match goal with *)
+(*   | H: context[forall s arr, ?ar ! s = Some arr -> _], H2: ?ar ! _ = Some _ |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H; pose proof H2 as H3; apply H in H3; repeat inv_exists *)
+(*   | H: context[forall s, ?ar ! s = None <-> _], H2: ?ar ! _ = None |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H; pose proof H2 as H3; apply H in H3 *)
+(*   | H: context[forall s, _ <-> ?ar ! s = None], H2: ?ar ! _ = None |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H; pose proof H2 as H3; apply H in H3 *)
+(*   | ra: arr_associations |- _ => *)
+(*     let ra1 := fresh "ran" in let ra2 := fresh "rab" in destruct ra as [ra1 ra2] *)
+(*   | |- _ ! _ = _ => solve [mgen_crush] *)
+(*   | |- _ = _ => congruence *)
+(*   | |- _ <> _ => lia *)
+(*   | H: ?ar ! ?s = _ |- context[match ?ar ! ?r with _ => _ end] => learn H; destruct (Pos.eq_dec s r); subst *)
+(*   | H: ?ar ! ?s = _ |- context[match ?ar ! ?s with _ => _ end] => setoid_rewrite H *)
+(*   | |- context[match ?ar ! ?s with _ => _ end] => destruct (ar ! s) eqn:? *)
+(*   | H: ?s <> ?r |- context[(_ # ?r <- _) ! ?s] => rewrite AssocMap.gso *)
+(*   | H: ?r <> ?s |- context[(_ # ?r <- _) ! ?s] => rewrite AssocMap.gso *)
+(*   | |- context[(_ # ?s <- _) ! ?s] => rewrite AssocMap.gss *)
+(*   | H: context[match ?ar ! ?r with _ => _ end ! ?s] |- _ => *)
+(*     destruct (ar ! r) eqn:?; destruct (Pos.eq_dec r s); subst *)
+(*   | H: ?ar ! ?s = _, H2: context[match ?ar ! ?s with _ => _ end] |- _ => *)
+(*     setoid_rewrite H in H2 *)
+(*   | H: context[match ?ar ! ?s with _ => _ end] |- _ => destruct (ar ! s) eqn:? *)
+(*   | H: ?s <> ?r, H2: context[(_ # ?r <- _) ! ?s] |- _ => rewrite AssocMap.gso in H2 *)
+(*   | H: ?r <> ?s, H2: context[(_ # ?r <- _) ! ?s] |- _ => rewrite AssocMap.gso in H2 *)
+(*   | H: context[(_ # ?s <- _) ! ?s] |- _ => rewrite AssocMap.gss in H *)
+(*   | |- context[match_empty_size] => constructor *)
+(*   | |- context[arr_assocmap_set] => unfold arr_assocmap_set *)
+(*   | H: context[arr_assocmap_set] |- _ => unfold arr_assocmap_set in H *)
+(*   | |- exists _, _ => econstructor *)
+(*   | |- _ <-> _ => split *)
+(*   end; simplify. *)
+
+(* Lemma match_empty_assocmap_set : *)
+(*   forall m r i rhsval asa, *)
+(*     match_empty_size m asa -> *)
+(*     match_empty_size m (arr_assocmap_set r i rhsval asa). *)
+(* Proof. *)
+(*   inversion 1; subst; simplify. *)
+(*   constructor. intros. *)
+(*   repeat masrp_tac. *)
+(*   intros. do 5 masrp_tac; try solve [repeat masrp_tac]. *)
+(*   apply H1 in H3. inv_exists. simplify. *)
+(*   econstructor. simplify. apply H3. congruence. *)
+(*   repeat masrp_tac. destruct (Pos.eq_dec r s); subst. *)
+(*   rewrite AssocMap.gss in H8. discriminate. *)
+(*   rewrite AssocMap.gso in H8; auto. apply H2 in H8. auto. *)
+(*   destruct (Pos.eq_dec r s); subst. apply H1 in H5. inv_exists. simplify. *)
+(*   rewrite H5 in H8. discriminate. *)
+(*   rewrite AssocMap.gso; auto. *)
+(*   apply H2 in H5. auto. apply H2 in H5. auto. *)
+(*   Unshelve. auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_empty_assocmap_set : mgen. *)
+
+(* Lemma match_arrs_size_stmnt_preserved : *)
+(*   forall m f rs1 ar1 ar2 c rs2, *)
+(*     stmnt_runp f rs1 ar1 c rs2 ar2 -> *)
+(*     match_empty_size m (assoc_nonblocking ar1) -> *)
+(*     match_empty_size m (assoc_blocking ar1) -> *)
+(*     match_empty_size m (assoc_nonblocking ar2) /\ match_empty_size m (assoc_blocking ar2). *)
+(* Proof. *)
+(*   induction 1; inversion 1; inversion 1; eauto; simplify; try solve [repeat masrp_tac]. *)
+(*   subst. apply IHstmnt_runp2; apply IHstmnt_runp1; auto. *)
+(*   apply IHstmnt_runp2; apply IHstmnt_runp1; auto. *)
+(*   apply match_empty_assocmap_set. auto. *)
+(*   apply match_empty_assocmap_set. auto. *)
+(* Qed. *)
+
+(* Lemma match_arrs_size_stmnt_preserved2 : *)
+(*   forall m f rs1 na ba na' ba' c rs2, *)
+(*     stmnt_runp f rs1 {| assoc_nonblocking := na; assoc_blocking := ba |} c rs2 *)
+(*                {| assoc_nonblocking := na'; assoc_blocking := ba' |} -> *)
+(*     match_empty_size m na -> *)
+(*     match_empty_size m ba -> *)
+(*     match_empty_size m na' /\ match_empty_size m ba'. *)
+(* Proof. *)
+(*   intros. *)
+(*   remember ({| assoc_blocking := ba; assoc_nonblocking := na |}) as ar1. *)
+(*   remember ({| assoc_blocking := ba'; assoc_nonblocking := na' |}) as ar2. *)
+(*   assert (X1: na' = (assoc_nonblocking ar2)) by (rewrite Heqar2; auto). rewrite X1. *)
+(*   assert (X2: ba' = (assoc_blocking ar2)) by (rewrite Heqar2; auto). rewrite X2. *)
+(*   assert (X3: na = (assoc_nonblocking ar1)) by (rewrite Heqar1; auto). rewrite X3 in *. *)
+(*   assert (X4: ba = (assoc_blocking ar1)) by (rewrite Heqar1; auto). rewrite X4 in *. *)
+(*   eapply match_arrs_size_stmnt_preserved; mgen_crush. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_arrs_size_stmnt_preserved2 : mgen. *)
+
+(* Lemma match_arrs_size_ram_preserved : *)
+(*   forall m rs1 ar1 ar2 ram rs2, *)
+(*     exec_ram rs1 ar1 ram rs2 ar2 -> *)
+(*     match_empty_size m (assoc_nonblocking ar1) -> *)
+(*     match_empty_size m (assoc_blocking ar1) -> *)
+(*     match_empty_size m (assoc_nonblocking ar2) *)
+(*     /\ match_empty_size m (assoc_blocking ar2). *)
+(* Proof. *)
+(*   induction 1; inversion 1; inversion 1; subst; simplify; try solve [repeat masrp_tac]. *)
+(*   masrp_tac. masrp_tac. solve [repeat masrp_tac]. *)
+(*   masrp_tac. masrp_tac. masrp_tac. masrp_tac. masrp_tac. masrp_tac. masrp_tac. *)
+(*   masrp_tac. masrp_tac. masrp_tac. masrp_tac. masrp_tac. masrp_tac. masrp_tac. *)
+(*   masrp_tac. apply H8 in H1; inv_exists; simplify. repeat masrp_tac. auto. *)
+(*   repeat masrp_tac. *)
+(*   repeat masrp_tac. *)
+(*   repeat masrp_tac. *)
+(*   destruct (Pos.eq_dec (ram_mem r) s); subst; repeat masrp_tac. *)
+(*   destruct (Pos.eq_dec (ram_mem r) s); subst; repeat masrp_tac. *)
+(*   apply H9 in H17; auto. apply H9 in H17; auto. *)
+(*   Unshelve. eauto. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_arrs_size_ram_preserved : mgen. *)
+
+(* Lemma match_arrs_size_ram_preserved2 : *)
+(*   forall m rs1 na na' ba ba' ram rs2, *)
+(*     exec_ram rs1 {| assoc_nonblocking := na; assoc_blocking := ba |} ram rs2 *)
+(*     {| assoc_nonblocking := na'; assoc_blocking := ba' |} -> *)
+(*     match_empty_size m na -> match_empty_size m ba -> *)
+(*     match_empty_size m na' /\ match_empty_size m ba'. *)
+(* Proof. *)
+(*   intros. *)
+(*   remember ({| assoc_blocking := ba; assoc_nonblocking := na |}) as ar1. *)
+(*   remember ({| assoc_blocking := ba'; assoc_nonblocking := na' |}) as ar2. *)
+(*   assert (X1: na' = (assoc_nonblocking ar2)) by (rewrite Heqar2; auto). rewrite X1. *)
+(*   assert (X2: ba' = (assoc_blocking ar2)) by (rewrite Heqar2; auto). rewrite X2. *)
+(*   assert (X3: na = (assoc_nonblocking ar1)) by (rewrite Heqar1; auto). rewrite X3 in *. *)
+(*   assert (X4: ba = (assoc_blocking ar1)) by (rewrite Heqar1; auto). rewrite X4 in *. *)
+(*   eapply match_arrs_size_ram_preserved; mgen_crush. *)
+(* Qed. *)
+(* #[local] Hint Resolve match_arrs_size_ram_preserved2 : mgen. *)
+
+(* Lemma empty_stack_m : *)
+(*   forall m, empty_stack m = empty_stack' (mod_stk_len m) (mod_stk m). *)
+(* Proof. unfold empty_stack, empty_stack'; mgen_crush. Qed. *)
+(* #[local] Hint Rewrite empty_stack_m : mgen. *)
+
+(* Ltac clear_forall := *)
+(*   repeat match goal with *)
+(*   | H: context[forall _, _] |- _ => clear H *)
+(*   end. *)
+
+(* Lemma list_combine_none : *)
+(*   forall n l, *)
+(*     length l = n -> *)
+(*     list_combine Verilog.merge_cell (list_repeat None n) l = l. *)
+(* Proof. *)
+(*   induction n; intros; crush. *)
+(*   - symmetry. apply length_zero_iff_nil. auto. *)
+(*   - destruct l; crush. *)
+(*     rewrite list_repeat_cons. *)
+(*     crush. f_equal. *)
+(*     eauto. *)
+(* Qed. *)
+
+(* Lemma combine_none : *)
+(*   forall n a, *)
+(*     a.(arr_length) = n -> *)
+(*     arr_contents (combine Verilog.merge_cell (arr_repeat None n) a) = arr_contents a. *)
+(* Proof. *)
+(*   intros. *)
+(*   unfold combine. *)
+(*   crush. *)
+
+(*   rewrite <- (arr_wf a) in H. *)
+(*   apply list_combine_none. *)
+(*   assumption. *)
+(* Qed. *)
+
+(* Lemma combine_none2 : *)
+(*   forall n a addr, *)
+(*     arr_length a = n -> *)
+(*     array_get_error addr (combine Verilog.merge_cell (arr_repeat None n) a) *)
+(*     = array_get_error addr a. *)
+(* Proof. intros; auto using array_get_error_equal, combine_none. Qed. *)
+
+(* Lemma list_combine_lookup_first : *)
+(*   forall l1 l2 n, *)
+(*     length l1 = length l2 -> *)
+(*     nth_error l1 n = Some None -> *)
+(*     nth_error (list_combine Verilog.merge_cell l1 l2) n = nth_error l2 n. *)
+(* Proof. *)
+(*   induction l1; intros; crush. *)
+
+(*   rewrite nth_error_nil in H0. *)
+(*   discriminate. *)
+
+(*   destruct l2 eqn:EQl2. crush. *)
+(*   simpl in H. inv H. *)
+(*   destruct n; simpl in *. *)
+(*   inv H0. simpl. reflexivity. *)
+(*   eauto. *)
+(* Qed. *)
+
+(* Lemma combine_lookup_first : *)
+(*   forall a1 a2 n, *)
+(*     a1.(arr_length) = a2.(arr_length) -> *)
+(*     array_get_error n a1 = Some None -> *)
+(*     array_get_error n (combine Verilog.merge_cell a1 a2) = array_get_error n a2. *)
+(* Proof. *)
+(*   intros. *)
+
+(*   unfold array_get_error in *. *)
+(*   apply list_combine_lookup_first; eauto. *)
+(*   rewrite a1.(arr_wf). rewrite a2.(arr_wf). *)
+(*   assumption. *)
+(* Qed. *)
+
+(* Lemma list_combine_lookup_second : *)
+(*   forall l1 l2 n x, *)
+(*     length l1 = length l2 -> *)
+(*     nth_error l1 n = Some (Some x) -> *)
+(*     nth_error (list_combine Verilog.merge_cell l1 l2) n = Some (Some x). *)
+(* Proof. *)
+(*   induction l1; intros; crush; auto. *)
+
+(*   destruct l2 eqn:EQl2. crush. *)
+(*   simpl in H. inv H. *)
+(*   destruct n; simpl in *. *)
+(*   inv H0. simpl. reflexivity. *)
+(*   eauto. *)
+(* Qed. *)
+
+(* Lemma combine_lookup_second : *)
+(*   forall a1 a2 n x, *)
+(*     a1.(arr_length) = a2.(arr_length) -> *)
+(*     array_get_error n a1 = Some (Some x) -> *)
+(*     array_get_error n (combine Verilog.merge_cell a1 a2) = Some (Some x). *)
+(* Proof. *)
+(*   intros. *)
+
+(*   unfold array_get_error in *. *)
+(*   apply list_combine_lookup_second; eauto. *)
+(*   rewrite a1.(arr_wf). rewrite a2.(arr_wf). *)
+(*   assumption. *)
+(* Qed. *)
+
+(* Lemma match_get_arrs2 : *)
+(*   forall a i v l, *)
+(*     length a = l -> *)
+(*     list_combine merge_cell (list_set i (Some v) (list_repeat None l)) a = *)
+(*     list_combine merge_cell (list_repeat None l) (list_set i (Some v) a). *)
+(* Proof. *)
+(*   induction a; crush; subst. *)
+(*   - destruct i. unfold list_repeat. unfold list_repeat'. auto. *)
+(*     unfold list_repeat. unfold list_repeat'. auto. *)
+(*   - destruct i. *)
+(*     rewrite list_repeat_cons. simplify. auto. *)
+(*     rewrite list_repeat_cons. simplify. f_equal. apply IHa. auto. *)
+(* Qed. *)
+
+(* Lemma match_get_arrs : *)
+(*   forall addr i v x4 x x3, *)
+(*     x4 = arr_length x -> *)
+(*     x4 = arr_length x3 -> *)
+(*     array_get_error addr (combine merge_cell (array_set i (Some v) (arr_repeat None x4)) *)
+(*                                   (combine merge_cell x x3)) *)
+(*     = array_get_error addr (combine merge_cell (arr_repeat None x4) *)
+(*                                     (array_set i (Some v) (combine merge_cell x x3))). *)
+(* Proof. *)
+(*   intros. apply array_get_error_equal. unfold combine. simplify. *)
+(*   destruct x; destruct x3; simplify. *)
+(*   apply match_get_arrs2. rewrite list_combine_length. subst. *)
+(*   rewrite H0. lia. *)
+(* Qed. *)
+
+(* Lemma combine_array_set' : *)
+(*   forall a b i v, *)
+(*     length a = length b -> *)
+(*     list_combine merge_cell (list_set i (Some v) a) b = *)
+(*     list_set i (Some v) (list_combine merge_cell a b). *)
+(* Proof. *)
+(*   induction a; simplify; crush. *)
+(*   - destruct i; crush. *)
+(*   - destruct i; destruct b; crush. *)
+(*     f_equal. apply IHa. auto. *)
+(* Qed. *)
+
+(* Lemma combine_array_set : *)
+(*   forall a b i v addr, *)
+(*     arr_length a = arr_length b -> *)
+(*     array_get_error addr (combine merge_cell (array_set i (Some v) a) b) *)
+(*     = array_get_error addr (array_set i (Some v) (combine merge_cell a b)). *)
+(* Proof. *)
+(*   intros. destruct a; destruct b. unfold array_set. simplify. *)
+(*   unfold array_get_error. simplify. f_equal. *)
+(*   apply combine_array_set'. crush. *)
+(* Qed. *)
+
+(* Lemma array_get_combine' : *)
+(*   forall a b a' b' addr, *)
+(*     length a = length b -> *)
+(*     length a = length b' -> *)
+(*     length a = length a' -> *)
+(*     nth_error a addr = nth_error a' addr -> *)
+(*     nth_error b addr = nth_error b' addr -> *)
+(*     nth_error (list_combine merge_cell a b) addr = *)
+(*     nth_error (list_combine merge_cell a' b') addr. *)
+(* Proof. *)
+(*   induction a; crush. *)
+(*   - destruct b; crush; destruct b'; crush; destruct a'; crush. *)
+(*   - destruct b; crush; destruct b'; crush; destruct a'; crush; *)
+(*     destruct addr; crush; apply IHa. *)
+(* Qed. *)
+
+(* Lemma array_get_combine : *)
+(*   forall a b a' b' addr, *)
+(*     arr_length a = arr_length b -> *)
+(*     arr_length a = arr_length b' -> *)
+(*     arr_length a = arr_length a' -> *)
+(*     array_get_error addr a = array_get_error addr a' -> *)
+(*     array_get_error addr b = array_get_error addr b' -> *)
+(*     array_get_error addr (combine merge_cell a b) *)
+(*     = array_get_error addr (combine merge_cell a' b'). *)
+(* Proof. *)
+(*   intros; unfold array_get_error, combine in *; destruct a; destruct b; *)
+(*   destruct a'; destruct b'; simplify; apply array_get_combine'; crush. *)
+(* Qed. *)
+
+(* Lemma match_empty_size_exists_Some : *)
+(*   forall m rab s v, *)
+(*     match_empty_size m rab -> *)
+(*     rab ! s = Some v -> *)
+(*     exists v', (empty_stack m) ! s = Some v' /\ arr_length v = arr_length v'. *)
+(* Proof. inversion 1; intros; repeat masrp_tac. Qed. *)
+
+(* Lemma match_empty_size_exists_None : *)
+(*   forall m rab s, *)
+(*     match_empty_size m rab -> *)
+(*     rab ! s = None -> *)
+(*     (empty_stack m) ! s = None. *)
+(* Proof. inversion 1; intros; repeat masrp_tac. Qed. *)
+
+(* Lemma match_empty_size_exists_None' : *)
+(*   forall m rab s, *)
+(*     match_empty_size m rab -> *)
+(*     (empty_stack m) ! s = None -> *)
+(*     rab ! s = None. *)
+(* Proof. inversion 1; intros; repeat masrp_tac. Qed. *)
+
+(* Lemma match_empty_size_exists_Some' : *)
+(*   forall m rab s v, *)
+(*     match_empty_size m rab -> *)
+(*     (empty_stack m) ! s = Some v -> *)
+(*     exists v', rab ! s = Some v' /\ arr_length v = arr_length v'. *)
+(* Proof. inversion 1; intros; repeat masrp_tac. Qed. *)
+
+(* Lemma match_arrs_Some : *)
+(*   forall ra ra' s v, *)
+(*     match_arrs ra ra' -> *)
+(*     ra ! s = Some v -> *)
+(*     exists v', ra' ! s = Some v' *)
+(*                /\ (forall addr, array_get_error addr v = array_get_error addr v') *)
+(*                /\ arr_length v = arr_length v'. *)
+(* Proof. inversion 1; intros; repeat masrp_tac. intros. rewrite H5. auto. Qed. *)
+
+(* Lemma match_arrs_None : *)
+(*   forall ra ra' s, *)
+(*     match_arrs ra ra' -> *)
+(*     ra ! s = None -> *)
+(*     ra' ! s = None. *)
+(* Proof. inversion 1; intros; repeat masrp_tac. Qed. *)
+
+(* Ltac learn_next := *)
+(*   match goal with *)
+(*   | H: match_empty_size _ ?rab, H2: ?rab ! _ = Some _ |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H2 as H3; eapply match_empty_size_exists_Some in H3; *)
+(*     eauto; inv_exists; simplify *)
+(*   | H: match_empty_size _ ?rab, H2: ?rab ! _ = None |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H2 as H3; eapply match_empty_size_exists_None in H3; eauto *)
+(*   end. *)
+
+(* Ltac learn_empty := *)
+(*   match goal with *)
+(*   | H: match_empty_size _ _, H2: (empty_stack _) ! _ = Some _ |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H as H3; eapply match_empty_size_exists_Some' in H3; *)
+(*     [| eassumption]; inv_exists; simplify *)
+(*   | H: match_arrs ?ar _, H2: ?ar ! _ = Some _ |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H as H3; eapply match_arrs_Some in H3; *)
+(*     [| eassumption]; inv_exists; simplify *)
+(*   | H: match_empty_size _ _, H2: (empty_stack _) ! _ = None |- _ => *)
+(*     let H3 := fresh "H" in *)
+(*     learn H as H3; eapply match_empty_size_exists_None' in H3; *)
+(*     [| eassumption]; simplify *)
+(*   end. *)
+
+(* Lemma empty_set_none : *)
+(*   forall m ran rab s i v s0, *)
+(*     match_empty_size m ran -> *)
+(*     match_empty_size m rab -> *)
+(*     (arr_assocmap_set s i v ran) ! s0 = None -> *)
+(*     (arr_assocmap_set s i v rab) ! s0 = None. *)
+(* Proof. *)
+(*   unfold arr_assocmap_set; inversion 1; subst; simplify. *)
+(*   destruct (Pos.eq_dec s s0); subst. *)
+(*   destruct ran ! s0 eqn:?. *)
+(*   rewrite AssocMap.gss in H4. inv H4. *)
+(*   learn_next. learn_empty. rewrite H6; auto. *)
+(*   destruct ran ! s eqn:?. rewrite AssocMap.gso in H4. *)
+(*   learn_next. learn_empty. rewrite H6. rewrite AssocMap.gso. *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. clear Heqo. clear H5. clear H6. *)
+(*   learn_next. repeat learn_empty. auto. auto. auto. *)
+(*   pose proof Heqo. learn_next; repeat learn_empty. *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. *)
+(*   pose proof H4. learn_next; repeat learn_empty. *)
+(*   rewrite H7. auto. *)
+(* Qed. *)
+
+(* Ltac clear_learnt := *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. *)
+
+(* Lemma match_arrs_size_assoc : *)
+(*   forall a b, *)
+(*     match_arrs_size a b -> *)
+(*     match_arrs_size b a. *)
+(* Proof. inversion 1; constructor; crush; split; apply H2. Qed. *)
+(* #[local] Hint Resolve match_arrs_size_assoc : mgen. *)
+
+(* Lemma match_arrs_merge_set2 : *)
+(*   forall rab rab' ran ran' s m i v, *)
+(*     match_empty_size m rab -> *)
+(*     match_empty_size m ran -> *)
+(*     match_empty_size m rab' -> *)
+(*     match_empty_size m ran' -> *)
+(*     match_arrs rab rab' -> *)
+(*     match_arrs ran ran' -> *)
+(*     match_arrs (merge_arrs (arr_assocmap_set s i v ran) rab) *)
+(*                (merge_arrs (arr_assocmap_set s i v (empty_stack m)) *)
+(*                            (merge_arrs ran' rab')). *)
+(* Proof. *)
+(*   simplify. *)
+(*   constructor; intros. *)
+(*   unfold arr_assocmap_set in *. destruct (Pos.eq_dec s s0); subst. *)
+(*   destruct ran ! s0 eqn:?. unfold merge_arrs in *. rewrite AssocMap.gcombine in *; auto. *)
+(*   learn_next. repeat learn_empty. *)
+(*   econstructor. simplify. rewrite H6. rewrite AssocMap.gcombine by auto. *)
+(*   rewrite AssocMap.gss. simplify. setoid_rewrite H9. setoid_rewrite H7. simplify. *)
+(*   intros. rewrite AssocMap.gss in H5. setoid_rewrite H13 in H5. *)
+(*   simplify. pose proof (empty_arr m s0). inv H5. inv_exists. setoid_rewrite H5 in H6. inv H6. *)
+(*   unfold arr_repeat in H8. simplify. rewrite list_repeat_len in H8. rewrite list_repeat_len in H10. *)
+(*   rewrite match_get_arrs. crush. rewrite combine_none2. rewrite combine_array_set; try congruence. *)
+(*   apply array_get_error_each. rewrite combine_length; try congruence. *)
+(*   rewrite combine_length; try congruence. *)
+(*   apply array_get_combine; crush. *)
+(*   rewrite <- array_set_len. rewrite combine_length; crush. crush. crush. *)
+(*   setoid_rewrite H21 in H6; discriminate. rewrite combine_length. *)
+(*   rewrite <- array_set_len; crush. *)
+(*   unfold merge_arr in *. rewrite AssocMap.gss in H5. setoid_rewrite H13 in H5. *)
+(*   inv H5. rewrite combine_length. rewrite <- array_set_len; crush. *)
+(*   rewrite <- array_set_len; crush. *)
+(*   rewrite combine_length; crush. *)
+(*   destruct rab ! s0 eqn:?. learn_next. repeat learn_empty. *)
+(*   rewrite H11 in Heqo. discriminate. *)
+(*   unfold merge_arrs in H5. rewrite AssocMap.gcombine in H5; auto. rewrite Heqo in H5. *)
+(*   rewrite Heqo0 in H5. crush. *)
+
+(*   destruct ran ! s eqn:?. *)
+(*   learn_next. repeat learn_empty. rewrite H6. *)
+(*   unfold merge_arrs in *. rewrite AssocMap.gcombine in H5; auto. *)
+(*   rewrite AssocMap.gcombine; auto. rewrite AssocMap.gso in H5; auto. *)
+(*   rewrite AssocMap.gso; auto. *)
+(*   destruct ran ! s0 eqn:?. *)
+(*   learn_next. *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. *)
+(*   repeat learn_empty. *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. *)
+(*   rewrite AssocMap.gcombine; auto. setoid_rewrite Heqo0 in H5. setoid_rewrite H29 in H5. *)
+(*   simplify. *)
+(*   pose proof (empty_arr m s0). inv H5. inv_exists. rewrite H5 in H21. inv H21. *)
+(*   econstructor. simplify. setoid_rewrite H23. rewrite H25. setoid_rewrite H5. *)
+(*   simplify. intros. rewrite combine_none2. apply array_get_combine; solve [crush]. *)
+(*   crush. rewrite list_combine_length. rewrite (arr_wf x5). rewrite (arr_wf x6). *)
+(*   rewrite <- H26. rewrite <- H28. rewrite list_repeat_len. lia. rewrite list_combine_length. *)
+(*   rewrite (arr_wf a). rewrite (arr_wf x7). rewrite combine_length. rewrite arr_repeat_length. *)
+(*   rewrite H24. rewrite <- H32. rewrite list_repeat_len. lia. *)
+(*   rewrite arr_repeat_length. rewrite combine_length. rewrite <- H26. symmetry. apply list_repeat_len. *)
+(*   congruence. *)
+(*   rewrite H37 in H21; discriminate. *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. eapply match_empty_size_exists_None in H0; eauto. *)
+(*   clear H6. repeat learn_empty. setoid_rewrite Heqo0 in H5. *)
+(*   setoid_rewrite H29 in H5. discriminate. *)
+(*   pose proof (match_arrs_merge ran ran' rab rab'). *)
+(*   eapply match_empty_size_match in H; [|apply H0]. *)
+(*   apply H6 in H; auto. inv H. apply H7 in H5. inv_exists. simplify. *)
+(*   learn_next. rewrite H9. econstructor. simplify. *)
+(*   apply merge_arr_empty''; mgen_crush. *)
+(*   auto. auto. *)
+(*   unfold merge_arrs in *. rewrite AssocMap.gcombine in H5; auto. rewrite AssocMap.gcombine; auto. *)
+(*   destruct (arr_assocmap_set s i v ran) ! s0 eqn:?; destruct rab ! s0 eqn:?; crush. *)
+(*   learn_next. repeat learn_empty. *)
+(*   repeat match goal with *)
+(*   | H: Learnt _ |- _ => clear H *)
+(*   end. *)
+(*   erewrite empty_set_none. rewrite AssocMap.gcombine; auto. *)
+(*   simplify. rewrite H7. rewrite H8. auto. apply H0. mgen_crush. auto. *)
+(* Qed. *)
+
+(* Definition all_match_empty_size m ar := *)
+(*   match_empty_size m (assoc_nonblocking ar) /\ match_empty_size m (assoc_blocking ar). *)
+(* #[local] Hint Unfold all_match_empty_size : mgen. *)
+
+(* Definition match_module_to_ram m ram := *)
+(*   ram_size ram = mod_stk_len m /\ ram_mem ram = mod_stk m. *)
+(* #[local] Hint Unfold match_module_to_ram : mgen. *)
+
+(* Lemma zip_range_forall_le : *)
+(*   forall A (l: list A) n, Forall (Pos.le n) (map snd (zip_range n l)). *)
+(* Proof. *)
+(*   induction l; crush; constructor; [lia|]. *)
+(*   assert (forall n x, n+1 <= x -> n <= x) by lia. *)
+(*   apply Forall_forall. intros. apply H. generalize dependent x. *)
+(*   apply Forall_forall. apply IHl. *)
+(* Qed. *)
+
+(* Lemma transf_code_fold_correct: *)
+(*   forall l m state ram d' c' n, *)
+(*     fold_right (transf_maps state ram) (mod_datapath m, mod_controllogic m) l = (d', c') -> *)
+(*     Forall (fun x => x < n) (map fst l) -> *)
+(*     Forall (Pos.le n) (map snd l) -> *)
+(*     list_norepet (map fst l) -> *)
+(*     list_norepet (map snd l) -> *)
+(*     (forall p i c_s rs1 ar1 rs2 ar2 trs1 tar1 d_s, *)
+(*         i < n -> *)
+(*         all_match_empty_size m ar1 -> *)
+(*         all_match_empty_size m tar1 -> *)
+(*         match_module_to_ram m ram -> *)
+(*         (mod_datapath m)!i = Some d_s -> *)
+(*         (mod_controllogic m)!i = Some c_s -> *)
+(*         match_reg_assocs p rs1 trs1 -> *)
+(*         match_arr_assocs ar1 tar1 -> *)
+(*         max_reg_module m < p -> *)
+(*         exec_all d_s c_s rs1 ar1 rs2 ar2 -> *)
+(*         exists d_s' c_s' trs2 tar2, *)
+(*           d'!i = Some d_s' /\ c'!i = Some c_s' *)
+(*           /\ exec_all_ram ram d_s' c_s' trs1 tar1 trs2 tar2 *)
+(*           /\ match_reg_assocs p (merge_reg_assocs rs2) (merge_reg_assocs trs2) *)
+(*           /\ match_arr_assocs (merge_arr_assocs (ram_mem ram) (ram_size ram) ar2) *)
+(*                               (merge_arr_assocs (ram_mem ram) (ram_size ram) tar2)). *)
+(* Proof. *)
+(*   induction l as [| a l IHl]; simplify. *)
+(*   - match goal with *)
+(*     | H: (_, _) = (_, _) |- _ => inv H *)
+(*     end; *)
+(*     unfold exec_all in *; repeat inv_exists; simplify. *)
+(*     exploit match_states_same; *)
+(*     try match goal with *)
+(*     | H: stmnt_runp _ _ _ ?c _ _, H2: (mod_controllogic _) ! _ = Some ?c |- _ => apply H *)
+(*     end; eauto; mgen_crush; *)
+(*     try match goal with *)
+(*     | H: (mod_controllogic _) ! _ = Some ?c |- _ => *)
+(*       apply max_reg_stmnt_le_stmnt_tree in H; unfold max_reg_module in *; lia *)
+(*     end; intros; *)
+(*     exploit match_states_same; *)
+(*     try match goal with *)
+(*     | H: stmnt_runp _ _ _ ?c _ _, H2: (mod_datapath _) ! _ = Some ?c |- _ => apply H *)
+(*     end; eauto; mgen_crush; *)
+(*     try match goal with *)
+(*     | H: (mod_datapath _) ! _ = Some ?c |- _ => *)
+(*       apply max_reg_stmnt_le_stmnt_tree in H; unfold max_reg_module in *; lia *)
+(*     end; intros; *)
+(*     repeat match goal with *)
+(*     | |- exists _, _ => eexists *)
+(*     end; simplify; eauto; *)
+(*     unfold exec_all_ram; *)
+(*     repeat match goal with *)
+(*     | |- exists _, _ => eexists *)
+(*     end; simplify; eauto. *)
+(*     constructor. admit. *)
+(*   Abort. *)
+
+(* Lemma empty_stack_transf : forall m, empty_stack (transf_module m) = empty_stack m. *)
+(* Proof. unfold empty_stack, transf_module; intros; repeat destruct_match; crush. Qed. *)
+
+(* Definition alt_unchanged (d : AssocMap.t stmnt) (c: AssocMap.t stmnt) d' c' i := *)
+(*   d ! i = d' ! i /\ c ! i = c' ! i. *)
+
+(* Definition alt_store ram d (c : AssocMap.t stmnt) d' c' i := *)
+(*   exists e1 e2, *)
+(*     d' ! i = Some (Vseq (Vnonblock (Vvar (ram_u_en ram)) (Vunop Vnot (Vvar (ram_u_en ram)))) *)
+(*                         (Vseq (Vnonblock (Vvar (ram_wr_en ram)) (Vlit (ZToValue 1))) *)
+(*                               (Vseq (Vnonblock (Vvar (ram_d_in ram)) e2) *)
+(*                                     (Vnonblock (Vvar (ram_addr ram)) e1)))) *)
+(*     /\ c' ! i = c ! i *)
+(*     /\ d ! i = Some (Vnonblock (Vvari (ram_mem ram) e1) e2). *)
+
+(* Definition alt_load state ram d (c : AssocMap.t stmnt) d' c' i n := *)
+(*   exists ns e1 e2, *)
+(*     d' ! i = Some (Vseq (Vnonblock (Vvar (ram_u_en ram)) (Vunop Vnot (Vvar (ram_u_en ram)))) *)
+(*                         (Vseq (Vnonblock (Vvar (ram_wr_en ram)) (Vlit (ZToValue 0))) *)
+(*                               (Vnonblock (Vvar (ram_addr ram)) e2))) *)
+(*     /\ d' ! n = Some (Vnonblock (Vvar e1) (Vvar (ram_d_out ram))) *)
+(*     /\ c' ! i = Some (Vnonblock (Vvar state) (Vlit (posToValue n))) *)
+(*     /\ c' ! n = Some (Vnonblock (Vvar state) ns) *)
+(*     /\ c ! i = Some (Vnonblock (Vvar state) ns) *)
+(*     /\ d ! i = Some (Vnonblock (Vvar e1) (Vvari (ram_mem ram) e2)) *)
+(*     /\ e1 < state *)
+(*     /\ max_reg_expr e2 < state *)
+(*     /\ max_reg_expr ns < state *)
+(*     /\ (Z.pos n <= Int.max_unsigned)%Z. *)
+
+(* Definition alternatives state ram d c d' c' i n := *)
+(*   alt_unchanged d c d' c' i *)
+(*   \/ alt_store ram d c d' c' i *)
+(*   \/ alt_load state ram d c d' c' i n. *)
+
+(* Lemma transf_alternatives : *)
+(*   forall ram n d c state i d' c', *)
+(*     transf_maps state ram (i, n) (d, c) = (d', c') -> *)
+(*     i <> n -> *)
+(*     alternatives state ram d c d' c' i n. *)
+(* Proof. *)
+(*   intros. unfold transf_maps in *. *)
+(*   repeat destruct_match; match goal with *)
+(*                          | H: (_, _) = (_, _) |- _ => inv H *)
+(*                          end; try solve [left; econstructor; crush]; simplify; *)
+(*   repeat match goal with *)
+(*   | H: (_ =? _) = true |- _ => apply Peqb_true_eq in H; subst *)
+(*   end; unfold alternatives; right; *)
+(*   match goal with *)
+(*   | H: context[Vnonblock (Vvari _ _) _] |- _ => left *)
+(*   | _ => right *)
+(*   end; repeat econstructor; simplify; *)
+(*   repeat match goal with *)
+(*          | |- ( _ # ?s <- _ ) ! ?s = Some _ => apply AssocMap.gss *)
+(*          | |- ( _ # ?s <- _ ) ! ?r = Some _ => rewrite AssocMap.gso by lia *)
+(*          | |- _ = None => apply max_index_2; lia *)
+(*          | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *)
+(*          end; auto. *)
+(* Qed. *)
+
+(* Lemma transf_alternatives_neq : *)
+(*   forall state ram a n' n d'' c'' d' c' i d c, *)
+(*     transf_maps state ram (a, n) (d, c) = (d', c') -> *)
+(*     a <> i -> n' <> n -> i <> n' -> a <> n' -> *)
+(*     i <> n -> a <> n -> *)
+(*     alternatives state ram d'' c'' d c i n' -> *)
+(*     alternatives state ram d'' c'' d' c' i n'. *)
+(* Proof. *)
+(*   unfold alternatives, alt_unchanged, alt_store, alt_load, transf_maps; intros; *)
+(*   repeat match goal with H: _ \/ _ |- _ => inv H | H: _ /\ _ |- _ => destruct H end; *)
+(*   [left | right; left | right; right]; *)
+(*   repeat inv_exists; simplify; *)
+(*   repeat destruct_match; *)
+(*   repeat match goal with *)
+(*          | H: (_, _) = (_, _) |- _ => inv H *)
+(*          | |- exists _, _ => econstructor *)
+(*          end; repeat split; repeat rewrite AssocMap.gso by lia; eauto; lia. *)
+(* Qed. *)
+
+(* Lemma transf_alternatives_neq2 : *)
+(*   forall state ram a n' n d'' c'' d' c' i d c, *)
+(*     transf_maps state ram (a, n) (d', c') = (d, c) -> *)
+(*     a <> i -> n' <> n -> i <> n' -> a <> n' -> i <> n -> *)
+(*     alternatives state ram d c d'' c'' i n' -> *)
+(*     alternatives state ram d' c' d'' c'' i n'. *)
+(* Proof. *)
+(*   unfold alternatives, alt_unchanged, alt_store, alt_load, transf_maps; intros; *)
+(*   repeat match goal with H: _ \/ _ |- _ => inv H | H: _ /\ _ |- _ => destruct H end; *)
+(*   [left | right; left | right; right]; *)
+(*   repeat inv_exists; simplify; *)
+(*   repeat destruct_match; *)
+(*   repeat match goal with *)
+(*          | H: (_, _) = (_, _) |- _ => inv H *)
+(*          | |- exists _, _ => econstructor *)
+(*          end; repeat split; repeat rewrite AssocMap.gso in * by lia; eauto; lia. *)
+(* Qed. *)
+
+(* Lemma transf_alt_unchanged_neq : *)
+(*   forall i c'' d'' d c d' c', *)
+(*     alt_unchanged d' c' d'' c'' i -> *)
+(*     d' ! i = d ! i -> *)
+(*     c' ! i = c ! i -> *)
+(*     alt_unchanged d c d'' c'' i. *)
+(* Proof. unfold alt_unchanged; simplify; congruence. Qed. *)
+
+(* Lemma transf_maps_neq : *)
+(*   forall state ram d c i n d' c' i' n' va vb vc vd, *)
+(*     transf_maps state ram (i, n) (d, c) = (d', c') -> *)
+(*     d ! i' = va -> d ! n' = vb -> *)
+(*     c ! i' = vc -> c ! n' = vd -> *)
+(*     i <> i' -> i <> n' -> n <> i' -> n <> n' -> *)
+(*     d' ! i' = va /\ d' ! n' = vb /\ c' ! i' = vc /\ c' ! n' = vd. *)
+(* Proof. *)
+(*   unfold transf_maps; intros; repeat destruct_match; simplify; *)
+(*   repeat match goal with *)
+(*          | H: (_, _) = (_, _) |- _ => inv H *)
+(*          | H: (_ =? _) = true |- _ => apply Peqb_true_eq in H; subst *)
+(*          | |- context[( _ # ?s <- _ ) ! ?r] => rewrite AssocMap.gso by lia *)
+(*          end; crush. *)
+(* Qed. *)
+
+(* Lemma alternatives_different_map : *)
+(*   forall l state ram d c d'' c'' d' c' n i p, *)
+(*     i <= p -> n > p -> *)
+(*     Forall (Pos.lt p) (map snd l) -> *)
+(*     Forall (Pos.ge p) (map fst l) -> *)
+(*     ~ In n (map snd l) -> *)
+(*     ~ In i (map fst l) -> *)
+(*     fold_right (transf_maps state ram) (d, c) l = (d', c') -> *)
+(*     alternatives state ram d' c' d'' c'' i n -> *)
+(*     alternatives state ram d c d'' c'' i n. *)
+(* Proof. *)
+(*   Opaque transf_maps. *)
+(*   induction l; intros. *)
+(*   - crush. *)
+(*   - simplify; repeat match goal with *)
+(*                      | H: context[_ :: _] |- _ => inv H *)
+(*                      | H: transf_maps _ _ _ (fold_right (transf_maps ?s ?r) (?d, ?c) ?l) = (_, _) |- _ => *)
+(*                        let X := fresh "X" in *)
+(*                        remember (fold_right (transf_maps s r) (d, c) l) as X *)
+(*                      | X: _ * _ |- _ => destruct X *)
+(*                      | H: (_, _) = _ |- _ => symmetry in H *)
+(*                      end; simplify. *)
+(*     remember p0 as i'. symmetry in Heqi'. subst. *)
+(*     remember p1 as n'. symmetry in Heqn'. subst. *)
+(*     assert (i <> n') by lia. *)
+(*     assert (n <> i') by lia. *)
+(*     assert (n <> n') by lia. *)
+(*     assert (i <> i') by lia. *)
+(*     eapply IHl; eauto. *)
+(*     eapply transf_alternatives_neq2; eauto; try lia. *)
+(* Qed. *)
+
+(* Lemma transf_fold_alternatives : *)
+(*   forall l state ram d c d' c' i n d_s c_s, *)
+(*     fold_right (transf_maps state ram) (d, c) l = (d', c') -> *)
+(*     Pos.max (max_pc c) (max_pc d) < n -> *)
+(*     Forall (Pos.lt (Pos.max (max_pc c) (max_pc d))) (map snd l) -> *)
+(*     Forall (Pos.ge (Pos.max (max_pc c) (max_pc d))) (map fst l) -> *)
+(*     list_norepet (map fst l) -> *)
+(*     list_norepet (map snd l) -> *)
+(*     In (i, n) l -> *)
+(*     d ! i = Some d_s -> *)
+(*     c ! i = Some c_s -> *)
+(*     alternatives state ram d c d' c' i n. *)
+(* Proof. *)
+(*   Opaque transf_maps. *)
+(*   induction l; crush; []. *)
+(*   repeat match goal with *)
+(*          | H: context[_ :: _] |- _ => inv H *)
+(*          | H: transf_maps _ _ _ (fold_right (transf_maps ?s ?r) (?d, ?c) ?l) = (_, _) |- _ => *)
+(*            let X := fresh "X" in *)
+(*            remember (fold_right (transf_maps s r) (d, c) l) as X *)
+(*          | X: _ * _ |- _ => destruct X *)
+(*          | H: (_, _) = _ |- _ => symmetry in H *)
+(*          end. *)
+(*   inv H5. inv H1. simplify. *)
+(*   eapply alternatives_different_map; eauto. *)
+(*   simplify; lia. simplify; lia. apply transf_alternatives; auto. lia. *)
+(*   simplify. *)
+(*   assert (X: In i (map fst l)). { replace i with (fst (i, n)) by auto. apply in_map; auto. } *)
+(*   assert (X2: In n (map snd l)). { replace n with (snd (i, n)) by auto. apply in_map; auto. } *)
+(*   assert (X3: n <> p0). { destruct (Pos.eq_dec n p0); subst; crush. } *)
+(*   assert (X4: i <> p). { destruct (Pos.eq_dec i p); subst; crush. } *)
+(*   eapply transf_alternatives_neq; eauto; apply max_index in H7; lia. *)
+(*   Transparent transf_maps. *)
+(* Qed. *)
+
+(* Lemma zip_range_inv : *)
+(*   forall A (l: list A) i n, *)
+(*     In i l -> *)
+(*     exists n', In (i, n') (zip_range n l) /\ n' >= n. *)
+(* Proof. *)
+(*   induction l; crush. *)
+(*   inv H. econstructor. *)
+(*   split. left. eauto. lia. *)
+(*   eapply IHl in H0. inv H0. inv H. *)
+(*   econstructor. split. right. apply H0. lia. *)
+(* Qed. *)
+
+(* Lemma zip_range_not_in_fst : *)
+(*   forall A (l: list A) a n, ~ In a l -> ~ In a (map fst (zip_range n l)). *)
+(* Proof. unfold not; induction l; crush; inv H0; firstorder. Qed. *)
+
+(* Lemma zip_range_no_repet_fst : *)
+(*   forall A (l: list A) a, list_norepet l -> list_norepet (map fst (zip_range a l)). *)
+(* Proof. *)
+(*   induction l; simplify; constructor; inv H; firstorder; *)
+(*   eapply zip_range_not_in_fst; auto. *)
+(* Qed. *)
+
+(* Lemma transf_code_alternatives : *)
+(*   forall state ram d c d' c' i d_s c_s, *)
+(*     transf_code state ram d c = (d', c') -> *)
+(*     d ! i = Some d_s -> *)
+(*     c ! i = Some c_s -> *)
+(*     exists n, alternatives state ram d c d' c' i n. *)
+(* Proof. *)
+(*   unfold transf_code; *)
+(*   intros. *)
+(*   pose proof H0 as X. *)
+(*   apply PTree.elements_correct in X. assert (In i (map fst (PTree.elements d))). *)
+(*   { replace i with (fst (i, d_s)) by auto. apply in_map. auto. } *)
+(*   exploit zip_range_inv. apply H2. intros. inv H3. simplify. *)
+(*   instantiate (1 := (Pos.max (max_pc c) (max_pc d) + 1)) in H3. *)
+(*   exists x. *)
+(*   eapply transf_fold_alternatives; *)
+(*   eauto using forall_gt, PTree.elements_keys_norepet, max_index. lia. *)
+(*   assert (Forall (Pos.le (Pos.max (max_pc c) (max_pc d) + 1)) *)
+(*     (map snd (zip_range (Pos.max (max_pc c) (max_pc d) + 1) *)
+(*                         (map fst (PTree.elements d))))) by apply zip_range_forall_le. *)
+(*   apply Forall_forall; intros. eapply Forall_forall in H4; eauto. lia. *)
+(*   rewrite zip_range_fst_idem. apply Forall_forall; intros. *)
+(*   apply AssocMapExt.elements_iff in H4. inv H4. apply max_index in H6. lia. *)
+(*   eapply zip_range_no_repet_fst. apply PTree.elements_keys_norepet. *)
+(*   eapply zip_range_snd_no_repet. *)
+(* Qed. *)
+
+(* Lemma max_reg_stmnt_not_modified : *)
+(*   forall s f rs ar rs' ar', *)
+(*     stmnt_runp f rs ar s rs' ar' -> *)
+(*     forall r, *)
+(*       max_reg_stmnt s < r -> *)
+(*       (assoc_blocking rs) ! r = (assoc_blocking rs') ! r. *)
+(* Proof. *)
+(*   induction 1; crush; *)
+(*   try solve [repeat destruct_match; apply IHstmnt_runp; try lia; auto]. *)
+(*   assert (X: (assoc_blocking asr1) ! r = (assoc_blocking asr2) ! r) by (apply IHstmnt_runp2; lia). *)
+(*   assert (X2: (assoc_blocking asr0) ! r = (assoc_blocking asr1) ! r) by (apply IHstmnt_runp1; lia). *)
+(*   congruence. *)
+(*   inv H. simplify. rewrite AssocMap.gso by lia; auto. *)
+(* Qed. *)
+
+(* Lemma max_reg_stmnt_not_modified_nb : *)
+(*   forall s f rs ar rs' ar', *)
+(*     stmnt_runp f rs ar s rs' ar' -> *)
+(*     forall r, *)
+(*       max_reg_stmnt s < r -> *)
+(*       (assoc_nonblocking rs) ! r = (assoc_nonblocking rs') ! r. *)
+(* Proof. *)
+(*   induction 1; crush; *)
+(*   try solve [repeat destruct_match; apply IHstmnt_runp; try lia; auto]. *)
+(*   assert (X: (assoc_nonblocking asr1) ! r = (assoc_nonblocking asr2) ! r) by (apply IHstmnt_runp2; lia). *)
+(*   assert (X2: (assoc_nonblocking asr0) ! r = (assoc_nonblocking asr1) ! r) by (apply IHstmnt_runp1; lia). *)
+(*   congruence. *)
+(*   inv H. simplify. rewrite AssocMap.gso by lia; auto. *)
+(* Qed. *)
+
+(* Lemma int_eq_not_changed : *)
+(*   forall ar ar' r r2 b, *)
+(*     Int.eq (ar # r) (ar # r2) = b -> *)
+(*     ar ! r = ar' ! r -> *)
+(*     ar ! r2 = ar' ! r2 -> *)
+(*     Int.eq (ar' # r) (ar' # r2) = b. *)
+(* Proof. *)
+(*   unfold find_assocmap, AssocMapExt.get_default. intros. *)
+(*   rewrite <- H0. rewrite <- H1. auto. *)
+(* Qed. *)
+
+(* Lemma merge_find_assocmap : *)
+(*   forall ran rab x, *)
+(*     ran ! x = None -> *)
+(*     (merge_regs ran rab) # x = rab # x. *)
+(* Proof. *)
+(*   unfold merge_regs, find_assocmap, AssocMapExt.get_default. *)
+(*   intros. destruct (rab ! x) eqn:?. *)
+(*   erewrite AssocMapExt.merge_correct_2; eauto. *)
+(*   erewrite AssocMapExt.merge_correct_3; eauto. *)
+(* Qed. *)
+
+(* Lemma max_reg_module_controllogic_gt : *)
+(*   forall m i v p, *)
+(*     (mod_controllogic m) ! i = Some v -> *)
+(*     max_reg_module m < p -> *)
+(*     max_reg_stmnt v < p. *)
+(* Proof. *)
+(*   intros. unfold max_reg_module in *. *)
+(*   apply max_reg_stmnt_le_stmnt_tree in H. lia. *)
+(* Qed. *)
+
+(* Lemma max_reg_module_datapath_gt : *)
+(*   forall m i v p, *)
+(*     (mod_datapath m) ! i = Some v -> *)
+(*     max_reg_module m < p -> *)
+(*     max_reg_stmnt v < p. *)
+(* Proof. *)
+(*   intros. unfold max_reg_module in *. *)
+(*   apply max_reg_stmnt_le_stmnt_tree in H. lia. *)
+(* Qed. *)
+
+(* Lemma merge_arr_empty2 : *)
+(*   forall m ar ar', *)
+(*     match_empty_size m ar' -> *)
+(*     match_arrs ar ar' -> *)
+(*     match_arrs ar (merge_arrs (empty_stack m) ar'). *)
+(* Proof. *)
+(*   inversion 1; subst; inversion 1; subst. *)
+(*   econstructor; intros. apply H4 in H6; inv_exists. simplify. *)
+(*   eapply merge_arr_empty'' in H6; eauto. *)
+(*   (* apply H5 in H6. pose proof H6. apply H2 in H7. *) *)
+(* (*   unfold merge_arrs. rewrite AssocMap.gcombine; auto. setoid_rewrite H6. *) *)
+(* (*   setoid_rewrite H7. auto. *) *)
+(* (* Qed. *) Admitted. *)
+(* #[local] Hint Resolve merge_arr_empty2 : mgen. *)
+
+(* Lemma find_assocmap_gso : *)
+(*   forall ar x y v, x <> y -> (ar # y <- v) # x = ar # x. *)
+(* Proof. *)
+(*   unfold find_assocmap, AssocMapExt.get_default; intros; rewrite AssocMap.gso; auto. *)
+(* Qed. *)
+
+(* Lemma find_assocmap_gss : *)
+(*   forall ar x v, (ar # x <- v) # x = v. *)
+(* Proof. *)
+(*   unfold find_assocmap, AssocMapExt.get_default; intros; rewrite AssocMap.gss; auto. *)
+(* Qed. *)
+
+(* Lemma expr_lt_max_module_datapath : *)
+(*   forall m x, *)
+(*     max_reg_stmnt x <= max_stmnt_tree (mod_datapath m) -> *)
+(*     max_reg_stmnt x < max_reg_module m + 1. *)
+(* Proof. unfold max_reg_module. lia. Qed. *)
+
+(* Lemma expr_lt_max_module_controllogic : *)
+(*   forall m x, *)
+(*     max_reg_stmnt x <= max_stmnt_tree (mod_controllogic m) -> *)
+(*     max_reg_stmnt x < max_reg_module m + 1. *)
+(* Proof. unfold max_reg_module. lia. Qed. *)
+
+(* Lemma int_eq_not : *)
+(*   forall x y, Int.eq x y = true -> Int.eq x (Int.not y) = false. *)
+(* Proof. *)
+(*   intros. pose proof (Int.eq_spec x y). rewrite H in H0. subst. *)
+(*   apply int_eq_not_false. *)
+(* Qed. *)
+
+(* Lemma match_assocmaps_gt2 : *)
+(*   forall (p s : positive) (ra ra' : assocmap) (v : value), *)
+(*   p <= s -> match_assocmaps p ra ra' -> match_assocmaps p (ra # s <- v) ra'. *)
+(* Proof. *)
+(*   intros; inv H0; constructor; intros. *)
+(*   destruct (Pos.eq_dec r s); subst. lia. *)
+(*   rewrite AssocMap.gso by lia. auto. *)
+(* Qed. *)
+
+(* Lemma match_assocmaps_switch_neq : *)
+(*   forall p ra ra' r v' s v, *)
+(*     match_assocmaps p ra ((ra' # r <- v') # s <- v) -> *)
+(*     s <> r -> *)
+(*     match_assocmaps p ra ((ra' # s <- v) # r <- v'). *)
+(* Proof. *)
+(*   inversion 1; constructor; simplify. *)
+(*   destruct (Pos.eq_dec r0 s); destruct (Pos.eq_dec r0 r); subst; try lia. *)
+(*   rewrite AssocMap.gso by lia. specialize (H0 s). apply H0 in H5. *)
+(*   rewrite AssocMap.gss in H5. rewrite AssocMap.gss. auto. *)
+(*   rewrite AssocMap.gss. apply H0 in H5. rewrite AssocMap.gso in H5 by lia. *)
+(*   rewrite AssocMap.gss in H5. auto. *)
+(*   repeat rewrite AssocMap.gso by lia. *)
+(*   apply H0 in H5. repeat rewrite AssocMap.gso in H5 by lia. *)
+(*   auto. *)
+(* Qed. *)
+
+(* Lemma match_assocmaps_duplicate : *)
+(*   forall p ra ra' v' s v, *)
+(*     match_assocmaps p ra (ra' # s <- v) -> *)
+(*     match_assocmaps p ra ((ra' # s <- v') # s <- v). *)
+(* Proof. *)
+(*   inversion 1; constructor; simplify. *)
+(*   destruct (Pos.eq_dec r s); subst. *)
+(*   rewrite AssocMap.gss. apply H0 in H4. rewrite AssocMap.gss in H4. auto. *)
+(*   repeat rewrite AssocMap.gso by lia. apply H0 in H4. rewrite AssocMap.gso in H4 by lia. *)
+(*   auto. *)
+(* Qed. *)
+
+(* Lemma translation_correct : *)
+(*   forall m asr nasa1 basa1 nasr1 basr1 basr2 nasr2 nasa2 basa2 nasr3 basr3 *)
+(*          nasa3 basa3 asr'0 asa'0 res' st tge pstval sf asa ctrl data f, *)
+(*     asr ! (mod_reset m) = Some (ZToValue 0) -> *)
+(*     asr ! (mod_finish m) = Some (ZToValue 0) -> *)
+(*     asr ! (mod_st m) = Some (posToValue st) -> *)
+(*     (mod_controllogic m) ! st = Some ctrl -> *)
+(*     (mod_datapath m) ! st = Some data -> *)
+(*     stmnt_runp f {| assoc_blocking := asr; assoc_nonblocking := empty_assocmap |} *)
+(*                {| assoc_blocking := asa; assoc_nonblocking := empty_stack m |} ctrl *)
+(*                {| assoc_blocking := basr1; assoc_nonblocking := nasr1 |} *)
+(*                {| assoc_blocking := basa1; assoc_nonblocking := nasa1 |} -> *)
+(*     basr1 ! (mod_st m) = Some (posToValue st) -> *)
+(*     stmnt_runp f {| assoc_blocking := basr1; assoc_nonblocking := nasr1 |} *)
+(*                {| assoc_blocking := basa1; assoc_nonblocking := nasa1 |} data *)
+(*                {| assoc_blocking := basr2; assoc_nonblocking := nasr2 |} *)
+(*                {| assoc_blocking := basa2; assoc_nonblocking := nasa2 |} -> *)
+(*     exec_ram {| assoc_blocking := merge_regs nasr2 basr2; assoc_nonblocking := empty_assocmap |} *)
+(*              {| assoc_blocking := merge_arrs nasa2 basa2; assoc_nonblocking := empty_stack m |} None *)
+(*              {| assoc_blocking := basr3; assoc_nonblocking := nasr3 |} *)
+(*              {| assoc_blocking := basa3; assoc_nonblocking := nasa3 |} -> *)
+(*     (merge_regs nasr3 basr3) ! (mod_st m) = Some (posToValue pstval) -> *)
+(*     (Z.pos pstval <= 4294967295)%Z -> *)
+(*     match_states (State sf m st asr asa) (State res' (transf_module m) st asr'0 asa'0) -> *)
+(*     mod_ram m = None -> *)
+(*     exists R2 : state, *)
+(*       Smallstep.plus step tge (State res' (transf_module m) st asr'0 asa'0) Events.E0 R2 /\ *)
+(*       match_states (State sf m pstval (merge_regs nasr3 basr3) (merge_arrs nasa3 basa3)) R2. *)
+(* Proof. *)
+(*   Ltac tac0 := *)
+(*     repeat match goal with *)
+(*            | H: match_reg_assocs _ _ _ |- _ => inv H *)
+(*            | H: match_arr_assocs _ _ |- _ => inv H *)
+(*            end. *)
+(*   intros. *)
+(*   repeat match goal with *)
+(*   | H: match_states _ _ |- _ => inv H *)
+(*   | H: context[exec_ram] |- _ => inv H *)
+(*   | H: mod_ram _ = None |- _ => *)
+(*     let H2 := fresh "TRANSF" in learn H as H2; apply transf_module_code in H2 *)
+(*   end. *)
+(*   eapply transf_code_alternatives in TRANSF; eauto; simplify; unfold alternatives in *. *)
+(*   repeat match goal with H: _ \/ _ |- _ => inv H end. *)
+(*   - unfold alt_unchanged in *; simplify. *)
+(*     assert (MATCH_SIZE1: match_empty_size m nasa1 /\ match_empty_size m basa1). *)
+(*     { eapply match_arrs_size_stmnt_preserved2; eauto. unfold match_empty_size; eauto with mgen. } *)
+(*     assert (MATCH_SIZE2: match_empty_size m nasa2 /\ match_empty_size m basa2). *)
+(*     { eapply match_arrs_size_stmnt_preserved2; mgen_crush. } simplify. *)
+(*     assert (MATCH_ARR3: match_arrs_size nasa2 basa2) by eauto with mgen. *)
+(*     exploit match_states_same; try solve [apply H4 | eapply max_stmnt_lt_module; eauto *)
+(*                                           | econstructor; eauto with mgen]; *)
+(*     intros; repeat inv_exists; simplify; tac0. *)
+(*     exploit match_states_same; try solve [eapply H6 | eapply max_stmnt_lt_module; eauto *)
+(*                                           | econstructor; eauto with mgen]; *)
+(*     intros; repeat inv_exists; simplify; tac0. *)
+(*     assert (MATCH_SIZE1': match_empty_size m ran'0 /\ match_empty_size m rab'0). *)
+(*     { eapply match_arrs_size_stmnt_preserved2; eauto. unfold match_empty_size; eauto with mgen. *)
+(*       rewrite empty_stack_transf; eauto with mgen. } *)
+(*     assert (MATCH_SIZE2': match_empty_size m ran'2 /\ match_empty_size m rab'2). *)
+(*     { eapply match_arrs_size_stmnt_preserved2; mgen_crush. } simplify. *)
+(*     assert (MATCH_ARR3': match_arrs_size ran'2 rab'2) by eauto with mgen. *)
+(*     do 2 econstructor. apply Smallstep.plus_one. econstructor. *)
+(*     eauto with mgen. eauto with mgen. eauto with mgen. *)
+(*     rewrite <- H12. eassumption. rewrite <- H7. eassumption. *)
+(*     eauto. eauto with mgen. eauto. *)
+(*     rewrite empty_stack_transf. unfold transf_module; repeat destruct_match; try discriminate. *)
+(*     econstructor. simplify. *)
+(*     unfold disable_ram in *. unfold transf_module in DISABLE_RAM. *)
+(*     repeat destruct_match; try discriminate; []. simplify. *)
+(*     pose proof H17 as R1. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R1. *)
+(*     pose proof H17 as R2. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R2. *)
+(*     pose proof H18 as R3. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R3. *)
+(*     pose proof H18 as R4. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R4. *)
+(*     pose proof H17 as R1'. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R1'. *)
+(*     pose proof H17 as R2'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R2'. *)
+(*     pose proof H18 as R3'. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R3'. *)
+(*     pose proof H18 as R4'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R4'. *)
+(*     simplify. *)
+(*     pose proof DISABLE_RAM as DISABLE_RAM1. *)
+(*     eapply int_eq_not_changed with (ar' := rab') in DISABLE_RAM; try congruence. *)
+(*     eapply int_eq_not_changed with (ar' := rab'1) in DISABLE_RAM; try congruence. *)
+(*     rewrite AssocMap.gempty in R2. rewrite <- R2 in R4. *)
+(*     rewrite AssocMap.gempty in R2'. rewrite <- R2' in R4'. *)
+(*     eapply int_eq_not_changed in DISABLE_RAM; auto. repeat (rewrite merge_find_assocmap; try congruence). *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     auto. auto. eauto with mgen. auto. *)
+(*     econstructor; mgen_crush. (* apply merge_arr_empty; mgen_crush. *) *)
+(* (*     unfold disable_ram in *. unfold transf_module in DISABLE_RAM. *) *)
+(* (*     repeat destruct_match; crush. unfold transf_module in Heqo; repeat destruct_match; crush. *) *)
+(* (*     pose proof H17 as R1. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R1. *) *)
+(* (*     pose proof H17 as R2. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R2. *) *)
+(* (*     pose proof H18 as R3. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R3. *) *)
+(* (*     pose proof H18 as R4. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R4. *) *)
+(* (*     pose proof H17 as R1'. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R1'. *) *)
+(* (*     pose proof H17 as R2'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R2'. *) *)
+(* (*     pose proof H18 as R3'. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R3'. *) *)
+(* (*     pose proof H18 as R4'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R4'. *) *)
+(* (*     simplify. *) *)
+(* (*     pose proof DISABLE_RAM as DISABLE_RAM1. *) *)
+(* (*     eapply int_eq_not_changed with (ar' := rab') in DISABLE_RAM; try congruence. *) *)
+(* (*     eapply int_eq_not_changed with (ar' := rab'1) in DISABLE_RAM; try congruence. *) *)
+(* (*     rewrite AssocMap.gempty in R2. rewrite <- R2 in R4. *) *)
+(* (*     rewrite AssocMap.gempty in R2'. rewrite <- R2' in R4'. *) *)
+(* (*     eapply int_eq_not_changed in DISABLE_RAM; auto. repeat (rewrite merge_find_assocmap; try congruence). *) *)
+(* (*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *) *)
+(* (*   - unfold alt_store in *; simplify. inv H6. inv H19. inv H19. simplify. *) *)
+(* (*     exploit match_states_same; try solve [eapply H4 | eapply max_stmnt_lt_module; eauto *) *)
+(* (*                                           | econstructor; eauto with mgen]; *) *)
+(* (*     intros; repeat inv_exists; simplify; tac0. *) *)
+(* (*     do 2 econstructor. apply Smallstep.plus_one. econstructor. solve [eauto with mgen]. solve [eauto with mgen]. *) *)
+(* (*     solve [eauto with mgen]. *) *)
+(* (*     rewrite H7. eassumption. eassumption. eassumption. solve [eauto with mgen]. *) *)
+(* (*     econstructor. econstructor. econstructor. econstructor. econstructor. *) *)
+(* (*     auto. auto. auto. econstructor. econstructor. econstructor. *) *)
+(* (*     econstructor. econstructor. econstructor. econstructor. *) *)
+(* (*     eapply expr_runp_matches2. eassumption. 2: { eassumption. } *) *)
+(* (*     pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*     apply expr_lt_max_module_datapath in X; simplify; remember (max_reg_module m); lia. *) *)
+(* (*     auto. *) *)
+(* (*     econstructor. econstructor. eapply expr_runp_matches2; eauto. *) *)
+(* (*     pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*     apply expr_lt_max_module_datapath in X. *) *)
+(* (*     remember (max_reg_module m); simplify; lia. *) *)
+
+(* (*     rewrite empty_stack_transf. *) *)
+(* (*     unfold transf_module; repeat destruct_match; try discriminate; simplify; []. *) *)
+(* (*     eapply exec_ram_Some_write. *) *)
+(* (*     3: { *) *)
+(* (*       simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*       repeat rewrite find_assocmap_gso by lia. *) *)
+(* (*       pose proof H12 as X. *) *)
+(* (*       eapply max_reg_stmnt_not_modified_nb with (r := (max_reg_module m + 2)) in X. *) *)
+(* (*       rewrite AssocMap.gempty in X. *) *)
+(* (*       apply merge_find_assocmap. auto. *) *)
+(* (*       apply max_reg_stmnt_le_stmnt_tree in H2. *) *)
+(* (*       apply expr_lt_max_module_controllogic in H2. lia. *) *)
+(* (*     } *) *)
+(* (*     3: { *) *)
+(* (*       simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*       repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *) *)
+(* (*     } *) *)
+(* (*     { unfold disable_ram in *. unfold transf_module in DISABLE_RAM; *) *)
+(* (*                                repeat destruct_match; try discriminate. *) *)
+(* (*       simplify. *) *)
+(* (*       pose proof H12 as X2. *) *)
+(* (*       pose proof H12 as X4. *) *)
+(* (*       apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in X2. *) *)
+(* (*       apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in X4. *) *)
+(* (*       assert (forall ar ar' x, ar ! x = ar' ! x -> ar # x = ar' # x). *) *)
+(* (*       { intros. unfold find_assocmap, AssocMapExt.get_default. rewrite H6. auto. } *) *)
+(* (*       apply H6 in X2. apply H6 in X4. simplify. rewrite <- X2. rewrite <- X4. *) *)
+(* (*       apply int_eq_not. auto. *) *)
+(* (*       apply max_reg_stmnt_le_stmnt_tree in H2. *) *)
+(* (*       apply expr_lt_max_module_controllogic in H2. simplify. remember (max_reg_module m). lia. *) *)
+(* (*       apply max_reg_stmnt_le_stmnt_tree in H2. *) *)
+(* (*       apply expr_lt_max_module_controllogic in H2. simplify. remember (max_reg_module m). lia. *) *)
+(* (*     } *) *)
+(* (*     2: { *) *)
+(* (*       simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*       repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *) *)
+(* (*     } *) *)
+(* (*     solve [auto]. *) *)
+(* (*     simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*     repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *) *)
+(* (*     simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*     repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *) *)
+(* (*     simplify. auto. *) *)
+(* (*     simplify. auto. *) *)
+(* (*     unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*     unfold_merge. *) *)
+(* (*     assert (mod_st (transf_module m) < max_reg_module m + 1). *) *)
+(* (*     { unfold max_reg_module, transf_module; repeat destruct_match; try discriminate; simplify; lia. } *) *)
+(* (*     remember (max_reg_module m). *) *)
+(* (*     repeat rewrite AssocMap.gso by lia. *) *)
+(* (*     unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*     replace (AssocMapExt.merge value ran' rab') with (merge_regs ran' rab'); *) *)
+(* (*     [|unfold merge_regs; auto]. *) *)
+(* (*     pose proof H19 as X. *) *)
+(* (*     eapply match_assocmaps_merge in X. *) *)
+(* (*     2: { apply H21. } *) *)
+(* (*     inv X. rewrite <- H14. eassumption. unfold transf_module in H6; repeat destruct_match; *) *)
+(* (*                                         try discriminate; simplify. *) *)
+(* (*     lia. auto. *) *)
+
+(* (*     econstructor. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *) *)
+(* (*     rewrite AssocMapExt.merge_base_1. *) *)
+(* (*     remember (max_reg_module m). *) *)
+(* (*     repeat (apply match_assocmaps_gt; [lia|]). *) *)
+(* (*     solve [eauto with mgen]. *) *)
+
+(* (*     apply merge_arr_empty. apply match_empty_size_merge. *) *)
+(* (*     apply match_empty_assocmap_set. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *) *)
+(* (*     apply match_arrs_merge_set2; auto. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H12; mgen_crush. *) *)
+(* (*     rewrite empty_stack_transf. mgen_crush. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H12; mgen_crush. *) *)
+(* (*     rewrite empty_stack_transf. mgen_crush. *) *)
+(* (*     auto. *) *)
+(* (*     apply merge_arr_empty_match. *) *)
+(* (*     apply match_empty_size_merge. apply match_empty_assocmap_set. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *) *)
+(* (*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *) *)
+(* (*     apply match_empty_size_merge. apply match_empty_assocmap_set. *) *)
+(* (*     mgen_crush. eapply match_arrs_size_stmnt_preserved in H12; mgen_crush. *) *)
+(* (*     rewrite empty_stack_transf; mgen_crush. *) *)
+(* (*     unfold disable_ram. unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*     unfold merge_regs. unfold_merge. *) *)
+(* (*     remember (max_reg_module m). *) *)
+(* (*     rewrite find_assocmap_gss. *) *)
+(* (*     repeat rewrite find_assocmap_gso by lia. *) *)
+(* (*     rewrite find_assocmap_gss. apply Int.eq_true. *) *)
+(* (*   - unfold alt_load in *; simplify. inv H6. *) *)
+(* (*     2: { match goal with H: context[location_is] |- _ => inv H end. } *) *)
+(* (*     match goal with H: context[location_is] |- _ => inv H end. *) *)
+(* (*     inv H30. simplify. inv H4. *) *)
+(* (*     2: { match goal with H: context[location_is] |- _ => inv H end. } *) *)
+(* (*     inv H27. simplify. *) *)
+(* (*     do 2 econstructor. eapply Smallstep.plus_two. *) *)
+(* (*     econstructor. mgen_crush. mgen_crush. mgen_crush. eassumption. *) *)
+(* (*     eassumption. econstructor. simplify. econstructor. econstructor. *) *)
+(* (*     solve [eauto with mgen]. econstructor. econstructor. econstructor. *) *)
+(* (*     econstructor. econstructor. auto. auto. auto. *) *)
+(* (*     econstructor. econstructor. econstructor. *) *)
+(* (*     econstructor. econstructor. econstructor. eapply expr_runp_matches2; auto. eassumption. *) *)
+(* (*     2: { eassumption. } *) *)
+(* (*     pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*     apply expr_lt_max_module_datapath in X. simplify. remember (max_reg_module m); lia. *) *)
+(* (*     auto. *) *)
+
+(* (*     simplify. rewrite empty_stack_transf. unfold transf_module; repeat destruct_match; crush. *) *)
+(* (*     eapply exec_ram_Some_read; simplify. *) *)
+(* (*     2: { *) *)
+(* (*       unfold merge_regs. unfold_merge. repeat rewrite find_assocmap_gso; try (remember (max_reg_module m); lia). *) *)
+(* (*       auto. unfold max_reg_module. lia. *) *)
+(* (*     } *) *)
+(* (*     2: { *) *)
+(* (*       unfold merge_regs. unfold_merge. rewrite AssocMap.gso by lia. rewrite AssocMap.gso by lia. *) *)
+(* (*       rewrite AssocMap.gss. auto. *) *)
+(* (*     } *) *)
+(* (*     { unfold disable_ram, transf_module in DISABLE_RAM; *) *)
+(* (*       repeat destruct_match; try discriminate. simplify. apply int_eq_not. auto. } *) *)
+(* (*     { unfold merge_regs; unfold_merge. repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. } *) *)
+(* (*     { unfold merge_regs; unfold_merge. apply AssocMap.gss. } *) *)
+(* (*     { eapply match_arrs_read. eassumption. mgen_crush. } *) *)
+(* (*     { crush. } *) *)
+(* (*     { crush. } *) *)
+(* (*     { unfold merge_regs. unfold_merge. *) *)
+(* (*       unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*       assert (mod_st m < max_reg_module m + 1). *) *)
+(* (*       { unfold max_reg_module; lia. } *) *)
+(* (*       remember (max_reg_module m). repeat rewrite AssocMap.gso by lia. *) *)
+(* (*       apply AssocMap.gss. *) *)
+(* (*     } *) *)
+(* (*     { auto. } *) *)
+
+(* (*     { econstructor. *) *)
+(* (*       { unfold merge_regs. unfold_merge. *) *)
+(* (*         assert (mod_reset m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         assert (mod_st m < mod_reset m). *) *)
+(* (*         { pose proof (mod_ordering_wf m); unfold module_ordering in *. simplify. *) *)
+(* (*           repeat match goal with *) *)
+(* (*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *) *)
+(* (*                  end; lia. *) *)
+(* (*         } *) *)
+(* (*         repeat rewrite AssocMap.gso by lia. *) *)
+(* (*         inv ASSOC. rewrite <- H19. auto. lia. *) *)
+(* (*       } *) *)
+(* (*       { unfold merge_regs. unfold_merge. *) *)
+(* (*         assert (mod_finish m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         assert (mod_st m < mod_finish m). *) *)
+(* (*         { pose proof (mod_ordering_wf m). unfold module_ordering in *. simplify. *) *)
+(* (*           repeat match goal with *) *)
+(* (*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *) *)
+(* (*                  end; lia. *) *)
+(* (*         } *) *)
+(* (*         repeat rewrite AssocMap.gso by lia. *) *)
+(* (*         inv ASSOC. rewrite <- H19. auto. lia. *) *)
+(* (*       } *) *)
+(* (*       { unfold merge_regs. unfold_merge. *) *)
+(* (*         assert (mod_st m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *) *)
+(* (*       } *) *)
+(* (*       { eassumption. } *) *)
+(* (*       { eassumption. } *) *)
+(* (*       { econstructor. econstructor. simplify. unfold merge_regs. unfold_merge. *) *)
+(* (*         eapply expr_runp_matches. eassumption. *) *)
+(* (*         assert (max_reg_expr x0 + 1 <= max_reg_module m + 1). *) *)
+(* (*         { pose proof H2 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*           apply expr_lt_max_module_controllogic in X. simplify. remember (max_reg_module m). lia. } *) *)
+(* (*         assert (max_reg_expr x0 + 1 <= mod_st m). *) *)
+(* (*         { unfold module_ordering in *. simplify. *) *)
+(* (*           repeat match goal with *) *)
+(* (*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *) *)
+(* (*                  end. *) *)
+(* (*           pose proof H2 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*           simplify. lia. *) *)
+(* (*         } *) *)
+(* (*         remember (max_reg_module m). *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         simplify. *) *)
+(* (*         eapply match_assocmaps_ge. eauto. lia. *) *)
+(* (*         mgen_crush. *) *)
+(* (*       } *) *)
+(* (*       { simplify. unfold merge_regs. unfold_merge. *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         assert (mod_st m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         remember (max_reg_module m). *) *)
+(* (*         repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *) *)
+(* (*       } *) *)
+(* (*       { *) *)
+(* (*         simplify. econstructor. econstructor. econstructor. simplify. *) *)
+(* (*         unfold merge_regs; unfold_merge. *) *)
+(* (*         repeat rewrite find_assocmap_gso by lia. apply find_assocmap_gss. *) *)
+(* (*       } *) *)
+(* (*       { simplify. rewrite empty_stack_transf. *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         econstructor. simplify. *) *)
+(* (*         unfold merge_regs; unfold_merge. simplify. *) *)
+(* (*         assert (r < max_reg_module m + 1). *) *)
+(* (*         { pose proof H3 as X. eapply max_reg_module_datapath_gt with (p := max_reg_module m + 1) in X. *) *)
+(* (*           unfold max_reg_stmnt in X. simplify. *) *)
+(* (*           lia. lia. } *) *)
+(* (*         assert (mod_st m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         repeat rewrite find_assocmap_gso by lia. rewrite find_assocmap_gss. *) *)
+(* (*         repeat rewrite find_assocmap_gso by lia. rewrite find_assocmap_gss. *) *)
+(* (*         apply Int.eq_true. *) *)
+(* (*       } *) *)
+(* (*       { crush. } *) *)
+(* (*       { crush. } *) *)
+(* (*       { unfold merge_regs. unfold_merge. simplify. *) *)
+(* (*         assert (r < mod_st m). *) *)
+(* (*         { unfold module_ordering in *. simplify. *) *)
+(* (*           repeat match goal with *) *)
+(* (*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *) *)
+(* (*                  end. *) *)
+(* (*           pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*           simplify. lia. *) *)
+(* (*         } *) *)
+(* (*         unfold merge_regs in H8. repeat rewrite AssocMapExt.merge_add_assoc in H8. *) *)
+(* (*         simplify. rewrite AssocMap.gso in H8 by lia. rewrite AssocMap.gss in H8. *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         repeat rewrite AssocMap.gso by lia. *) *)
+(* (*         apply AssocMap.gss. } *) *)
+(* (*       { eassumption. } *) *)
+(* (*     } *) *)
+(* (*     { eauto. } *) *)
+(* (*     { econstructor. *) *)
+(* (*       { unfold merge_regs. unfold_merge. simplify. *) *)
+(* (*         apply match_assocmaps_gss. *) *)
+(* (*         unfold merge_regs in H8. repeat rewrite AssocMapExt.merge_add_assoc in H8. *) *)
+(* (*         rewrite AssocMap.gso in H8. rewrite AssocMap.gss in H8. inv H8. *) *)
+(* (*         remember (max_reg_module m). *) *)
+(* (*         assert (mod_st m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         apply match_assocmaps_switch_neq; [|lia]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_switch_neq; [|lia]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_switch_neq; [|lia]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_switch_neq; [|lia]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_switch_neq; [|lia]. *) *)
+(* (*         apply match_assocmaps_gt; [lia|]. *) *)
+(* (*         apply match_assocmaps_duplicate. *) *)
+(* (*         apply match_assocmaps_gss. auto. *) *)
+(* (*         assert (r < mod_st m). *) *)
+(* (*         { unfold module_ordering in *. simplify. *) *)
+(* (*           repeat match goal with *) *)
+(* (*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *) *)
+(* (*                  end. *) *)
+(* (*           pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *) *)
+(* (*           simplify. lia. *) *)
+(* (*         } lia. *) *)
+(* (*       } *) *)
+(* (*       { *) *)
+(* (*         apply merge_arr_empty. mgen_crush. *) *)
+(* (*         apply merge_arr_empty2. mgen_crush. *) *)
+(* (*         apply merge_arr_empty2. mgen_crush. *) *)
+(* (*         apply merge_arr_empty2. mgen_crush. *) *)
+(* (*         mgen_crush. *) *)
+(* (*       } *) *)
+(* (*       { auto. } *) *)
+(* (*       { mgen_crush. } *) *)
+(* (*       { mgen_crush. } *) *)
+(* (*       { unfold disable_ram. *) *)
+(* (*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *) *)
+(* (*         unfold merge_regs. unfold_merge. simplify. *) *)
+(* (*         assert (mod_st m < max_reg_module m + 1). *) *)
+(* (*         { unfold max_reg_module; lia. } *) *)
+(* (*         assert (r < max_reg_module m + 1). *) *)
+(* (*         { pose proof H3 as X. eapply max_reg_module_datapath_gt with (p := max_reg_module m + 1) in X. *) *)
+(* (*           unfold max_reg_stmnt in X. simplify. *) *)
+(* (*           lia. lia. } *) *)
+(* (*         repeat rewrite find_assocmap_gso by lia. *) *)
+(* (*         rewrite find_assocmap_gss. *) *)
+(* (*         repeat rewrite find_assocmap_gso by lia. *) *)
+(* (*         rewrite find_assocmap_gss. apply Int.eq_true. *) *)
+(* (*       } *) *)
+(* (*     } *) *)
+(* (* Qed. *) Admitted. *)
+
+(* Lemma exec_ram_resets_en : *)
+(*   forall rs ar rs' ar' r, *)
+(*     exec_ram rs ar (Some r) rs' ar' -> *)
+(*     assoc_nonblocking rs = empty_assocmap -> *)
+(*     Int.eq ((assoc_blocking (merge_reg_assocs rs')) # (ram_en r, 32)) *)
+(*            ((assoc_blocking (merge_reg_assocs rs')) # (ram_u_en r, 32)) = true. *)
+(* Proof. *)
+(*   inversion 1; intros; subst; unfold merge_reg_assocs; simplify. *)
+(*   - rewrite H6. mgen_crush. *)
+(*   (* - unfold merge_regs. rewrite H12. unfold_merge. *) *)
+(* (*     unfold find_assocmap, AssocMapExt.get_default in *. *) *)
+(* (*     rewrite AssocMap.gss; auto. rewrite AssocMap.gso; auto. setoid_rewrite H4. apply Int.eq_true. *) *)
+(* (*     pose proof (ram_ordering r); lia. *) *)
+(* (*   - unfold merge_regs. rewrite H11. unfold_merge. *) *)
+(* (*     unfold find_assocmap, AssocMapExt.get_default in *. *) *)
+(* (*     rewrite AssocMap.gss; auto. *) *)
+(* (*     repeat rewrite AssocMap.gso by (pose proof (ram_ordering r); lia). *) *)
+(* (*     setoid_rewrite H3. apply Int.eq_true. *) *)
+(* (* Qed. *) Admitted. *)
+
+(* Lemma disable_ram_set_gso : *)
+(*   forall rs r i v, *)
+(*     disable_ram (Some r) rs -> *)
+(*     i <> (ram_en r) -> i <> (ram_u_en r) -> *)
+(*     disable_ram (Some r) (rs # i <- v). *)
+(* Proof. *)
+(*   unfold disable_ram, find_assocmap, AssocMapExt.get_default; intros; *)
+(*   repeat rewrite AssocMap.gso by lia; auto. *)
+(* Qed. *)
+(* #[local] Hint Resolve disable_ram_set_gso : mgen. *)
+
+(* Lemma disable_ram_None rs : disable_ram None rs. *)
+(* Proof. unfold disable_ram; auto. Qed. *)
+(* #[local] Hint Resolve disable_ram_None : mgen. *)
+
+(* Lemma init_regs_equal_empty l st : *)
+(*   Forall (Pos.gt st) l -> (init_regs nil l) ! st = None. *)
+(* Proof. induction l; simplify; apply AssocMap.gempty. Qed. *)
+
+(* Lemma forall_lt_num : *)
+(*   forall l p p', Forall (Pos.gt p) l -> p < p' -> Forall (Pos.gt p') l. *)
+(* Proof. induction l; crush; inv H; constructor; [lia | eauto]. Qed. *)
+
+Section CORRECTNESS.
+
+  Context (prog tprog: program).
+  Context (TRANSL: match_prog prog tprog).
+
+  Let ge : genv := Genv.globalenv prog.
+  Let tge : genv := Genv.globalenv tprog.
+
+  Lemma symbols_preserved:
+    forall (s: AST.ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+  Proof using TRANSL. intros. eapply (Genv.find_symbol_match TRANSL). Qed.
+  #[local] Hint Resolve symbols_preserved : mgen.
+
+  Lemma function_ptr_translated:
+    forall (b: Values.block) (f: fundef),
+      Genv.find_funct_ptr ge b = Some f ->
+      exists tf,
+        Genv.find_funct_ptr tge b = Some tf /\ transf_fundef f = tf.
+  Proof using TRANSL.
+    intros. exploit (Genv.find_funct_ptr_match TRANSL); eauto.
+    intros (cu & tf & P & Q & R); exists tf; auto.
+  Qed.
+  #[local] Hint Resolve function_ptr_translated : mgen.
+
+  Lemma functions_translated:
+    forall (v: Values.val) (f: fundef),
+      Genv.find_funct ge v = Some f ->
+      exists tf,
+        Genv.find_funct tge v = Some tf /\ transf_fundef f = tf.
+  Proof using TRANSL.
+    intros. exploit (Genv.find_funct_match TRANSL); eauto.
+    intros (cu & tf & P & Q & R); exists tf; auto.
+  Qed.
+  #[local] Hint Resolve functions_translated : mgen.
+
+  Lemma senv_preserved:
+    Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge).
+  Proof (Genv.senv_transf TRANSL).
+  #[local] Hint Resolve senv_preserved : mgen.
+
+  (* Theorem transf_step_correct: *)
+  (*   forall (S1 : state) t S2, *)
+  (*     step ge S1 t S2 -> *)
+  (*     forall R1, *)
+  (*       match_states S1 R1 -> *)
+  (*       exists R2, Smallstep.plus step tge R1 t R2 /\ match_states S2 R2. *)
+  (* Proof. *)
+  (*   Ltac transf_step_correct_assum := *)
+  (*     match goal with *)
+  (*     | H: match_states _ _ |- _ => let H2 := fresh "MATCH" in learn H as H2; inv H2 *)
+  (*     | H: mod_ram ?m = Some ?r |- _ => *)
+  (*       let H2 := fresh "RAM" in learn H; *)
+  (*         pose proof (transf_module_code_ram m r H) as H2 *)
+  (*     | H: mod_ram ?m = None |- _ => *)
+  (*       let H2 := fresh "RAM" in learn H; *)
+  (*         pose proof (transf_module_code m H) as H2 *)
+  (*     end. *)
+  (*   Ltac transf_step_correct_tac := *)
+  (*     match goal with *)
+  (*     | |- Smallstep.plus _ _ _ _ _ => apply Smallstep.plus_one *)
+  (*     end. *)
+  (*   induction 1; destruct (mod_ram m) eqn:RAM; simplify; repeat transf_step_correct_assum; *)
+  (*     repeat transf_step_correct_tac. *)
+  (*   - assert (MATCH_SIZE1: match_empty_size m nasa1 /\ match_empty_size m basa1). *)
+  (*     { eapply match_arrs_size_stmnt_preserved2; eauto. unfold match_empty_size; mgen_crush. } *)
+  (*     simplify. *)
+  (*     assert (MATCH_SIZE2: match_empty_size m nasa2 /\ match_empty_size m basa2). *)
+  (*     { eapply match_arrs_size_stmnt_preserved2; mgen_crush. } simplify. *)
+  (*     assert (MATCH_SIZE2: match_empty_size m nasa3 /\ match_empty_size m basa3). *)
+  (*     { eapply match_arrs_size_ram_preserved2; mgen_crush. } simplify. *)
+  (*     assert (MATCH_ARR3: match_arrs_size nasa3 basa3) by mgen_crush. *)
+  (*     exploit match_states_same. apply H4. eauto with mgen. *)
+  (*     econstructor; eauto. econstructor; eauto. econstructor; eauto. econstructor; eauto. *)
+  (*     intros. repeat inv_exists. simplify. inv H18. inv H21. *)
+  (*     exploit match_states_same. apply H6. eauto with mgen. *)
+  (*     econstructor; eauto. econstructor; eauto. intros. repeat inv_exists. simplify. inv H18. inv H23. *)
+  (*     exploit exec_ram_same; eauto. eauto with mgen. *)
+  (*     econstructor. eapply match_assocmaps_merge; eauto. eauto with mgen. *)
+  (*     econstructor. *)
+  (*     apply match_arrs_merge; eauto with mgen. eauto with mgen. *)
+  (*     intros. repeat inv_exists. simplify. inv H18. inv H28. *)
+  (*     econstructor; simplify. apply Smallstep.plus_one. econstructor. *)
+  (*     mgen_crush. mgen_crush. mgen_crush. rewrite RAM0; eassumption. rewrite RAM0; eassumption. *)
+  (*     rewrite RAM0. eassumption. mgen_crush. eassumption. rewrite RAM0 in H21. rewrite RAM0. *)
+  (*     rewrite RAM. eassumption. eauto. eauto. eauto with mgen. eauto. *)
+  (*     econstructor. mgen_crush. apply match_arrs_merge; mgen_crush. eauto. *)
+  (*     apply match_empty_size_merge; mgen_crush; mgen_crush. *)
+  (*     assert (MATCH_SIZE1': match_empty_size m ran'0 /\ match_empty_size m rab'0). *)
+  (*     { eapply match_arrs_size_stmnt_preserved2; eauto. unfold match_empty_size; mgen_crush. } *)
+  (*     simplify. *)
+  (*     assert (MATCH_SIZE2': match_empty_size m ran'2 /\ match_empty_size m rab'2). *)
+  (*     { eapply match_arrs_size_stmnt_preserved2; mgen_crush. } simplify. *)
+  (*     assert (MATCH_SIZE2': match_empty_size m ran'4 /\ match_empty_size m rab'4). *)
+  (*     { eapply match_arrs_size_ram_preserved2; mgen_crush. *)
+  (*       unfold match_empty_size, transf_module, empty_stack. *)
+  (*       repeat destruct_match; crush. mgen_crush.  } *)
+  (*     apply match_empty_size_merge; mgen_crush; mgen_crush. *)
+  (*     unfold disable_ram. *)
+  (*     unfold transf_module; repeat destruct_match; crush. *)
+  (*     apply exec_ram_resets_en in H21. unfold merge_reg_assocs in H21. *)
+  (*     simplify. auto. auto. *)
+  (*   - eapply translation_correct; eauto. *)
+  (*   - do 2 econstructor. apply Smallstep.plus_one. *)
+  (*     apply step_finish; mgen_crush. constructor; eauto. *)
+  (*   - do 2 econstructor. apply Smallstep.plus_one. *)
+  (*     apply step_finish; mgen_crush. econstructor; eauto. *)
+  (*   - econstructor. econstructor. apply Smallstep.plus_one. econstructor. *)
+  (*     replace (mod_entrypoint (transf_module m)) with (mod_entrypoint m) by (rewrite RAM0; auto). *)
+  (*     replace (mod_reset (transf_module m)) with (mod_reset m) by (rewrite RAM0; auto). *)
+  (*     replace (mod_finish (transf_module m)) with (mod_finish m) by (rewrite RAM0; auto). *)
+  (*     replace (empty_stack (transf_module m)) with (empty_stack m) by (rewrite RAM0; auto). *)
+  (*     replace (mod_params (transf_module m)) with (mod_params m) by (rewrite RAM0; auto). *)
+  (*     replace (mod_st (transf_module m)) with (mod_st m) by (rewrite RAM0; auto). *)
+  (*     repeat econstructor; mgen_crush. *)
+  (*     unfold disable_ram. unfold transf_module; repeat destruct_match; crush. *)
+  (*     pose proof (mod_ordering_wf m); unfold module_ordering in *. *)
+  (*     pose proof (mod_params_wf m). *)
+  (*     pose proof (mod_ram_wf m r Heqo0). *)
+  (*     pose proof (ram_ordering r). *)
+  (*     simplify. *)
+  (*     repeat rewrite find_assocmap_gso by lia. *)
+  (*     assert ((init_regs nil (mod_params m)) ! (ram_en r) = None). *)
+  (*     { apply init_regs_equal_empty. eapply forall_lt_num. eassumption. lia. } *)
+  (*     assert ((init_regs nil (mod_params m)) ! (ram_u_en r) = None). *)
+  (*     { apply init_regs_equal_empty. eapply forall_lt_num. eassumption. lia. } *)
+  (*     unfold find_assocmap, AssocMapExt.get_default. rewrite H7. rewrite H14. auto. *)
+  (*   - econstructor. econstructor. apply Smallstep.plus_one. econstructor. *)
+  (*     replace (mod_entrypoint (transf_module m)) with (mod_entrypoint m). *)
+  (*     replace (mod_reset (transf_module m)) with (mod_reset m). *)
+  (*     replace (mod_finish (transf_module m)) with (mod_finish m). *)
+  (*     replace (empty_stack (transf_module m)) with (empty_stack m). *)
+  (*     replace (mod_params (transf_module m)) with (mod_params m). *)
+  (*     replace (mod_st (transf_module m)) with (mod_st m). *)
+  (*     all: try solve [unfold transf_module; repeat destruct_match; mgen_crush]. *)
+  (*     repeat econstructor; mgen_crush. *)
+  (*     unfold disable_ram. unfold transf_module; repeat destruct_match; crush. *)
+  (*     unfold max_reg_module. *)
+  (*     repeat rewrite find_assocmap_gso by lia. *)
+  (*     assert (max_reg_module m + 1 > max_list (mod_params m)). *)
+  (*     { unfold max_reg_module. lia. } *)
+  (*     apply max_list_correct in H0. *)
+  (*     unfold find_assocmap, AssocMapExt.get_default. *)
+  (*     rewrite init_regs_equal_empty. rewrite init_regs_equal_empty. auto. *)
+  (*     eapply forall_lt_num. eassumption. unfold max_reg_module. lia. *)
+  (*     eapply forall_lt_num. eassumption. unfold max_reg_module. lia. *)
+  (*   - inv STACKS. destruct b1; subst. *)
+  (*     econstructor. econstructor. apply Smallstep.plus_one. *)
+  (*     econstructor. eauto. *)
+  (*     clear Learn. inv H0. inv H3. inv STACKS. inv H3. constructor. *)
+  (*     constructor. intros. *)
+  (*     rewrite RAM0. *)
+  (*     destruct (Pos.eq_dec r res); subst. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. auto. *)
+  (*     rewrite AssocMap.gso; auto. *)
+  (*     symmetry. rewrite AssocMap.gso; auto. *)
+  (*     destruct (Pos.eq_dec (mod_st m) r); subst. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. auto. *)
+  (*     rewrite AssocMap.gso; auto. *)
+  (*     symmetry. rewrite AssocMap.gso; auto. inv MATCH_ASSOC0. apply H1. auto. *)
+  (*     auto. auto. auto. auto. *)
+  (*     rewrite RAM0. rewrite RAM. rewrite RAM0 in DISABLE_RAM. rewrite RAM in DISABLE_RAM. *)
+  (*     apply disable_ram_set_gso. *)
+  (*     apply disable_ram_set_gso. auto. *)
+  (*     pose proof (mod_ordering_wf m); unfold module_ordering in *. *)
+  (*     pose proof (ram_ordering r0). simplify. *)
+  (*     pose proof (mod_ram_wf m r0 H). lia. *)
+  (*     pose proof (mod_ordering_wf m); unfold module_ordering in *. *)
+  (*     pose proof (ram_ordering r0). simplify. *)
+  (*     pose proof (mod_ram_wf m r0 H). lia. *)
+  (*     pose proof (mod_ordering_wf m); unfold module_ordering in *. *)
+  (*     pose proof (ram_ordering r0). simplify. *)
+  (*     pose proof (mod_ram_wf m r0 H). lia. *)
+  (*     pose proof (mod_ordering_wf m); unfold module_ordering in *. *)
+  (*     pose proof (ram_ordering r0). simplify. *)
+  (*     pose proof (mod_ram_wf m r0 H). lia. *)
+  (*   - inv STACKS. destruct b1; subst. *)
+  (*     econstructor. econstructor. apply Smallstep.plus_one. *)
+  (*     econstructor. eauto. *)
+  (*     clear Learn. inv H0. inv H3. inv STACKS. constructor. *)
+  (*     constructor. intros. *)
+  (*     unfold transf_module. repeat destruct_match; crush. *)
+  (*     destruct (Pos.eq_dec r res); subst. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. auto. *)
+  (*     rewrite AssocMap.gso; auto. *)
+  (*     symmetry. rewrite AssocMap.gso; auto. *)
+  (*     destruct (Pos.eq_dec (mod_st m) r); subst. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. auto. *)
+  (*     rewrite AssocMap.gso; auto. *)
+  (*     symmetry. rewrite AssocMap.gso; auto. inv MATCH_ASSOC. apply H. auto. *)
+  (*     auto. auto. auto. auto. *)
+  (*     Opaque disable_ram. *)
+  (*     unfold transf_module in *; repeat destruct_match; crush. *)
+  (*     apply disable_ram_set_gso. *)
+  (*     apply disable_ram_set_gso. *)
+  (*     auto. *)
+  (*     simplify. unfold max_reg_module. lia. *)
+  (*     simplify. unfold max_reg_module. lia. *)
+  (*     simplify. unfold max_reg_module. lia. *)
+  (*     simplify. unfold max_reg_module. lia. *)
+  (* Qed. *)
+  (* #[local] Hint Resolve transf_step_correct : mgen. *)
+
+  (* Lemma transf_initial_states : *)
+  (*   forall s1 : state, *)
+  (*     initial_state prog s1 -> *)
+  (*     exists s2 : state, *)
+  (*       initial_state tprog s2 /\ match_states s1 s2. *)
+  (* Proof using TRANSL. *)
+  (*   simplify. inv H. *)
+  (*   exploit function_ptr_translated. eauto. intros. *)
+  (*   inv H. inv H3. *)
+  (*   econstructor. econstructor. econstructor. *)
+  (*   eapply (Genv.init_mem_match TRANSL); eauto. *)
+  (*   setoid_rewrite (Linking.match_program_main TRANSL). *)
+  (*   rewrite symbols_preserved. eauto. *)
+  (*   eauto. *)
+  (*   econstructor. *)
+  (* Qed. *)
+  (* #[local] Hint Resolve transf_initial_states : mgen. *)
+
+  (* Lemma transf_final_states : *)
+  (*   forall (s1 : state) *)
+  (*          (s2 : state) *)
+  (*          (r : Int.int), *)
+  (*     match_states s1 s2 -> *)
+  (*     final_state s1 r -> *)
+  (*     final_state s2 r. *)
+  (* Proof using TRANSL. *)
+  (*   intros. inv H0. inv H. inv STACKS. unfold valueToInt. constructor. auto. *)
+  (* Qed. *)
+  (* #[local] Hint Resolve transf_final_states : mgen. *)
+
+  Theorem transf_program_correct:
+    Smallstep.forward_simulation (semantics prog) (semantics tprog).
+  Proof using TRANSL.
+  (*   eapply Smallstep.forward_simulation_plus; mgen_crush. *)
+  (*   apply senv_preserved. *)
+  (* Qed. *) Admitted.
+
+End CORRECTNESS.
diff --git a/src/hls/DVeriloggen.v b/src/hls/DVeriloggen.v
new file mode 100644
index 0000000..3f8a0b7
--- /dev/null
+++ b/src/hls/DVeriloggen.v
@@ -0,0 +1,101 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2020 Yann Herklotz <yann@yannherklotz.com>
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ *)
+
+Require Import compcert.common.AST.
+Require compcert.common.Errors.
+Require Import compcert.lib.Maps.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.AssocMap.
+Require Import vericert.hls.DHTL.
+Require Import vericert.hls.ValueInt.
+Require Import vericert.hls.Verilog.
+
+Definition transl_list_fun (a : node * Verilog.stmnt) :=
+  let (n, stmnt) := a in
+  (Vlit (posToValue n), stmnt).
+
+Definition transl_list st := map transl_list_fun st.
+
+Definition scl_to_Vdecl_fun (a : reg * (option io * scl_decl)) :=
+  match a with (r, (io, VScalar sz)) => (Vdecl io r sz) end.
+
+Definition scl_to_Vdecl scldecl := map scl_to_Vdecl_fun scldecl.
+
+Definition arr_to_Vdeclarr_fun (a : reg * (option io * arr_decl)) :=
+  match a with (r, (io, VArray sz l)) => (Vdeclarr io r sz l) end.
+
+Definition arr_to_Vdeclarr arrdecl := map arr_to_Vdeclarr_fun arrdecl.
+
+Definition inst_ram clk ram :=
+  Valways (Vnegedge clk)
+          (Vcond (Vbinop Vne (Vvar (ram_u_en ram)) (Vvar (ram_en ram)))
+                 (Vseq (Vcond (Vvar (ram_wr_en ram))
+                              (Vnonblock (Vvari (ram_mem ram) (Vvar (ram_addr ram)))
+                                         (Vvar (ram_d_in ram)))
+                              (Vnonblock (Vvar (ram_d_out ram))
+                                         (Vvari (ram_mem ram) (Vvar (ram_addr ram)))))
+                       (Vnonblock (Vvar (ram_en ram)) (Vvar (ram_u_en ram))))
+                 Vskip).
+
+Definition transl_module (m : DHTL.module) : Verilog.module :=
+  let case_el_data := list_to_stmnt (transl_list (PTree.elements m.(mod_datapath))) in
+  match m.(DHTL.mod_ram) with
+  | Some ram =>
+    let body :=
+        Valways (Vposedge m.(DHTL.mod_clk)) (Vcond (Vbinop Veq (Vvar m.(DHTL.mod_reset)) (Vlit (ZToValue 1)))
+                                                  (Vnonblock (Vvar m.(DHTL.mod_st)) (Vlit (posToValue m.(DHTL.mod_entrypoint))))
+(Vcase (Vvar m.(DHTL.mod_st)) case_el_data (Some Vskip)))
+                :: inst_ram m.(DHTL.mod_clk) ram
+                :: List.map Vdeclaration (arr_to_Vdeclarr (AssocMap.elements m.(mod_arrdecls))
+                                                          ++ scl_to_Vdecl (AssocMap.elements m.(mod_scldecls))) in
+    Verilog.mkmodule m.(DHTL.mod_start)
+                     m.(DHTL.mod_reset)
+                     m.(DHTL.mod_clk)
+                     m.(DHTL.mod_finish)
+                     m.(DHTL.mod_return)
+                     m.(DHTL.mod_st)
+                     m.(DHTL.mod_stk)
+                     m.(DHTL.mod_stk_len)
+                     m.(DHTL.mod_params)
+                     body
+                     m.(DHTL.mod_entrypoint)
+  | None =>
+    let body :=
+        Valways (Vposedge m.(DHTL.mod_clk)) (Vcond (Vbinop Veq (Vvar m.(DHTL.mod_reset)) (Vlit (ZToValue 1)))
+                                                  (Vnonblock (Vvar m.(DHTL.mod_st)) (Vlit (posToValue m.(DHTL.mod_entrypoint))))
+(Vcase (Vvar m.(DHTL.mod_st)) case_el_data (Some Vskip)))
+                :: List.map Vdeclaration (arr_to_Vdeclarr (AssocMap.elements m.(mod_arrdecls))
+                                                          ++ scl_to_Vdecl (AssocMap.elements m.(mod_scldecls))) in
+    Verilog.mkmodule m.(DHTL.mod_start)
+                     m.(DHTL.mod_reset)
+                     m.(DHTL.mod_clk)
+                     m.(DHTL.mod_finish)
+                     m.(DHTL.mod_return)
+                     m.(DHTL.mod_st)
+                     m.(DHTL.mod_stk)
+                     m.(DHTL.mod_stk_len)
+                     m.(DHTL.mod_params)
+                     body
+                     m.(DHTL.mod_entrypoint)
+  end.
+
+Definition transl_fundef := transf_fundef transl_module.
+
+Definition transl_program (p: DHTL.program) : Verilog.program :=
+  transform_program transl_fundef p.
diff --git a/src/hls/DVeriloggenproof.v b/src/hls/DVeriloggenproof.v
new file mode 100644
index 0000000..31cdfca
--- /dev/null
+++ b/src/hls/DVeriloggenproof.v
@@ -0,0 +1,544 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2020 Yann Herklotz <yann@yannherklotz.com>
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ *)
+
+From compcert Require Import Smallstep Linking Integers Globalenvs.
+From vericert Require HTL.
+From vericert Require Import Vericertlib DVeriloggen Verilog ValueInt AssocMap.
+Require Import Lia.
+
+Local Open Scope assocmap.
+
+Definition match_prog (prog : DHTL.program) (tprog : Verilog.program) :=
+  match_program (fun cu f tf => tf = transl_fundef f) eq prog tprog.
+
+Lemma transf_program_match:
+  forall prog, match_prog prog (transl_program prog).
+Proof.
+  intros. eapply match_transform_program_contextual. auto.
+Qed.
+
+Inductive match_stacks : list DHTL.stackframe -> list stackframe -> Prop :=
+| match_stack :
+    forall res m pc reg_assoc arr_assoc hstk vstk,
+      match_stacks hstk vstk ->
+      match_stacks (DHTL.Stackframe res m pc reg_assoc arr_assoc :: hstk)
+                   (Stackframe res (transl_module m) pc
+                                       reg_assoc arr_assoc :: vstk)
+| match_stack_nil : match_stacks nil nil.
+
+Inductive match_states : DHTL.state -> state -> Prop :=
+| match_state :
+    forall m st reg_assoc arr_assoc hstk vstk,
+      match_stacks hstk vstk ->
+      match_states (DHTL.State hstk m st reg_assoc arr_assoc)
+                   (State vstk (transl_module m) st reg_assoc arr_assoc)
+| match_returnstate :
+    forall v hstk vstk,
+      match_stacks hstk vstk ->
+      match_states (DHTL.Returnstate hstk v) (Returnstate vstk v)
+| match_initial_call :
+    forall m,
+      match_states (DHTL.Callstate nil m nil) (Callstate nil (transl_module m) nil).
+
+Lemma Vlit_inj :
+  forall a b, Vlit a = Vlit b -> a = b.
+Proof. inversion 1. trivial. Qed.
+
+Lemma posToValue_inj :
+  forall a b,
+    0 <= Z.pos a <= Int.max_unsigned ->
+    0 <= Z.pos b <= Int.max_unsigned ->
+    posToValue a = posToValue b ->
+    a = b.
+Proof.
+  intros. rewrite <- Pos2Z.id at 1. rewrite <- Pos2Z.id.
+  rewrite <- Int.unsigned_repr at 1; try assumption.
+  symmetry.
+  rewrite <- Int.unsigned_repr at 1; try assumption.
+  unfold posToValue in *. rewrite H1; auto.
+Qed.
+
+Lemma valueToPos_inj :
+  forall a b,
+    0 < Int.unsigned a ->
+    0 < Int.unsigned b ->
+    valueToPos a = valueToPos b ->
+    a = b.
+Proof.
+  intros. unfold valueToPos in *.
+  rewrite <- Int.repr_unsigned at 1.
+  rewrite <- Int.repr_unsigned.
+  apply Pos2Z.inj_iff in H1.
+  rewrite Z2Pos.id in H1; auto.
+  rewrite Z2Pos.id in H1; auto.
+  rewrite H1. auto.
+Qed.
+
+Lemma unsigned_posToValue_le :
+  forall p,
+    Z.pos p <= Int.max_unsigned ->
+    0 < Int.unsigned (posToValue p).
+Proof.
+  intros. unfold posToValue. rewrite Int.unsigned_repr; lia.
+Qed.
+
+Lemma transl_list_fun_fst :
+  forall p1 p2 a b,
+    0 <= Z.pos p1 <= Int.max_unsigned ->
+    0 <= Z.pos p2 <= Int.max_unsigned ->
+    transl_list_fun (p1, a) = transl_list_fun (p2, b) ->
+    (p1, a) = (p2, b).
+Proof.
+  intros. unfold transl_list_fun in H1. apply pair_equal_spec in H1.
+  destruct H1. rewrite H2. apply Vlit_inj in H1.
+  apply posToValue_inj in H1; try assumption.
+  rewrite H1; auto.
+Qed.
+
+Lemma Zle_relax :
+  forall p q r,
+  p < q <= r ->
+  p <= q <= r.
+Proof. lia. Qed.
+#[local] Hint Resolve Zle_relax : verilogproof.
+
+Lemma transl_in :
+  forall l p,
+  0 <= Z.pos p <= Int.max_unsigned ->
+  (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+  In (Vlit (posToValue p)) (map fst (map transl_list_fun l)) ->
+  In p (map fst l).
+Proof.
+  induction l.
+  - simplify. auto.
+  - intros. destruct a. simplify. destruct (peq p0 p); auto.
+    right. inv H1. apply Vlit_inj in H. apply posToValue_inj in H; auto. contradiction.
+    auto with verilogproof.
+    apply IHl; auto.
+Qed.
+
+Lemma transl_notin :
+  forall l p,
+    0 <= Z.pos p <= Int.max_unsigned ->
+    (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+    ~ In p (List.map fst l) -> ~ In (Vlit (posToValue p)) (List.map fst (transl_list l)).
+Proof.
+  induction l; auto. intros. destruct a. unfold not in *. intros.
+  simplify.
+  destruct (peq p0 p). apply H1. auto. apply H1.
+  unfold transl_list in *. inv H2. apply Vlit_inj in H. apply posToValue_inj in H.
+  contradiction.
+  auto with verilogproof. auto.
+  right. apply transl_in; auto.
+Qed.
+
+Lemma transl_norepet :
+  forall l,
+    (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+    list_norepet (List.map fst l) -> list_norepet (List.map fst (transl_list l)).
+Proof.
+  induction l.
+  - intros. simpl. apply list_norepet_nil.
+  - destruct a. intros. simpl. apply list_norepet_cons.
+    inv H0. apply transl_notin. apply Zle_relax. apply H. simplify; auto.
+    intros. apply H. destruct (peq p0 p); subst; simplify; auto.
+    assumption. apply IHl. intros. apply H. destruct (peq p0 p); subst; simplify; auto.
+    simplify. inv H0. assumption.
+Qed.
+
+Lemma transl_list_correct :
+  forall l v ev f asr asa asrn asan asr' asa' asrn' asan',
+    (forall p0, In p0 (List.map fst l) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+    list_norepet (List.map fst l) ->
+    asr!ev = Some v ->
+    (forall p s,
+        In (p, s) l ->
+        v = posToValue p ->
+        stmnt_runp f
+                   {| assoc_blocking := asr; assoc_nonblocking := asrn |}
+                   {| assoc_blocking := asa; assoc_nonblocking := asan |}
+                   s
+                   {| assoc_blocking := asr'; assoc_nonblocking := asrn' |}
+                   {| assoc_blocking := asa'; assoc_nonblocking := asan' |} ->
+        stmnt_runp f
+                   {| assoc_blocking := asr; assoc_nonblocking := asrn |}
+                   {| assoc_blocking := asa; assoc_nonblocking := asan |}
+                   (Vcase (Vvar ev) (list_to_stmnt (transl_list l)) (Some Vskip))
+                   {| assoc_blocking := asr'; assoc_nonblocking := asrn' |}
+                   {| assoc_blocking := asa'; assoc_nonblocking := asan' |}).
+Proof.
+  induction l as [| a l IHl].
+  - contradiction.
+  - intros v ev f asr asa asrn asan asr' asa' asrn' asan' BOUND NOREP ASSOC p s IN EQ SRUN.
+    destruct a as [p' s']. simplify.
+    destruct (peq p p'); subst. eapply stmnt_runp_Vcase_match.
+    constructor. simplify. unfold AssocMap.find_assocmap, AssocMapExt.get_default.
+    rewrite ASSOC. trivial. constructor. auto.
+    inversion IN as [INV | INV]. inversion INV as [INV2]; subst. assumption.
+    inv NOREP. eapply in_map with (f := fst) in INV. contradiction.
+
+    eapply stmnt_runp_Vcase_nomatch. constructor. simplify.
+    unfold AssocMap.find_assocmap, AssocMapExt.get_default. rewrite ASSOC.
+    trivial. constructor. unfold not. intros. apply n. apply posToValue_inj.
+    apply Zle_relax. apply BOUND. right. inv IN. inv H0; contradiction.
+    eapply in_map with (f := fst) in H0. auto.
+    apply Zle_relax. apply BOUND; auto. auto.
+
+    eapply IHl. auto. inv NOREP. auto. eassumption. inv IN. inv H. contradiction. apply H.
+    trivial. assumption.
+Qed.
+#[local] Hint Resolve transl_list_correct : verilogproof.
+
+Lemma pc_wf :
+  forall A m p v,
+  (forall p0, In p0 (List.map fst (@AssocMap.elements A m)) -> 0 < Z.pos p0 <= Int.max_unsigned) ->
+  m!p = Some v ->
+  0 <= Z.pos p <= Int.max_unsigned.
+Proof.
+  intros A m p v LT S. apply Zle_relax. apply LT.
+  apply AssocMap.elements_correct in S. remember (p, v) as x.
+  exploit in_map. apply S. instantiate (1 := fst). subst. simplify. auto.
+Qed.
+
+Lemma mis_stepp_decl :
+  forall l asr asa f,
+    mis_stepp f asr asa (map Vdeclaration l) asr asa.
+Proof.
+  induction l.
+  - intros. constructor.
+  - intros. simplify. econstructor. constructor. auto.
+Qed.
+#[local] Hint Resolve mis_stepp_decl : verilogproof.
+
+Lemma mis_stepp_negedge_decl :
+  forall l asr asa f,
+    mis_stepp_negedge f asr asa (map Vdeclaration l) asr asa.
+Proof.
+  induction l.
+  - intros. constructor.
+  - intros. simplify. econstructor. constructor. auto.
+Qed.
+#[local] Hint Resolve mis_stepp_negedge_decl : verilogproof.
+
+Lemma mod_entrypoint_equiv m : mod_entrypoint (transl_module m) = DHTL.mod_entrypoint m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_st_equiv m : mod_st (transl_module m) = DHTL.mod_st m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_stk_equiv m : mod_stk (transl_module m) = DHTL.mod_stk m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_stk_len_equiv m : mod_stk_len (transl_module m) = DHTL.mod_stk_len m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_finish_equiv m : mod_finish (transl_module m) = DHTL.mod_finish m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_reset_equiv m : mod_reset (transl_module m) = DHTL.mod_reset m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_clk_equiv m : mod_clk (transl_module m) = DHTL.mod_clk m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_return_equiv m : mod_return (transl_module m) = DHTL.mod_return m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma mod_params_equiv m : mod_args (transl_module m) = DHTL.mod_params m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Lemma empty_stack_equiv m : empty_stack (transl_module m) = DHTL.empty_stack m.
+Proof. unfold transl_module; intros; destruct (DHTL.mod_ram m) eqn:?; crush. Qed.
+
+Ltac rewrite_eq := rewrite mod_return_equiv
+                   || rewrite mod_clk_equiv
+                   || rewrite mod_reset_equiv
+                   || rewrite mod_finish_equiv
+                   || rewrite mod_stk_len_equiv
+                   || rewrite mod_stk_equiv
+                   || rewrite mod_st_equiv
+                   || rewrite mod_entrypoint_equiv
+                   || rewrite mod_params_equiv
+                   || rewrite empty_stack_equiv.
+
+Lemma find_assocmap_get r i v : r ! i = Some v -> r # i = v.
+Proof.
+  intros. unfold find_assocmap, AssocMapExt.get_default. rewrite H. auto.
+Qed.
+
+Lemma ram_exec_match :
+  forall f asr asa asr' asa' r clk,
+    DHTL.exec_ram asr asa (Some r) asr' asa' ->
+    mi_stepp_negedge f asr asa (inst_ram clk r) asr' asa'.
+Proof.
+  inversion 1; subst; simplify.
+  { unfold inst_ram. econstructor.
+    eapply stmnt_runp_Vcond_false.
+    econstructor. econstructor. econstructor. auto.
+    econstructor. auto.
+    simplify.
+    unfold boolToValue, natToValue, valueToBool.
+    rewrite Int.eq_sym. rewrite H3. simplify.
+    auto. constructor. }
+  { unfold inst_ram. econstructor. econstructor. econstructor.
+    econstructor. econstructor. auto.
+    econstructor. auto.
+    simplify.
+    unfold boolToValue, natToValue, valueToBool.
+    pose proof H4 as X. apply find_assocmap_get in X.
+    rewrite X. rewrite Int.eq_sym. rewrite H1. auto.
+    econstructor. econstructor. econstructor. econstructor.
+    pose proof H5 as X. apply find_assocmap_get in X.
+    rewrite X.
+    unfold valueToBool. unfold ZToValue in *.
+    unfold Int.eq in H2.
+    unfold uvalueToZ.
+    assert (Int.unsigned wr_en =? 0 = false).
+    apply Z.eqb_neq. rewrite Int.unsigned_repr in H2 by (simplify; lia).
+    destruct (zeq (Int.unsigned wr_en) 0); crush.
+    rewrite H0. auto.
+    apply stmnt_runp_Vnonblock_arr. econstructor. econstructor. auto.
+    econstructor. econstructor.
+    apply find_assocmap_get in H9. rewrite H9.
+    apply find_assocmap_get in H6. rewrite H6.
+    repeat econstructor. apply find_assocmap_get; auto.
+  }
+  { econstructor. econstructor. econstructor. econstructor. auto.
+    econstructor. auto.
+    econstructor.
+    unfold boolToValue, natToValue, valueToBool.
+    apply find_assocmap_get in H3. rewrite H3.
+    rewrite Int.eq_sym. rewrite H1. auto.
+    econstructor.
+    eapply stmnt_runp_Vcond_false. econstructor. auto.
+    simplify. apply find_assocmap_get in H4. rewrite H4.
+    auto.
+    repeat (econstructor; auto). apply find_assocmap_get in H5.
+    rewrite H5. eassumption.
+    repeat econstructor. simplify. apply find_assocmap_get; auto.
+  }
+Qed.
+
+
+Section CORRECTNESS.
+
+  Variable prog: DHTL.program.
+  Variable tprog: program.
+
+  Hypothesis TRANSL : match_prog prog tprog.
+
+  Let ge : DHTL.genv := Globalenvs.Genv.globalenv prog.
+  Let tge : genv := Globalenvs.Genv.globalenv tprog.
+
+  Lemma symbols_preserved:
+    forall (s: AST.ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
+  Proof. intros. eapply (Genv.find_symbol_match TRANSL). Qed.
+  #[local] Hint Resolve symbols_preserved : verilogproof.
+
+  Lemma function_ptr_translated:
+    forall (b: Values.block) (f: DHTL.fundef),
+      Genv.find_funct_ptr ge b = Some f ->
+      exists tf,
+        Genv.find_funct_ptr tge b = Some tf /\ transl_fundef f = tf.
+  Proof.
+    intros. exploit (Genv.find_funct_ptr_match TRANSL); eauto.
+    intros (cu & tf & P & Q & R); exists tf; auto.
+  Qed.
+  #[local] Hint Resolve function_ptr_translated : verilogproof.
+
+  Lemma functions_translated:
+    forall (v: Values.val) (f: DHTL.fundef),
+      Genv.find_funct ge v = Some f ->
+      exists tf,
+        Genv.find_funct tge v = Some tf /\ transl_fundef f = tf.
+  Proof.
+    intros. exploit (Genv.find_funct_match TRANSL); eauto.
+    intros (cu & tf & P & Q & R); exists tf; auto.
+  Qed.
+  #[local] Hint Resolve functions_translated : verilogproof.
+
+  Lemma senv_preserved:
+    Senv.equiv (Genv.to_senv ge) (Genv.to_senv tge).
+  Proof.
+    intros. eapply (Genv.senv_match TRANSL).
+  Qed.
+  #[local] Hint Resolve senv_preserved : verilogproof.
+
+  Ltac unfold_replace :=
+    match goal with
+    | H: DHTL.mod_ram _ = _ |- context[transl_module] =>
+      unfold transl_module; rewrite H
+    end.
+
+  Theorem transl_step_correct :
+    forall (S1 : DHTL.state) t S2,
+      DHTL.step ge S1 t S2 ->
+      forall (R1 : state),
+        match_states S1 R1 ->
+        exists R2, Smallstep.plus step tge R1 t R2 /\ match_states S2 R2.
+  Proof.
+    induction 1; intros R1 MSTATE; inv MSTATE; destruct (DHTL.mod_ram m) eqn:?.
+    - econstructor; split. apply Smallstep.plus_one. econstructor.
+      unfold_replace. assumption. unfold_replace. assumption.
+      unfold_replace. eassumption. apply valueToPos_posToValue.
+      split. lia.
+  (*     eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. *)
+  (*     split. lia. apply HP. eassumption. eassumption. *)
+  (*     unfold_replace. *)
+  (*     econstructor. econstructor. eapply stmnt_runp_Vcond_false. econstructor. econstructor. *)
+  (*     simpl. unfold find_assocmap. unfold AssocMapExt.get_default. *)
+  (*     rewrite H. trivial. *)
+
+  (*     econstructor. simpl. auto. auto. *)
+
+  (*     eapply transl_list_correct. *)
+  (*     intros. split. lia. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. auto. *)
+  (*     apply Maps.PTree.elements_keys_norepet. eassumption. *)
+  (*     2: { apply valueToPos_inj. apply unsigned_posToValue_le. *)
+  (*          eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. *)
+  (*          apply unsigned_posToValue_le. eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. *)
+  (*          destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. trivial. *)
+  (*     } *)
+  (*     apply Maps.PTree.elements_correct. eassumption. eassumption. *)
+
+  (*     econstructor. econstructor. *)
+
+  (*     eapply transl_list_correct. *)
+  (*     intros. split. lia. pose proof (DHTL.mod_wf m) as HP. destruct HP as [_ HP]. *)
+  (*     auto. apply Maps.PTree.elements_keys_norepet. eassumption. *)
+  (*     2: { apply valueToPos_inj. apply unsigned_posToValue_le. *)
+  (*          eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. *)
+  (*          apply unsigned_posToValue_le. eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. *)
+  (*          destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. trivial. *)
+  (*     } *)
+  (*     apply Maps.PTree.elements_correct. eassumption. eassumption. *)
+  (*     econstructor. econstructor. *)
+  (*     apply mis_stepp_decl. simplify. unfold_replace. simplify. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+  (*     econstructor. *)
+  (*     apply ram_exec_match. eauto. *)
+  (*     apply mis_stepp_negedge_decl. simplify. auto. auto. *)
+  (*     rewrite_eq. eauto. auto. *)
+  (*     rewrite valueToPos_posToValue. econstructor. auto. *)
+  (*     simplify; lia. *)
+  (*   - inv H7. econstructor; split. apply Smallstep.plus_one. econstructor. *)
+  (*     unfold_replace. assumption. unfold_replace. assumption. *)
+  (*     unfold_replace. eassumption. apply valueToPos_posToValue. *)
+  (*     split. lia. *)
+  (*     eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. *)
+  (*     split. lia. apply HP. eassumption. eassumption. *)
+  (*     unfold_replace. *)
+  (*     econstructor. econstructor. eapply stmnt_runp_Vcond_false. econstructor. econstructor. *)
+  (*     simpl. unfold find_assocmap. unfold AssocMapExt.get_default. *)
+  (*     rewrite H. trivial. *)
+
+  (*     econstructor. simpl. auto. auto. *)
+
+  (*     eapply transl_list_correct. *)
+  (*     intros. split. lia. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. auto. *)
+  (*     apply Maps.PTree.elements_keys_norepet. eassumption. *)
+  (*     2: { apply valueToPos_inj. apply unsigned_posToValue_le. *)
+  (*          eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. *)
+  (*          apply unsigned_posToValue_le. eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. *)
+  (*          destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. trivial. *)
+  (*     } *)
+  (*     apply Maps.PTree.elements_correct. eassumption. eassumption. *)
+
+  (*     econstructor. econstructor. *)
+
+  (*     eapply transl_list_correct. *)
+  (*     intros. split. lia. pose proof (DHTL.mod_wf m) as HP. *)
+  (*     destruct HP as [_ HP]; auto. *)
+  (*     apply Maps.PTree.elements_keys_norepet. eassumption. *)
+  (*     2: { apply valueToPos_inj. apply unsigned_posToValue_le. *)
+  (*          eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. *)
+  (*          apply unsigned_posToValue_le. eapply pc_wf. intros. pose proof (DHTL.mod_wf m) as HP. *)
+  (*          destruct HP as [HP _]. *)
+  (*          split. lia. apply HP. eassumption. eassumption. trivial. *)
+  (*     } *)
+  (*     apply Maps.PTree.elements_correct. eassumption. eassumption. *)
+
+  (*     apply mis_stepp_decl. simplify. *)
+  (*     unfold_replace. *)
+  (*     repeat econstructor. apply mis_stepp_negedge_decl. trivial. trivial. *)
+  (*     simpl. unfold_replace. eassumption. auto. simplify. *)
+  (*     rewrite valueToPos_posToValue. constructor; eassumption. simplify; lia. *)
+  (*   - econstructor; split. apply Smallstep.plus_one. apply step_finish. *)
+  (*     rewrite_eq. assumption. *)
+  (*     rewrite_eq. eassumption. *)
+  (*     econstructor; auto. *)
+  (*   - econstructor; split. apply Smallstep.plus_one. apply step_finish. *)
+  (*     unfold transl_module. rewrite Heqo. simplify. *)
+  (*     assumption. unfold_replace. eassumption. *)
+  (*     constructor; assumption. *)
+  (*   - econstructor; split. apply Smallstep.plus_one. constructor. *)
+  (*     repeat rewrite_eq. constructor. constructor. *)
+  (*   - econstructor; split. apply Smallstep.plus_one. constructor. *)
+  (*     repeat rewrite_eq. constructor. constructor. *)
+  (*   - inv H3. econstructor; split. apply Smallstep.plus_one. constructor. trivial. *)
+  (*     repeat rewrite_eq. apply match_state. assumption. *)
+  (*   - inv H3. econstructor; split. apply Smallstep.plus_one. constructor. trivial. *)
+  (*     repeat rewrite_eq. apply match_state. assumption. *)
+  (* Qed. *) Admitted.
+  #[local] Hint Resolve transl_step_correct : verilogproof.
+
+  Lemma transl_initial_states :
+    forall s1 : Smallstep.state (DHTL.semantics prog),
+      Smallstep.initial_state (DHTL.semantics prog) s1 ->
+      exists s2 : Smallstep.state (Verilog.semantics tprog),
+        Smallstep.initial_state (Verilog.semantics tprog) s2 /\ match_states s1 s2.
+  Proof.
+    induction 1.
+    econstructor; split. econstructor.
+    apply (Genv.init_mem_transf TRANSL); eauto.
+    rewrite symbols_preserved.
+    replace (AST.prog_main tprog) with (AST.prog_main prog); eauto.
+    symmetry; eapply Linking.match_program_main; eauto.
+    exploit function_ptr_translated; eauto. intros [tf [A B]].
+    inv B. eauto.
+    constructor.
+  Qed.
+  #[local] Hint Resolve transl_initial_states : verilogproof.
+
+  Lemma transl_final_states :
+    forall (s1 : Smallstep.state (DHTL.semantics prog))
+           (s2 : Smallstep.state (Verilog.semantics tprog))
+           (r : Integers.Int.int),
+      match_states s1 s2 ->
+      Smallstep.final_state (DHTL.semantics prog) s1 r ->
+      Smallstep.final_state (Verilog.semantics tprog) s2 r.
+  Proof.
+    intros. inv H0. inv H. inv H3. constructor. reflexivity.
+  Qed.
+  #[local] Hint Resolve transl_final_states : verilogproof.
+
+  Theorem transf_program_correct:
+    forward_simulation (DHTL.semantics prog) (Verilog.semantics tprog).
+  Proof.
+    eapply Smallstep.forward_simulation_plus; eauto with verilogproof.
+    apply senv_preserved.
+  Qed.
+
+End CORRECTNESS.
diff --git a/src/hls/FunctionalUnits.v b/src/hls/FunctionalUnits.v
index dcbe22f..e94b8e8 100644
--- a/src/hls/FunctionalUnits.v
+++ b/src/hls/FunctionalUnits.v
@@ -52,11 +52,13 @@ Record ram := mk_ram {
   ram_wr_en: reg;
   ram_d_in: reg;
   ram_d_out: reg;
+  ram_ordering: (ram_addr < ram_en
+                 /\ ram_en < ram_d_in
+                 /\ ram_d_in < ram_d_out
+                 /\ ram_d_out < ram_wr_en
+                 /\ ram_wr_en < ram_u_en)
 }.
 
-Definition all_ram_regs r :=
-  ram_mem r::ram_en r::ram_u_en r::ram_addr r::ram_wr_en r::ram_d_in r::ram_d_out r::nil.
-
 Inductive funct_unit: Type :=
 | SignedDiv: divider true -> funct_unit
 | UnsignedDiv: divider false -> funct_unit
@@ -75,80 +77,6 @@ Record resources := mk_resources {
   res_arch: arch;
 }.
 
-Definition index_div {b:bool} r (d: divider b) :=
-  match r with
-  | 1 => div_numer d
-  | 2 => div_denom d
-  | 3 => div_quot d
-  | _ => div_rem d
-  end.
-
-Definition index_ram r (d: ram) :=
-  match r with
-  | 1 => ram_mem d
-  | 2 => ram_en d
-  | 3 => ram_u_en d
-  | 4 => ram_addr d
-  | 5 => ram_wr_en d
-  | 6 => ram_d_in d
-  | _ => ram_d_out d
-  end.
-
-Definition index_res u r res :=
-  match PTree.get u res with
-  | Some (SignedDiv d) => Some (index_div r d)
-  | Some (UnsignedDiv d) => Some (index_div r d)
-  | Some (Ram d) => Some (index_ram r d)
-  | None => None
-  end.
-
-Definition get_ram n res: option (positive * ram) :=
-  match nth_error (arch_ram (res_arch res)) n with
-  | Some ri =>
-      match PTree.get ri (res_funct_units res) with
-      | Some (Ram r) => Some (ri, r)
-      | _ => None
-      end
-  | None => None
-  end.
-
-Definition get_div n res :=
-  match nth_error (arch_div (res_arch res)) n with
-  | Some ri =>
-      match PTree.get ri (res_funct_units res) with
-      | Some (UnsignedDiv d) => Some (ri, d)
-      | _ => None
-      end
-  | None => None
-  end.
-
-Definition get_sdiv n res :=
-  match nth_error (arch_sdiv (res_arch res)) n with
-  | Some ri =>
-      match PTree.get ri (res_funct_units res) with
-      | Some (SignedDiv d) => Some (ri, d)
-      | _ => None
-      end
-  | None => None
-  end.
-
-Definition set_res fu res :=
-  let max := ((fold_left Pos.max ((arch_sdiv (res_arch res))
-                                  ++ (arch_div (res_arch res))
-                                  ++ (arch_ram (res_arch res))) 1) + 1)%positive in
-  let nt := PTree.set max fu (res_funct_units res) in
-  match fu with
-  | UnsignedDiv _ => mk_resources nt (mk_arch (max :: arch_div (res_arch res))
-                                              (arch_sdiv (res_arch res))
-                                              (arch_ram (res_arch res)))
-  | SignedDiv _ => mk_resources nt (mk_arch (arch_div (res_arch res))
-                                            (max :: arch_sdiv (res_arch res))
-                                            (arch_ram (res_arch res)))
-  | Ram _ => mk_resources nt (mk_arch (arch_div (res_arch res))
-                                      (arch_sdiv (res_arch res))
-                                      (max :: arch_ram (res_arch res)))
-  end.
-
 Definition initial_funct_units: funct_units := PTree.empty _.
 
 Definition initial_arch := mk_arch nil nil nil.
@@ -162,22 +90,3 @@ Definition funct_unit_stages (f: funct_unit) : positive :=
   | UnsignedDiv d => div_stages d
   | _ => 1
   end.
-
-Definition max_reg_ram r :=
-  fold_right Pos.max 1 (ram_mem r::ram_en r::ram_u_en r::ram_addr r
-                                ::ram_wr_en r::ram_d_in r::ram_d_out r::nil).
-
-Definition max_reg_divider {b: bool} (d: divider b) :=
-  fold_right Pos.max 1 (div_numer d::div_denom d::div_quot d::div_rem d::nil).
-
-Definition max_reg_fu fu :=
-  match fu with
-  | SignedDiv d | UnsignedDiv d => max_reg_divider d
-  | Ram r => max_reg_ram r
-  end.
-
-Definition max_reg_funct_units r :=
-  PTree.fold (fun m _ a => Pos.max m (max_reg_fu a)) r 1.
-
-Definition max_reg_resources r :=
-  max_reg_funct_units r.(res_funct_units).
diff --git a/src/hls/GiblePargen.v b/src/hls/GiblePargen.v
index 57e067d..e3cfcda 100644
--- a/src/hls/GiblePargen.v
+++ b/src/hls/GiblePargen.v
@@ -268,10 +268,10 @@ Definition update (fop : pred_op * forest) (i : instr): option (pred_op * forest
            → from_predicated true f.(forest_preds) predicated)
         ∧ (from_pred_op f.(forest_preds) (¬ (dfltp p') ∨ ¬ pred) → (f #p p))
       in
-      do _ <- assert_ (check_mutexcl pred_expr_dec predicated);
-      do _ <- assert_ (predicated_not_in_forest p f);
-      do _ <- assert_ (is_initial_pred_and_notin f p pred);
-      do _ <- assert_ (match sat_pred_simple (¬ from_predicated_inv predicated) with None => true | Some _ => false end);
+      do _t1 <- assert_ (check_mutexcl pred_expr_dec predicated);
+      do _t2 <- assert_ (predicated_not_in_forest p f);
+      do _t3 <- assert_ (is_initial_pred_and_notin f p pred);
+      do _t4 <- assert_ (match sat_pred_simple (¬ from_predicated_inv predicated) with None => true | Some _ => false end);
       Some (pred, f #p p <- new_pred)
   | RBexit p c =>
       let new_p := simplify (negate (dfltp p) ∧ pred) in
diff --git a/src/hls/HTL.v b/src/hls/HTL.v
index 4e3687a..8cebbfd 100644
--- a/src/hls/HTL.v
+++ b/src/hls/HTL.v
@@ -28,21 +28,18 @@ Require Import compcert.lib.Integers.
 Require Import compcert.lib.Maps.
 
 Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.ValueInt.
+Require Import vericert.hls.AssocMap.
 Require Import vericert.hls.Array.
-Require Import vericert.hls.FunctionalUnits.
 Require vericert.hls.Verilog.
-Require Import AssocMap.
-Require Import ValueInt.
 
 Local Open Scope positive.
 
-(*|
-The purpose of the hardware transfer language (HTL) is to create a more
+(** The purpose of the hardware transfer language (HTL) is to create a more
 hardware-like layout that is still similar to the register transfer language
 (RTL) that it came from. The main change is that function calls become module
 instantiations and that we now describe a state machine instead of a
-control-flow graph.
-|*)
+control-flow graph. *)
 
 Local Open Scope assocmap.
 
@@ -57,6 +54,24 @@ Definition map_well_formed {A : Type} (m : PTree.t A) : Prop :=
     In p0 (map fst (Maps.PTree.elements m)) ->
     (Z.pos p0 <= Integers.Int.max_unsigned)%Z.
 
+Record ram := mk_ram {
+  ram_size: nat;
+  ram_mem: reg;
+  ram_en: reg;
+  ram_u_en: reg;
+  ram_addr: reg;
+  ram_wr_en: reg;
+  ram_d_in: reg;
+  ram_d_out: reg;
+  ram_ordering: (ram_addr < ram_en
+                 /\ ram_en < ram_d_in
+                 /\ ram_d_in < ram_d_out
+                 /\ ram_d_out < ram_wr_en
+                 /\ ram_wr_en < ram_u_en)
+}.
+
+Definition module_ordering a b c d e f g := a < b < c /\ c < d < e /\ e < f < g.
+
 Record module: Type :=
   mkmodule {
     mod_params : list reg;
@@ -64,6 +79,8 @@ Record module: Type :=
     mod_controllogic : controllogic;
     mod_entrypoint : node;
     mod_st : reg;
+    mod_stk : reg;
+    mod_stk_len : nat;
     mod_finish : reg;
     mod_return : reg;
     mod_start : reg;
@@ -71,7 +88,11 @@ Record module: Type :=
     mod_clk : reg;
     mod_scldecls : AssocMap.t (option Verilog.io * Verilog.scl_decl);
     mod_arrdecls : AssocMap.t (option Verilog.io * Verilog.arr_decl);
-    mod_ram : ram;
+    mod_ram : option ram;
+    mod_wf : map_well_formed mod_controllogic /\ map_well_formed mod_datapath;
+    mod_ordering_wf : module_ordering mod_st mod_finish mod_return mod_stk mod_start mod_reset mod_clk;
+    mod_ram_wf : forall r', mod_ram = Some r' -> mod_clk < ram_addr r';
+    mod_params_wf : Forall (Pos.gt mod_st) mod_params;
   }.
 
 Definition fundef := AST.fundef module.
@@ -85,12 +106,9 @@ Fixpoint init_regs (vl : list value) (rl : list reg) {struct rl} :=
   end.
 
 Definition empty_stack (m : module) : Verilog.assocmap_arr :=
-  (AssocMap.set m.(mod_ram).(ram_mem) (Array.arr_repeat None m.(mod_ram).(ram_size)) (AssocMap.empty Verilog.arr)).
+  (AssocMap.set m.(mod_stk) (Array.arr_repeat None m.(mod_stk_len)) (AssocMap.empty Verilog.arr)).
 
-(*|
-Operational Semantics
-=====================
-|*)
+(** * Operational Semantics *)
 
 Definition genv := Globalenvs.Genv.t fundef unit.
 
@@ -119,13 +137,13 @@ Inductive state : Type :=
            (args : list value), state.
 
 Inductive exec_ram:
-  Verilog.reg_associations -> Verilog.arr_associations -> ram ->
+  Verilog.reg_associations -> Verilog.arr_associations -> option ram ->
   Verilog.reg_associations -> Verilog.arr_associations -> Prop :=
 | exec_ram_Some_idle:
     forall ra ar r,
       Int.eq (Verilog.assoc_blocking ra)#(ram_en r, 32)
              (Verilog.assoc_blocking ra)#(ram_u_en r, 32) = true ->
-      exec_ram ra ar r ra ar
+      exec_ram ra ar (Some r) ra ar
 | exec_ram_Some_write:
     forall ra ar r d_in addr en wr_en u_en,
       Int.eq en u_en = false ->
@@ -135,7 +153,7 @@ Inductive exec_ram:
       (Verilog.assoc_blocking ra)!(ram_wr_en r) = Some wr_en ->
       (Verilog.assoc_blocking ra)!(ram_d_in r) = Some d_in ->
       (Verilog.assoc_blocking ra)!(ram_addr r) = Some addr ->
-      exec_ram ra ar r (Verilog.nonblock_reg (ram_en r) ra u_en)
+      exec_ram ra ar (Some r) (Verilog.nonblock_reg (ram_en r) ra u_en)
                (Verilog.nonblock_arr (ram_mem r) (valueToNat addr) ar d_in)
 | exec_ram_Some_read:
     forall ra ar r addr v_d_out en u_en,
@@ -146,8 +164,11 @@ Inductive exec_ram:
       (Verilog.assoc_blocking ra)!(ram_addr r) = Some addr ->
       Verilog.arr_assocmap_lookup (Verilog.assoc_blocking ar)
                                   (ram_mem r) (valueToNat addr) = Some v_d_out ->
-      exec_ram ra ar r (Verilog.nonblock_reg (ram_en r)
-                               (Verilog.nonblock_reg (ram_d_out r) ra v_d_out) u_en) ar.
+      exec_ram ra ar (Some r) (Verilog.nonblock_reg (ram_en r)
+                               (Verilog.nonblock_reg (ram_d_out r) ra v_d_out) u_en) ar
+| exec_ram_None:
+    forall r a,
+      exec_ram r a None r a.
 
 Inductive step : genv -> state -> Events.trace -> state -> Prop :=
 | step_module :
@@ -225,10 +246,6 @@ Definition semantics (m : program) :=
   Smallstep.Semantics step (initial_state m) final_state
                       (Globalenvs.Genv.globalenv m).
 
-Definition all_module_regs m :=
-  all_ram_regs (mod_ram m) ++
-               (mod_st m::mod_finish m::mod_return m::mod_start m::mod_reset m::mod_clk m::nil).
-
 Definition max_pc_function (m: module) :=
   List.fold_left Pos.max (List.map fst (PTree.elements m.(mod_controllogic))) 1.
 
@@ -249,20 +266,17 @@ Definition max_reg_ram r :=
                      (Pos.max (ram_d_out ram) (ram_u_en ram)))))))
   end.
 
-Definition max_reg_body m :=
-  Pos.max (max_list (mod_params m))
-          (Pos.max (max_stmnt_tree (mod_datapath m))
-                   (max_stmnt_tree (mod_controllogic m))).
-
 Definition max_reg_module m :=
-  Pos.max (max_reg_body m) (max_list (all_module_regs m)).
-
-Record wf_htl_module m :=
-  mk_wf_htl_module {
-      mod_wf : map_well_formed (mod_controllogic m) /\ map_well_formed (mod_datapath m);
-      mod_ordering_wf : list_norepet (all_module_regs m);
-      mod_gt : Forall (Pos.lt (max_reg_body m)) (all_module_regs m);
-    }.
+  Pos.max (max_list (mod_params m))
+   (Pos.max (max_stmnt_tree (mod_datapath m))
+    (Pos.max (max_stmnt_tree (mod_controllogic m))
+     (Pos.max (mod_st m)
+      (Pos.max (mod_stk m)
+       (Pos.max (mod_finish m)
+        (Pos.max (mod_return m)
+         (Pos.max (mod_start m)
+          (Pos.max (mod_reset m)
+           (Pos.max (mod_clk m) (max_reg_ram (mod_ram m))))))))))).
 
 Lemma max_fold_lt :
   forall m l n, m <= n -> m <= (fold_left Pos.max l n).
@@ -319,16 +333,12 @@ Proof. intros. apply max_reg_stmnt_le_stmnt_tree in H; lia. Qed.
 
 Lemma max_stmnt_lt_module :
   forall m d i,
-    wf_htl_module m ->
     (mod_controllogic m) ! i = Some d \/ (mod_datapath m) ! i = Some d ->
     Verilog.max_reg_stmnt d < max_reg_module m + 1.
 Proof.
-  intros. apply mod_gt in H.
-  unfold Pos.lt, max_reg_body, max_reg_module, max_list, all_module_regs, all_ram_regs in *.
-  simplify.
-  repeat match goal with H: Forall _ _ |- _ => inv H end.
-  inversion H0 as [Hv | Hv]; apply max_reg_stmnt_le_stmnt_tree in Hv.
-  Admitted.
+  inversion 1 as [ Hv | Hv ]; unfold max_reg_module;
+  apply max_reg_stmnt_le_stmnt_tree in Hv; lia.
+Qed.
 
 Lemma max_list_correct l st : st > max_list l -> Forall (Pos.gt st) l.
 Proof. induction l; crush; constructor; [|apply IHl]; lia. Qed.
@@ -341,14 +351,4 @@ Definition max_list_dec (l: list reg) (st: reg) : {Forall (Pos.gt st) l} + {True
       end
     ); auto.
   apply max_list_correct. apply Pos.ltb_lt in e. lia.
-Defined.
-
-Variant wf_htl_fundef: fundef -> Prop :=
-  | wf_htl_fundef_external: forall ef,
-      wf_htl_fundef (AST.External ef)
-  | wf_htl_function_internal: forall f,
-      wf_htl_module f ->
-      wf_htl_fundef (AST.Internal f).
-
-Definition wf_htl_program (p: program) : Prop :=
-  forall f id, In (id, AST.Gfun f) (AST.prog_defs p) -> wf_htl_fundef f.
+Qed.
diff --git a/src/hls/HTLPargen.v b/src/hls/HTLPargen.v
index b602ab6..10c4357 100644
--- a/src/hls/HTLPargen.v
+++ b/src/hls/HTLPargen.v
@@ -1,6 +1,7 @@
-(*
+(* 
  * Vericert: Verified high-level synthesis.
- * Copyright (C) 2021 Yann Herklotz <yann@yannherklotz.com>
+ * Copyright (C) 2020 Yann Herklotz <yann@yannherklotz.com>
+ *               2020 James Pollard <j@mes.dev>
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -18,23 +19,21 @@
 
 Require Import Coq.micromega.Lia.
 
-Require Import compcert.common.AST.
-Require compcert.common.Errors.
+Require Import compcert.lib.Maps.
+Require Import compcert.common.Errors.
 Require compcert.common.Globalenvs.
 Require compcert.lib.Integers.
-Require Import compcert.lib.Maps.
+Require Import compcert.common.AST.
 
 Require Import vericert.common.Statemonad.
 Require Import vericert.common.Vericertlib.
 Require Import vericert.hls.AssocMap.
-Require Import vericert.hls.FunctionalUnits.
-Require Import vericert.hls.HTL.
-Require Import vericert.hls.Predicate.
-Require Import vericert.hls.GiblePar.
-Require Import vericert.hls.Gible.
-Require Import vericert.hls.FunctionalUnits.
+Require Import vericert.hls.DHTL.
 Require Import vericert.hls.ValueInt.
 Require Import vericert.hls.Verilog.
+Require Import vericert.hls.Gible.
+Require Import vericert.hls.GiblePar.
+Require Import vericert.hls.Predicate.
 
 #[local] Hint Resolve AssocMap.gempty : htlh.
 #[local] Hint Resolve AssocMap.gso : htlh.
@@ -42,16 +41,13 @@ Require Import vericert.hls.Verilog.
 #[local] Hint Resolve Ple_refl : htlh.
 #[local] Hint Resolve Ple_succ : htlh.
 
-Definition assignment : Type := expr -> expr -> stmnt.
-
 Record state: Type := mkstate {
-  st_st: reg;
+  st_st : reg;
   st_freshreg: reg;
   st_freshstate: node;
   st_scldecls: AssocMap.t (option io * scl_decl);
   st_arrdecls: AssocMap.t (option io * arr_decl);
   st_datapath: datapath;
-  st_controllogic: controllogic;
 }.
 
 Definition init_state (st : reg) : state :=
@@ -60,7 +56,6 @@ Definition init_state (st : reg) : state :=
           1%positive
           (AssocMap.empty (option io * scl_decl))
           (AssocMap.empty (option io * arr_decl))
-          (AssocMap.empty stmnt)
           (AssocMap.empty stmnt).
 
 Module HTLState <: State.
@@ -74,23 +69,20 @@ Module HTLState <: State.
         Ple s1.(st_freshreg) s2.(st_freshreg) ->
         Ple s1.(st_freshstate) s2.(st_freshstate) ->
         (forall n,
-            s1.(st_controllogic)!n = None
-            \/ s2.(st_controllogic)!n = s1.(st_controllogic)!n) ->
+            s1.(st_datapath)!n = None \/ s2.(st_datapath)!n = s1.(st_datapath)!n) ->
         st_incr s1 s2.
-  #[local] Hint Constructors st_incr : htlh.
+  #[export] Hint Constructors st_incr : htlh.
 
   Definition st_prop := st_incr.
-  #[local] Hint Unfold st_prop : htlh.
+  #[export] Hint Unfold st_prop : htlh.
 
-  Lemma st_refl : forall s, st_prop s s.
-  Proof. auto with htlh. Qed.
+  Lemma st_refl : forall s, st_prop s s. Proof. auto with htlh. Qed.
 
   Lemma st_trans :
     forall s1 s2 s3, st_prop s1 s2 -> st_prop s2 s3 -> st_prop s1 s3.
   Proof.
-    intros. inv H. inv H0.
-    apply state_incr_intro; eauto using Ple_trans; intros; try congruence.
-    destruct H4 with n; destruct H7 with n; intuition congruence.
+    intros. inv H. inv H0. apply state_incr_intro; eauto using Ple_trans; intros; try congruence.
+    - destruct H4 with n; destruct H7 with n; intuition congruence.
   Qed.
 
 End HTLState.
@@ -102,14 +94,18 @@ Export HTLMonad.
 Module HTLMonadExtra := Monad.MonadExtra(HTLMonad).
 Import HTLMonadExtra.
 Export MonadNotation.
+
 #[local] Open Scope monad_scope.
 
+Definition pred_lit (preg: reg) (pred: predicate) :=
+  Vrange preg (Vlit (posToValue pred)) (Vlit (posToValue pred)).
+
 Fixpoint pred_expr (preg: reg) (p: pred_op) :=
   match p with
   | Plit (b, pred) =>
     if b
-    then Vrange preg (Vlit (posToValue pred)) (Vlit (posToValue pred))
-    else Vunop Vnot (Vrange preg (Vlit (posToValue pred)) (Vlit (posToValue pred)))
+    then pred_lit preg pred
+    else Vunop Vnot (pred_lit preg pred)
   | Ptrue => Vlit (ZToValue 1)
   | Pfalse => Vlit (ZToValue 0)
   | Pand p1 p2 =>
@@ -118,14 +114,20 @@ Fixpoint pred_expr (preg: reg) (p: pred_op) :=
     Vbinop Vor (pred_expr preg p1) (pred_expr preg p2)
   end.
 
+Definition assignment : Type := expr -> expr -> stmnt.
+
 Definition translate_predicate (a : assignment)
            (preg: reg) (p: option pred_op) (dst e: expr) :=
   match p with
   | None => a dst e
   | Some pos =>
-    a dst (Vternary (pred_expr preg pos) e dst)
+    let pos' := deep_simplify peq pos in
+    match sat_pred_simple (negate pos') with
+    | None => a dst e
+    | Some _ => a dst (Vternary (pred_expr preg pos') e dst)
+    end
   end.
-
+ 
 Definition state_goto (preg: reg) (p: option pred_op) (st : reg) (n : node) : stmnt :=
   translate_predicate Vblock preg p (Vvar st) (Vlit (posToValue n)).
 
@@ -138,11 +140,11 @@ Proof.
   intros. case (s.(st_datapath)!n); tauto.
 Defined.
 
-Definition check_empty_node_controllogic:
-  forall (s: state) (n: node), { s.(st_controllogic)!n = None } + { True }.
-Proof.
-  intros. case (s.(st_controllogic)!n); tauto.
-Defined.
+Definition append_instr (n : node) (st : stmnt) (d : datapath) : datapath :=
+  match AssocMap.get n d with 
+  | Some st' => AssocMap.set n (Vseq st' st) d
+  | None => AssocMap.set n st d
+  end.
 
 Lemma declare_reg_state_incr :
   forall i s r sz,
@@ -153,8 +155,7 @@ Lemma declare_reg_state_incr :
        s.(st_freshstate)
        (AssocMap.set r (i, VScalar sz) s.(st_scldecls))
        s.(st_arrdecls)
-       s.(st_datapath)
-       s.(st_controllogic)).
+       s.(st_datapath)).
 Proof. Admitted.
 
 Definition declare_reg (i : option io) (r : reg) (sz : nat) : mon unit :=
@@ -164,8 +165,7 @@ Definition declare_reg (i : option io) (r : reg) (sz : nat) : mon unit :=
                 s.(st_freshstate)
                 (AssocMap.set r (i, VScalar sz) s.(st_scldecls))
                 s.(st_arrdecls)
-                s.(st_datapath)
-                s.(st_controllogic))
+                s.(st_datapath))
               (declare_reg_state_incr i s r sz).
 
 Lemma declare_arr_state_incr :
@@ -177,8 +177,7 @@ Lemma declare_arr_state_incr :
        s.(st_freshstate)
        s.(st_scldecls)
        (AssocMap.set r (i, VArray sz ln) s.(st_arrdecls))
-       s.(st_datapath)
-       s.(st_controllogic)).
+       s.(st_datapath)).
 Proof. Admitted.
 
 Definition declare_arr (i : option io) (r : reg) (sz : nat) (ln : nat) : mon unit :=
@@ -188,112 +187,9 @@ Definition declare_arr (i : option io) (r : reg) (sz : nat) (ln : nat) : mon uni
                 s.(st_freshstate)
                 s.(st_scldecls)
                 (AssocMap.set r (i, VArray sz ln) s.(st_arrdecls))
-                s.(st_datapath)
-                s.(st_controllogic))
+                s.(st_datapath))
               (declare_arr_state_incr i s r sz ln).
 
-Lemma add_instr_state_incr :
-  forall s preg p n n' st,
-    (st_controllogic s)!n = None ->
-    st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (st_freshstate s)
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       (AssocMap.set n st s.(st_datapath))
-       (AssocMap.set n (state_goto preg p s.(st_st) n') s.(st_controllogic))).
-Proof.
-  constructor; intros;
-    try (simpl; destruct (peq n n0); subst);
-    auto with htlh.
-Qed.
-
-Definition add_instr (preg: reg) (p: option pred_op) (n : node) (n' : node) (st : stmnt) : mon unit :=
-  fun s =>
-    match check_empty_node_controllogic s n with
-    | left TRANS =>
-      OK tt (mkstate
-               s.(st_st)
-               s.(st_freshreg)
-               (st_freshstate s)
-               s.(st_scldecls)
-               s.(st_arrdecls)
-               (AssocMap.set n st s.(st_datapath))
-               (AssocMap.set n (state_goto preg p s.(st_st) n') s.(st_controllogic)))
-         (add_instr_state_incr s preg p n n' st TRANS)
-    | _ => Error (Errors.msg "HTL.add_instr")
-    end.
-
-Lemma add_instr_skip_state_incr :
-  forall s n st,
-    (st_controllogic s)!n = None ->
-    st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (st_freshstate s)
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       (AssocMap.set n st s.(st_datapath))
-       (AssocMap.set n Vskip s.(st_controllogic))).
-Proof.
-  constructor; intros;
-    try (simpl; destruct (peq n n0); subst);
-    auto with htlh.
-Qed.
-
-Definition add_instr_skip (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    match check_empty_node_controllogic s n with
-    | left TRANS =>
-      OK tt (mkstate
-               s.(st_st)
-               s.(st_freshreg)
-               (st_freshstate s)
-               s.(st_scldecls)
-               s.(st_arrdecls)
-               (AssocMap.set n st s.(st_datapath))
-               (AssocMap.set n Vskip s.(st_controllogic)))
-         (add_instr_skip_state_incr s n st TRANS)
-    | _ => Error (Errors.msg "HTL.add_instr_skip")
-    end.
-
-Lemma add_node_skip_state_incr :
-  forall s n st,
-    (st_controllogic s)!n = None ->
-    st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (st_freshstate s)
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       (AssocMap.set n Vskip s.(st_datapath))
-       (AssocMap.set n st s.(st_controllogic))).
-Proof.
-  constructor; intros;
-    try (simpl; destruct (peq n n0); subst);
-    auto with htlh.
-Qed.
-
-Definition add_node_skip (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    match check_empty_node_controllogic s n with
-    | left TRANS =>
-      OK tt (mkstate
-               s.(st_st)
-               s.(st_freshreg)
-               (st_freshstate s)
-               s.(st_scldecls)
-               s.(st_arrdecls)
-               (AssocMap.set n Vskip s.(st_datapath))
-               (AssocMap.set n st s.(st_controllogic)))
-         (add_node_skip_state_incr s n st TRANS)
-    | _ => Error (Errors.msg "HTL.add_node_skip")
-    end.
-
 Definition nonblock (dst : reg) (e : expr) := Vnonblock (Vvar dst) e.
 Definition block (dst : reg) (e : expr) := Vblock (Vvar dst) e.
 
@@ -306,68 +202,57 @@ Definition boplit (op : binop) (r : reg) (l : Integers.int) : expr :=
 Definition boplitz (op: binop) (r: reg) (l: Z) : expr :=
   Vbinop op (Vvar r) (Vlit (ZToValue l)).
 
-Definition translate_comparison (c : Integers.comparison) (args : list reg)
-  : mon expr :=
+Definition translate_comparison (c : Integers.comparison) (args : list reg) : Errors.res expr :=
   match c, args with
-  | Integers.Ceq, r1::r2::nil => ret (bop Veq r1 r2)
-  | Integers.Cne, r1::r2::nil => ret (bop Vne r1 r2)
-  | Integers.Clt, r1::r2::nil => ret (bop Vlt r1 r2)
-  | Integers.Cgt, r1::r2::nil => ret (bop Vgt r1 r2)
-  | Integers.Cle, r1::r2::nil => ret (bop Vle r1 r2)
-  | Integers.Cge, r1::r2::nil => ret (bop Vge r1 r2)
-  | _, _ => error (Errors.msg
-                 "Htlgen: comparison instruction not implemented: other")
+  | Integers.Ceq, r1::r2::nil => Errors.OK (bop Veq r1 r2)
+  | Integers.Cne, r1::r2::nil => Errors.OK (bop Vne r1 r2)
+  | Integers.Clt, r1::r2::nil => Errors.OK (bop Vlt r1 r2)
+  | Integers.Cgt, r1::r2::nil => Errors.OK (bop Vgt r1 r2)
+  | Integers.Cle, r1::r2::nil => Errors.OK (bop Vle r1 r2)
+  | Integers.Cge, r1::r2::nil => Errors.OK (bop Vge r1 r2)
+  | _, _ => Errors.Error (Errors.msg "Htlgen: comparison instruction not implemented: other")
   end.
 
-Definition translate_comparison_imm (c : Integers.comparison) (args : list reg)
-           (i: Integers.int) : mon expr :=
+Definition translate_comparison_imm (c : Integers.comparison) (args : list reg) (i: Integers.int)
+  : Errors.res expr :=
   match c, args with
-  | Integers.Ceq, r1::nil => ret (boplit Veq r1 i)
-  | Integers.Cne, r1::nil => ret (boplit Vne r1 i)
-  | Integers.Clt, r1::nil => ret (boplit Vlt r1 i)
-  | Integers.Cgt, r1::nil => ret (boplit Vgt r1 i)
-  | Integers.Cle, r1::nil => ret (boplit Vle r1 i)
-  | Integers.Cge, r1::nil => ret (boplit Vge r1 i)
-  | _, _ => error (Errors.msg
-                 "Htlgen: comparison_imm instruction not implemented: other")
+  | Integers.Ceq, r1::nil => Errors.OK (boplit Veq r1 i)
+  | Integers.Cne, r1::nil => Errors.OK (boplit Vne r1 i)
+  | Integers.Clt, r1::nil => Errors.OK (boplit Vlt r1 i)
+  | Integers.Cgt, r1::nil => Errors.OK (boplit Vgt r1 i)
+  | Integers.Cle, r1::nil => Errors.OK (boplit Vle r1 i)
+  | Integers.Cge, r1::nil => Errors.OK (boplit Vge r1 i)
+  | _, _ => Errors.Error (Errors.msg "Htlgen: comparison_imm instruction not implemented: other")
   end.
 
-Definition translate_comparisonu (c : Integers.comparison) (args : list reg)
-  : mon expr :=
+Definition translate_comparisonu (c : Integers.comparison) (args : list reg) : Errors.res expr :=
   match c, args with
-  | Integers.Clt, r1::r2::nil => ret (bop Vltu r1 r2)
-  | Integers.Cgt, r1::r2::nil => ret (bop Vgtu r1 r2)
-  | Integers.Cle, r1::r2::nil => ret (bop Vleu r1 r2)
-  | Integers.Cge, r1::r2::nil => ret (bop Vgeu r1 r2)
-  | _, _ => error (Errors.msg
-                 "Htlgen: comparison instruction not implemented: other")
+  | Integers.Clt, r1::r2::nil => Errors.OK (bop Vltu r1 r2)
+  | Integers.Cgt, r1::r2::nil => Errors.OK (bop Vgtu r1 r2)
+  | Integers.Cle, r1::r2::nil => Errors.OK (bop Vleu r1 r2)
+  | Integers.Cge, r1::r2::nil => Errors.OK (bop Vgeu r1 r2)
+  | _, _ => Errors.Error (Errors.msg "Htlgen: comparison instruction not implemented: other")
   end.
 
-Definition translate_comparison_immu (c : Integers.comparison)
-           (args : list reg) (i: Integers.int) : mon expr :=
+Definition translate_comparison_immu (c : Integers.comparison) (args : list reg) (i: Integers.int)
+  : Errors.res expr :=
   match c, args with
-  | Integers.Clt, r1::nil => ret (boplit Vltu r1 i)
-  | Integers.Cgt, r1::nil => ret (boplit Vgtu r1 i)
-  | Integers.Cle, r1::nil => ret (boplit Vleu r1 i)
-  | Integers.Cge, r1::nil => ret (boplit Vgeu r1 i)
-  | _, _ => error (Errors.msg
-                 "Htlgen: comparison_imm instruction not implemented: other")
+  | Integers.Clt, r1::nil => Errors.OK (boplit Vltu r1 i)
+  | Integers.Cgt, r1::nil => Errors.OK (boplit Vgtu r1 i)
+  | Integers.Cle, r1::nil => Errors.OK (boplit Vleu r1 i)
+  | Integers.Cge, r1::nil => Errors.OK (boplit Vgeu r1 i)
+  | _, _ => Errors.Error (Errors.msg "Htlgen: comparison_imm instruction not implemented: other")
   end.
 
-Definition translate_condition (c : Op.condition) (args : list reg)
-  : mon expr :=
+Definition translate_condition (c : Op.condition) (args : list reg) : Errors.res expr :=
   match c, args with
   | Op.Ccomp c, _ => translate_comparison c args
   | Op.Ccompu c, _ => translate_comparisonu c args
   | Op.Ccompimm c i, _ => translate_comparison_imm c args i
   | Op.Ccompuimm c i, _ => translate_comparison_immu c args i
-  | Op.Cmaskzero n, _ =>
-    error (Errors.msg "Htlgen: condition instruction not implemented: Cmaskzero")
-  | Op.Cmasknotzero n, _ =>
-    error (Errors.msg
-         "Htlgen: condition instruction not implemented: Cmasknotzero")
-  | _, _ =>
-    error (Errors.msg "Htlgen: condition instruction not implemented: other")
+  | Op.Cmaskzero n, _ => Errors.Error (Errors.msg "Htlgen: condition instruction not implemented: Cmaskzero")
+  | Op.Cmasknotzero n, _ => Errors.Error (Errors.msg "Htlgen: condition instruction not implemented: Cmasknotzero")
+  | _, _ => Errors.Error (Errors.msg "Htlgen: condition instruction not implemented: other")
   end.
 
 Definition check_address_parameter_signed (p : Z) : bool :=
@@ -377,136 +262,100 @@ Definition check_address_parameter_signed (p : Z) : bool :=
 Definition check_address_parameter_unsigned (p : Z) : bool :=
   Z.leb p Integers.Ptrofs.max_unsigned.
 
-Lemma create_reg_state_incr:
-  forall s sz i,
-    st_incr s (mkstate
-         s.(st_st)
-         (Pos.succ (st_freshreg s))
-         (st_freshstate s)
-         (AssocMap.set s.(st_freshreg) (i, VScalar sz) s.(st_scldecls))
-         s.(st_arrdecls)
-         (st_datapath s)
-         (st_controllogic s)).
-Proof. constructor; simpl; auto with htlh. Qed.
-
-Definition create_reg (i : option io) (sz : nat) : mon reg :=
-  fun s => let r := s.(st_freshreg) in
-           OK r (mkstate
-                   s.(st_st)
-                   (Pos.succ r)
-                   (st_freshstate s)
-                   (AssocMap.set s.(st_freshreg) (i, VScalar sz) s.(st_scldecls))
-                   (st_arrdecls s)
-                   (st_datapath s)
-                   (st_controllogic s))
-              (create_reg_state_incr s sz i).
-
-Definition translate_eff_addressing (a: Op.addressing) (args: list reg)
-  : mon expr :=
+Definition translate_eff_addressing (a: Op.addressing) (args: list reg) : Errors.res expr :=
   match a, args with (* TODO: We should be more methodical here; what are the possibilities?*)
   | Op.Aindexed off, r1::nil =>
     if (check_address_parameter_signed off)
-    then ret (boplitz Vadd r1 off)
-    else error (Errors.msg ("HTLPargen: translate_eff_addressing (Aindexed): address out of bounds"))
+    then Errors.OK (boplitz Vadd r1 off)
+    else Errors.Error (Errors.msg "Veriloggen: translate_eff_addressing (Aindexed): address out of bounds")
   | Op.Ascaled scale offset, r1::nil =>
     if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
-    then ret (Vbinop Vadd (boplitz Vmul r1 scale) (Vlit (ZToValue offset)))
-    else error (Errors.msg "HTLPargen: translate_eff_addressing (Ascaled): address out of bounds")
+    then Errors.OK (Vbinop Vadd (boplitz Vmul r1 scale) (Vlit (ZToValue offset)))
+    else Errors.Error (Errors.msg "Veriloggen: translate_eff_addressing (Ascaled): address out of bounds")
   | Op.Aindexed2 offset, r1::r2::nil =>
     if (check_address_parameter_signed offset)
-    then ret (Vbinop Vadd (bop Vadd r1 r2) (Vlit (ZToValue offset)))
-    else error (Errors.msg "HTLPargen: translate_eff_addressing (Aindexed2): address out of bounds")
+    then Errors.OK (Vbinop Vadd (bop Vadd r1 r2) (Vlit (ZToValue offset)))
+    else Errors.Error (Errors.msg "Veriloggen: translate_eff_addressing (Aindexed2): address out of bounds")
   | Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *)
     if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
-    then ret (Vbinop Vadd (Vvar r1) (Vbinop Vadd (boplitz Vmul r2 scale) (Vlit (ZToValue offset))))
-    else error (Errors.msg "HTLPargen: translate_eff_addressing (Aindexed2scaled): address out of bounds")
+    then Errors.OK (Vbinop Vadd (Vvar r1) (Vbinop Vadd (boplitz Vmul r2 scale) (Vlit (ZToValue offset))))
+    else Errors.Error (Errors.msg "Veriloggen: translate_eff_addressing (Aindexed2scaled): address out of bounds")
   | Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *)
     let a := Integers.Ptrofs.unsigned a in
     if (check_address_parameter_unsigned a)
-    then ret (Vlit (ZToValue a))
-    else error (Errors.msg "HTLPargen: translate_eff_addressing (Ainstack): address out of bounds")
-  | _, _ => error (Errors.msg "HTLPargen: translate_eff_addressing unsuported addressing")
+    then Errors.OK (Vlit (ZToValue a))
+    else Errors.Error (Errors.msg "Veriloggen: translate_eff_addressing (Ainstack): address out of bounds")
+  | _, _ => Errors.Error (Errors.msg "Veriloggen: translate_eff_addressing unsuported addressing")
   end.
 
-(*|
-Translate an instruction to a statement. FIX mulhs mulhu
-|*)
+#[local] Close Scope monad_scope.
+#[local] Open Scope error_monad_scope.
 
-Definition translate_instr (op : Op.operation) (args : list reg) : mon expr :=
+(** Translate an instruction to a statement. FIX mulhs mulhu *)
+Definition translate_instr (op : Op.operation) (args : list reg) : Errors.res expr :=
   match op, args with
-  | Op.Omove, r::nil => ret (Vvar r)
-  | Op.Ointconst n, _ => ret (Vlit (intToValue n))
-  | Op.Oneg, r::nil => ret (Vunop Vneg (Vvar r))
-  | Op.Osub, r1::r2::nil => ret (bop Vsub r1 r2)
-  | Op.Omul, r1::r2::nil => ret (bop Vmul r1 r2)
-  | Op.Omulimm n, r::nil => ret (boplit Vmul r n)
-  | Op.Omulhs, r1::r2::nil => error (Errors.msg "Htlgen: Instruction not implemented: mulhs")
-  | Op.Omulhu, r1::r2::nil => error (Errors.msg "Htlgen: Instruction not implemented: mulhu")
-  | Op.Odiv, r1::r2::nil => ret (bop Vdiv r1 r2)
-  | Op.Odivu, r1::r2::nil => ret (bop Vdivu r1 r2)
-  | Op.Omod, r1::r2::nil => ret (bop Vmod r1 r2)
-  | Op.Omodu, r1::r2::nil => ret (bop Vmodu r1 r2)
-  | Op.Oand, r1::r2::nil => ret (bop Vand r1 r2)
-  | Op.Oandimm n, r::nil => ret (boplit Vand r n)
-  | Op.Oor, r1::r2::nil => ret (bop Vor r1 r2)
-  | Op.Oorimm n, r::nil => ret (boplit Vor r n)
-  | Op.Oxor, r1::r2::nil => ret (bop Vxor r1 r2)
-  | Op.Oxorimm n, r::nil => ret (boplit Vxor r n)
-  | Op.Onot, r::nil => ret (Vunop Vnot (Vvar r))
-  | Op.Oshl, r1::r2::nil => ret (bop Vshl r1 r2)
-  | Op.Oshlimm n, r::nil => ret (boplit Vshl r n)
-  | Op.Oshr, r1::r2::nil => ret (bop Vshr r1 r2)
-  | Op.Oshrimm n, r::nil => ret (boplit Vshr r n)
+  | Op.Omove, r::nil => Errors.OK (Vvar r)
+  | Op.Ointconst n, _ => Errors.OK (Vlit (intToValue n))
+  | Op.Oneg, r::nil => Errors.OK (Vunop Vneg (Vvar r))
+  | Op.Osub, r1::r2::nil => Errors.OK (bop Vsub r1 r2)
+  | Op.Omul, r1::r2::nil => Errors.OK (bop Vmul r1 r2)
+  | Op.Omulimm n, r::nil => Errors.OK (boplit Vmul r n)
+  | Op.Omulhs, r1::r2::nil => Errors.Error (Errors.msg "Htlgen: Instruction not implemented: mulhs")
+  | Op.Omulhu, r1::r2::nil => Errors.Error (Errors.msg "Htlgen: Instruction not implemented: mulhu")
+  | Op.Odiv, r1::r2::nil => Errors.OK (bop Vdiv r1 r2)
+  | Op.Odivu, r1::r2::nil => Errors.OK (bop Vdivu r1 r2)
+  | Op.Omod, r1::r2::nil => Errors.OK (bop Vmod r1 r2)
+  | Op.Omodu, r1::r2::nil => Errors.OK (bop Vmodu r1 r2)
+  | Op.Oand, r1::r2::nil => Errors.OK (bop Vand r1 r2)
+  | Op.Oandimm n, r::nil => Errors.OK (boplit Vand r n)
+  | Op.Oor, r1::r2::nil => Errors.OK (bop Vor r1 r2)
+  | Op.Oorimm n, r::nil => Errors.OK (boplit Vor r n)
+  | Op.Oxor, r1::r2::nil => Errors.OK (bop Vxor r1 r2)
+  | Op.Oxorimm n, r::nil => Errors.OK (boplit Vxor r n)
+  | Op.Onot, r::nil => Errors.OK (Vunop Vnot (Vvar r))
+  | Op.Oshl, r1::r2::nil => Errors.OK (bop Vshl r1 r2)
+  | Op.Oshlimm n, r::nil => Errors.OK (boplit Vshl r n)
+  | Op.Oshr, r1::r2::nil => Errors.OK (bop Vshr r1 r2)
+  | Op.Oshrimm n, r::nil => Errors.OK (boplit Vshr r n)
   | Op.Oshrximm n, r::nil =>
-    ret (Vternary (Vbinop Vlt (Vvar r) (Vlit (ZToValue 0)))
+    Errors.OK (Vternary (Vbinop Vlt (Vvar r) (Vlit (ZToValue 0)))
                   (Vunop Vneg (Vbinop Vshru (Vunop Vneg (Vvar r)) (Vlit n)))
                   (Vbinop Vshru (Vvar r) (Vlit n)))
-  | Op.Oshru, r1::r2::nil => ret (bop Vshru r1 r2)
-  | Op.Oshruimm n, r::nil => ret (boplit Vshru r n)
-  | Op.Ororimm n, r::nil => error (Errors.msg "Htlgen: Instruction not implemented: Ororimm")
-  (*ret (Vbinop Vor (boplit Vshru r (Integers.Int.modu n (Integers.Int.repr 32)))
+  | Op.Oshru, r1::r2::nil => Errors.OK (bop Vshru r1 r2)
+  | Op.Oshruimm n, r::nil => Errors.OK (boplit Vshru r n)
+  | Op.Ororimm n, r::nil => Errors.Error (Errors.msg "Htlgen: Instruction not implemented: Ororimm")
+  (*Errors.OK (Vbinop Vor (boplit Vshru r (Integers.Int.modu n (Integers.Int.repr 32)))
                                         (boplit Vshl r (Integers.Int.sub (Integers.Int.repr 32) (Integers.Int.modu n (Integers.Int.repr 32)))))*)
-  | Op.Oshldimm n, r::nil => ret (Vbinop Vor (boplit Vshl r n) (boplit Vshr r (Integers.Int.sub (Integers.Int.repr 32) n)))
+  | Op.Oshldimm n, r::nil => Errors.OK (Vbinop Vor (boplit Vshl r n) (boplit Vshr r (Integers.Int.sub (Integers.Int.repr 32) n)))
   | Op.Ocmp c, _ => translate_condition c args
   | Op.Osel c AST.Tint, r1::r2::rl =>
     do tc <- translate_condition c rl;
-    ret (Vternary tc (Vvar r1) (Vvar r2))
+    Errors.OK (Vternary tc (Vvar r1) (Vvar r2))
   | Op.Olea a, _ => translate_eff_addressing a args
-  | _, _ => error (Errors.msg "Htlgen: Instruction not implemented: other")
+  | _, _ => Errors.Error (Errors.msg "Htlgen: Instruction not implemented: other")
   end.
 
-Lemma add_branch_instr_state_incr:
-  forall s preg p e n n1 n2,
-    (st_controllogic s) ! n = None ->
-    st_incr s (mkstate
-                 s.(st_st)
-                (st_freshreg s)
-                (st_freshstate s)
-                s.(st_scldecls)
-                s.(st_arrdecls)
-                (AssocMap.set n Vskip (st_datapath s))
-                (AssocMap.set n (state_cond preg p s.(st_st) e n1 n2) (st_controllogic s))).
-Proof.
-  intros. apply state_incr_intro; simpl;
-            try (intros; destruct (peq n0 n); subst);
-            auto with htlh.
-Qed.
-
-Definition add_branch_instr preg p (e: expr) (n n1 n2: node) : mon unit :=
-  fun s =>
-    match check_empty_node_controllogic s n with
-    | left NTRANS =>
-      OK tt (mkstate
-               s.(st_st)
-                (st_freshreg s)
-                (st_freshstate s)
-                s.(st_scldecls)
-                s.(st_arrdecls)
-                (AssocMap.set n Vskip (st_datapath s))
-                (AssocMap.set n (state_cond preg p s.(st_st) e n1 n2) (st_controllogic s)))
-         (add_branch_instr_state_incr s preg p e n n1 n2 NTRANS)
-    | _ => Error (Errors.msg "Htlgen: add_branch_instr")
-    end.
+Definition translate_arr_access (mem : AST.memory_chunk) (addr : Op.addressing)
+           (args : list reg) (stack : reg) : Errors.res expr :=
+  match mem, addr, args with (* TODO: We should be more methodical here; what are the possibilities?*)
+  | Mint32, Op.Aindexed off, r1::nil =>
+    if (check_address_parameter_signed off)
+    then Errors.OK (Vvari stack (Vbinop Vdivu (boplitz Vadd r1 off) (Vlit (ZToValue 4))))
+    else Errors.Error (Errors.msg "HTLPargen: translate_arr_access address out of bounds")
+  | Mint32, Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *)
+    if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
+    then Errors.OK (Vvari stack
+                    (Vbinop Vdivu
+                            (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale))
+                            (Vlit (ZToValue 4))))
+    else Errors.Error (Errors.msg "HTLPargen: translate_arr_access address out of bounds")
+  | Mint32, Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *)
+    let a := Integers.Ptrofs.unsigned a in
+    if (check_address_parameter_unsigned a)
+    then Errors.OK (Vvari stack (Vlit (ZToValue (a / 4))))
+    else Errors.Error (Errors.msg "HTLPargen: eff_addressing out of bounds stack offset")
+  | _, _, _ => Errors.Error (Errors.msg "HTLPargen: translate_arr_access unsuported addressing")
+  end.
 
 Fixpoint enumerate (i : nat) (ns : list node) {struct ns} : list (nat * node) :=
   match ns with
@@ -516,12 +365,156 @@ Fixpoint enumerate (i : nat) (ns : list node) {struct ns} : list (nat * node) :=
 
 Definition tbl_to_case_expr (st : reg) (ns : list node) : list (expr * stmnt) :=
   List.map (fun a => match a with
-                    (i, n) => (Vlit (natToValue i), Vblock (Vvar st) (Vlit (posToValue n)))
+                    (i, n) => (Vlit (natToValue i), Vnonblock (Vvar st) (Vlit (posToValue n)))
                   end)
            (enumerate 0 ns).
 
-Definition stack_correct (sz : Z) : bool :=
-  (0 <=? sz) && (sz <? Integers.Ptrofs.modulus) && (Z.modulo sz 4 =? 0).
+Definition translate_cfi (fin rtrn state preg: reg) p (cfi: cf_instr)
+  : Errors.res stmnt :=
+  match cfi with
+  | RBgoto n' =>
+    Errors.OK (state_goto preg p state n')
+  | RBcond c args n1 n2 =>
+    do e <- translate_condition c args;
+    Errors.OK (state_cond preg p state e n1 n2)
+  | RBreturn r =>
+    match r with
+    | Some r' =>
+      Errors.OK (Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vvar r')))
+    | None =>
+      Errors.OK (Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vlit (ZToValue 0%Z))))
+    end
+  | RBjumptable r tbl =>
+    Errors.OK (Vcase (Vvar r) (list_to_stmnt (tbl_to_case_expr state tbl)) (Some Vskip))
+  | RBcall sig ri rl r n =>
+    Errors.Error (Errors.msg "HTLPargen: RBcall not supported.")
+  | RBtailcall sig ri lr =>
+    Errors.Error (Errors.msg "HTLPargen: RBtailcall not supported.")
+  | RBbuiltin e lb b n =>
+    Errors.Error (Errors.msg "HTLPargen: RBbuildin not supported.")
+  end.
+
+Definition dfltp {A} (p: option (@Predicate.pred_op A)) := Option.default Ptrue p.
+
+Definition transf_instr (fin rtrn stack state preg: reg) 
+           (dc: pred_op * stmnt) (i: instr)
+           : Errors.res (pred_op * stmnt) :=
+  let '(curr_p, d) := dc in
+  let npred p := Some (Pand curr_p (dfltp p)) in
+  match i with
+  | RBnop => Errors.OK dc
+  | RBop p op args dst => 
+    do instr <- translate_instr op args;
+    let stmnt := translate_predicate Vblock preg (npred p) (Vvar dst) instr in
+    Errors.OK (curr_p, Vseq d stmnt)
+  | RBload p mem addr args dst =>
+    do src <- translate_arr_access mem addr args stack;
+    let stmnt := translate_predicate Vblock preg (npred p) (Vvar dst) src in
+    Errors.OK (curr_p, Vseq d stmnt)
+  | RBstore p mem addr args src =>
+    do dst <- translate_arr_access mem addr args stack;
+    let stmnt := translate_predicate Vblock preg (npred p) dst (Vvar src) in
+    Errors.OK (curr_p, Vseq d stmnt)
+  | RBsetpred p' cond args p =>
+    do cond' <- translate_condition cond args;
+    let stmnt := translate_predicate Vblock preg (npred p') (pred_expr preg (Plit (true, p))) cond' in
+    Errors.OK (curr_p, Vseq d stmnt)
+  | RBexit p cf => 
+    do d_stmnt <- translate_cfi fin rtrn state preg (npred p) cf;
+    Errors.OK (Pand curr_p (negate (dfltp p)), Vseq d d_stmnt)
+  end.
+
+Definition fold_leftE {A B} (f: A -> B -> Errors.res A) (l: list B) (el: A): Errors.res A :=
+  fold_left (fun a b => do a' <- a; f a' b) l (Errors.OK el).
+
+Definition transf_chained_block (fin rtrn stack state preg: reg)
+           (dc: @pred_op positive * stmnt)
+           (block: list instr)
+           : Errors.res (pred_op * stmnt) :=
+  fold_leftE (transf_instr fin rtrn stack state preg) block dc.
+
+Definition transf_parallel_block (fin rtrn stack state preg: reg)
+           (dc: @pred_op positive * stmnt)
+           (block: list (list instr))
+           : Errors.res (pred_op * stmnt) :=
+  fold_leftE (transf_chained_block fin rtrn stack state preg) block dc.
+
+Definition transf_parallel_full_block (fin rtrn stack state preg: reg)
+           (dc: node * @pred_op positive * datapath)
+           (block: list (list instr))
+           : Errors.res (node * pred_op * datapath) :=
+  let '(n, curr_p, dt) := dc in
+  match AssocMap.get n dt with
+  | None =>
+    do ctrl_init_stmnt <-
+          translate_cfi fin rtrn state preg (Some curr_p) (RBgoto (n - 1)%positive);
+    do dc' <- transf_parallel_block fin rtrn stack state preg (curr_p, ctrl_init_stmnt) block;
+    let '(curr_p', dt_stmnt) := dc' in
+    Errors.OK ((n - 1)%positive, curr_p', AssocMap.set n dt_stmnt dt)
+  | _ => Errors.Error (msg "HtlPargen.transf_parallel_full_block: block not empty")
+  end.
+
+Definition transf_seq_block (fin rtrn stack state preg: reg)
+           (d: datapath) (n: node)
+           (block: list (list (list instr)))
+           : Errors.res datapath :=
+  do res <- fold_leftE
+    (transf_parallel_full_block fin rtrn stack state preg) block (n, Ptrue, d);
+  let '(_, _, d') := res in
+  Errors.OK d'.
+
+#[local] Close Scope error_monad_scope.
+#[local] Open Scope monad_scope.
+
+Program Definition transf_seq_blockM (fin rtrn stack preg: reg) (ni: node * ParBB.t): mon unit :=
+  fun st =>
+    let (n, i) := ni in
+    match transf_seq_block fin rtrn stack st.(st_st) preg st.(st_datapath) n i with
+    | Errors.OK d => 
+      OK tt (mkstate st.(st_st)
+             st.(st_freshreg)
+             st.(st_freshstate)
+             st.(st_scldecls)
+             st.(st_arrdecls)
+             d) _
+    | Errors.Error m => Error m
+    end.
+Next Obligation.
+admit.
+Admitted.
+
+Definition declare_regs (i: instr): mon unit :=
+  match i with
+  | RBop _ _ _ d => declare_reg None d 32
+  | RBload _ _ _ _ d => declare_reg None d 32
+  | _ => ret tt
+  end.
+
+Definition declare_all_regs (ni: node * ParBB.t): mon unit :=
+  let (n, i) := ni in
+  ParBB.foldl _ (fun (st_f: mon unit) i => do _tt <- st_f; declare_regs i) i (ret tt).
+
+Lemma create_reg_state_incr:
+  forall s sz i,
+    st_incr s (mkstate
+         s.(st_st)
+         (Pos.succ (st_freshreg s))
+         (st_freshstate s)
+         (AssocMap.set s.(st_freshreg) (i, VScalar sz) s.(st_scldecls))
+         s.(st_arrdecls)
+         (st_datapath s)).
+Proof. constructor; simpl; auto with htlh. Qed.
+
+Definition create_reg (i : option io) (sz : nat) : mon reg :=
+  fun s => let r := s.(st_freshreg) in
+           OK r (mkstate
+                   s.(st_st)
+                   (Pos.succ r)
+                   (st_freshstate s)
+                   (AssocMap.set s.(st_freshreg) (i, VScalar sz) s.(st_scldecls))
+                   (st_arrdecls s)
+                   (st_datapath s))
+              (create_reg_state_incr s sz i).
 
 Lemma create_arr_state_incr:
   forall s sz ln i,
@@ -531,8 +524,7 @@ Lemma create_arr_state_incr:
          (st_freshstate s)
          s.(st_scldecls)
          (AssocMap.set s.(st_freshreg) (i, VArray sz ln) s.(st_arrdecls))
-         (st_datapath s)
-         (st_controllogic s)).
+         (st_datapath s)).
 Proof. constructor; simpl; auto with htlh. Qed.
 
 Definition create_arr (i : option io) (sz : nat) (ln : nat) : mon (reg * nat) :=
@@ -543,17 +535,19 @@ Definition create_arr (i : option io) (sz : nat) (ln : nat) : mon (reg * nat) :=
                    (st_freshstate s)
                    s.(st_scldecls)
                    (AssocMap.set s.(st_freshreg) (i, VArray sz ln) s.(st_arrdecls))
-                   (st_datapath s)
-                   (st_controllogic s))
+                   (st_datapath s))
               (create_arr_state_incr s sz ln i).
 
+Definition stack_correct (sz : Z) : bool :=
+  (0 <=? sz) && (sz <? Integers.Ptrofs.modulus) && (Z.modulo sz 4 =? 0).
+
 Definition max_pc_map (m : Maps.PTree.t stmnt) :=
   PTree.fold (fun m pc i => Pos.max m pc) m 1%positive.
 
 Lemma max_pc_map_sound:
   forall m pc i, m!pc = Some i -> Ple pc (max_pc_map m).
 Proof.
-  intros until i.
+  intros until i. unfold max_pc_function.
   apply PTree_Properties.fold_rec with (P := fun c m => c!pc = Some i -> Ple pc m).
   (* extensionality *)
   intros. apply H0. rewrite H; auto.
@@ -561,9 +555,8 @@ Proof.
   rewrite PTree.gempty. congruence.
   (* inductive case *)
   intros. rewrite PTree.gsspec in H2. destruct (peq pc k).
-  inv H2. unfold Ple, Plt in *. lia.
-  apply Ple_trans with a. auto.
-  unfold Ple, Plt in *. lia.
+  inv H2. unfold Ple; lia.
+  apply Ple_trans with a. auto. unfold Ple; lia.
 Qed.
 
 Lemma max_pc_wf :
@@ -577,282 +570,7 @@ Proof.
   simplify. transitivity (Z.pos (max_pc_map m)); eauto.
 Qed.
 
-Definition poslength {A : Type} (l : list A) : positive :=
-  match Zlength l with
-  | Z.pos p => p
-  | _ => 1
-  end.
-
-Fixpoint penumerate {A : Type} (p : positive) (l : list A) {struct l}
-  : list (positive * A) :=
-  match l with
-  | x :: xs => (p, x) :: penumerate (Pos.pred p) xs
-  | nil => nil
-  end.
-
-Fixpoint prange {A: Type} (p1 p2: positive) (l: list A) {struct l} :=
-  match l with
-  | x :: xs => (p1, p2, x) :: prange p2 (Pos.pred p2) xs
-  | nil => nil
-  end.
-
-Lemma add_data_instr_state_incr :
-  forall s n st,
-    st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (st_freshstate s)
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       (AssocMap.set n (Vseq (AssocMapExt.get_default
-                            _ Vskip n s.(st_datapath)) st) s.(st_datapath))
-       s.(st_controllogic)).
-Proof.
-  constructor; intros;
-    try (simpl; destruct (peq n n0); subst);
-    auto with htlh.
-Qed.
-
-Definition add_data_instr (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    OK tt (mkstate
-         s.(st_st)
-         s.(st_freshreg)
-         (st_freshstate s)
-         s.(st_scldecls)
-         s.(st_arrdecls)
-         (AssocMap.set n (Vseq (AssocMapExt.get_default _ Vskip n s.(st_datapath)) st) s.(st_datapath))
-         s.(st_controllogic))
-       (add_data_instr_state_incr s n st).
-
-Lemma add_control_instr_state_incr :
-  forall s n st,
-  (st_controllogic s) ! n = None ->
-    st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (st_freshstate s)
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       s.(st_datapath)
-       (AssocMap.set n st s.(st_controllogic))).
-Proof.
-  constructor; intros;
-    try (simpl; destruct (peq n n0); subst);
-    auto with htlh.
-Qed.
-
-Definition add_control_instr (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    match check_empty_node_controllogic s n with
-    | left CTRL =>
-      OK tt (mkstate
-           s.(st_st)
-           s.(st_freshreg)
-           (st_freshstate s)
-           s.(st_scldecls)
-           s.(st_arrdecls)
-           s.(st_datapath)
-           (AssocMap.set n st s.(st_controllogic)))
-         (add_control_instr_state_incr s n st CTRL)
-    | _ =>
-      Error (Errors.msg "HTLPargen.add_control_instr: control logic is not empty")
-    end.
-
-Definition add_control_instr_force_state_incr :
-  forall s n st,
-    st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (st_freshstate s)
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       s.(st_datapath)
-       (AssocMap.set n st s.(st_controllogic))).
-Admitted.
-
-Definition update_control_instr (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    match s.(st_controllogic) ! n with
-    | Some st' =>
-      OK tt (mkstate
-           s.(st_st)
-           s.(st_freshreg)
-           (st_freshstate s)
-           s.(st_scldecls)
-           s.(st_arrdecls)
-           s.(st_datapath)
-           (AssocMap.set n (Vseq st' st) s.(st_controllogic)))
-         (add_control_instr_force_state_incr s n (Vseq st' st))
-    | None =>
-      OK tt (mkstate
-           s.(st_st)
-           s.(st_freshreg)
-           (st_freshstate s)
-           s.(st_scldecls)
-           s.(st_arrdecls)
-           s.(st_datapath)
-           (AssocMap.set n st s.(st_controllogic)))
-         (add_control_instr_force_state_incr s n st)
-    end.
-
-Definition add_control_instr_force (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    OK tt (mkstate
-      s.(st_st)
-      s.(st_freshreg)
-      (st_freshstate s)
-      s.(st_scldecls)
-      s.(st_arrdecls)
-      s.(st_datapath)
-      (AssocMap.set n st s.(st_controllogic)))
-   (add_control_instr_force_state_incr s n st).
-
-Definition add_control_instr_try (n : node) (st : stmnt) : mon unit :=
-  fun s =>
-    match check_empty_node_controllogic s n with
-    | left CTRL =>
-      OK tt (mkstate
-           s.(st_st)
-           s.(st_freshreg)
-           (st_freshstate s)
-           s.(st_scldecls)
-           s.(st_arrdecls)
-           s.(st_datapath)
-           (AssocMap.set n st s.(st_controllogic)))
-         (add_control_instr_state_incr s n st CTRL)
-    | _ =>
-      OK tt s (st_refl s)
-    end.
-
-Definition translate_arr_access (mem : AST.memory_chunk) (addr : Op.addressing)
-           (args : list reg) (stack : reg) : mon expr :=
-  match mem, addr, args with (* TODO: We should be more methodical here; what are the possibilities?*)
-  | Mint32, Op.Aindexed off, r1::nil =>
-    if (check_address_parameter_signed off)
-    then ret (Vvari stack (Vbinop Vdivu (boplitz Vadd r1 off) (Vlit (ZToValue 4))))
-    else error (Errors.msg "HTLgen: translate_arr_access address out of bounds")
-  | Mint32, Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *)
-    if (check_address_parameter_signed scale) && (check_address_parameter_signed offset)
-    then ret (Vvari stack
-                    (Vbinop Vdivu
-                            (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale))
-                            (Vlit (ZToValue 4))))
-    else error (Errors.msg "HTLgen: translate_arr_access address out of bounds")
-  | Mint32, Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *)
-    let a := Integers.Ptrofs.unsigned a in
-    if (check_address_parameter_unsigned a)
-    then ret (Vvari stack (Vlit (ZToValue (a / 4))))
-    else error (Errors.msg "HTLgen: eff_addressing out of bounds stack offset")
-  | _, _, _ => error (Errors.msg "HTLgen: translate_arr_access unsuported addressing")
-  end.
-
-Lemma create_new_state_state_incr:
-  forall s p,
-  st_incr s
-    (mkstate
-       s.(st_st)
-       s.(st_freshreg)
-       (s.(st_freshstate) + p)%positive
-       s.(st_scldecls)
-       s.(st_arrdecls)
-       s.(st_datapath)
-       s.(st_controllogic)).
-Admitted.
-
-Definition create_new_state (p: node): mon node :=
-  fun s => OK s.(st_freshstate)
-              (mkstate
-                s.(st_st)
-                s.(st_freshreg)
-                (s.(st_freshstate) + p)%positive
-                s.(st_scldecls)
-                s.(st_arrdecls)
-                s.(st_datapath)
-                s.(st_controllogic))
-              (create_new_state_state_incr s p).
-
-Definition translate_cfi' (fin rtrn preg: reg) p (cfi: cf_instr)
-  : mon (stmnt * stmnt) :=
-  match cfi with
-  | RBgoto n' =>
-    do st <- get;
-    ret (Vskip, state_goto preg p st.(st_st) n')
-  | RBcond c args n1 n2 =>
-    do st <- get;
-    do e <- translate_condition c args;
-    ret (Vskip, state_cond preg p st.(st_st) e n1 n2)
-  | RBreturn r =>
-    match r with
-    | Some r' =>
-      ret ((Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vvar r'))),
-           Vskip)
-    | None =>
-      ret ((Vseq (block fin (Vlit (ZToValue 1%Z))) (block rtrn (Vlit (ZToValue 0%Z)))),
-           Vskip)
-    end
-  | RBjumptable r tbl =>
-    do s <- get;
-    ret (Vskip, Vcase (Vvar r) (list_to_stmnt (tbl_to_case_expr s.(st_st) tbl)) (Some Vskip))
-  | RBcall sig ri rl r n =>
-    error (Errors.msg "HTLPargen: RPcall not supported.")
-  | RBtailcall sig ri lr =>
-    error (Errors.msg "HTLPargen: RPtailcall not supported.")
-  | RBbuiltin e lb b n =>
-    error (Errors.msg "HTLPargen: RPbuildin not supported.")
-  end.
-
-Definition translate_cfi (fin rtrn preg: reg) p (ni: node * cf_instr) : mon unit :=
-  let (n, cfi) := ni in
-  do (s, c) <- translate_cfi' fin rtrn preg p cfi;
-  do _ <- update_control_instr n c;
-  add_data_instr n s.
-
-Definition translate_inst a (fin rtrn preg stack : reg) (n : node) (i : instr) :=
-  match i with
-  | RBnop =>
-    do stmnt <- ret Vskip;
-    add_data_instr n stmnt
-  | RBop p op args dst =>
-    do instr <- translate_instr op args;
-    do _ <- declare_reg None dst 32;
-    add_data_instr n (translate_predicate a preg p (Vvar dst) instr)
-  | RBload p mem addr args dst =>
-    do src <- translate_arr_access mem addr args stack;
-    do _ <- declare_reg None dst 32;
-    add_data_instr n (translate_predicate a preg p (Vvar dst) src)
-  | RBstore p mem addr args src =>
-    do dst <- translate_arr_access mem addr args stack;
-    add_data_instr n (translate_predicate a preg p dst (Vvar src))
-  | RBsetpred _ c args p =>
-    do cond <- translate_condition c args;
-    do stmnt <- ret (a (pred_expr preg (Plit (true, p))) cond);
-    add_data_instr n stmnt
-  | RBexit p cf =>
-    translate_cfi fin rtrn preg p (n, cf)
-  end.
-
-Definition translate_inst_list (fin rtrn preg stack: reg) (ni : node * node * list (list instr)) :=
-  match ni with
-  | (n, p, li) =>
-      do st <- get;
-      do _ <- add_control_instr n (state_goto preg None st.(st_st) p);
-      collectlist (fun l => translate_inst Vblock fin rtrn preg stack n l) (concat li)
-  end.
-
-Definition transf_bblock (fin rtrn preg stack: reg) (ni : node * ParBB.t)
-  : mon unit :=
-  let (n, bb) := ni in
-  do nstate <- create_new_state ((poslength bb))%positive;
-  do _ <- add_control_instr nstate Vskip;
-  collectlist (translate_inst_list fin rtrn preg stack)
-                      (prange n (nstate + poslength bb - 1)%positive
-                                  bb).
-
-(*Definition decide_order a b c d e f g : {module_ordering a b c d e f g} + {True}.
+Definition decide_order a b c d e f g : {module_ordering a b c d e f g} + {True}.
   refine (match bool_dec ((a <? b) && (b <? c) && (c <? d)
                           && (d <? e) && (e <? f) && (f <? g))%positive true with
           | left t => left _
@@ -861,67 +579,50 @@ Definition transf_bblock (fin rtrn preg stack: reg) (ni : node * ParBB.t)
   simplify; repeat match goal with
                    | H: context[(_ <? _)%positive] |- _ => apply Pos.ltb_lt in H
                    end; unfold module_ordering; auto.
-Defined.*)
-
-Lemma clk_greater :
-  forall ram clk r',
-    Some ram = Some r' -> (clk < ram_addr r')%positive.
-Proof. Admitted.
+Defined.
 
-Definition declare_ram (r: ram) : mon unit :=
-  do _ <- declare_reg None r.(ram_en) 1;
-  do _ <- declare_reg None r.(ram_u_en) 1;
-  do _ <- declare_reg None r.(ram_wr_en) 1;
-  do _ <- declare_reg None r.(ram_addr) 32;
-  do _ <- declare_reg None r.(ram_d_in) 32;
-  do _ <- declare_reg None r.(ram_d_out) 32;
-  do _ <- declare_arr None r.(ram_mem) 32 r.(ram_size);
-  ret tt.
-
-Definition transf_module (f: function) : mon HTL.module :=
+Definition transf_module (f: function) : mon DHTL.module.
+  refine (
   if stack_correct f.(fn_stacksize) then
     do fin <- create_reg (Some Voutput) 1;
     do rtrn <- create_reg (Some Voutput) 32;
-    do preg <- create_reg None 128;
+    do preg <- create_reg None 32;
     do (stack, stack_len) <- create_arr None 32 (Z.to_nat (f.(fn_stacksize) / 4));
-    do _ <- collectlist (transf_bblock fin rtrn preg stack)
-                        (Maps.PTree.elements f.(fn_code));
-    do _ <- collectlist (fun r => declare_reg (Some Vinput) r 32)
-                        f.(fn_params);
+    do _stmnt <- collectlist (transf_seq_blockM fin rtrn stack preg) (Maps.PTree.elements f.(GiblePar.fn_code));
+    do _stmnt' <- collectlist (fun r => declare_reg (Some Vinput) r 32) f.(GiblePar.fn_params);
+    do _stmnt'' <- collectlist declare_all_regs (Maps.PTree.elements f.(GiblePar.fn_code));
     do start <- create_reg (Some Vinput) 1;
     do rst <- create_reg (Some Vinput) 1;
     do clk <- create_reg (Some Vinput) 1;
-    do r_en <- create_reg None 1;
-    do r_u_en <- create_reg None 1;
-    do r_addr <- create_reg None 32;
-    do r_wr_en <- create_reg None 1;
-    do r_d_in <- create_reg None 32;
-    do r_d_out <- create_reg None 32;
     do current_state <- get;
-    match zle (Z.pos (max_pc_map current_state.(st_datapath)))
-              Integers.Int.max_unsigned,
-      zle (Z.pos (max_pc_map current_state.(st_controllogic)))
-          Integers.Int.max_unsigned,
-      max_list_dec (fn_params f) (st_st current_state)
+    match zle (Z.pos (max_pc_map current_state.(st_datapath))) Integers.Int.max_unsigned,
+          decide_order (st_st current_state) fin rtrn stack start rst clk,
+          max_list_dec (GiblePar.fn_params f) (st_st current_state)
     with
-    | left LEDATA, left LECTRL, left WFPARAMS =>
-        ret (HTL.mkmodule
-        f.(fn_params)
-        current_state.(st_datapath)
-        current_state.(st_controllogic)
-        f.(fn_entrypoint)
-        current_state.(st_st)
-        fin
-        rtrn
-        start
-        rst
-        clk
-        current_state.(st_scldecls)
-        current_state.(st_arrdecls)
-        (mk_ram stack_len stack r_en r_u_en r_addr r_wr_en r_d_in r_d_out))
-    | _, _, _=> error (Errors.msg "More than 2^32 states.")
+    | left LEDATA, left MORD, left WFPARAMS =>
+        ret (DHTL.mkmodule
+           f.(GiblePar.fn_params)
+           current_state.(st_datapath)
+           f.(fn_entrypoint)
+           current_state.(st_st)
+           stack
+           stack_len
+           fin
+           rtrn
+           start
+           rst
+           clk
+           current_state.(st_scldecls)
+           current_state.(st_arrdecls)
+           None
+           (max_pc_wf _ LEDATA)
+           MORD
+           _
+           WFPARAMS)
+    | _, _, _ => error (Errors.msg "More than 2^32 states.")
     end
-  else error (Errors.msg "Stack size misalignment.").
+  else error (Errors.msg "Stack size misalignment.")); discriminate.
+Defined.
 
 Definition max_state (f: function) : state :=
   let st := Pos.succ (max_reg_function f) in
@@ -930,10 +631,9 @@ Definition max_state (f: function) : state :=
           (Pos.succ (max_pc_function f))
           (AssocMap.set st (None, VScalar 32) (st_scldecls (init_state st)))
           (st_arrdecls (init_state st))
-          (st_datapath (init_state st))
-          (st_controllogic (init_state st)).
+          (st_datapath (init_state st)).
 
-Definition transl_module (f : function) : Errors.res HTL.module :=
+Definition transl_module (f : function) : Errors.res DHTL.module :=
   run_mon (max_state f) (transf_module f).
 
 Definition transl_fundef := transf_partial_fundef transl_module.
@@ -949,7 +649,7 @@ Definition main_is_internal (p : GiblePar.program) : bool :=
   | _ => false
   end.
 
-Definition transl_program (p : GiblePar.program) : Errors.res HTL.program :=
+Definition transl_program (p : GiblePar.program) : Errors.res DHTL.program :=
   if main_is_internal p
   then transform_partial_program transl_fundef p
   else Errors.Error (Errors.msg "Main function is not Internal.").
diff --git a/src/hls/HTLgen.v b/src/hls/HTLgen.v
index 0460e54..41a1798 100644
--- a/src/hls/HTLgen.v
+++ b/src/hls/HTLgen.v
@@ -32,7 +32,6 @@ Require Import vericert.hls.AssocMap.
 Require Import vericert.hls.HTL.
 Require Import vericert.hls.ValueInt.
 Require Import vericert.hls.Verilog.
-Require Import vericert.hls.FunctionalUnits.
 
 #[local] Hint Resolve AssocMap.gempty : htlh.
 #[local] Hint Resolve AssocMap.gso : htlh.
@@ -99,13 +98,14 @@ Export HTLMonad.
 Module HTLMonadExtra := Monad.MonadExtra(HTLMonad).
 Import HTLMonadExtra.
 Export MonadNotation.
+
 #[local] Open Scope monad_scope.
 
 Definition state_goto (st : reg) (n : node) : stmnt :=
-  Vblock (Vvar st) (Vlit (posToValue n)).
+  Vnonblock (Vvar st) (Vlit (posToValue n)).
 
 Definition state_cond (st : reg) (c : expr) (n1 n2 : node) : stmnt :=
-  Vblock (Vvar st) (Vternary c (posToExpr n1) (posToExpr n2)).
+  Vnonblock (Vvar st) (Vternary c (posToExpr n1) (posToExpr n2)).
 
 Definition check_empty_node_datapath:
   forall (s: state) (n: node), { s.(st_datapath)!n = None } + { True }.
@@ -385,7 +385,7 @@ Definition translate_instr (op : Op.operation) (args : list reg) : mon expr :=
   | Op.Ocmp c, _ => translate_condition c args
   | Op.Osel c AST.Tint, r1::r2::rl =>
     do tc <- translate_condition c rl;
-    mret (Vternary tc (Vvar r1) (Vvar r2))
+    ret (Vternary tc (Vvar r1) (Vvar r2))
   | Op.Olea a, _ => translate_eff_addressing a args
   | _, _ => error (Errors.msg "Htlgen: Instruction not implemented: other")
   end.
@@ -454,7 +454,7 @@ Fixpoint enumerate (i : nat) (ns : list node) {struct ns} : list (nat * node) :=
 
 Definition tbl_to_case_expr (st : reg) (ns : list node) : list (expr * stmnt) :=
   List.map (fun a => match a with
-                    (i, n) => (Vlit (natToValue i), Vblock (Vvar st) (Vlit (posToValue n)))
+                    (i, n) => (Vlit (natToValue i), Vnonblock (Vvar st) (Vlit (posToValue n)))
                   end)
            (enumerate 0 ns).
 
@@ -469,19 +469,19 @@ Definition transf_instr (fin rtrn stack: reg) (ni: node * instruction) : mon uni
     | Iop op args dst n' =>
       if Z.leb (Z.pos n') Integers.Int.max_unsigned then
         do instr <- translate_instr op args;
-        do _ <- declare_reg None dst 32;
-        add_instr n n' (block dst instr)
+        do _empty <- declare_reg None dst 32;
+        add_instr n n' (nonblock dst instr)
       else error (Errors.msg "State is larger than 2^32.")
     | Iload mem addr args dst n' =>
       if Z.leb (Z.pos n') Integers.Int.max_unsigned then
         do src <- translate_arr_access mem addr args stack;
-        do _ <- declare_reg None dst 32;
-        add_instr n n' (block dst src)
+        do _empty <- declare_reg None dst 32;
+        add_instr n n' (nonblock dst src)
       else error (Errors.msg "State is larger than 2^32.")
     | Istore mem addr args src n' =>
       if Z.leb (Z.pos n') Integers.Int.max_unsigned then
         do dst <- translate_arr_access mem addr args stack;
-        add_instr n n' (Vblock dst (Vvar src)) (* TODO: Could juse use add_instr? reg exists. *)
+        add_instr n n' (Vnonblock dst (Vvar src)) (* TODO: Could juse use add_instr? reg exists. *)
       else error (Errors.msg "State is larger than 2^32.")
     | Icall _ _ _ _ _ => error (Errors.msg "Calls are not implemented.")
     | Itailcall _ _ _ => error (Errors.msg "Tailcalls are not implemented.")
@@ -585,7 +585,7 @@ Proof.
   simplify. transitivity (Z.pos (max_pc_map m)); eauto.
 Qed.
 
-(*Definition decide_order a b c d e f g : {module_ordering a b c d e f g} + {True}.
+Definition decide_order a b c d e f g : {module_ordering a b c d e f g} + {True}.
   refine (match bool_dec ((a <? b) && (b <? c) && (c <? d)
                           && (d <? e) && (e <? f) && (f <? g))%positive true with
           | left t => left _
@@ -594,7 +594,7 @@ Qed.
   simplify; repeat match goal with
                    | H: context[(_ <? _)%positive] |- _ => apply Pos.ltb_lt in H
                    end; unfold module_ordering; auto.
-Defined.*)
+Defined.
 
 Definition transf_module (f: function) : mon HTL.module.
   refine (
@@ -602,29 +602,26 @@ Definition transf_module (f: function) : mon HTL.module.
     do fin <- create_reg (Some Voutput) 1;
     do rtrn <- create_reg (Some Voutput) 32;
     do (stack, stack_len) <- create_arr None 32 (Z.to_nat (f.(fn_stacksize) / 4));
-    do _ <- collectlist (transf_instr fin rtrn stack) (Maps.PTree.elements f.(RTL.fn_code));
-    do _ <- collectlist (fun r => declare_reg (Some Vinput) r 32) f.(RTL.fn_params);
+    do _empty <- collectlist (transf_instr fin rtrn stack) (Maps.PTree.elements f.(RTL.fn_code));
+    do _empty' <- collectlist (fun r => declare_reg (Some Vinput) r 32) f.(RTL.fn_params);
     do start <- create_reg (Some Vinput) 1;
     do rst <- create_reg (Some Vinput) 1;
     do clk <- create_reg (Some Vinput) 1;
-    do r_en <- create_reg None 1;
-    do r_u_en <- create_reg None 1;
-    do r_addr <- create_reg None 32;
-    do r_wr_en <- create_reg None 1;
-    do r_d_in <- create_reg None 32;
-    do r_d_out <- create_reg None 32;
     do current_state <- get;
     match zle (Z.pos (max_pc_map current_state.(st_datapath))) Integers.Int.max_unsigned,
           zle (Z.pos (max_pc_map current_state.(st_controllogic))) Integers.Int.max_unsigned,
+          decide_order (st_st current_state) fin rtrn stack start rst clk,
           max_list_dec (RTL.fn_params f) (st_st current_state)
     with
-    | left LEDATA, left LECTRL, left WFPARAMS =>
+    | left LEDATA, left LECTRL, left MORD, left WFPARAMS =>
         ret (HTL.mkmodule
            f.(RTL.fn_params)
            current_state.(st_datapath)
            current_state.(st_controllogic)
            f.(fn_entrypoint)
            current_state.(st_st)
+           stack
+           stack_len
            fin
            rtrn
            start
@@ -632,8 +629,12 @@ Definition transf_module (f: function) : mon HTL.module.
            clk
            current_state.(st_scldecls)
            current_state.(st_arrdecls)
-           (mk_ram stack_len stack r_en r_u_en r_addr r_wr_en r_d_in r_d_out))
-    | _, _, _ => error (Errors.msg "More than 2^32 states.")
+           None
+           (conj (max_pc_wf _ LECTRL) (max_pc_wf _ LEDATA))
+           MORD
+           _
+           WFPARAMS)
+    | _, _, _, _ => error (Errors.msg "More than 2^32 states.")
     end
   else error (Errors.msg "Stack size misalignment.")); discriminate.
 Defined.
diff --git a/src/hls/HTLgenproof.v b/src/hls/HTLgenproof.v
index 272a434..75ee2fb 100644
--- a/src/hls/HTLgenproof.v
+++ b/src/hls/HTLgenproof.v
@@ -34,7 +34,6 @@ Require vericert.hls.HTL.
 Require Import vericert.hls.HTLgen.
 Require Import vericert.hls.HTLgenspec.
 Require Import vericert.hls.ValueInt.
-Require Import vericert.hls.FunctionalUnits.
 Require vericert.hls.Verilog.
 
 Require Import Lia.
@@ -63,10 +62,10 @@ Definition state_st_wf (m : HTL.module) (s : HTL.state) :=
 Inductive match_arrs (m : HTL.module) (f : RTL.function) (sp : Values.val) (mem : mem) :
   Verilog.assocmap_arr -> Prop :=
 | match_arr : forall asa stack,
-    asa ! (m.(HTL.mod_ram).(ram_mem)) = Some stack /\
+    asa ! (m.(HTL.mod_stk)) = Some stack /\
     stack.(arr_length) = Z.to_nat (f.(RTL.fn_stacksize) / 4) /\
     (forall ptr,
-        0 <= ptr < Z.of_nat m.(HTL.mod_ram).(ram_size) ->
+        0 <= ptr < Z.of_nat m.(HTL.mod_stk_len) ->
         opt_val_value_lessdef (Mem.loadv AST.Mint32 mem
                                          (Values.Val.offset_ptr sp (Integers.Ptrofs.repr (4 * ptr))))
                               (Option.default (NToValue 0)
@@ -406,7 +405,7 @@ Section CORRECTNESS.
   Lemma op_stack_based :
     forall F V sp v m args rs op ge pc' res0 pc f e fin rtrn st stk,
       tr_instr fin rtrn st stk (RTL.Iop op args res0 pc')
-               (Verilog.Vblock (Verilog.Vvar res0) e)
+               (Verilog.Vnonblock (Verilog.Vvar res0) e)
                (state_goto st pc') ->
       reg_stack_based_pointers sp rs ->
       (RTL.fn_code f) ! pc = Some (RTL.Iop op args res0 pc') ->
@@ -1004,42 +1003,40 @@ Section CORRECTNESS.
         constructor.
   Qed.
 
-(*|
-The proof of semantic preservation for the translation of instructions is a
-simulation argument based on diagrams of the following form:
-
-::
->                      match_states
->    code st rs ------------------------- State m st assoc
->         ||                                      |
->         ||                                      |
->         ||                                      |
->         \/                                      v
->    code st rs' ------------------------ State m st assoc'
->                      match_states
-
-where ``tr_code c data control fin rtrn st`` is assumed to hold.
-
-The precondition and postcondition is that that should hold is ``match_assocmaps
-rs assoc``.
-|*)
+  (** The proof of semantic preservation for the translation of instructions
+      is a simulation argument based on diagrams of the following form:
+<<
+                      match_states
+    code st rs ---------------- State m st assoc
+         ||                             |
+         ||                             |
+         ||                             |
+         \/                             v
+    code st rs' --------------- State m st assoc'
+                      match_states
+>>
+      where [tr_code c data control fin rtrn st] is assumed to hold.
+
+      The precondition and postcondition is that that should hold is [match_assocmaps rs assoc].
+   *)
 
   Definition transl_instr_prop (instr : RTL.instruction) : Prop :=
     forall m asr asa fin rtrn st stmt trans res,
-      tr_instr fin rtrn st (m.(HTL.mod_ram).(ram_mem)) instr stmt trans ->
+      tr_instr fin rtrn st (m.(HTL.mod_stk)) instr stmt trans ->
       exists asr' asa',
         HTL.step tge (HTL.State res m st asr asa) Events.E0 (HTL.State res m st asr' asa').
 
-  Opaque combine.
+Ltac name_goal name := refine ?[name].
+
+Ltac unfold_merge :=
+  unfold merge_assocmap; repeat (rewrite AssocMapExt.merge_add_assoc);
+  try (rewrite AssocMapExt.merge_base_1).
 
   Ltac tac0 :=
     match goal with
     | [ |- HTL.exec_ram _ _ _ _ _ ] => constructor
-    | [ |- context[Verilog.merge_arrs _ _] ] => unfold Verilog.merge_arrs
-    | [ |- context[Verilog.merge_arr] ] => unfold Verilog.merge_arr
-    | [ |- context[Verilog.merge_regs _ _] ] => unfold Verilog.merge_regs; crush; unfold_merge
+    | [ |- context[Verilog.merge_regs _ _] ] => unfold Verilog.merge_regs; cbn; unfold_merge
     | [ |- context[reg_stack_based_pointers] ] => unfold reg_stack_based_pointers; intros
-    | [ |- context[Verilog.arr_assocmap_set _ _ _ _] ] => unfold Verilog.arr_assocmap_set
 
     | [ |- context[HTL.empty_stack] ] => unfold HTL.empty_stack
 
@@ -1071,11 +1068,97 @@ rs assoc``.
     | [ H : opt_val_value_lessdef _ _ |- _ ] => inv H
     | [ H : context[Z.of_nat (Z.to_nat _)] |- _ ] => rewrite Z2Nat.id in H; [> solve crush |]
     | [ H : _ ! _ = Some _ |- _] => setoid_rewrite H
+    | [ |- context[AssocMapExt.merge]] => progress unfold_merge
     end.
 
+  Ltac simplify_local := intros; unfold_constants; cbn in *;
+                         repeat (nicify_hypotheses; nicify_goals; kill_bools; substpp);
+                         cbn in *.
+
+  Ltac simplify_val := repeat (simplify_local; unfold uvalueToZ, valueToPtr, Ptrofs.of_int, valueToInt, intToValue,
+                                 ptrToValue in *).
+
+                               Ltac crush_val := simplify_val; try discriminate; try congruence; try lia; liapp; try assumption.
+
   Ltac small_tac := repeat (crush_val; try array; try ptrofs); crush_val; auto.
   Ltac big_tac := repeat (crush_val; try array; try ptrofs; try tac0); crush_val; auto.
 
+  Lemma merge_get_default :
+    forall ars ars' r x,
+      ars ! r = Some x ->
+      (AssocMapExt.merge _ ars ars') # r = x.
+  Proof.
+    unfold AssocMapExt.merge; intros.
+    unfold "#", AssocMapExt.get_default.
+    rewrite AssocMap.gcombine by auto.
+    unfold AssocMapExt.merge_atom. 
+    now rewrite !H.
+  Qed.
+
+  Lemma merge_get_default2 :
+    forall ars ars' r,
+      ars ! r = None ->
+      (AssocMapExt.merge _ ars ars') # r = ars' # r.
+  Proof.
+    unfold AssocMapExt.merge; intros.
+    unfold "#", AssocMapExt.get_default.
+    rewrite AssocMap.gcombine by auto.
+    unfold AssocMapExt.merge_atom. 
+    now rewrite !H.
+  Qed.
+
+  Lemma merge_get_default3 :
+    forall A ars ars' r,
+      ars ! r = None ->
+      (AssocMapExt.merge A ars ars') ! r = ars' ! r.
+  Proof.
+    unfold AssocMapExt.merge; intros.
+    unfold "#", AssocMapExt.get_default.
+    rewrite AssocMap.gcombine by auto.
+    unfold AssocMapExt.merge_atom.
+    now rewrite !H.
+  Qed.
+
+  Lemma merge_get_default4 :
+    forall A ars ars' r x,
+      ars ! r = Some x ->
+      (AssocMapExt.merge A ars ars') ! r = Some x.
+  Proof.
+    unfold AssocMapExt.merge; intros.
+    unfold "#", AssocMapExt.get_default.
+    rewrite AssocMap.gcombine by auto.
+    unfold AssocMapExt.merge_atom. 
+    now rewrite !H.
+  Qed.
+
+  Lemma match_assocmaps_merge_empty:
+    forall f rs ars,
+      match_assocmaps f rs ars ->
+      match_assocmaps f rs (AssocMapExt.merge value empty_assocmap ars).
+  Proof.
+    inversion 1; subst; clear H.
+    constructor; intros.
+    rewrite merge_get_default2; auto.
+  Qed.
+
+  Opaque AssocMap.get.
+  Opaque AssocMap.set.
+  Opaque AssocMapExt.merge.
+  Opaque Verilog.merge_arr.
+
+  Lemma match_assocmaps_ext :
+    forall f rs ars1 ars2,
+      (forall x, Ple x (RTL.max_reg_function f) -> ars1 ! x = ars2 ! x) ->
+      match_assocmaps f rs ars1 ->
+      match_assocmaps f rs ars2.
+  Proof.
+    intros * YFRL YMATCH.
+    inv YMATCH. constructor; intros x' YPLE.
+    unfold "#", AssocMapExt.get_default in *. 
+    rewrite <- YFRL by auto.
+    eauto.
+  Qed.
+
   Lemma transl_inop_correct:
     forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
       (rs : RTL.regset) (m : mem) (pc' : RTL.node),
@@ -1094,17 +1177,33 @@ rs assoc``.
     apply Smallstep.plus_one.
     eapply HTL.step_module; eauto.
     inv CONST; assumption.
-    inv CONST; assumption.
+    inv CONST; assumption. 
     (* processing of state *)
     econstructor.
-    (* crush. *)
-    (* econstructor. *)
-    (* econstructor. *)
-    (* econstructor. *)
-
-    (* all: inv MARR; big_tac. *) Abort.
-
-(*    inv CONST; constructor; simplify; rewrite AssocMap.gso; auto; lia.
+    crush.
+    econstructor.
+    econstructor.
+    econstructor.
+    big_tac.
+    cbn.
+
+    solve [inv MARR; big_tac].
+
+    (* inv MARR; big_tac. *)
+    inv MARR; big_tac; auto.
+
+    - eapply match_assocmaps_ext; [|eauto]; intros.
+      repeat unfold_merge. rewrite AssocMap.gso by (unfold Ple in *; lia).
+      rewrite AssocMapExt.merge_base_1; auto.
+    - rewrite <- H1. unfold Verilog.merge_arrs.
+      rewrite !AssocMap.gcombine by auto. rewrite !AssocMap.gss.
+      setoid_rewrite H1.
+      repeat erewrite Verilog.merge_arr_empty2; eauto.
+    - inv CONST; cbn in *. constructor; cbn in *. 
+      + repeat unfold_merge. rewrite AssocMap.gso by lia.
+        unfold_merge; auto.
+      + repeat unfold_merge. rewrite AssocMap.gso by lia.
+        unfold_merge; auto.
 
     Unshelve. exact tt.
   Qed.
@@ -1138,27 +1237,38 @@ rs assoc``.
 
     all: big_tac.
 
-    assert (HPle: Ple res0 (RTL.max_reg_function f))
+    - assert (HPle: Ple res0 (RTL.max_reg_function f))
         by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-
-    unfold Ple in HPle. lia.
-    apply regs_lessdef_add_match. assumption.
-    apply regs_lessdef_add_greater. unfold Plt; lia. assumption.
-    assert (HPle: Ple res0 (RTL.max_reg_function f))
+      unfold Ple in HPle. lia.
+    - eapply match_assocmaps_merge_empty. eapply match_assocmaps_ext; intros.
+      unfold Ple in *. instantiate (1 := asr # res0 <- x).
+      destruct (peq res0 x1); subst.
+      + rewrite merge_get_default4 with (x := x);
+        apply AssocMap.gss.
+      + rewrite merge_get_default3; [now rewrite AssocMap.gso by auto|].
+        rewrite AssocMap.gso by auto.
+        now rewrite AssocMap.gso by lia.
+      + now apply regs_lessdef_add_match.
+    - assert (HPle: Ple res0 (RTL.max_reg_function f))
         by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-    unfold Ple in HPle; lia.
-    eapply op_stack_based; eauto.
-    inv CONST. constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso.
-    assumption. lia.
-    assert (HPle: Ple res0 (RTL.max_reg_function f))
-      by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-    unfold Ple in HPle. lia.
-    rewrite AssocMap.gso. rewrite AssocMap.gso.
-    assumption. lia.
-    assert (HPle: Ple res0 (RTL.max_reg_function f))
-      by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-    unfold Ple in HPle. lia.
-    Unshelve. exact tt.
+      unfold Ple in HPle. lia.
+    - unfold Verilog.merge_arrs.
+      rewrite ! AssocMap.gcombine by auto. rewrite ! AssocMap.gss.
+      erewrite ! Verilog.merge_arr_empty2; eauto.
+      erewrite ! Verilog.merge_arr_empty2; eauto.
+    - assumption.
+    - eapply op_stack_based; eauto.
+    - assert (HPle: Ple res0 (RTL.max_reg_function f))
+        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
+      unfold Ple in *.
+      inv CONST. constructor; cbn.
+      repeat rewrite merge_get_default3 by solve [auto | lia].
+      rewrite merge_get_default3; [eauto | ].
+      repeat rewrite AssocMap.gso by solve [auto | lia]. auto.
+      repeat rewrite merge_get_default3 by solve [auto | lia].
+      rewrite merge_get_default3; [eauto | ].
+      repeat rewrite AssocMap.gso by solve [auto | lia]. auto.
+      Unshelve. apply tt.
   Qed.
   #[local] Hint Resolve transl_iop_correct : htlproof.
 
@@ -1266,373 +1376,374 @@ rs assoc``.
           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\
           match_states (RTL.State s f sp pc' (Registers.Regmap.set dst v rs) m) R2.
   Proof.
-    intros s f sp pc rs m chunk addr args dst pc' a v H H0 H1 R1 MSTATE.
-    inv_state. inv_arr_access.
-
-    + (** Preamble *)
-      inv MARR. inv CONST. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-
-      pose proof MASSOC as MASSOC'.
-      inv MASSOC'.
-      pose proof (H0 r0).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      apply H0 in HPler0.
-      inv HPler0; try congruence.
-      rewrite EQr0 in H11.
-      inv H11.
-
-      unfold check_address_parameter_signed in *;
-      unfold check_address_parameter_unsigned in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { apply Mem.load_valid_access in H1. unfold Mem.valid_access in *. simplify.
-        apply Zdivide_mod. assumption. }
-
-      (** Read bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto.
-        split; try lia; apply Integers.Ptrofs.unsigned_range_2.
-        small_tac. }
-
-      (** Normalisation proof *)
-      assert (Integers.Ptrofs.repr
-                (4 * Integers.Ptrofs.unsigned
-                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET)
-        as NORMALISE.
-      { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity.
-        rewrite <- PtrofsExtra.mul_unsigned.
-        apply PtrofsExtra.mul_divu; crush; auto. }
-
-      (** Normalised bounds proof *)
-      assert (0 <=
-              Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))
-              < (RTL.fn_stacksize f / 4))
-        as NORMALISE_BOUND.
-      { split.
-        apply Integers.Ptrofs.unsigned_range_2.
-        assert (HDIV: forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity.
-        unfold Integers.Ptrofs.divu at 2 in HDIV.
-        rewrite HDIV. clear HDIV.
-        rewrite Integers.Ptrofs.unsigned_repr; crush.
-        apply Zmult_lt_reg_r with (p := 4); try lia.
-        repeat rewrite ZLib.div_mul_undo; try lia.
-        apply Z.div_pos; small_tac.
-        apply Z.div_le_upper_bound; small_tac. }
-
-      inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ];
-      clear NORMALISE_BOUND.
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor.
-
-      all: big_tac.
-
-      1: {
-        assert (HPle : Ple dst (RTL.max_reg_function f)).
-        eapply RTL.max_reg_function_def. eassumption. auto.
-        apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption.
-      }
-
-      2: {
-        assert (HPle : Ple dst (RTL.max_reg_function f)).
-        eapply RTL.max_reg_function_def. eassumption. auto.
-        apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption.
-      }
-
-      (** Match assocmaps *)
-      apply regs_lessdef_add_match; big_tac.
-
-      (** Equality proof *)
-      rewrite <- offset_expr_ok.
-
-      specialize (H9 (Integers.Ptrofs.unsigned
-                        (Integers.Ptrofs.divu
-                           OFFSET
-                           (Integers.Ptrofs.repr 4)))).
-      exploit H9; big_tac.
-
-      (** RSBP preservation *)
-      unfold arr_stack_based_pointers in ASBP.
-      specialize (ASBP (Integers.Ptrofs.unsigned
-                          (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))).
-      exploit ASBP; big_tac.
-      rewrite NORMALISE in H14. rewrite HeqOFFSET in H14. rewrite H1 in H14. assumption.
-      constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso.
-      assumption. lia.
-      assert (HPle: Ple dst (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-      unfold Ple in HPle. lia.
-      rewrite AssocMap.gso. rewrite AssocMap.gso.
-      assumption. lia.
-      assert (HPle: Ple dst (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-      unfold Ple in HPle. lia.
-    + (** Preamble *)
-      inv MARR. inv CONST. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-      pose proof (RSBP r1) as RSBPr1.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0;
-      destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-      clear RSBPr1.
-
-      pose proof MASSOC as MASSOC'.
-      inv MASSOC'.
-      pose proof (H0 r0).
-      pose proof (H0 r1).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      assert (HPler1 : Ple r1 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto).
-      apply H8 in HPler0.
-      apply H11 in HPler1.
-      inv HPler0; inv HPler1; try congruence.
-      rewrite EQr0 in H13.
-      rewrite EQr1 in H14.
-      inv H13. inv H14.
-      clear H0. clear H8. clear H11.
-
-      unfold check_address_parameter_signed in *;
-      unfold check_address_parameter_unsigned in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int
-                                       (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z))
-                                                         (Integers.Int.repr z0)))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { apply Mem.load_valid_access in H1. unfold Mem.valid_access in *. simplify.
-        apply Zdivide_mod. assumption. }
-
-      (** Read bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto.
-        split; try lia; apply Integers.Ptrofs.unsigned_range_2.
-        small_tac. }
-
-      (** Normalisation proof *)
-      assert (Integers.Ptrofs.repr
-                (4 * Integers.Ptrofs.unsigned
-                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET)
-        as NORMALISE.
-      { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity.
-        rewrite <- PtrofsExtra.mul_unsigned.
-        apply PtrofsExtra.mul_divu; crush. }
-
-      (** Normalised bounds proof *)
-      assert (0 <=
-              Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))
-              < (RTL.fn_stacksize f / 4))
-        as NORMALISE_BOUND.
-      { split.
-        apply Integers.Ptrofs.unsigned_range_2.
-        assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity.
-        unfold Integers.Ptrofs.divu at 2 in H14.
-        rewrite H14. clear H14.
-        rewrite Integers.Ptrofs.unsigned_repr; crush.
-        apply Zmult_lt_reg_r with (p := 4); try lia.
-        repeat rewrite ZLib.div_mul_undo; try lia.
-        apply Z.div_pos; small_tac.
-        apply Z.div_le_upper_bound; lia. }
-
-      inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ];
-      clear NORMALISE_BOUND.
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. auto. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      all: big_tac.
-
-      1: { assert (HPle : Ple dst (RTL.max_reg_function f)).
-           eapply RTL.max_reg_function_def. eassumption. auto.
-           apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. }
-
-      2: { assert (HPle : Ple dst (RTL.max_reg_function f)).
-           eapply RTL.max_reg_function_def. eassumption. auto.
-           apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. }
-
-      (** Match assocmaps *)
-      apply regs_lessdef_add_match; big_tac.
-
-      (** Equality proof *)
-      rewrite <- offset_expr_ok_2.
-
-      specialize (H9 (Integers.Ptrofs.unsigned
-                        (Integers.Ptrofs.divu
-                           OFFSET
-                           (Integers.Ptrofs.repr 4)))).
-      exploit H9; big_tac.
-
-      (** RSBP preservation *)
-      unfold arr_stack_based_pointers in ASBP.
-      specialize (ASBP (Integers.Ptrofs.unsigned
-                          (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))).
-      exploit ASBP; big_tac.
-      rewrite NORMALISE in H14. rewrite HeqOFFSET in H14. rewrite H1 in H14. assumption.
-
-      constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso.
-      assumption. lia.
-      assert (HPle: Ple dst (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-      unfold Ple in HPle. lia.
-      rewrite AssocMap.gso. rewrite AssocMap.gso.
-      assumption. lia.
-      assert (HPle: Ple dst (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-      unfold Ple in HPle. lia.
-
-    + inv MARR. inv CONST. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-      rewrite ARCHI in H0. crush.
-
-      unfold check_address_parameter_unsigned in *;
-      unfold check_address_parameter_signed in *; crush.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      rewrite ZERO in H1. clear ZERO.
-      rewrite Integers.Ptrofs.add_zero_l in H1.
-
-      remember i0 as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { apply Mem.load_valid_access in H1. unfold Mem.valid_access in *. simplify.
-        apply Zdivide_mod. assumption. }
-
-      (** Read bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:?EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); big_tac. }
-
-      (** Normalisation proof *)
-      assert (Integers.Ptrofs.repr
-                (4 * Integers.Ptrofs.unsigned
-                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET)
-        as NORMALISE.
-      { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity.
-        rewrite <- PtrofsExtra.mul_unsigned.
-        apply PtrofsExtra.mul_divu; crush. }
-
-      (** Normalised bounds proof *)
-      assert (0 <=
-              Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))
-              < (RTL.fn_stacksize f / 4))
-        as NORMALISE_BOUND.
-      { split.
-        apply Integers.Ptrofs.unsigned_range_2.
-        assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity.
-        unfold Integers.Ptrofs.divu at 2 in H0.
-        rewrite H0. clear H0.
-        rewrite Integers.Ptrofs.unsigned_repr; crush.
-        apply Zmult_lt_reg_r with (p := 4); try lia.
-        repeat rewrite ZLib.div_mul_undo; try lia.
-        apply Z.div_pos; small_tac.
-        apply Z.div_le_upper_bound; lia. }
-
-      inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ];
-      clear NORMALISE_BOUND.
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      econstructor. econstructor. econstructor. crush.
-      econstructor. econstructor. econstructor. econstructor. crush.
-
-      all: big_tac.
-
-      1: { assert (HPle : Ple dst (RTL.max_reg_function f)).
-           eapply RTL.max_reg_function_def. eassumption. auto.
-           apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. }
-
-      2: { assert (HPle : Ple dst (RTL.max_reg_function f)).
-           eapply RTL.max_reg_function_def. eassumption. auto.
-           apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. }
-
-      (** Match assocmaps *)
-      apply regs_lessdef_add_match; big_tac.
-
-      (** Equality proof *)
-      rewrite <- offset_expr_ok_3.
-
-      specialize (H9 (Integers.Ptrofs.unsigned
-                        (Integers.Ptrofs.divu
-                           OFFSET
-                           (Integers.Ptrofs.repr 4)))).
-      exploit H9; big_tac.
-
-      (** RSBP preservation *)
-      unfold arr_stack_based_pointers in ASBP.
-      specialize (ASBP (Integers.Ptrofs.unsigned
-                          (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))).
-      exploit ASBP; big_tac.
-      rewrite NORMALISE in H0. rewrite H1 in H0. assumption.
-
-      constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso.
-      assumption. lia.
-      assert (HPle: Ple dst (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-      unfold Ple in HPle. lia.
-      rewrite AssocMap.gso. rewrite AssocMap.gso.
-      assumption. lia.
-      assert (HPle: Ple dst (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_def; eauto; simpl; auto).
-      unfold Ple in HPle. lia.
-
-      Unshelve.
-      exact (Values.Vint (Int.repr 0)).
-      exact tt.
-      exact (Values.Vint (Int.repr 0)).
-      exact tt.
-      exact (Values.Vint (Int.repr 0)).
-      exact tt.
-  Qed.
+    (* intros s f sp pc rs m chunk addr args dst pc' a v H H0 H1 R1 MSTATE. *)
+    (* inv_state. inv_arr_access. *)
+
+    (* + (** Preamble *) *)
+    (*   inv MARR. inv CONST. crush. *)
+
+    (*   unfold Op.eval_addressing in H0. *)
+    (*   destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+    (*   unfold reg_stack_based_pointers in RSBP. *)
+    (*   pose proof (RSBP r0) as RSBPr0. *)
+
+    (*   destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush. *)
+
+    (*   rewrite ARCHI in H1. crush. *)
+    (*   subst. *)
+
+    (*   pose proof MASSOC as MASSOC'. *)
+    (*   inv MASSOC'. *)
+    (*   pose proof (H0 r0). *)
+    (*   assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+    (*   apply H0 in HPler0. *)
+    (*   inv HPler0; try congruence. *)
+    (*   rewrite EQr0 in H11. *)
+    (*   inv H11. *)
+
+    (*   unfold check_address_parameter_signed in *; *)
+    (*   unfold check_address_parameter_unsigned in *; crush. *)
+
+    (*   remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+    (*                                 (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET. *)
+
+    (*   (** Modular preservation proof *) *)
+    (*   assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+    (*   { apply Mem.load_valid_access in H1. unfold Mem.valid_access in *. simplify. *)
+    (*     apply Zdivide_mod. assumption. } *)
+
+    (*   (** Read bounds proof *) *)
+    (*   assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH. *)
+    (*   { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+    (*     unfold stack_bounds in BOUNDS. *)
+    (*     exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto. *)
+    (*     split; try lia; apply Integers.Ptrofs.unsigned_range_2. *)
+    (*     small_tac. } *)
+
+    (*   (** Normalisation proof *) *)
+    (*   assert (Integers.Ptrofs.repr *)
+    (*             (4 * Integers.Ptrofs.unsigned *)
+    (*                    (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET) *)
+    (*     as NORMALISE. *)
+    (*   { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity. *)
+    (*     rewrite <- PtrofsExtra.mul_unsigned. *)
+    (*     apply PtrofsExtra.mul_divu; crush; auto. } *)
+
+    (*   (** Normalised bounds proof *) *)
+    (*   assert (0 <= *)
+    (*           Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)) *)
+    (*           < (RTL.fn_stacksize f / 4)) *)
+    (*     as NORMALISE_BOUND. *)
+    (*   { split. *)
+    (*     apply Integers.Ptrofs.unsigned_range_2. *)
+    (*     assert (HDIV: forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity. *)
+    (*     unfold Integers.Ptrofs.divu at 2 in HDIV. *)
+    (*     rewrite HDIV. clear HDIV. *)
+    (*     rewrite Integers.Ptrofs.unsigned_repr; crush. *)
+    (*     apply Zmult_lt_reg_r with (p := 4); try lia. *)
+    (*     repeat rewrite ZLib.div_mul_undo; try lia. *)
+    (*     apply Z.div_pos; small_tac. *)
+    (*     apply Z.div_le_upper_bound; small_tac. } *)
+
+    (*   inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ]; *)
+    (*   clear NORMALISE_BOUND. *)
+
+    (*   (** Start of proof proper *) *)
+    (*   eexists. split. *)
+    (*   eapply Smallstep.plus_one. *)
+    (*   eapply HTL.step_module; eauto. *)
+    (*   econstructor. econstructor. econstructor. crush. *)
+    (*   econstructor. econstructor. econstructor. crush. *)
+    (*   econstructor. econstructor. *)
+    (*   econstructor. econstructor. econstructor. econstructor. *)
+    (*   econstructor. econstructor. *)
+
+    (*   all: big_tac. *)
+
+    (*   1: { *)
+    (*     assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+    (*     eapply RTL.max_reg_function_def. eassumption. auto. *)
+    (*     apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. *)
+    (*   } *)
+
+    (*   2: { *)
+    (*     assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+    (*     eapply RTL.max_reg_function_def. eassumption. auto. *)
+    (*     apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. *)
+    (*   } *)
+
+    (*   (** Match assocmaps *) *)
+    (*   apply regs_lessdef_add_match; big_tac. *)
+
+    (*   (** Equality proof *) *)
+    (*   rewrite <- offset_expr_ok. *)
+
+    (*   specialize (H9 (Integers.Ptrofs.unsigned *)
+    (*                     (Integers.Ptrofs.divu *)
+    (*                        OFFSET *)
+    (*                        (Integers.Ptrofs.repr 4)))). *)
+    (*   exploit H9; big_tac. *)
+
+    (*   (** RSBP preservation *) *)
+    (*   unfold arr_stack_based_pointers in ASBP. *)
+    (*   specialize (ASBP (Integers.Ptrofs.unsigned *)
+    (*                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))). *)
+    (*   exploit ASBP; big_tac. *)
+    (*   rewrite NORMALISE in H14. rewrite HeqOFFSET in H14. rewrite H1 in H14. assumption. *)
+    (*   constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+    (*   assumption. lia. *)
+    (*   assert (HPle: Ple dst (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+    (*   unfold Ple in HPle. lia. *)
+    (*   rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+    (*   assumption. lia. *)
+    (*   assert (HPle: Ple dst (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+    (*   unfold Ple in HPle. lia. *)
+    (* + (** Preamble *) *)
+    (*   inv MARR. inv CONST. crush. *)
+
+    (*   unfold Op.eval_addressing in H0. *)
+    (*   destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+    (*   unfold reg_stack_based_pointers in RSBP. *)
+    (*   pose proof (RSBP r0) as RSBPr0. *)
+    (*   pose proof (RSBP r1) as RSBPr1. *)
+
+    (*   destruct (Registers.Regmap.get r0 rs) eqn:EQr0; *)
+    (*   destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush. *)
+
+    (*   rewrite ARCHI in H1. crush. *)
+    (*   subst. *)
+    (*   clear RSBPr1. *)
+
+    (*   pose proof MASSOC as MASSOC'. *)
+    (*   inv MASSOC'. *)
+    (*   pose proof (H0 r0). *)
+    (*   pose proof (H0 r1). *)
+    (*   assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+    (*   assert (HPler1 : Ple r1 (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_use; eauto; simpl; auto). *)
+    (*   apply H8 in HPler0. *)
+    (*   apply H11 in HPler1. *)
+    (*   inv HPler0; inv HPler1; try congruence. *)
+    (*   rewrite EQr0 in H13. *)
+    (*   rewrite EQr1 in H14. *)
+    (*   inv H13. inv H14. *)
+    (*   clear H0. clear H8. clear H11. *)
+
+    (*   unfold check_address_parameter_signed in *; *)
+    (*   unfold check_address_parameter_unsigned in *; crush. *)
+
+    (*   remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+    (*                                 (Integers.Ptrofs.of_int *)
+    (*                                    (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z)) *)
+    (*                                                      (Integers.Int.repr z0)))) as OFFSET. *)
+
+    (*   (** Modular preservation proof *) *)
+    (*   assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+    (*   { apply Mem.load_valid_access in H1. unfold Mem.valid_access in *. simplify. *)
+    (*     apply Zdivide_mod. assumption. } *)
+
+    (*   (** Read bounds proof *) *)
+    (*   assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH. *)
+    (*   { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+    (*     unfold stack_bounds in BOUNDS. *)
+    (*     exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); auto. *)
+    (*     split; try lia; apply Integers.Ptrofs.unsigned_range_2. *)
+    (*     small_tac. } *)
+
+    (*   (** Normalisation proof *) *)
+    (*   assert (Integers.Ptrofs.repr *)
+    (*             (4 * Integers.Ptrofs.unsigned *)
+    (*                    (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET) *)
+    (*     as NORMALISE. *)
+    (*   { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity. *)
+    (*     rewrite <- PtrofsExtra.mul_unsigned. *)
+    (*     apply PtrofsExtra.mul_divu; crush. } *)
+
+    (*   (** Normalised bounds proof *) *)
+    (*   assert (0 <= *)
+    (*           Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)) *)
+    (*           < (RTL.fn_stacksize f / 4)) *)
+    (*     as NORMALISE_BOUND. *)
+    (*   { split. *)
+    (*     apply Integers.Ptrofs.unsigned_range_2. *)
+    (*     assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity. *)
+    (*     unfold Integers.Ptrofs.divu at 2 in H14. *)
+    (*     rewrite H14. clear H14. *)
+    (*     rewrite Integers.Ptrofs.unsigned_repr; crush. *)
+    (*     apply Zmult_lt_reg_r with (p := 4); try lia. *)
+    (*     repeat rewrite ZLib.div_mul_undo; try lia. *)
+    (*     apply Z.div_pos; small_tac. *)
+    (*     apply Z.div_le_upper_bound; lia. } *)
+
+    (*   inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ]; *)
+    (*   clear NORMALISE_BOUND. *)
+
+    (*   (** Start of proof proper *) *)
+    (*   eexists. split. *)
+    (*   eapply Smallstep.plus_one. *)
+    (*   eapply HTL.step_module; eauto. *)
+    (*   econstructor. econstructor. econstructor. crush. *)
+    (*   econstructor. econstructor. econstructor. crush. *)
+    (*   econstructor. econstructor. econstructor. *)
+    (*   econstructor. econstructor. econstructor. econstructor. *)
+    (*   econstructor. econstructor. auto. econstructor. *)
+    (*   econstructor. econstructor. econstructor. econstructor. *)
+    (*   all: big_tac. *)
+
+    (*   1: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+    (*        eapply RTL.max_reg_function_def. eassumption. auto. *)
+    (*        apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+    (*   2: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+    (*        eapply RTL.max_reg_function_def. eassumption. auto. *)
+    (*        apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+    (*   (** Match assocmaps *) *)
+    (*   apply regs_lessdef_add_match; big_tac. *)
+
+    (*   (** Equality proof *) *)
+    (*   rewrite <- offset_expr_ok_2. *)
+
+    (*   specialize (H9 (Integers.Ptrofs.unsigned *)
+    (*                     (Integers.Ptrofs.divu *)
+    (*                        OFFSET *)
+    (*                        (Integers.Ptrofs.repr 4)))). *)
+    (*   exploit H9; big_tac. *)
+
+    (*   (** RSBP preservation *) *)
+    (*   unfold arr_stack_based_pointers in ASBP. *)
+    (*   specialize (ASBP (Integers.Ptrofs.unsigned *)
+    (*                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))). *)
+    (*   exploit ASBP; big_tac. *)
+    (*   rewrite NORMALISE in H14. rewrite HeqOFFSET in H14. rewrite H1 in H14. assumption. *)
+
+    (*   constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+    (*   assumption. lia. *)
+    (*   assert (HPle: Ple dst (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+    (*   unfold Ple in HPle. lia. *)
+    (*   rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+    (*   assumption. lia. *)
+    (*   assert (HPle: Ple dst (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+    (*   unfold Ple in HPle. lia. *)
+
+    (* + inv MARR. inv CONST. crush. *)
+
+    (*   unfold Op.eval_addressing in H0. *)
+    (*   destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+    (*   rewrite ARCHI in H0. crush. *)
+
+    (*   unfold check_address_parameter_unsigned in *; *)
+    (*   unfold check_address_parameter_signed in *; crush. *)
+
+    (*   assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+    (*   rewrite ZERO in H1. clear ZERO. *)
+    (*   rewrite Integers.Ptrofs.add_zero_l in H1. *)
+
+    (*   remember i0 as OFFSET. *)
+
+    (*   (** Modular preservation proof *) *)
+    (*   assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+    (*   { apply Mem.load_valid_access in H1. unfold Mem.valid_access in *. simplify. *)
+    (*     apply Zdivide_mod. assumption. } *)
+
+    (*   (** Read bounds proof *) *)
+    (*   assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH. *)
+    (*   { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:?EQ; crush; auto. *)
+    (*     unfold stack_bounds in BOUNDS. *)
+    (*     exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET)); big_tac. } *)
+
+    (*   (** Normalisation proof *) *)
+    (*   assert (Integers.Ptrofs.repr *)
+    (*             (4 * Integers.Ptrofs.unsigned *)
+    (*                    (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4))) = OFFSET) *)
+    (*     as NORMALISE. *)
+    (*   { replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) at 1 by reflexivity. *)
+    (*     rewrite <- PtrofsExtra.mul_unsigned. *)
+    (*     apply PtrofsExtra.mul_divu; crush. } *)
+
+    (*   (** Normalised bounds proof *) *)
+    (*   assert (0 <= *)
+    (*           Integers.Ptrofs.unsigned (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)) *)
+    (*           < (RTL.fn_stacksize f / 4)) *)
+    (*     as NORMALISE_BOUND. *)
+    (*   { split. *)
+    (*     apply Integers.Ptrofs.unsigned_range_2. *)
+    (*     assert (forall x y, Integers.Ptrofs.divu x y = Integers.Ptrofs.divu x y ) by reflexivity. *)
+    (*     unfold Integers.Ptrofs.divu at 2 in H0. *)
+    (*     rewrite H0. clear H0. *)
+    (*     rewrite Integers.Ptrofs.unsigned_repr; crush. *)
+    (*     apply Zmult_lt_reg_r with (p := 4); try lia. *)
+    (*     repeat rewrite ZLib.div_mul_undo; try lia. *)
+    (*     apply Z.div_pos; small_tac. *)
+    (*     apply Z.div_le_upper_bound; lia. } *)
+
+    (*   inversion NORMALISE_BOUND as [ NORMALISE_BOUND_LOW NORMALISE_BOUND_HIGH ]; *)
+    (*   clear NORMALISE_BOUND. *)
+
+    (*   (** Start of proof proper *) *)
+    (*   eexists. split. *)
+    (*   eapply Smallstep.plus_one. *)
+    (*   eapply HTL.step_module; eauto. *)
+    (*   econstructor. econstructor. econstructor. crush. *)
+    (*   econstructor. econstructor. econstructor. econstructor. crush. *)
+
+    (*   all: big_tac. *)
+
+    (*   1: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+    (*        eapply RTL.max_reg_function_def. eassumption. auto. *)
+    (*        apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+    (*   2: { assert (HPle : Ple dst (RTL.max_reg_function f)). *)
+    (*        eapply RTL.max_reg_function_def. eassumption. auto. *)
+    (*        apply ZExtra.Pge_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. } *)
+
+    (*   (** Match assocmaps *) *)
+    (*   apply regs_lessdef_add_match; big_tac. *)
+
+    (*   (** Equality proof *) *)
+    (*   rewrite <- offset_expr_ok_3. *)
+
+    (*   specialize (H9 (Integers.Ptrofs.unsigned *)
+    (*                     (Integers.Ptrofs.divu *)
+    (*                        OFFSET *)
+    (*                        (Integers.Ptrofs.repr 4)))). *)
+    (*   exploit H9; big_tac. *)
+
+    (*   (** RSBP preservation *) *)
+    (*   unfold arr_stack_based_pointers in ASBP. *)
+    (*   specialize (ASBP (Integers.Ptrofs.unsigned *)
+    (*                       (Integers.Ptrofs.divu OFFSET (Integers.Ptrofs.repr 4)))). *)
+    (*   exploit ASBP; big_tac. *)
+    (*   rewrite NORMALISE in H0. rewrite H1 in H0. assumption. *)
+
+    (*   constructor; simplify. rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+    (*   assumption. lia. *)
+    (*   assert (HPle: Ple dst (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+    (*   unfold Ple in HPle. lia. *)
+    (*   rewrite AssocMap.gso. rewrite AssocMap.gso. *)
+    (*   assumption. lia. *)
+    (*   assert (HPle: Ple dst (RTL.max_reg_function f)) *)
+    (*     by (eapply RTL.max_reg_function_def; eauto; simpl; auto). *)
+    (*   unfold Ple in HPle. lia. *)
+
+    (*   Unshelve. *)
+    (*   exact (Values.Vint (Int.repr 0)). *)
+    (*   exact tt. *)
+    (*   exact (Values.Vint (Int.repr 0)). *)
+    (*   exact tt. *)
+    (*   exact (Values.Vint (Int.repr 0)). *)
+    (*   exact tt. *)
+  (* Qed. *)
+  Admitted.
   #[local] Hint Resolve transl_iload_correct : htlproof.
 
   Lemma transl_istore_correct:
@@ -1648,861 +1759,861 @@ rs assoc``.
         exists R2 : HTL.state,
           Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m') R2.
   Proof.
-    intros s f sp pc rs m chunk addr args src pc' a m' H H0 H1 R1 MSTATES.
-    inv_state. inv_arr_access.
-
-    + (** Preamble *)
-      inv MARR. inv CONST. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-
-      pose proof MASSOC as MASSOC'.
-      inv MASSOC'.
-      pose proof (H0 r0).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      apply H8 in HPler0.
-      inv HPler0; try congruence.
-      rewrite EQr0 in H11.
-      inv H11.
-      clear H0. clear H8.
-
-      unfold check_address_parameter_unsigned in *;
-      unfold check_address_parameter_signed in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { apply Mem.store_valid_access_3 in H1. unfold Mem.valid_access in *. simplify.
-        apply Zdivide_mod. assumption. }
-
-      (** Write bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); big_tac.
-        apply Integers.Ptrofs.unsigned_range_2. }
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      econstructor. econstructor. econstructor.
-      eapply Verilog.stmnt_runp_Vnonblock_arr. crush.
-      econstructor.
-      econstructor.
-      econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: try constructor; crush.
-
-      (** State Lookup *)
-      unfold Verilog.merge_regs.
-      crush.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Match states *)
-      econstructor; eauto.
-
-      (** Match assocmaps *)
-      unfold Verilog.merge_regs. crush. unfold_merge.
-      apply regs_lessdef_add_greater.
-      unfold Plt; lia.
-      assumption.
-
-      (** States well formed *)
-      unfold state_st_wf. inversion 1. crush.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Equality proof *)
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET.
-
-      econstructor.
-      repeat split; crush.
-      unfold HTL.empty_stack.
-      crush.
-      unfold Verilog.merge_arrs.
-
-      rewrite AssocMap.gcombine by reflexivity.
-      rewrite AssocMap.gss.
-      erewrite Verilog.merge_arr_empty2.
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gcombine by reflexivity.
-      rewrite AssocMap.gss.
-      rewrite AssocMap.gss.
-      unfold Verilog.merge_arr.
-      setoid_rewrite H7.
-      reflexivity.
-
-      rewrite AssocMap.gcombine by reflexivity.
-      unfold Verilog.merge_arr.
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gss.
-      rewrite AssocMap.gss.
-      setoid_rewrite H7.
-      reflexivity.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      symmetry.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite H4.
-      apply list_repeat_len.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite H4.
-      apply list_repeat_len.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET.
-
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           rewrite HeqOFFSET.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      constructor.
-      erewrite combine_lookup_second.
-      simplify.
-      assert (HPle : Ple src (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto);
-      apply H11 in HPle.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; inv HPle; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-
-      assert (HMul : 4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption).
-      rewrite Z.mul_comm in HMul.
-      rewrite Z_div_mult in HMul; try lia.
-      replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in HMul by reflexivity.
-      rewrite <- PtrofsExtra.divu_unsigned in HMul; unfold_constants; try lia.
-      rewrite HMul. rewrite <- offset_expr_ok.
-      rewrite HeqOFFSET.
-      rewrite array_get_error_set_bound.
-      reflexivity.
-      unfold arr_length, arr_repeat. simpl.
-      rewrite list_repeat_len. rewrite HeqOFFSET in HMul. lia.
-
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           rewrite HeqOFFSET in *. simplify_val.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           rewrite HeqOFFSET in *. simplify_val.
-           left; auto.
-           rewrite HeqOFFSET in *. simplify_val.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           rewrite Z2Nat.id in H15; try lia.
-           apply Zmult_lt_compat_r with (p := 4) in H15; try lia.
-           rewrite ZLib.div_mul_undo in H15; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-
-      rewrite <- offset_expr_ok.
-      rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia).
-      destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4).
-      apply Z.mul_cancel_r with (p := 4) in e; try lia.
-      rewrite ZLib.div_mul_undo in e; try lia.
-      rewrite combine_lookup_first.
-      eapply H9; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-      rewrite array_gso.
-      unfold array_get_error.
-      unfold arr_repeat.
-      crush.
-      apply list_repeat_lookup.
-      lia.
-      unfold_constants.
-      intro.
-      apply Z2Nat.inj_iff in H13; rewrite HeqOFFSET in n0; try lia.
-      apply Z.div_pos; try lia.
-      apply Integers.Ptrofs.unsigned_range.
-      apply Integers.Ptrofs.unsigned_range_2.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO1 by reflexivity.
-      unfold arr_stack_based_pointers.
-      intros.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      crush.
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO1.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      crush.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor.
-      destruct (Archi.ptr64); try discriminate.
-      pose proof (RSBP src). rewrite EQ_SRC in H11.
-      assumption.
-
-      simpl.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO1.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           rewrite HeqOFFSET in *. simplify_val.
-           left; auto.
-           rewrite HeqOFFSET in *. simplify_val.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           inv H11.
-           apply Zmult_lt_compat_r with (p := 4) in H14; try lia.
-           rewrite ZLib.div_mul_undo in H14; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-      apply ASBP; assumption.
-
-      unfold stack_bounds in *. intros.
-      simpl.
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { rewrite HeqOFFSET in *. simplify_val.
-        right. right. simpl.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr; crush; try lia.
-           apply ZExtra.mod_0_bounds; crush; try lia. }
-      crush.
-      exploit (BOUNDS ptr); try lia. intros. crush.
-      exploit (BOUNDS ptr v); try lia. intros.
-      inv H11.
-      match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity.
-      assert (Mem.valid_access m AST.Mint32 sp'
-                               (Integers.Ptrofs.unsigned
-                                  (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                       (Integers.Ptrofs.repr ptr))) Writable).
-      { pose proof H1. eapply Mem.store_valid_access_2 in H11.
-        exact H11. eapply Mem.store_valid_access_3. eassumption. }
-      pose proof (Mem.valid_access_store m AST.Mint32 sp'
-                                         (Integers.Ptrofs.unsigned
-                                            (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                                 (Integers.Ptrofs.repr ptr))) v).
-      apply X in H11. inv H11. congruence.
-
-      constructor; simplify. unfold Verilog.merge_regs. unfold_merge.
-      rewrite AssocMap.gso.
-      assumption. lia.
-      unfold Verilog.merge_regs. unfold_merge.
-      rewrite AssocMap.gso.
-      assumption. lia.
-
-    + (** Preamble *)
-      inv MARR. inv CONST. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-
-      unfold reg_stack_based_pointers in RSBP.
-      pose proof (RSBP r0) as RSBPr0.
-      pose proof (RSBP r1) as RSBPr1.
-
-      destruct (Registers.Regmap.get r0 rs) eqn:EQr0;
-      destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush.
-
-      rewrite ARCHI in H1. crush.
-      subst.
-      clear RSBPr1.
-
-      pose proof MASSOC as MASSOC'.
-      inv MASSOC'.
-      pose proof (H0 r0).
-      pose proof (H0 r1).
-      assert (HPler0 : Ple r0 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; crush; eauto).
-      assert (HPler1 : Ple r1 (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto).
-      apply H8 in HPler0.
-      apply H11 in HPler1.
-      inv HPler0; inv HPler1; try congruence.
-      rewrite EQr0 in H13.
-      rewrite EQr1 in H14.
-      inv H13. inv H14.
-      clear H0. clear H8. clear H11.
-
-      unfold check_address_parameter_signed in *;
-      unfold check_address_parameter_unsigned in *; crush.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int
-                                       (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z))
-                                                         (Integers.Int.repr z0)))) as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { apply Mem.store_valid_access_3 in H1. unfold Mem.valid_access in *. simplify.
-        apply Zdivide_mod. assumption. }
-
-      (** Write bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto.
-        split; try lia; apply Integers.Ptrofs.unsigned_range_2.
-        small_tac. }
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      econstructor. econstructor. econstructor.
-      eapply Verilog.stmnt_runp_Vnonblock_arr. crush.
-      econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: try constructor; crush.
-
-      (** State Lookup *)
-      unfold Verilog.merge_regs.
-      crush.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Match states *)
-      econstructor; eauto.
-
-      (** Match assocmaps *)
-      unfold Verilog.merge_regs. crush. unfold_merge.
-      apply regs_lessdef_add_greater.
-      unfold Plt; lia.
-      assumption.
-
-      (** States well formed *)
-      unfold state_st_wf. inversion 1. crush.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Equality proof *)
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET.
-
-      econstructor.
-      repeat split; crush.
-      unfold HTL.empty_stack.
-      crush.
-      unfold Verilog.merge_arrs.
-
-      rewrite AssocMap.gcombine by reflexivity.
-      rewrite AssocMap.gss.
-      erewrite Verilog.merge_arr_empty2.
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gcombine by reflexivity.
-      rewrite AssocMap.gss.
-      rewrite AssocMap.gss.
-      unfold Verilog.merge_arr.
-      setoid_rewrite H7.
-      reflexivity.
-
-      rewrite AssocMap.gcombine by reflexivity.
-      unfold Verilog.merge_arr.
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gss.
-      rewrite AssocMap.gss.
-      setoid_rewrite H7.
-      reflexivity.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      symmetry.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite H4.
-      apply list_repeat_len.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite H4.
-      apply list_repeat_len.
-
-      remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0))
-                                    (Integers.Ptrofs.of_int
-                                       (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z))
-                                                         (Integers.Int.repr z0)))) as OFFSET.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           rewrite HeqOFFSET.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      constructor.
-      erewrite combine_lookup_second.
-      simpl.
-      assert (Ple src (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto);
-      apply H14 in H15.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; inv H15; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-
-      assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption).
-      rewrite Z.mul_comm in H15.
-      rewrite Z_div_mult in H15; try lia.
-      replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H15 by reflexivity.
-      rewrite <- PtrofsExtra.divu_unsigned in H15; unfold_constants; try lia.
-      rewrite H15. rewrite <- offset_expr_ok_2.
-      rewrite HeqOFFSET in *.
-      rewrite array_get_error_set_bound.
-      reflexivity.
-      unfold arr_length, arr_repeat. simpl.
-      rewrite list_repeat_len. lia.
-
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           rewrite HeqOFFSET in *. simplify_val.
-           left; auto.
-           rewrite HeqOFFSET in *. simplify_val.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           rewrite Z2Nat.id in H17; try lia.
-           apply Zmult_lt_compat_r with (p := 4) in H17; try lia.
-           rewrite ZLib.div_mul_undo in H17; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-
-      rewrite <- offset_expr_ok_2.
-      rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia).
-      destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4).
-      apply Z.mul_cancel_r with (p := 4) in e; try lia.
-      rewrite ZLib.div_mul_undo in e; try lia.
-      rewrite combine_lookup_first.
-      eapply H9; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-      rewrite array_gso.
-      unfold array_get_error.
-      unfold arr_repeat.
-      crush.
-      apply list_repeat_lookup.
-      lia.
-      unfold_constants.
-      intro.
-      rewrite HeqOFFSET in *.
-      apply Z2Nat.inj_iff in H15; try lia.
-      apply Z.div_pos; try lia.
-      apply Integers.Ptrofs.unsigned_range.
-      apply Integers.Ptrofs.unsigned_range_2.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO1 by reflexivity.
-      unfold arr_stack_based_pointers.
-      intros.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      crush.
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO1.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      crush.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor.
-      destruct (Archi.ptr64); try discriminate.
-      pose proof (RSBP src). rewrite EQ_SRC in H14.
-      assumption.
-
-      simpl.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO1.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           rewrite HeqOFFSET in *. simplify_val.
-           left; auto.
-           rewrite HeqOFFSET in *. simplify_val.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           inv H14.
-           apply Zmult_lt_compat_r with (p := 4) in H16; try lia.
-           rewrite ZLib.div_mul_undo in H16; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-      apply ASBP; assumption.
-
-      unfold stack_bounds in *. intros.
-      simpl.
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { rewrite HeqOFFSET in *. simplify_val.
-           right. right. simpl.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr; crush; try lia.
-           apply ZExtra.mod_0_bounds; crush; try lia. }
-      crush.
-      exploit (BOUNDS ptr); try lia. intros. crush.
-      exploit (BOUNDS ptr v); try lia. intros.
-      simplify.
-      match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity.
-      assert (Mem.valid_access m AST.Mint32 sp'
-                               (Integers.Ptrofs.unsigned
-                                  (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                       (Integers.Ptrofs.repr ptr))) Writable).
-      { pose proof H1. eapply Mem.store_valid_access_2 in H14.
-        exact H14. eapply Mem.store_valid_access_3. eassumption. }
-      pose proof (Mem.valid_access_store m AST.Mint32 sp'
-                                         (Integers.Ptrofs.unsigned
-                                            (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                                 (Integers.Ptrofs.repr ptr))) v).
-      apply X in H14. inv H14. congruence.
-
-      constructor; simplify. unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso.
-      assumption. lia.
-      unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso.
-      assumption. lia.
-
-    + inv MARR. inv CONST. crush.
-
-      unfold Op.eval_addressing in H0.
-      destruct (Archi.ptr64) eqn:ARCHI; crush.
-      rewrite ARCHI in H0. crush.
-
-      unfold check_address_parameter_unsigned in *;
-      unfold check_address_parameter_signed in *; crush.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      rewrite ZERO in H1. clear ZERO.
-      rewrite Integers.Ptrofs.add_zero_l in H1.
-
-      remember i0 as OFFSET.
-
-      (** Modular preservation proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE.
-      { apply Mem.store_valid_access_3 in H1. unfold Mem.valid_access in *. simplify.
-        apply Zdivide_mod. assumption. }
-
-      (** Write bounds proof *)
-      assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH.
-      { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:?EQ; crush; auto.
-        unfold stack_bounds in BOUNDS.
-        exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto.
-        crush.
-        replace (Integers.Ptrofs.repr 0) with (Integers.Ptrofs.zero) by reflexivity.
-        small_tac. }
-
-      (** Start of proof proper *)
-      eexists. split.
-      eapply Smallstep.plus_one.
-      eapply HTL.step_module; eauto.
-      econstructor. econstructor. econstructor.
-      eapply Verilog.stmnt_runp_Vnonblock_arr. crush.
-      econstructor. econstructor. econstructor. econstructor.
-
-      all: try constructor; crush.
-
-      (** State Lookup *)
-      unfold Verilog.merge_regs.
-      crush.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Match states *)
-      econstructor; eauto.
-
-      (** Match assocmaps *)
-      unfold Verilog.merge_regs. crush. unfold_merge.
-      apply regs_lessdef_add_greater.
-      unfold Plt; lia.
-      assumption.
-
-      (** States well formed *)
-      unfold state_st_wf. inversion 1. crush.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      apply AssocMap.gss.
-
-      (** Equality proof *)
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET.
-
-      econstructor.
-      repeat split; crush.
-      unfold HTL.empty_stack.
-      crush.
-      unfold Verilog.merge_arrs.
-
-      rewrite AssocMap.gcombine by reflexivity.
-      rewrite AssocMap.gss.
-      erewrite Verilog.merge_arr_empty2.
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gcombine by reflexivity.
-      rewrite AssocMap.gss.
-      rewrite AssocMap.gss.
-      unfold Verilog.merge_arr.
-      setoid_rewrite H7.
-      reflexivity.
-
-      rewrite AssocMap.gcombine by reflexivity.
-      unfold Verilog.merge_arr.
-      unfold Verilog.arr_assocmap_set.
-      rewrite AssocMap.gss.
-      rewrite AssocMap.gss.
-      setoid_rewrite H7.
-      reflexivity.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      symmetry.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite H4.
-      apply list_repeat_len.
-
-      rewrite combine_length.
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      apply list_repeat_len.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite H4.
-      apply list_repeat_len.
-
-      remember i0 as OFFSET.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      constructor.
-      erewrite combine_lookup_second.
-      simpl.
-      assert (Ple src (RTL.max_reg_function f))
-        by (eapply RTL.max_reg_function_use; eauto; simpl; auto);
-      apply H0 in H8.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; inv H8; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-
-      assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption).
-      rewrite Z.mul_comm in H8.
-      rewrite Z_div_mult in H8; try lia.
-      replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H8 by reflexivity.
-      rewrite <- PtrofsExtra.divu_unsigned in H8; unfold_constants; try lia.
-      rewrite H8. rewrite <- offset_expr_ok_3.
-      rewrite array_get_error_set_bound.
-      reflexivity.
-      unfold arr_length, arr_repeat. simpl.
-      rewrite list_repeat_len. lia.
-
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           rewrite Z2Nat.id in H13; try lia.
-           apply Zmult_lt_compat_r with (p := 4) in H13; try lia.
-           rewrite ZLib.div_mul_undo in H13; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-
-      rewrite <- offset_expr_ok_3.
-      rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia).
-      destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4).
-      apply Z.mul_cancel_r with (p := 4) in e; try lia.
-      rewrite ZLib.div_mul_undo in e; try lia.
-      rewrite combine_lookup_first.
-      eapply H9; eauto.
-
-      rewrite <- array_set_len.
-      unfold arr_repeat. crush.
-      rewrite list_repeat_len. auto.
-      rewrite array_gso.
-      unfold array_get_error.
-      unfold arr_repeat.
-      crush.
-      apply list_repeat_lookup.
-      lia.
-      unfold_constants.
-      intro.
-      apply Z2Nat.inj_iff in H8; try lia.
-      apply Z.div_pos; try lia.
-      apply Integers.Ptrofs.unsigned_range.
-
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      unfold arr_stack_based_pointers.
-      intros.
-      destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET).
-
-      crush.
-      erewrite Mem.load_store_same.
-      2: { rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite e.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           exact H1.
-           apply Integers.Ptrofs.unsigned_range_2. }
-      crush.
-      destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor.
-      destruct (Archi.ptr64); try discriminate.
-      pose proof (RSBP src). rewrite EQ_SRC in H0.
-      assumption.
-
-      simpl.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr.
-           simpl.
-           destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto.
-           right.
-           apply ZExtra.mod_0_bounds; try lia.
-           apply ZLib.Z_mod_mult'.
-           inv H0.
-           apply Zmult_lt_compat_r with (p := 4) in H11; try lia.
-           rewrite ZLib.div_mul_undo in H11; try lia.
-           split; try lia.
-           apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia.
-      }
-      apply ASBP; assumption.
-
-      unfold stack_bounds in *. intros.
-      simpl.
-      assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity.
-      erewrite Mem.load_store_other with (m1 := m).
-      2: { exact H1. }
-      2: { right. right. simpl.
-           rewrite ZERO.
-           rewrite Integers.Ptrofs.add_zero_l.
-           rewrite Integers.Ptrofs.unsigned_repr; crush; try lia.
-           apply ZExtra.mod_0_bounds; crush; try lia. }
-      crush.
-      exploit (BOUNDS ptr); try lia. intros. crush.
-      exploit (BOUNDS ptr v); try lia. intros.
-      inv H0.
-      match goal with | |- ?x = _ => destruct x eqn:?EQ end; try reflexivity.
-      assert (Mem.valid_access m AST.Mint32 sp'
-                               (Integers.Ptrofs.unsigned
-                                  (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                       (Integers.Ptrofs.repr ptr))) Writable).
-      { pose proof H1. eapply Mem.store_valid_access_2 in H0.
-        exact H0. eapply Mem.store_valid_access_3. eassumption. }
-      pose proof (Mem.valid_access_store m AST.Mint32 sp'
-                                         (Integers.Ptrofs.unsigned
-                                            (Integers.Ptrofs.add (Integers.Ptrofs.repr 0)
-                                                                 (Integers.Ptrofs.repr ptr))) v).
-      apply X in H0. inv H0. congruence.
-
-      constructor; simplify. unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso.
-      assumption. lia.
-      unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso.
-      assumption. lia.
-
-      Unshelve.
-      exact tt.
-      exact (Values.Vint (Int.repr 0)).
-      exact tt.
-      exact (Values.Vint (Int.repr 0)).
-      exact tt.
-      exact (Values.Vint (Int.repr 0)).
-  Qed.
+    (* intros s f sp pc rs m chunk addr args src pc' a m' H H0 H1 R1 MSTATES. *)
+  (*   inv_state. inv_arr_access. *)
+
+  (*   + (** Preamble *) *)
+  (*     inv MARR. inv CONST. crush. *)
+
+  (*     unfold Op.eval_addressing in H0. *)
+  (*     destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+  (*     unfold reg_stack_based_pointers in RSBP. *)
+  (*     pose proof (RSBP r0) as RSBPr0. *)
+
+  (*     destruct (Registers.Regmap.get r0 rs) eqn:EQr0; crush. *)
+
+  (*     rewrite ARCHI in H1. crush. *)
+  (*     subst. *)
+
+  (*     pose proof MASSOC as MASSOC'. *)
+  (*     inv MASSOC'. *)
+  (*     pose proof (H0 r0). *)
+  (*     assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+  (*       by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+  (*     apply H8 in HPler0. *)
+  (*     inv HPler0; try congruence. *)
+  (*     rewrite EQr0 in H11. *)
+  (*     inv H11. *)
+  (*     clear H0. clear H8. *)
+
+  (*     unfold check_address_parameter_unsigned in *; *)
+  (*     unfold check_address_parameter_signed in *; crush. *)
+
+  (*     remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+  (*                                   (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET. *)
+
+  (*     (** Modular preservation proof *) *)
+  (*     assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+  (*     { apply Mem.store_valid_access_3 in H1. unfold Mem.valid_access in *. simplify. *)
+  (*       apply Zdivide_mod. assumption. } *)
+
+  (*     (** Write bounds proof *) *)
+  (*     assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH. *)
+  (*     { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+  (*       unfold stack_bounds in BOUNDS. *)
+  (*       exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); big_tac. *)
+  (*       apply Integers.Ptrofs.unsigned_range_2. } *)
+
+  (*     (** Start of proof proper *) *)
+  (*     eexists. split. *)
+  (*     eapply Smallstep.plus_one. *)
+  (*     eapply HTL.step_module; eauto. *)
+  (*     econstructor. econstructor. econstructor. *)
+  (*     eapply Verilog.stmnt_runp_Vnonblock_arr. crush. *)
+  (*     econstructor. *)
+  (*     econstructor. *)
+  (*     econstructor. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+
+  (*     all: try constructor; crush. *)
+
+  (*     (** State Lookup *) *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     crush. *)
+  (*     unfold_merge. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     (** Match states *) *)
+  (*     econstructor; eauto. *)
+
+  (*     (** Match assocmaps *) *)
+  (*     unfold Verilog.merge_regs. crush. unfold_merge. *)
+  (*     apply regs_lessdef_add_greater. *)
+  (*     unfold Plt; lia. *)
+  (*     assumption. *)
+
+  (*     (** States well formed *) *)
+  (*     unfold state_st_wf. inversion 1. crush. *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     unfold_merge. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     (** Equality proof *) *)
+
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET. *)
+
+  (*     econstructor. *)
+  (*     repeat split; crush. *)
+  (*     unfold HTL.empty_stack. *)
+  (*     crush. *)
+  (*     unfold Verilog.merge_arrs. *)
+
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     erewrite Verilog.merge_arr_empty2. *)
+  (*     unfold Verilog.arr_assocmap_set. *)
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     unfold Verilog.merge_arr. *)
+  (*     setoid_rewrite H7. *)
+  (*     reflexivity. *)
+
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     unfold Verilog.merge_arr. *)
+  (*     unfold Verilog.arr_assocmap_set. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     setoid_rewrite H7. *)
+  (*     reflexivity. *)
+
+  (*     rewrite combine_length. *)
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     symmetry. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite H4. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite combine_length. *)
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite H4. *)
+  (*     apply list_repeat_len. *)
+
+  (*     remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+  (*                                   (Integers.Ptrofs.of_int (Integers.Int.repr z))) as OFFSET. *)
+
+  (*     destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+  (*     erewrite Mem.load_store_same. *)
+  (*     2: { rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite e. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          rewrite HeqOFFSET. *)
+  (*          exact H1. *)
+  (*          apply Integers.Ptrofs.unsigned_range_2. } *)
+  (*     constructor. *)
+  (*     erewrite combine_lookup_second. *)
+  (*     simplify. *)
+  (*     assert (HPle : Ple src (RTL.max_reg_function f)) *)
+  (*       by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+  (*     apply H11 in HPle. *)
+  (*     destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; inv HPle; eauto. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite list_repeat_len. auto. *)
+
+  (*     assert (HMul : 4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption). *)
+  (*     rewrite Z.mul_comm in HMul. *)
+  (*     rewrite Z_div_mult in HMul; try lia. *)
+  (*     replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in HMul by reflexivity. *)
+  (*     rewrite <- PtrofsExtra.divu_unsigned in HMul; unfold_constants; try lia. *)
+  (*     rewrite HMul. rewrite <- offset_expr_ok. *)
+  (*     rewrite HeqOFFSET. *)
+  (*     rewrite array_get_error_set_bound. *)
+  (*     reflexivity. *)
+  (*     unfold arr_length, arr_repeat. simpl. *)
+  (*     rewrite list_repeat_len. rewrite HeqOFFSET in HMul. lia. *)
+
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          simpl. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          left; auto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          right. *)
+  (*          apply ZExtra.mod_0_bounds; try lia. *)
+  (*          apply ZLib.Z_mod_mult'. *)
+  (*          rewrite Z2Nat.id in H15; try lia. *)
+  (*          apply Zmult_lt_compat_r with (p := 4) in H15; try lia. *)
+  (*          rewrite ZLib.div_mul_undo in H15; try lia. *)
+  (*          split; try lia. *)
+  (*          apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+  (*     } *)
+
+  (*     rewrite <- offset_expr_ok. *)
+  (*     rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia). *)
+  (*     destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4). *)
+  (*     apply Z.mul_cancel_r with (p := 4) in e; try lia. *)
+  (*     rewrite ZLib.div_mul_undo in e; try lia. *)
+  (*     rewrite combine_lookup_first. *)
+  (*     eapply H9; eauto. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite list_repeat_len. auto. *)
+  (*     rewrite array_gso. *)
+  (*     unfold array_get_error. *)
+  (*     unfold arr_repeat. *)
+  (*     crush. *)
+  (*     apply list_repeat_lookup. *)
+  (*     lia. *)
+  (*     unfold_constants. *)
+  (*     intro. *)
+  (*     apply Z2Nat.inj_iff in H13; rewrite HeqOFFSET in n0; try lia. *)
+  (*     apply Z.div_pos; try lia. *)
+  (*     apply Integers.Ptrofs.unsigned_range. *)
+  (*     apply Integers.Ptrofs.unsigned_range_2. *)
+
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO1 by reflexivity. *)
+  (*     unfold arr_stack_based_pointers. *)
+  (*     intros. *)
+  (*     destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+  (*     crush. *)
+  (*     erewrite Mem.load_store_same. *)
+  (*     2: { rewrite ZERO1. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite e. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          exact H1. *)
+  (*          apply Integers.Ptrofs.unsigned_range_2. } *)
+  (*     crush. *)
+  (*     destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor. *)
+  (*     destruct (Archi.ptr64); try discriminate. *)
+  (*     pose proof (RSBP src). rewrite EQ_SRC in H11. *)
+  (*     assumption. *)
+
+  (*     simpl. *)
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. *)
+  (*          rewrite ZERO1. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          simpl. *)
+  (*          destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          left; auto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          right. *)
+  (*          apply ZExtra.mod_0_bounds; try lia. *)
+  (*          apply ZLib.Z_mod_mult'. *)
+  (*          inv H11. *)
+  (*          apply Zmult_lt_compat_r with (p := 4) in H14; try lia. *)
+  (*          rewrite ZLib.div_mul_undo in H14; try lia. *)
+  (*          split; try lia. *)
+  (*          apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+  (*     } *)
+  (*     apply ASBP; assumption. *)
+
+  (*     unfold stack_bounds in *. intros. *)
+  (*     simpl. *)
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { rewrite HeqOFFSET in *. simplify_val. *)
+  (*       right. right. simpl. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr; crush; try lia. *)
+  (*          apply ZExtra.mod_0_bounds; crush; try lia. } *)
+  (*     crush. *)
+  (*     exploit (BOUNDS ptr); try lia. intros. crush. *)
+  (*     exploit (BOUNDS ptr v); try lia. intros. *)
+  (*     inv H11. *)
+  (*     match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity. *)
+  (*     assert (Mem.valid_access m AST.Mint32 sp' *)
+  (*                              (Integers.Ptrofs.unsigned *)
+  (*                                 (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+  (*                                                      (Integers.Ptrofs.repr ptr))) Writable). *)
+  (*     { pose proof H1. eapply Mem.store_valid_access_2 in H11. *)
+  (*       exact H11. eapply Mem.store_valid_access_3. eassumption. } *)
+  (*     pose proof (Mem.valid_access_store m AST.Mint32 sp' *)
+  (*                                        (Integers.Ptrofs.unsigned *)
+  (*                                           (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+  (*                                                                (Integers.Ptrofs.repr ptr))) v). *)
+  (*     apply X in H11. inv H11. congruence. *)
+
+  (*     constructor; simplify. unfold Verilog.merge_regs. unfold_merge. *)
+  (*     rewrite AssocMap.gso. *)
+  (*     assumption. lia. *)
+  (*     unfold Verilog.merge_regs. unfold_merge. *)
+  (*     rewrite AssocMap.gso. *)
+  (*     assumption. lia. *)
+
+  (*   + (** Preamble *) *)
+  (*     inv MARR. inv CONST. crush. *)
+
+  (*     unfold Op.eval_addressing in H0. *)
+  (*     destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+
+  (*     unfold reg_stack_based_pointers in RSBP. *)
+  (*     pose proof (RSBP r0) as RSBPr0. *)
+  (*     pose proof (RSBP r1) as RSBPr1. *)
+
+  (*     destruct (Registers.Regmap.get r0 rs) eqn:EQr0; *)
+  (*     destruct (Registers.Regmap.get r1 rs) eqn:EQr1; crush. *)
+
+  (*     rewrite ARCHI in H1. crush. *)
+  (*     subst. *)
+  (*     clear RSBPr1. *)
+
+  (*     pose proof MASSOC as MASSOC'. *)
+  (*     inv MASSOC'. *)
+  (*     pose proof (H0 r0). *)
+  (*     pose proof (H0 r1). *)
+  (*     assert (HPler0 : Ple r0 (RTL.max_reg_function f)) *)
+  (*       by (eapply RTL.max_reg_function_use; eauto; crush; eauto). *)
+  (*     assert (HPler1 : Ple r1 (RTL.max_reg_function f)) *)
+  (*       by (eapply RTL.max_reg_function_use; eauto; simpl; auto). *)
+  (*     apply H8 in HPler0. *)
+  (*     apply H11 in HPler1. *)
+  (*     inv HPler0; inv HPler1; try congruence. *)
+  (*     rewrite EQr0 in H13. *)
+  (*     rewrite EQr1 in H14. *)
+  (*     inv H13. inv H14. *)
+  (*     clear H0. clear H8. clear H11. *)
+
+  (*     unfold check_address_parameter_signed in *; *)
+  (*     unfold check_address_parameter_unsigned in *; crush. *)
+
+  (*     remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+  (*                                   (Integers.Ptrofs.of_int *)
+  (*                                      (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z)) *)
+  (*                                                        (Integers.Int.repr z0)))) as OFFSET. *)
+
+  (*     (** Modular preservation proof *) *)
+  (*     assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+  (*     { apply Mem.store_valid_access_3 in H1. unfold Mem.valid_access in *. simplify. *)
+  (*       apply Zdivide_mod. assumption. } *)
+
+  (*     (** Write bounds proof *) *)
+  (*     assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH. *)
+  (*     { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:EQ; crush; auto. *)
+  (*       unfold stack_bounds in BOUNDS. *)
+  (*       exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto. *)
+  (*       split; try lia; apply Integers.Ptrofs.unsigned_range_2. *)
+  (*       small_tac. } *)
+
+  (*     (** Start of proof proper *) *)
+  (*     eexists. split. *)
+  (*     eapply Smallstep.plus_one. *)
+  (*     eapply HTL.step_module; eauto. *)
+  (*     econstructor. econstructor. econstructor. *)
+  (*     eapply Verilog.stmnt_runp_Vnonblock_arr. crush. *)
+  (*     econstructor. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+  (*     econstructor. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+
+  (*     all: try constructor; crush. *)
+
+  (*     (** State Lookup *) *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     crush. *)
+  (*     unfold_merge. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     (** Match states *) *)
+  (*     econstructor; eauto. *)
+
+  (*     (** Match assocmaps *) *)
+  (*     unfold Verilog.merge_regs. crush. unfold_merge. *)
+  (*     apply regs_lessdef_add_greater. *)
+  (*     unfold Plt; lia. *)
+  (*     assumption. *)
+
+  (*     (** States well formed *) *)
+  (*     unfold state_st_wf. inversion 1. crush. *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     unfold_merge. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     (** Equality proof *) *)
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET. *)
+
+  (*     econstructor. *)
+  (*     repeat split; crush. *)
+  (*     unfold HTL.empty_stack. *)
+  (*     crush. *)
+  (*     unfold Verilog.merge_arrs. *)
+
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     erewrite Verilog.merge_arr_empty2. *)
+  (*     unfold Verilog.arr_assocmap_set. *)
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     unfold Verilog.merge_arr. *)
+  (*     setoid_rewrite H7. *)
+  (*     reflexivity. *)
+
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     unfold Verilog.merge_arr. *)
+  (*     unfold Verilog.arr_assocmap_set. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     setoid_rewrite H7. *)
+  (*     reflexivity. *)
+
+  (*     rewrite combine_length. *)
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     symmetry. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite H4. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite combine_length. *)
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite H4. *)
+  (*     apply list_repeat_len. *)
+
+  (*     remember (Integers.Ptrofs.add (Integers.Ptrofs.repr (uvalueToZ asr # r0)) *)
+  (*                                   (Integers.Ptrofs.of_int *)
+  (*                                      (Integers.Int.add (Integers.Int.mul (valueToInt asr # r1) (Integers.Int.repr z)) *)
+  (*                                                        (Integers.Int.repr z0)))) as OFFSET. *)
+  (*     destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+  (*     erewrite Mem.load_store_same. *)
+  (*     2: { rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite e. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          rewrite HeqOFFSET. *)
+  (*          exact H1. *)
+  (*          apply Integers.Ptrofs.unsigned_range_2. } *)
+  (*     constructor. *)
+  (*     erewrite combine_lookup_second. *)
+  (*     simpl. *)
+  (*     assert (Ple src (RTL.max_reg_function f)) *)
+  (*       by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+  (*     apply H14 in H15. *)
+  (*     destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; inv H15; eauto. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite list_repeat_len. auto. *)
+
+  (*     assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption). *)
+  (*     rewrite Z.mul_comm in H15. *)
+  (*     rewrite Z_div_mult in H15; try lia. *)
+  (*     replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H15 by reflexivity. *)
+  (*     rewrite <- PtrofsExtra.divu_unsigned in H15; unfold_constants; try lia. *)
+  (*     rewrite H15. rewrite <- offset_expr_ok_2. *)
+  (*     rewrite HeqOFFSET in *. *)
+  (*     rewrite array_get_error_set_bound. *)
+  (*     reflexivity. *)
+  (*     unfold arr_length, arr_repeat. simpl. *)
+  (*     rewrite list_repeat_len. lia. *)
+
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          simpl. *)
+  (*          destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          left; auto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          right. *)
+  (*          apply ZExtra.mod_0_bounds; try lia. *)
+  (*          apply ZLib.Z_mod_mult'. *)
+  (*          rewrite Z2Nat.id in H17; try lia. *)
+  (*          apply Zmult_lt_compat_r with (p := 4) in H17; try lia. *)
+  (*          rewrite ZLib.div_mul_undo in H17; try lia. *)
+  (*          split; try lia. *)
+  (*          apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+  (*     } *)
+
+  (*     rewrite <- offset_expr_ok_2. *)
+  (*     rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia). *)
+  (*     destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4). *)
+  (*     apply Z.mul_cancel_r with (p := 4) in e; try lia. *)
+  (*     rewrite ZLib.div_mul_undo in e; try lia. *)
+  (*     rewrite combine_lookup_first. *)
+  (*     eapply H9; eauto. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite list_repeat_len. auto. *)
+  (*     rewrite array_gso. *)
+  (*     unfold array_get_error. *)
+  (*     unfold arr_repeat. *)
+  (*     crush. *)
+  (*     apply list_repeat_lookup. *)
+  (*     lia. *)
+  (*     unfold_constants. *)
+  (*     intro. *)
+  (*     rewrite HeqOFFSET in *. *)
+  (*     apply Z2Nat.inj_iff in H15; try lia. *)
+  (*     apply Z.div_pos; try lia. *)
+  (*     apply Integers.Ptrofs.unsigned_range. *)
+  (*     apply Integers.Ptrofs.unsigned_range_2. *)
+
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO1 by reflexivity. *)
+  (*     unfold arr_stack_based_pointers. *)
+  (*     intros. *)
+  (*     destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+  (*     crush. *)
+  (*     erewrite Mem.load_store_same. *)
+  (*     2: { rewrite ZERO1. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite e. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          exact H1. *)
+  (*          apply Integers.Ptrofs.unsigned_range_2. } *)
+  (*     crush. *)
+  (*     destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor. *)
+  (*     destruct (Archi.ptr64); try discriminate. *)
+  (*     pose proof (RSBP src). rewrite EQ_SRC in H14. *)
+  (*     assumption. *)
+
+  (*     simpl. *)
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. *)
+  (*          rewrite ZERO1. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          simpl. *)
+  (*          destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          left; auto. *)
+  (*          rewrite HeqOFFSET in *. simplify_val. *)
+  (*          right. *)
+  (*          apply ZExtra.mod_0_bounds; try lia. *)
+  (*          apply ZLib.Z_mod_mult'. *)
+  (*          inv H14. *)
+  (*          apply Zmult_lt_compat_r with (p := 4) in H16; try lia. *)
+  (*          rewrite ZLib.div_mul_undo in H16; try lia. *)
+  (*          split; try lia. *)
+  (*          apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+  (*     } *)
+  (*     apply ASBP; assumption. *)
+
+  (*     unfold stack_bounds in *. intros. *)
+  (*     simpl. *)
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { rewrite HeqOFFSET in *. simplify_val. *)
+  (*          right. right. simpl. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr; crush; try lia. *)
+  (*          apply ZExtra.mod_0_bounds; crush; try lia. } *)
+  (*     crush. *)
+  (*     exploit (BOUNDS ptr); try lia. intros. crush. *)
+  (*     exploit (BOUNDS ptr v); try lia. intros. *)
+  (*     simplify. *)
+  (*     match goal with | |- ?x = _ => destruct x eqn:EQ end; try reflexivity. *)
+  (*     assert (Mem.valid_access m AST.Mint32 sp' *)
+  (*                              (Integers.Ptrofs.unsigned *)
+  (*                                 (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+  (*                                                      (Integers.Ptrofs.repr ptr))) Writable). *)
+  (*     { pose proof H1. eapply Mem.store_valid_access_2 in H14. *)
+  (*       exact H14. eapply Mem.store_valid_access_3. eassumption. } *)
+  (*     pose proof (Mem.valid_access_store m AST.Mint32 sp' *)
+  (*                                        (Integers.Ptrofs.unsigned *)
+  (*                                           (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+  (*                                                                (Integers.Ptrofs.repr ptr))) v). *)
+  (*     apply X in H14. inv H14. congruence. *)
+
+  (*     constructor; simplify. unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso. *)
+  (*     assumption. lia. *)
+  (*     unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso. *)
+  (*     assumption. lia. *)
+
+  (*   + inv MARR. inv CONST. crush. *)
+
+  (*     unfold Op.eval_addressing in H0. *)
+  (*     destruct (Archi.ptr64) eqn:ARCHI; crush. *)
+  (*     rewrite ARCHI in H0. crush. *)
+
+  (*     unfold check_address_parameter_unsigned in *; *)
+  (*     unfold check_address_parameter_signed in *; crush. *)
+
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     rewrite ZERO in H1. clear ZERO. *)
+  (*     rewrite Integers.Ptrofs.add_zero_l in H1. *)
+
+  (*     remember i0 as OFFSET. *)
+
+  (*     (** Modular preservation proof *) *)
+  (*     assert (Integers.Ptrofs.unsigned OFFSET mod 4 = 0) as MOD_PRESERVE. *)
+  (*     { apply Mem.store_valid_access_3 in H1. unfold Mem.valid_access in *. simplify. *)
+  (*       apply Zdivide_mod. assumption. } *)
+
+  (*     (** Write bounds proof *) *)
+  (*     assert (Integers.Ptrofs.unsigned OFFSET < f.(RTL.fn_stacksize)) as WRITE_BOUND_HIGH. *)
+  (*     { destruct (Integers.Ptrofs.unsigned OFFSET <? f.(RTL.fn_stacksize)) eqn:?EQ; crush; auto. *)
+  (*       unfold stack_bounds in BOUNDS. *)
+  (*       exploit (BOUNDS (Integers.Ptrofs.unsigned OFFSET) (Registers.Regmap.get src rs)); auto. *)
+  (*       crush. *)
+  (*       replace (Integers.Ptrofs.repr 0) with (Integers.Ptrofs.zero) by reflexivity. *)
+  (*       small_tac. } *)
+
+  (*     (** Start of proof proper *) *)
+  (*     eexists. split. *)
+  (*     eapply Smallstep.plus_one. *)
+  (*     eapply HTL.step_module; eauto. *)
+  (*     econstructor. econstructor. econstructor. *)
+  (*     eapply Verilog.stmnt_runp_Vnonblock_arr. crush. *)
+  (*     econstructor. econstructor. econstructor. econstructor. *)
+
+  (*     all: try constructor; crush. *)
+
+  (*     (** State Lookup *) *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     crush. *)
+  (*     unfold_merge. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     (** Match states *) *)
+  (*     econstructor; eauto. *)
+
+  (*     (** Match assocmaps *) *)
+  (*     unfold Verilog.merge_regs. crush. unfold_merge. *)
+  (*     apply regs_lessdef_add_greater. *)
+  (*     unfold Plt; lia. *)
+  (*     assumption. *)
+
+  (*     (** States well formed *) *)
+  (*     unfold state_st_wf. inversion 1. crush. *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     unfold_merge. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     (** Equality proof *) *)
+
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     inversion MASSOC; revert HeqOFFSET; subst; clear MASSOC; intros HeqOFFSET. *)
+
+  (*     econstructor. *)
+  (*     repeat split; crush. *)
+  (*     unfold HTL.empty_stack. *)
+  (*     crush. *)
+  (*     unfold Verilog.merge_arrs. *)
+
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     erewrite Verilog.merge_arr_empty2. *)
+  (*     unfold Verilog.arr_assocmap_set. *)
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     unfold Verilog.merge_arr. *)
+  (*     setoid_rewrite H7. *)
+  (*     reflexivity. *)
+
+  (*     rewrite AssocMap.gcombine by reflexivity. *)
+  (*     unfold Verilog.merge_arr. *)
+  (*     unfold Verilog.arr_assocmap_set. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     rewrite AssocMap.gss. *)
+  (*     setoid_rewrite H7. *)
+  (*     reflexivity. *)
+
+  (*     rewrite combine_length. *)
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     symmetry. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite H4. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite combine_length. *)
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     apply list_repeat_len. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite H4. *)
+  (*     apply list_repeat_len. *)
+
+  (*     remember i0 as OFFSET. *)
+  (*     destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+  (*     erewrite Mem.load_store_same. *)
+  (*     2: { rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite e. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          exact H1. *)
+  (*          apply Integers.Ptrofs.unsigned_range_2. } *)
+  (*     constructor. *)
+  (*     erewrite combine_lookup_second. *)
+  (*     simpl. *)
+  (*     assert (Ple src (RTL.max_reg_function f)) *)
+  (*       by (eapply RTL.max_reg_function_use; eauto; simpl; auto); *)
+  (*     apply H0 in H8. *)
+  (*     destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; constructor; inv H8; eauto. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite list_repeat_len. auto. *)
+
+  (*     assert (4 * ptr / 4 = Integers.Ptrofs.unsigned OFFSET / 4) by (f_equal; assumption). *)
+  (*     rewrite Z.mul_comm in H8. *)
+  (*     rewrite Z_div_mult in H8; try lia. *)
+  (*     replace 4 with (Integers.Ptrofs.unsigned (Integers.Ptrofs.repr 4)) in H8 by reflexivity. *)
+  (*     rewrite <- PtrofsExtra.divu_unsigned in H8; unfold_constants; try lia. *)
+  (*     rewrite H8. rewrite <- offset_expr_ok_3. *)
+  (*     rewrite array_get_error_set_bound. *)
+  (*     reflexivity. *)
+  (*     unfold arr_length, arr_repeat. simpl. *)
+  (*     rewrite list_repeat_len. lia. *)
+
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          simpl. *)
+  (*          destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+  (*          right. *)
+  (*          apply ZExtra.mod_0_bounds; try lia. *)
+  (*          apply ZLib.Z_mod_mult'. *)
+  (*          rewrite Z2Nat.id in H13; try lia. *)
+  (*          apply Zmult_lt_compat_r with (p := 4) in H13; try lia. *)
+  (*          rewrite ZLib.div_mul_undo in H13; try lia. *)
+  (*          split; try lia. *)
+  (*          apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+  (*     } *)
+
+  (*     rewrite <- offset_expr_ok_3. *)
+  (*     rewrite PtrofsExtra.divu_unsigned; auto; try (unfold_constants; lia). *)
+  (*     destruct (ptr ==Z Integers.Ptrofs.unsigned OFFSET / 4). *)
+  (*     apply Z.mul_cancel_r with (p := 4) in e; try lia. *)
+  (*     rewrite ZLib.div_mul_undo in e; try lia. *)
+  (*     rewrite combine_lookup_first. *)
+  (*     eapply H9; eauto. *)
+
+  (*     rewrite <- array_set_len. *)
+  (*     unfold arr_repeat. crush. *)
+  (*     rewrite list_repeat_len. auto. *)
+  (*     rewrite array_gso. *)
+  (*     unfold array_get_error. *)
+  (*     unfold arr_repeat. *)
+  (*     crush. *)
+  (*     apply list_repeat_lookup. *)
+  (*     lia. *)
+  (*     unfold_constants. *)
+  (*     intro. *)
+  (*     apply Z2Nat.inj_iff in H8; try lia. *)
+  (*     apply Z.div_pos; try lia. *)
+  (*     apply Integers.Ptrofs.unsigned_range. *)
+
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     unfold arr_stack_based_pointers. *)
+  (*     intros. *)
+  (*     destruct (4 * ptr ==Z Integers.Ptrofs.unsigned OFFSET). *)
+
+  (*     crush. *)
+  (*     erewrite Mem.load_store_same. *)
+  (*     2: { rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite e. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          exact H1. *)
+  (*          apply Integers.Ptrofs.unsigned_range_2. } *)
+  (*     crush. *)
+  (*     destruct (Registers.Regmap.get src rs) eqn:EQ_SRC; try constructor. *)
+  (*     destruct (Archi.ptr64); try discriminate. *)
+  (*     pose proof (RSBP src). rewrite EQ_SRC in H0. *)
+  (*     assumption. *)
+
+  (*     simpl. *)
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr. *)
+  (*          simpl. *)
+  (*          destruct (Z_le_gt_dec (4 * ptr + 4) (Integers.Ptrofs.unsigned OFFSET)); eauto. *)
+  (*          right. *)
+  (*          apply ZExtra.mod_0_bounds; try lia. *)
+  (*          apply ZLib.Z_mod_mult'. *)
+  (*          inv H0. *)
+  (*          apply Zmult_lt_compat_r with (p := 4) in H11; try lia. *)
+  (*          rewrite ZLib.div_mul_undo in H11; try lia. *)
+  (*          split; try lia. *)
+  (*          apply Z.le_trans with (m := RTL.fn_stacksize f); crush; lia. *)
+  (*     } *)
+  (*     apply ASBP; assumption. *)
+
+  (*     unfold stack_bounds in *. intros. *)
+  (*     simpl. *)
+  (*     assert (Integers.Ptrofs.repr 0 = Integers.Ptrofs.zero) as ZERO by reflexivity. *)
+  (*     erewrite Mem.load_store_other with (m1 := m). *)
+  (*     2: { exact H1. } *)
+  (*     2: { right. right. simpl. *)
+  (*          rewrite ZERO. *)
+  (*          rewrite Integers.Ptrofs.add_zero_l. *)
+  (*          rewrite Integers.Ptrofs.unsigned_repr; crush; try lia. *)
+  (*          apply ZExtra.mod_0_bounds; crush; try lia. } *)
+  (*     crush. *)
+  (*     exploit (BOUNDS ptr); try lia. intros. crush. *)
+  (*     exploit (BOUNDS ptr v); try lia. intros. *)
+  (*     inv H0. *)
+  (*     match goal with | |- ?x = _ => destruct x eqn:?EQ end; try reflexivity. *)
+  (*     assert (Mem.valid_access m AST.Mint32 sp' *)
+  (*                              (Integers.Ptrofs.unsigned *)
+  (*                                 (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+  (*                                                      (Integers.Ptrofs.repr ptr))) Writable). *)
+  (*     { pose proof H1. eapply Mem.store_valid_access_2 in H0. *)
+  (*       exact H0. eapply Mem.store_valid_access_3. eassumption. } *)
+  (*     pose proof (Mem.valid_access_store m AST.Mint32 sp' *)
+  (*                                        (Integers.Ptrofs.unsigned *)
+  (*                                           (Integers.Ptrofs.add (Integers.Ptrofs.repr 0) *)
+  (*                                                                (Integers.Ptrofs.repr ptr))) v). *)
+  (*     apply X in H0. inv H0. congruence. *)
+
+  (*     constructor; simplify. unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso. *)
+  (*     assumption. lia. *)
+  (*     unfold Verilog.merge_regs. unfold_merge. rewrite AssocMap.gso. *)
+  (*     assumption. lia. *)
+
+  (*     Unshelve. *)
+  (*     exact tt. *)
+  (*     exact (Values.Vint (Int.repr 0)). *)
+  (*     exact tt. *)
+  (*     exact (Values.Vint (Int.repr 0)). *)
+  (*     exact tt. *)
+  (*     exact (Values.Vint (Int.repr 0)). *)
+  (* Qed. *) Admitted.
   #[local] Hint Resolve transl_istore_correct : htlproof.
 
   Lemma transl_icond_correct:
@@ -2532,48 +2643,48 @@ rs assoc``.
       intros. eapply RTL.max_reg_function_use. apply H22. auto.
       econstructor. auto.
       simpl. econstructor. constructor. unfold Verilog.merge_regs. unfold_merge. simpl.
-      apply AssocMap.gss.
+      unfold_merge. apply AssocMap.gss.
 
       inv MARR. inv CONST.
       big_tac.
-      constructor; rewrite AssocMap.gso; simplify; try assumption; lia.
-    - eexists. split. apply Smallstep.plus_one.
-      clear H32.
-      eapply HTL.step_module; eauto.
-      inv CONST; assumption.
-      inv CONST; assumption.
-      econstructor; simpl; trivial.
-      constructor; trivial.
-      eapply Verilog.erun_Vternary_false; simpl; eauto.
-      eapply eval_cond_correct; eauto. intros.
-      intros. eapply RTL.max_reg_function_use. apply H22. auto.
-      econstructor. auto.
-      simpl. econstructor. constructor. unfold Verilog.merge_regs. unfold_merge. simpl.
-      apply AssocMap.gss.
-
-      inv MARR. inv CONST.
-      big_tac.
-      constructor; rewrite AssocMap.gso; simplify; try assumption; lia.
-
-      Unshelve. all: exact tt.
-  Qed.
+  (*     constructor; rewrite AssocMap.gso; simplify; try assumption; lia. *)
+  (*   - eexists. split. apply Smallstep.plus_one. *)
+  (*     clear H32. *)
+  (*     eapply HTL.step_module; eauto. *)
+  (*     inv CONST; assumption. *)
+  (*     inv CONST; assumption. *)
+  (*     econstructor; simpl; trivial. *)
+  (*     constructor; trivial. *)
+  (*     eapply Verilog.erun_Vternary_false; simpl; eauto. *)
+  (*     eapply eval_cond_correct; eauto. intros. *)
+  (*     intros. eapply RTL.max_reg_function_use. apply H22. auto. *)
+  (*     econstructor. auto. *)
+  (*     simpl. econstructor. constructor. unfold Verilog.merge_regs. unfold_merge. simpl. *)
+  (*     apply AssocMap.gss. *)
+
+  (*     inv MARR. inv CONST. *)
+  (*     big_tac. *)
+  (*     constructor; rewrite AssocMap.gso; simplify; try assumption; lia. *)
+
+  (*     Unshelve. all: exact tt. *)
+  (* Qed. *) Admitted.
   #[local] Hint Resolve transl_icond_correct : htlproof.
 
-  (*Lemma transl_ijumptable_correct:
-    forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive)
-      (rs : Registers.Regmap.t Values.val) (m : mem) (arg : Registers.reg) (tbl : list RTL.node)
-      (n : Integers.Int.int) (pc' : RTL.node),
-      (RTL.fn_code f) ! pc = Some (RTL.Ijumptable arg tbl) ->
-      Registers.Regmap.get arg rs = Values.Vint n ->
-      list_nth_z tbl (Integers.Int.unsigned n) = Some pc' ->
-      forall R1 : HTL.state,
-        match_states (RTL.State s f sp pc rs m) R1 ->
-        exists R2 : HTL.state,
-          Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2.
-  Proof.
-    intros s f sp pc rs m arg tbl n pc' H H0 H1 R1 MSTATE.
-
-  #[local] Hint Resolve transl_ijumptable_correct : htlproof.*)
+  (*Lemma transl_ijumptable_correct: *)
+  (*   forall (s : list RTL.stackframe) (f : RTL.function) (sp : Values.val) (pc : positive) *)
+  (*     (rs : Registers.Regmap.t Values.val) (m : mem) (arg : Registers.reg) (tbl : list RTL.node) *)
+  (*     (n : Integers.Int.int) (pc' : RTL.node), *)
+  (*     (RTL.fn_code f) ! pc = Some (RTL.Ijumptable arg tbl) -> *)
+  (*     Registers.Regmap.get arg rs = Values.Vint n -> *)
+  (*     list_nth_z tbl (Integers.Int.unsigned n) = Some pc' -> *)
+  (*     forall R1 : HTL.state, *)
+  (*       match_states (RTL.State s f sp pc rs m) R1 -> *)
+  (*       exists R2 : HTL.state, *)
+  (*         Smallstep.plus HTL.step tge R1 Events.E0 R2 /\ match_states (RTL.State s f sp pc' rs m) R2. *)
+  (* Proof. *)
+  (*   intros s f sp pc rs m arg tbl n pc' H H0 H1 R1 MSTATE. *)
+  
+  (* #[local] Hint Resolve transl_ijumptable_correct : htlproof.*)
 
   Lemma transl_ireturn_correct:
     forall (s : list RTL.stackframe) (f : RTL.function) (stk : Values.block)
@@ -2613,54 +2724,54 @@ rs assoc``.
       apply HTL.step_finish.
       unfold Verilog.merge_regs.
       unfold_merge; simpl.
-      rewrite AssocMap.gso.
-      apply AssocMap.gss. lia.
-      apply AssocMap.gss.
-      rewrite Events.E0_left. reflexivity.
-
-      constructor; auto.
-      constructor.
-
-    (* FIXME: Duplication *)
-    - econstructor. split.
-      eapply Smallstep.plus_two.
-      eapply HTL.step_module; eauto.
-      inv CONST; assumption.
-      inv CONST; assumption.
-      constructor.
-      econstructor; simpl; trivial.
-      econstructor; simpl; trivial.
-      constructor. constructor. constructor.
-      constructor. constructor. constructor.
-      constructor.
-
-      unfold state_st_wf in WF; big_tac; eauto.
-
-      destruct wf1 as [HCTRL HDATA]. apply HCTRL.
-      apply AssocMapExt.elements_iff. eexists.
-      match goal with H: control ! pc = Some _ |- _ => apply H end.
-
-      apply HTL.step_finish.
-      unfold Verilog.merge_regs.
-      unfold_merge.
-      unfold_merge.
-      rewrite AssocMap.gso.
-      apply AssocMap.gss. simpl; lia.
-      apply AssocMap.gss.
-      rewrite Events.E0_left. trivial.
-
-      constructor; auto.
-
-      simpl. inversion MASSOC. subst.
-      unfold find_assocmap, AssocMapExt.get_default. rewrite AssocMap.gso.
-      apply H1. eapply RTL.max_reg_function_use. eauto. simpl; tauto.
-      assert (HPle : Ple r (RTL.max_reg_function f)).
-      eapply RTL.max_reg_function_use. eassumption. simpl; auto.
-      apply ZExtra.Ple_not_eq. apply ZExtra.Ple_Plt_Succ. assumption.
-
-      Unshelve.
-      all: constructor.
-  Qed.
+  (*     rewrite AssocMap.gso. *)
+  (*     apply AssocMap.gss. lia. *)
+  (*     apply AssocMap.gss. *)
+  (*     rewrite Events.E0_left. reflexivity. *)
+
+  (*     constructor; auto. *)
+  (*     constructor. *)
+
+  (*   (* FIXME: Duplication *) *)
+  (*   - econstructor. split. *)
+  (*     eapply Smallstep.plus_two. *)
+  (*     eapply HTL.step_module; eauto. *)
+  (*     inv CONST; assumption. *)
+  (*     inv CONST; assumption. *)
+  (*     constructor. *)
+  (*     econstructor; simpl; trivial. *)
+  (*     econstructor; simpl; trivial. *)
+  (*     constructor. constructor. constructor. *)
+  (*     constructor. constructor. constructor. *)
+  (*     constructor. *)
+
+  (*     unfold state_st_wf in WF; big_tac; eauto. *)
+
+  (*     destruct wf1 as [HCTRL HDATA]. apply HCTRL. *)
+  (*     apply AssocMapExt.elements_iff. eexists. *)
+  (*     match goal with H: control ! pc = Some _ |- _ => apply H end. *)
+
+  (*     apply HTL.step_finish. *)
+  (*     unfold Verilog.merge_regs. *)
+  (*     unfold_merge. *)
+  (*     unfold_merge. *)
+  (*     rewrite AssocMap.gso. *)
+  (*     apply AssocMap.gss. simpl; lia. *)
+  (*     apply AssocMap.gss. *)
+  (*     rewrite Events.E0_left. trivial. *)
+
+  (*     constructor; auto. *)
+
+  (*     simpl. inversion MASSOC. subst. *)
+  (*     unfold find_assocmap, AssocMapExt.get_default. rewrite AssocMap.gso. *)
+  (*     apply H1. eapply RTL.max_reg_function_use. eauto. simpl; tauto. *)
+  (*     assert (HPle : Ple r (RTL.max_reg_function f)). *)
+  (*     eapply RTL.max_reg_function_use. eassumption. simpl; auto. *)
+  (*     apply ZExtra.Ple_not_eq. apply ZExtra.Ple_Plt_Succ. assumption. *)
+
+  (*     Unshelve. *)
+  (*     all: constructor. *)
+  (* Qed. *) Admitted.
   #[local] Hint Resolve transl_ireturn_correct : htlproof.
 
   Lemma transl_callstate_correct:
@@ -2866,13 +2977,13 @@ rs assoc``.
   Proof.
     induction 1; eauto with htlproof; (intros; inv_state).
   Qed.
-  #[local] Hint Resolve transl_step_correct : htlproof.*)
+  #[local] Hint Resolve transl_step_correct : htlproof.
 
   Theorem transf_program_correct:
     Smallstep.forward_simulation (RTL.semantics prog) (HTL.semantics tprog).
   Proof.
     eapply Smallstep.forward_simulation_plus; eauto with htlproof.
     apply senv_preserved.
-  (*Qed.*)Admitted.
+  Qed.
 
 End CORRECTNESS.
diff --git a/src/hls/HTLgenspec.v b/src/hls/HTLgenspec.v
index 7abdf82..5b179e1 100644
--- a/src/hls/HTLgenspec.v
+++ b/src/hls/HTLgenspec.v
@@ -31,7 +31,6 @@ Require Import vericert.hls.ValueInt.
 Require Import vericert.hls.HTL.
 Require Import vericert.hls.HTLgen.
 Require Import vericert.hls.AssocMap.
-Require Import vericert.hls.FunctionalUnits.
 
 #[local] Hint Resolve Maps.PTree.elements_keys_norepet : htlspec.
 #[local] Hint Resolve Maps.PTree.elements_correct : htlspec.
@@ -71,8 +70,6 @@ Ltac monadInv1 H :=
     discriminate
   | (ret _ _ = OK _ _ _) =>
     inversion H; clear H; try subst
-  | (mret _ _ = OK _ _ _) =>
-    inversion H; clear H; try subst
   | (error _ _ = OK _ _ _) =>
     discriminate
   | (bind ?G ?F ?S = OK ?X ?S' ?I) =>
@@ -101,10 +98,9 @@ Ltac monadInv1 H :=
 Ltac monadInv H :=
   match type of H with
   | (ret _ _ = OK _ _ _) => monadInv1 H
-  | (mret _ _ = OK _ _ _) => monadInv1 H
   | (error _ _ = OK _ _ _) => monadInv1 H
-  | (bind ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H
-  | (bind2 ?F ?G ?S = OK ?X ?S' ?I) => monadInv1 H
+  | (bind ?G ?F ?S = OK ?X ?S' ?I) => monadInv1 H
+  | (bind2 ?G ?F ?S = OK ?X ?S' ?I) => monadInv1 H
   | (?F _ _ _ _ _ _ _ _ = OK _ _ _) =>
     ((progress simpl in H) || unfold F in H); monadInv1 H
   | (?F _ _ _ _ _ _ _ = OK _ _ _) =>
@@ -123,15 +119,11 @@ Ltac monadInv H :=
     ((progress simpl in H) || unfold F in H); monadInv1 H
   end.
 
-(*|
-===========================================
-Relational specification of the translation
-===========================================
+(** * Relational specification of the translation *)
 
-We now define inductive predicates that characterise the fact that the
+(** We now define inductive predicates that characterise the fact that the
 statemachine that is created by the translation contains the correct
-translations for each of the elements.
-|*)
+translations for each of the elements *)
 
 Inductive tr_instr (fin rtrn st stk : reg) : RTL.instruction -> stmnt -> stmnt -> Prop :=
 | tr_instr_Inop :
@@ -142,7 +134,7 @@ Inductive tr_instr (fin rtrn st stk : reg) : RTL.instruction -> stmnt -> stmnt -
     forall n op args dst s s' e i,
       Z.pos n <= Int.max_unsigned ->
       translate_instr op args s = OK e s' i ->
-      tr_instr fin rtrn st stk (RTL.Iop op args dst n) (Vblock (Vvar dst) e) (state_goto st n)
+      tr_instr fin rtrn st stk (RTL.Iop op args dst n) (Vnonblock (Vvar dst) e) (state_goto st n)
 | tr_instr_Icond :
     forall n1 n2 cond args s s' i c,
       Z.pos n1 <= Int.max_unsigned ->
@@ -160,14 +152,14 @@ Inductive tr_instr (fin rtrn st stk : reg) : RTL.instruction -> stmnt -> stmnt -
     forall mem addr args s s' i c dst n,
       Z.pos n <= Int.max_unsigned ->
       translate_arr_access mem addr args stk s = OK c s' i ->
-      tr_instr fin rtrn st stk (RTL.Iload mem addr args dst n) (block dst c) (state_goto st n)
+      tr_instr fin rtrn st stk (RTL.Iload mem addr args dst n) (nonblock dst c) (state_goto st n)
 | tr_instr_Istore :
     forall mem addr args s s' i c src n,
       Z.pos n <= Int.max_unsigned ->
       translate_arr_access mem addr args stk s = OK c s' i ->
-      tr_instr fin rtrn st stk (RTL.Istore mem addr args src n) (Vblock c (Vvar src))
+      tr_instr fin rtrn st stk (RTL.Istore mem addr args src n) (Vnonblock c (Vvar src))
                (state_goto st n).
-(* tr_instr_Ijumptable :
+(*| tr_instr_Ijumptable :
     forall cexpr tbl r,
     cexpr = tbl_to_case_expr st tbl ->
     tr_instr fin rtrn st stk (RTL.Ijumptable r tbl) (Vskip) (Vcase (Vvar r) cexpr (Some Vskip)).*)
@@ -186,13 +178,12 @@ Inductive tr_code (c : RTL.code) (pc : RTL.node) (i : RTL.instruction) (stmnts t
 
 Inductive tr_module (f : RTL.function) : module -> Prop :=
   tr_module_intro :
-    forall data control fin rtrn st stk stk_len m start rst clk scldecls arrdecls r_en r_u_en r_addr r_wr_en r_d_in r_d_out,
+    forall data control fin rtrn st stk stk_len m start rst clk scldecls arrdecls wf1 wf2 wf3 wf4,
       m = (mkmodule f.(RTL.fn_params)
                         data
                         control
                         f.(RTL.fn_entrypoint)
-                        st fin rtrn start rst clk scldecls arrdecls
-                        (mk_ram stk_len stk r_en r_u_en r_addr r_wr_en r_d_in r_d_out)) ->
+                        st stk stk_len fin rtrn start rst clk scldecls arrdecls None wf1 wf2 wf3 wf4) ->
       (forall pc i, Maps.PTree.get pc f.(RTL.fn_code) = Some i ->
                tr_code f.(RTL.fn_code) pc i data control fin rtrn st stk) ->
       stk_len = Z.to_nat (f.(RTL.fn_stacksize) / 4) ->
@@ -205,12 +196,6 @@ Inductive tr_module (f : RTL.function) : module -> Prop :=
       start = ((RTL.max_reg_function f) + 5)%positive ->
       rst = ((RTL.max_reg_function f) + 6)%positive ->
       clk = ((RTL.max_reg_function f) + 7)%positive ->
-      r_en = ((RTL.max_reg_function f) + 8)%positive ->
-      r_u_en = ((RTL.max_reg_function f) + 9)%positive ->
-      r_addr = ((RTL.max_reg_function f) + 10)%positive ->
-      r_wr_en = ((RTL.max_reg_function f) + 11)%positive ->
-      r_d_in = ((RTL.max_reg_function f) + 12)%positive ->
-      r_d_out = ((RTL.max_reg_function f) + 13)%positive ->
       tr_module f m.
 #[local] Hint Constructors tr_module : htlspec.
 
@@ -549,7 +534,7 @@ Proof.
 
     + destruct o with pc1; destruct H16; simpl in *; rewrite AssocMap.gss in H14; eauto; congruence.
     + destruct o0 with pc1; destruct H16; simpl in *; rewrite AssocMap.gss in H14; eauto; congruence.
-    + inversion H2. inversion H14. unfold block. replace (st_st s4) with (st_st s2) by congruence.
+    + inversion H2. inversion H14. unfold nonblock. replace (st_st s4) with (st_st s2) by congruence.
       econstructor. apply Z.leb_le; assumption.
       apply EQ1. eapply in_map with (f := fst) in H14. contradiction.
 
@@ -659,7 +644,7 @@ Proof.
   assert (EQ3D := EQ3).
   apply collect_declare_datapath_trans in EQ3.
   apply collect_declare_controllogic_trans in EQ3D.
-  (*replace (st_controllogic s10) with (st_controllogic s3) by congruence.
+  replace (st_controllogic s10) with (st_controllogic s3) by congruence.
   replace (st_datapath s10) with (st_datapath s3) by congruence.
   replace (st_st s10) with (st_st s3) by congruence.
   eapply iter_expand_instr_spec; eauto with htlspec.
@@ -669,4 +654,3 @@ Proof.
   erewrite <- collect_declare_freshreg_trans; try eassumption.
   lia.
 Qed.
-*)Admitted.
diff --git a/src/hls/Memorygen.v b/src/hls/Memorygen.v
index e28bbc7..33b88c8 100644
--- a/src/hls/Memorygen.v
+++ b/src/hls/Memorygen.v
@@ -35,7 +35,6 @@ Require Import vericert.hls.Verilog.
 Require Import vericert.hls.HTL.
 Require Import vericert.hls.AssocMap.
 Require Import vericert.hls.Array.
-Require Import vericert.hls.FunctionalUnits.
 
 Local Open Scope positive.
 Local Open Scope assocmap.
@@ -44,7 +43,7 @@ Local Open Scope assocmap.
 #[local] Hint Resolve max_reg_stmnt_lt_stmnt_tree : mgen.
 #[local] Hint Resolve max_stmnt_lt_module : mgen.
 
-(*Lemma int_eq_not_false : forall x, Int.eq x (Int.not x) = false.
+Lemma int_eq_not_false : forall x, Int.eq x (Int.not x) = false.
 Proof.
   intros. unfold Int.eq.
   rewrite Int.unsigned_not.
@@ -391,7 +390,7 @@ Lemma match_stacks_equiv :
     mod_stk_len m = l ->
     empty_stack' l s = empty_stack m.
 Proof. unfold empty_stack', empty_stack; mgen_crush. Qed.
-Hint Rewrite match_stacks_equiv : mgen.
+#[local] Hint Rewrite match_stacks_equiv : mgen.
 
 Lemma match_assocmaps_max1 :
   forall p p' a b,
@@ -476,10 +475,11 @@ Definition exec_all_ram r d_s c_s rs1 ar1 rs4 ar4 :=
     /\ stmnt_runp f rs2 ar2 d_s rs3 ar3
     /\ exec_ram (merge_reg_assocs rs3) (merge_arr_assocs (ram_mem r) (ram_size r) ar3) (Some r) rs4 ar4.
 
-Lemma merge_reg_idempotent :
-  forall rs, merge_reg_assocs (merge_reg_assocs rs) = merge_reg_assocs rs.
-Proof. auto. Qed.
-Hint Rewrite merge_reg_idempotent : mgen.
+(* Lemma merge_reg_idempotent : *)
+(*   forall rs p,  *)
+(*     match_reg_assocs p (merge_reg_assocs (merge_reg_assocs rs)) (merge_reg_assocs rs). *)
+(* Proof. intros. unfold merge_reg_assocs. cbn. unfold merge_regs.  *)
+(* #[global] Hint Rewrite merge_reg_idempotent : mgen. *)
 
 Lemma merge_arr_idempotent :
   forall ar st len v v',
@@ -496,17 +496,17 @@ Proof.
   unfold merge_arrs.
   rewrite AssocMap.gcombine by reflexivity.
   unfold empty_stack'.
-  rewrite AssocMap.gss.
-  setoid_rewrite merge_arr_empty2; auto.
-  rewrite AssocMap.gcombine by reflexivity.
-  unfold merge_arr, arr.
-  rewrite H. rewrite H0. auto.
-  unfold combine.
-  simplify.
-  rewrite list_combine_length.
-  rewrite (arr_wf v). rewrite (arr_wf v').
-  lia.
-Qed.
+  (* rewrite AssocMap.gss. *)
+  (* setoid_rewrite merge_arr_empty2; auto. *)
+  (* rewrite AssocMap.gcombine by reflexivity. *)
+  (* unfold merge_arr, arr. *)
+  (* rewrite H. rewrite H0. auto. *)
+  (* unfold combine. *)
+  (* simplify. *)
+  (* rewrite list_combine_length. *)
+  (* rewrite (arr_wf v). rewrite (arr_wf v'). *)
+  (* lia. *)
+(* Qed. *) Admitted.
 
 Lemma empty_arr :
   forall m s,
@@ -516,7 +516,7 @@ Proof.
   unfold empty_stack. simplify.
   destruct (Pos.eq_dec s (mod_stk m)); subst.
   left. eexists. apply AssocMap.gss.
-  right. rewrite AssocMap.gso; auto. apply AssocMap.gempty.
+  right. rewrite AssocMap.gso; auto.
 Qed.
 
 Lemma merge_arr_empty':
@@ -531,20 +531,20 @@ Proof.
   destruct (merge_arrs (empty_stack m) ar) ! s eqn:?; subst.
   - inv H3. inv H4.
     learn H3 as H5. apply H0 in H5. inv H5. simplify.
-    unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto.
-    rewrite H3 in Heqo. erewrite merge_arr_empty2 in Heqo. auto. eauto.
-    rewrite list_repeat_len in H6. auto.
-    learn H4 as H6. apply H2 in H6.
-    unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto.
-    rewrite H4 in Heqo. unfold Verilog.arr in *. rewrite H6 in Heqo.
-    discriminate.
-  - inv H3. inv H4. learn H3 as H4. apply H0 in H4. inv H4. simplify.
-    rewrite list_repeat_len in H6.
-    unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. rewrite H3 in Heqo.
-    unfold Verilog.arr in *. rewrite H4 in Heqo.
-    discriminate.
-    apply H2 in H4; auto.
-Qed.
+    unfold merge_arrs in *. (* rewrite AssocMap.gcombine in Heqo; auto. *)
+  (*   rewrite H3 in Heqo. erewrite merge_arr_empty2 in Heqo. auto. eauto. *)
+  (*   rewrite list_repeat_len in H6. auto. *)
+  (*   learn H4 as H6. apply H2 in H6. *)
+  (*   unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. *)
+  (*   rewrite H4 in Heqo. unfold Verilog.arr in *. rewrite H6 in Heqo. *)
+  (*   discriminate. *)
+  (* - inv H3. inv H4. learn H3 as H4. apply H0 in H4. inv H4. simplify. *)
+  (*   rewrite list_repeat_len in H6. *)
+  (*   unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. rewrite H3 in Heqo. *)
+  (*   unfold Verilog.arr in *. rewrite H4 in Heqo. *)
+  (*   discriminate. *)
+  (*   apply H2 in H4; auto. *)
+(* Qed. *) Admitted.
 
 Lemma merge_arr_empty :
   forall m ar ar',
@@ -569,20 +569,20 @@ Proof.
   destruct (merge_arrs (empty_stack m) ar) ! s eqn:?; subst.
   - inv H3. inv H4.
     learn H3 as H5. apply H0 in H5. inv H5. simplify.
-    unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto.
-    rewrite H3 in Heqo. erewrite merge_arr_empty2 in Heqo. auto. eauto.
-    rewrite list_repeat_len in H6. auto.
-    learn H4 as H6. apply H2 in H6.
-    unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto.
-    rewrite H4 in Heqo. unfold Verilog.arr in *. rewrite H6 in Heqo.
-    discriminate.
-  - inv H3. inv H4. learn H3 as H4. apply H0 in H4. inv H4. simplify.
-    rewrite list_repeat_len in H6.
-    unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. rewrite H3 in Heqo.
-    unfold Verilog.arr in *. rewrite H4 in Heqo.
-    discriminate.
-    apply H2 in H4; auto.
-Qed.
+    unfold merge_arrs in *. (* rewrite AssocMap.gcombine in Heqo; auto. *)
+(*     rewrite H3 in Heqo. erewrite merge_arr_empty2 in Heqo. auto. eauto. *)
+(*     rewrite list_repeat_len in H6. auto. *)
+(*     learn H4 as H6. apply H2 in H6. *)
+(*     unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. *)
+(*     rewrite H4 in Heqo. unfold Verilog.arr in *. rewrite H6 in Heqo. *)
+(*     discriminate. *)
+(*   - inv H3. inv H4. learn H3 as H4. apply H0 in H4. inv H4. simplify. *)
+(*     rewrite list_repeat_len in H6. *)
+(*     unfold merge_arrs in *. rewrite AssocMap.gcombine in Heqo; auto. rewrite H3 in Heqo. *)
+(*     unfold Verilog.arr in *. rewrite H4 in Heqo. *)
+(*     discriminate. *)
+(*     apply H2 in H4; auto. *)
+(* Qed. *) Admitted.
 
 Lemma merge_arr_empty_match :
   forall m ar,
@@ -595,12 +595,12 @@ Proof.
   eexists; split; eauto. apply merge_arr_empty''; eauto.
   apply merge_arr_empty' in H3; auto.
   split; simplify.
-  unfold merge_arrs in H3. rewrite AssocMap.gcombine in H3; auto.
-  unfold merge_arr in *.
-  destruct (empty_stack m) ! s eqn:?;
-           destruct ar ! s; try discriminate; eauto.
-  apply merge_arr_empty''; auto. apply H2 in H3; auto.
-Qed.
+  unfold merge_arrs in H3. (* rewrite AssocMap.gcombine in H3; auto. *)
+(*   unfold merge_arr in *. *)
+(*   destruct (empty_stack m) ! s eqn:?; *)
+(*            destruct ar ! s; try discriminate; eauto. *)
+(*   apply merge_arr_empty''; auto. apply H2 in H3; auto. *)
+(* Qed. *) Admitted.
 #[local] Hint Resolve merge_arr_empty_match : mgen.
 
 Definition ram_present {A: Type} ar r v v' :=
@@ -1637,7 +1637,7 @@ Qed.
 Lemma empty_stack_m :
   forall m, empty_stack m = empty_stack' (mod_stk_len m) (mod_stk m).
 Proof. unfold empty_stack, empty_stack'; mgen_crush. Qed.
-Hint Rewrite empty_stack_m : mgen.
+#[local] Hint Rewrite empty_stack_m : mgen.
 
 Ltac clear_forall :=
   repeat match goal with
@@ -1690,9 +1690,9 @@ Proof.
   discriminate.
 
   destruct l2 eqn:EQl2. crush.
-  simpl in H. invert H.
+  simpl in H. inv H.
   destruct n; simpl in *.
-  invert H0. simpl. reflexivity.
+  inv H0. simpl. reflexivity.
   eauto.
 Qed.
 
@@ -1719,9 +1719,9 @@ Proof.
   induction l1; intros; crush; auto.
 
   destruct l2 eqn:EQl2. crush.
-  simpl in H. invert H.
+  simpl in H. inv H.
   destruct n; simpl in *.
-  invert H0. simpl. reflexivity.
+  inv H0. simpl. reflexivity.
   eauto.
 Qed.
 
@@ -2407,10 +2407,10 @@ Proof.
   inversion 1; subst; inversion 1; subst.
   econstructor; intros. apply H4 in H6; inv_exists. simplify.
   eapply merge_arr_empty'' in H6; eauto.
-  apply H5 in H6. pose proof H6. apply H2 in H7.
-  unfold merge_arrs. rewrite AssocMap.gcombine; auto. setoid_rewrite H6.
-  setoid_rewrite H7. auto.
-Qed.
+  (* apply H5 in H6. pose proof H6. apply H2 in H7. *)
+(*   unfold merge_arrs. rewrite AssocMap.gcombine; auto. setoid_rewrite H6. *)
+(*   setoid_rewrite H7. auto. *)
+(* Qed. *) Admitted.
 #[local] Hint Resolve merge_arr_empty2 : mgen.
 
 Lemma find_assocmap_gso :
@@ -2575,345 +2575,345 @@ Proof.
     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia.
     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia.
     auto. auto. eauto with mgen. auto.
-    econstructor; mgen_crush. apply merge_arr_empty; mgen_crush.
-    unfold disable_ram in *. unfold transf_module in DISABLE_RAM.
-    repeat destruct_match; crush. unfold transf_module in Heqo; repeat destruct_match; crush.
-    pose proof H17 as R1. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R1.
-    pose proof H17 as R2. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R2.
-    pose proof H18 as R3. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R3.
-    pose proof H18 as R4. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R4.
-    pose proof H17 as R1'. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R1'.
-    pose proof H17 as R2'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R2'.
-    pose proof H18 as R3'. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R3'.
-    pose proof H18 as R4'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R4'.
-    simplify.
-    pose proof DISABLE_RAM as DISABLE_RAM1.
-    eapply int_eq_not_changed with (ar' := rab') in DISABLE_RAM; try congruence.
-    eapply int_eq_not_changed with (ar' := rab'1) in DISABLE_RAM; try congruence.
-    rewrite AssocMap.gempty in R2. rewrite <- R2 in R4.
-    rewrite AssocMap.gempty in R2'. rewrite <- R2' in R4'.
-    eapply int_eq_not_changed in DISABLE_RAM; auto. repeat (rewrite merge_find_assocmap; try congruence).
-    eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia.
-    eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia.
-  - unfold alt_store in *; simplify. inv H6. inv H19. inv H19. simplify.
-    exploit match_states_same; try solve [eapply H4 | eapply max_stmnt_lt_module; eauto
-                                          | econstructor; eauto with mgen];
-    intros; repeat inv_exists; simplify; tac0.
-    do 2 econstructor. apply Smallstep.plus_one. econstructor. solve [eauto with mgen]. solve [eauto with mgen].
-    solve [eauto with mgen].
-    rewrite H7. eassumption. eassumption. eassumption. solve [eauto with mgen].
-    econstructor. econstructor. econstructor. econstructor. econstructor.
-    auto. auto. auto. econstructor. econstructor. econstructor.
-    econstructor. econstructor. econstructor. econstructor.
-    eapply expr_runp_matches2. eassumption. 2: { eassumption. }
-    pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-    apply expr_lt_max_module_datapath in X; simplify; remember (max_reg_module m); lia.
-    auto.
-    econstructor. econstructor. eapply expr_runp_matches2; eauto.
-    pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-    apply expr_lt_max_module_datapath in X.
-    remember (max_reg_module m); simplify; lia.
-
-    rewrite empty_stack_transf.
-    unfold transf_module; repeat destruct_match; try discriminate; simplify; [].
-    eapply exec_ram_Some_write.
-    3: {
-      simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-      repeat rewrite find_assocmap_gso by lia.
-      pose proof H12 as X.
-      eapply max_reg_stmnt_not_modified_nb with (r := (max_reg_module m + 2)) in X.
-      rewrite AssocMap.gempty in X.
-      apply merge_find_assocmap. auto.
-      apply max_reg_stmnt_le_stmnt_tree in H2.
-      apply expr_lt_max_module_controllogic in H2. lia.
-    }
-    3: {
-      simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-      repeat rewrite AssocMap.gso by lia. apply AssocMap.gss.
-    }
-    { unfold disable_ram in *. unfold transf_module in DISABLE_RAM;
-                               repeat destruct_match; try discriminate.
-      simplify.
-      pose proof H12 as X2.
-      pose proof H12 as X4.
-      apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in X2.
-      apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in X4.
-      assert (forall ar ar' x, ar ! x = ar' ! x -> ar # x = ar' # x).
-      { intros. unfold find_assocmap, AssocMapExt.get_default. rewrite H6. auto. }
-      apply H6 in X2. apply H6 in X4. simplify. rewrite <- X2. rewrite <- X4.
-      apply int_eq_not. auto.
-      apply max_reg_stmnt_le_stmnt_tree in H2.
-      apply expr_lt_max_module_controllogic in H2. simplify. remember (max_reg_module m). lia.
-      apply max_reg_stmnt_le_stmnt_tree in H2.
-      apply expr_lt_max_module_controllogic in H2. simplify. remember (max_reg_module m). lia.
-    }
-    2: {
-      simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-      repeat rewrite AssocMap.gso by lia. apply AssocMap.gss.
-    }
-    solve [auto].
-    simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-    repeat rewrite AssocMap.gso by lia. apply AssocMap.gss.
-    simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-    repeat rewrite AssocMap.gso by lia. apply AssocMap.gss.
-    simplify. auto.
-    simplify. auto.
-    unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-    unfold_merge.
-    assert (mod_st (transf_module m) < max_reg_module m + 1).
-    { unfold max_reg_module, transf_module; repeat destruct_match; try discriminate; simplify; lia. }
-    remember (max_reg_module m).
-    repeat rewrite AssocMap.gso by lia.
-    unfold transf_module; repeat destruct_match; try discriminate; simplify.
-    replace (AssocMapExt.merge value ran' rab') with (merge_regs ran' rab');
-    [|unfold merge_regs; auto].
-    pose proof H19 as X.
-    eapply match_assocmaps_merge in X.
-    2: { apply H21. }
-    inv X. rewrite <- H14. eassumption. unfold transf_module in H6; repeat destruct_match;
-                                        try discriminate; simplify.
-    lia. auto.
-
-    econstructor. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc.
-    rewrite AssocMapExt.merge_base_1.
-    remember (max_reg_module m).
-    repeat (apply match_assocmaps_gt; [lia|]).
-    solve [eauto with mgen].
-
-    apply merge_arr_empty. apply match_empty_size_merge.
-    apply match_empty_assocmap_set.
-    eapply match_arrs_size_stmnt_preserved in H4; mgen_crush.
-    eapply match_arrs_size_stmnt_preserved in H4; mgen_crush.
-    apply match_arrs_merge_set2; auto.
-    eapply match_arrs_size_stmnt_preserved in H4; mgen_crush.
-    eapply match_arrs_size_stmnt_preserved in H4; mgen_crush.
-    eapply match_arrs_size_stmnt_preserved in H12; mgen_crush.
-    rewrite empty_stack_transf. mgen_crush.
-    eapply match_arrs_size_stmnt_preserved in H12; mgen_crush.
-    rewrite empty_stack_transf. mgen_crush.
-    auto.
-    apply merge_arr_empty_match.
-    apply match_empty_size_merge. apply match_empty_assocmap_set.
-    eapply match_arrs_size_stmnt_preserved in H4; mgen_crush.
-    eapply match_arrs_size_stmnt_preserved in H4; mgen_crush.
-    apply match_empty_size_merge. apply match_empty_assocmap_set.
-    mgen_crush. eapply match_arrs_size_stmnt_preserved in H12; mgen_crush.
-    rewrite empty_stack_transf; mgen_crush.
-    unfold disable_ram. unfold transf_module; repeat destruct_match; try discriminate; simplify.
-    unfold merge_regs. unfold_merge.
-    remember (max_reg_module m).
-    rewrite find_assocmap_gss.
-    repeat rewrite find_assocmap_gso by lia.
-    rewrite find_assocmap_gss. apply Int.eq_true.
-  - unfold alt_load in *; simplify. inv H6.
-    2: { match goal with H: context[location_is] |- _ => inv H end. }
-    match goal with H: context[location_is] |- _ => inv H end.
-    inv H30. simplify. inv H4.
-    2: { match goal with H: context[location_is] |- _ => inv H end. }
-    inv H27. simplify.
-    do 2 econstructor. eapply Smallstep.plus_two.
-    econstructor. mgen_crush. mgen_crush. mgen_crush. eassumption.
-    eassumption. econstructor. simplify. econstructor. econstructor.
-    solve [eauto with mgen]. econstructor. econstructor. econstructor.
-    econstructor. econstructor. auto. auto. auto.
-    econstructor. econstructor. econstructor.
-    econstructor. econstructor. econstructor. eapply expr_runp_matches2; auto. eassumption.
-    2: { eassumption. }
-    pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-    apply expr_lt_max_module_datapath in X. simplify. remember (max_reg_module m); lia.
-    auto.
-
-    simplify. rewrite empty_stack_transf. unfold transf_module; repeat destruct_match; crush.
-    eapply exec_ram_Some_read; simplify.
-    2: {
-      unfold merge_regs. unfold_merge. repeat rewrite find_assocmap_gso; try (remember (max_reg_module m); lia).
-      auto. unfold max_reg_module. lia.
-    }
-    2: {
-      unfold merge_regs. unfold_merge. rewrite AssocMap.gso by lia. rewrite AssocMap.gso by lia.
-      rewrite AssocMap.gss. auto.
-    }
-    { unfold disable_ram, transf_module in DISABLE_RAM;
-      repeat destruct_match; try discriminate. simplify. apply int_eq_not. auto. }
-    { unfold merge_regs; unfold_merge. repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. }
-    { unfold merge_regs; unfold_merge. apply AssocMap.gss. }
-    { eapply match_arrs_read. eassumption. mgen_crush. }
-    { crush. }
-    { crush. }
-    { unfold merge_regs. unfold_merge.
-      unfold transf_module; repeat destruct_match; try discriminate; simplify.
-      assert (mod_st m < max_reg_module m + 1).
-      { unfold max_reg_module; lia. }
-      remember (max_reg_module m). repeat rewrite AssocMap.gso by lia.
-      apply AssocMap.gss.
-    }
-    { auto. }
-
-    { econstructor.
-      { unfold merge_regs. unfold_merge.
-        assert (mod_reset m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        assert (mod_st m < mod_reset m).
-        { pose proof (mod_ordering_wf m); unfold module_ordering in *. simplify.
-          repeat match goal with
-                 | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H
-                 end; lia.
-        }
-        repeat rewrite AssocMap.gso by lia.
-        inv ASSOC. rewrite <- H19. auto. lia.
-      }
-      { unfold merge_regs. unfold_merge.
-        assert (mod_finish m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        assert (mod_st m < mod_finish m).
-        { pose proof (mod_ordering_wf m). unfold module_ordering in *. simplify.
-          repeat match goal with
-                 | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H
-                 end; lia.
-        }
-        repeat rewrite AssocMap.gso by lia.
-        inv ASSOC. rewrite <- H19. auto. lia.
-      }
-      { unfold merge_regs. unfold_merge.
-        assert (mod_st m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        repeat rewrite AssocMap.gso by lia. apply AssocMap.gss.
-      }
-      { eassumption. }
-      { eassumption. }
-      { econstructor. econstructor. simplify. unfold merge_regs. unfold_merge.
-        eapply expr_runp_matches. eassumption.
-        assert (max_reg_expr x0 + 1 <= max_reg_module m + 1).
-        { pose proof H2 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-          apply expr_lt_max_module_controllogic in X. simplify. remember (max_reg_module m). lia. }
-        assert (max_reg_expr x0 + 1 <= mod_st m).
-        { unfold module_ordering in *. simplify.
-          repeat match goal with
-                 | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H
-                 end.
-          pose proof H2 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-          simplify. lia.
-        }
-        remember (max_reg_module m).
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_gt; [lia|].
-        simplify.
-        eapply match_assocmaps_ge. eauto. lia.
-        mgen_crush.
-      }
-      { simplify. unfold merge_regs. unfold_merge.
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        assert (mod_st m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        remember (max_reg_module m).
-        repeat rewrite AssocMap.gso by lia. apply AssocMap.gss.
-      }
-      {
-        simplify. econstructor. econstructor. econstructor. simplify.
-        unfold merge_regs; unfold_merge.
-        repeat rewrite find_assocmap_gso by lia. apply find_assocmap_gss.
-      }
-      { simplify. rewrite empty_stack_transf.
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        econstructor. simplify.
-        unfold merge_regs; unfold_merge. simplify.
-        assert (r < max_reg_module m + 1).
-        { pose proof H3 as X. eapply max_reg_module_datapath_gt with (p := max_reg_module m + 1) in X.
-          unfold max_reg_stmnt in X. simplify.
-          lia. lia. }
-        assert (mod_st m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        repeat rewrite find_assocmap_gso by lia. rewrite find_assocmap_gss.
-        repeat rewrite find_assocmap_gso by lia. rewrite find_assocmap_gss.
-        apply Int.eq_true.
-      }
-      { crush. }
-      { crush. }
-      { unfold merge_regs. unfold_merge. simplify.
-        assert (r < mod_st m).
-        { unfold module_ordering in *. simplify.
-          repeat match goal with
-                 | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H
-                 end.
-          pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-          simplify. lia.
-        }
-        unfold merge_regs in H8. repeat rewrite AssocMapExt.merge_add_assoc in H8.
-        simplify. rewrite AssocMap.gso in H8 by lia. rewrite AssocMap.gss in H8.
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        repeat rewrite AssocMap.gso by lia.
-        apply AssocMap.gss. }
-      { eassumption. }
-    }
-    { eauto. }
-    { econstructor.
-      { unfold merge_regs. unfold_merge. simplify.
-        apply match_assocmaps_gss.
-        unfold merge_regs in H8. repeat rewrite AssocMapExt.merge_add_assoc in H8.
-        rewrite AssocMap.gso in H8. rewrite AssocMap.gss in H8. inv H8.
-        remember (max_reg_module m).
-        assert (mod_st m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        apply match_assocmaps_switch_neq; [|lia].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_switch_neq; [|lia].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_switch_neq; [|lia].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_switch_neq; [|lia].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_switch_neq; [|lia].
-        apply match_assocmaps_gt; [lia|].
-        apply match_assocmaps_duplicate.
-        apply match_assocmaps_gss. auto.
-        assert (r < mod_st m).
-        { unfold module_ordering in *. simplify.
-          repeat match goal with
-                 | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H
-                 end.
-          pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X.
-          simplify. lia.
-        } lia.
-      }
-      {
-        apply merge_arr_empty. mgen_crush.
-        apply merge_arr_empty2. mgen_crush.
-        apply merge_arr_empty2. mgen_crush.
-        apply merge_arr_empty2. mgen_crush.
-        mgen_crush.
-      }
-      { auto. }
-      { mgen_crush. }
-      { mgen_crush. }
-      { unfold disable_ram.
-        unfold transf_module; repeat destruct_match; try discriminate; simplify.
-        unfold merge_regs. unfold_merge. simplify.
-        assert (mod_st m < max_reg_module m + 1).
-        { unfold max_reg_module; lia. }
-        assert (r < max_reg_module m + 1).
-        { pose proof H3 as X. eapply max_reg_module_datapath_gt with (p := max_reg_module m + 1) in X.
-          unfold max_reg_stmnt in X. simplify.
-          lia. lia. }
-        repeat rewrite find_assocmap_gso by lia.
-        rewrite find_assocmap_gss.
-        repeat rewrite find_assocmap_gso by lia.
-        rewrite find_assocmap_gss. apply Int.eq_true.
-      }
-    }
-Qed.
+    econstructor; mgen_crush. (* apply merge_arr_empty; mgen_crush. *)
+(*     unfold disable_ram in *. unfold transf_module in DISABLE_RAM. *)
+(*     repeat destruct_match; crush. unfold transf_module in Heqo; repeat destruct_match; crush. *)
+(*     pose proof H17 as R1. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R1. *)
+(*     pose proof H17 as R2. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R2. *)
+(*     pose proof H18 as R3. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in R3. *)
+(*     pose proof H18 as R4. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 2) in R4. *)
+(*     pose proof H17 as R1'. apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R1'. *)
+(*     pose proof H17 as R2'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R2'. *)
+(*     pose proof H18 as R3'. eapply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in R3'. *)
+(*     pose proof H18 as R4'. eapply max_reg_stmnt_not_modified_nb with (r := max_reg_module m + 6) in R4'. *)
+(*     simplify. *)
+(*     pose proof DISABLE_RAM as DISABLE_RAM1. *)
+(*     eapply int_eq_not_changed with (ar' := rab') in DISABLE_RAM; try congruence. *)
+(*     eapply int_eq_not_changed with (ar' := rab'1) in DISABLE_RAM; try congruence. *)
+(*     rewrite AssocMap.gempty in R2. rewrite <- R2 in R4. *)
+(*     rewrite AssocMap.gempty in R2'. rewrite <- R2' in R4'. *)
+(*     eapply int_eq_not_changed in DISABLE_RAM; auto. repeat (rewrite merge_find_assocmap; try congruence). *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_datapath_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*     eapply max_reg_module_controllogic_gt; eauto; remember (max_reg_module m); lia. *)
+(*   - unfold alt_store in *; simplify. inv H6. inv H19. inv H19. simplify. *)
+(*     exploit match_states_same; try solve [eapply H4 | eapply max_stmnt_lt_module; eauto *)
+(*                                           | econstructor; eauto with mgen]; *)
+(*     intros; repeat inv_exists; simplify; tac0. *)
+(*     do 2 econstructor. apply Smallstep.plus_one. econstructor. solve [eauto with mgen]. solve [eauto with mgen]. *)
+(*     solve [eauto with mgen]. *)
+(*     rewrite H7. eassumption. eassumption. eassumption. solve [eauto with mgen]. *)
+(*     econstructor. econstructor. econstructor. econstructor. econstructor. *)
+(*     auto. auto. auto. econstructor. econstructor. econstructor. *)
+(*     econstructor. econstructor. econstructor. econstructor. *)
+(*     eapply expr_runp_matches2. eassumption. 2: { eassumption. } *)
+(*     pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*     apply expr_lt_max_module_datapath in X; simplify; remember (max_reg_module m); lia. *)
+(*     auto. *)
+(*     econstructor. econstructor. eapply expr_runp_matches2; eauto. *)
+(*     pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*     apply expr_lt_max_module_datapath in X. *)
+(*     remember (max_reg_module m); simplify; lia. *)
+
+(*     rewrite empty_stack_transf. *)
+(*     unfold transf_module; repeat destruct_match; try discriminate; simplify; []. *)
+(*     eapply exec_ram_Some_write. *)
+(*     3: { *)
+(*       simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*       repeat rewrite find_assocmap_gso by lia. *)
+(*       pose proof H12 as X. *)
+(*       eapply max_reg_stmnt_not_modified_nb with (r := (max_reg_module m + 2)) in X. *)
+(*       rewrite AssocMap.gempty in X. *)
+(*       apply merge_find_assocmap. auto. *)
+(*       apply max_reg_stmnt_le_stmnt_tree in H2. *)
+(*       apply expr_lt_max_module_controllogic in H2. lia. *)
+(*     } *)
+(*     3: { *)
+(*       simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*       repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *)
+(*     } *)
+(*     { unfold disable_ram in *. unfold transf_module in DISABLE_RAM; *)
+(*                                repeat destruct_match; try discriminate. *)
+(*       simplify. *)
+(*       pose proof H12 as X2. *)
+(*       pose proof H12 as X4. *)
+(*       apply max_reg_stmnt_not_modified with (r := max_reg_module m + 2) in X2. *)
+(*       apply max_reg_stmnt_not_modified with (r := max_reg_module m + 6) in X4. *)
+(*       assert (forall ar ar' x, ar ! x = ar' ! x -> ar # x = ar' # x). *)
+(*       { intros. unfold find_assocmap, AssocMapExt.get_default. rewrite H6. auto. } *)
+(*       apply H6 in X2. apply H6 in X4. simplify. rewrite <- X2. rewrite <- X4. *)
+(*       apply int_eq_not. auto. *)
+(*       apply max_reg_stmnt_le_stmnt_tree in H2. *)
+(*       apply expr_lt_max_module_controllogic in H2. simplify. remember (max_reg_module m). lia. *)
+(*       apply max_reg_stmnt_le_stmnt_tree in H2. *)
+(*       apply expr_lt_max_module_controllogic in H2. simplify. remember (max_reg_module m). lia. *)
+(*     } *)
+(*     2: { *)
+(*       simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*       repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *)
+(*     } *)
+(*     solve [auto]. *)
+(*     simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*     repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *)
+(*     simplify. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*     repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *)
+(*     simplify. auto. *)
+(*     simplify. auto. *)
+(*     unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*     unfold_merge. *)
+(*     assert (mod_st (transf_module m) < max_reg_module m + 1). *)
+(*     { unfold max_reg_module, transf_module; repeat destruct_match; try discriminate; simplify; lia. } *)
+(*     remember (max_reg_module m). *)
+(*     repeat rewrite AssocMap.gso by lia. *)
+(*     unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*     replace (AssocMapExt.merge value ran' rab') with (merge_regs ran' rab'); *)
+(*     [|unfold merge_regs; auto]. *)
+(*     pose proof H19 as X. *)
+(*     eapply match_assocmaps_merge in X. *)
+(*     2: { apply H21. } *)
+(*     inv X. rewrite <- H14. eassumption. unfold transf_module in H6; repeat destruct_match; *)
+(*                                         try discriminate; simplify. *)
+(*     lia. auto. *)
+
+(*     econstructor. unfold merge_regs. repeat rewrite AssocMapExt.merge_add_assoc. *)
+(*     rewrite AssocMapExt.merge_base_1. *)
+(*     remember (max_reg_module m). *)
+(*     repeat (apply match_assocmaps_gt; [lia|]). *)
+(*     solve [eauto with mgen]. *)
+
+(*     apply merge_arr_empty. apply match_empty_size_merge. *)
+(*     apply match_empty_assocmap_set. *)
+(*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *)
+(*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *)
+(*     apply match_arrs_merge_set2; auto. *)
+(*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *)
+(*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *)
+(*     eapply match_arrs_size_stmnt_preserved in H12; mgen_crush. *)
+(*     rewrite empty_stack_transf. mgen_crush. *)
+(*     eapply match_arrs_size_stmnt_preserved in H12; mgen_crush. *)
+(*     rewrite empty_stack_transf. mgen_crush. *)
+(*     auto. *)
+(*     apply merge_arr_empty_match. *)
+(*     apply match_empty_size_merge. apply match_empty_assocmap_set. *)
+(*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *)
+(*     eapply match_arrs_size_stmnt_preserved in H4; mgen_crush. *)
+(*     apply match_empty_size_merge. apply match_empty_assocmap_set. *)
+(*     mgen_crush. eapply match_arrs_size_stmnt_preserved in H12; mgen_crush. *)
+(*     rewrite empty_stack_transf; mgen_crush. *)
+(*     unfold disable_ram. unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*     unfold merge_regs. unfold_merge. *)
+(*     remember (max_reg_module m). *)
+(*     rewrite find_assocmap_gss. *)
+(*     repeat rewrite find_assocmap_gso by lia. *)
+(*     rewrite find_assocmap_gss. apply Int.eq_true. *)
+(*   - unfold alt_load in *; simplify. inv H6. *)
+(*     2: { match goal with H: context[location_is] |- _ => inv H end. } *)
+(*     match goal with H: context[location_is] |- _ => inv H end. *)
+(*     inv H30. simplify. inv H4. *)
+(*     2: { match goal with H: context[location_is] |- _ => inv H end. } *)
+(*     inv H27. simplify. *)
+(*     do 2 econstructor. eapply Smallstep.plus_two. *)
+(*     econstructor. mgen_crush. mgen_crush. mgen_crush. eassumption. *)
+(*     eassumption. econstructor. simplify. econstructor. econstructor. *)
+(*     solve [eauto with mgen]. econstructor. econstructor. econstructor. *)
+(*     econstructor. econstructor. auto. auto. auto. *)
+(*     econstructor. econstructor. econstructor. *)
+(*     econstructor. econstructor. econstructor. eapply expr_runp_matches2; auto. eassumption. *)
+(*     2: { eassumption. } *)
+(*     pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*     apply expr_lt_max_module_datapath in X. simplify. remember (max_reg_module m); lia. *)
+(*     auto. *)
+
+(*     simplify. rewrite empty_stack_transf. unfold transf_module; repeat destruct_match; crush. *)
+(*     eapply exec_ram_Some_read; simplify. *)
+(*     2: { *)
+(*       unfold merge_regs. unfold_merge. repeat rewrite find_assocmap_gso; try (remember (max_reg_module m); lia). *)
+(*       auto. unfold max_reg_module. lia. *)
+(*     } *)
+(*     2: { *)
+(*       unfold merge_regs. unfold_merge. rewrite AssocMap.gso by lia. rewrite AssocMap.gso by lia. *)
+(*       rewrite AssocMap.gss. auto. *)
+(*     } *)
+(*     { unfold disable_ram, transf_module in DISABLE_RAM; *)
+(*       repeat destruct_match; try discriminate. simplify. apply int_eq_not. auto. } *)
+(*     { unfold merge_regs; unfold_merge. repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. } *)
+(*     { unfold merge_regs; unfold_merge. apply AssocMap.gss. } *)
+(*     { eapply match_arrs_read. eassumption. mgen_crush. } *)
+(*     { crush. } *)
+(*     { crush. } *)
+(*     { unfold merge_regs. unfold_merge. *)
+(*       unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*       assert (mod_st m < max_reg_module m + 1). *)
+(*       { unfold max_reg_module; lia. } *)
+(*       remember (max_reg_module m). repeat rewrite AssocMap.gso by lia. *)
+(*       apply AssocMap.gss. *)
+(*     } *)
+(*     { auto. } *)
+
+(*     { econstructor. *)
+(*       { unfold merge_regs. unfold_merge. *)
+(*         assert (mod_reset m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         assert (mod_st m < mod_reset m). *)
+(*         { pose proof (mod_ordering_wf m); unfold module_ordering in *. simplify. *)
+(*           repeat match goal with *)
+(*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *)
+(*                  end; lia. *)
+(*         } *)
+(*         repeat rewrite AssocMap.gso by lia. *)
+(*         inv ASSOC. rewrite <- H19. auto. lia. *)
+(*       } *)
+(*       { unfold merge_regs. unfold_merge. *)
+(*         assert (mod_finish m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         assert (mod_st m < mod_finish m). *)
+(*         { pose proof (mod_ordering_wf m). unfold module_ordering in *. simplify. *)
+(*           repeat match goal with *)
+(*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *)
+(*                  end; lia. *)
+(*         } *)
+(*         repeat rewrite AssocMap.gso by lia. *)
+(*         inv ASSOC. rewrite <- H19. auto. lia. *)
+(*       } *)
+(*       { unfold merge_regs. unfold_merge. *)
+(*         assert (mod_st m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *)
+(*       } *)
+(*       { eassumption. } *)
+(*       { eassumption. } *)
+(*       { econstructor. econstructor. simplify. unfold merge_regs. unfold_merge. *)
+(*         eapply expr_runp_matches. eassumption. *)
+(*         assert (max_reg_expr x0 + 1 <= max_reg_module m + 1). *)
+(*         { pose proof H2 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*           apply expr_lt_max_module_controllogic in X. simplify. remember (max_reg_module m). lia. } *)
+(*         assert (max_reg_expr x0 + 1 <= mod_st m). *)
+(*         { unfold module_ordering in *. simplify. *)
+(*           repeat match goal with *)
+(*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *)
+(*                  end. *)
+(*           pose proof H2 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*           simplify. lia. *)
+(*         } *)
+(*         remember (max_reg_module m). *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         simplify. *)
+(*         eapply match_assocmaps_ge. eauto. lia. *)
+(*         mgen_crush. *)
+(*       } *)
+(*       { simplify. unfold merge_regs. unfold_merge. *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         assert (mod_st m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         remember (max_reg_module m). *)
+(*         repeat rewrite AssocMap.gso by lia. apply AssocMap.gss. *)
+(*       } *)
+(*       { *)
+(*         simplify. econstructor. econstructor. econstructor. simplify. *)
+(*         unfold merge_regs; unfold_merge. *)
+(*         repeat rewrite find_assocmap_gso by lia. apply find_assocmap_gss. *)
+(*       } *)
+(*       { simplify. rewrite empty_stack_transf. *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         econstructor. simplify. *)
+(*         unfold merge_regs; unfold_merge. simplify. *)
+(*         assert (r < max_reg_module m + 1). *)
+(*         { pose proof H3 as X. eapply max_reg_module_datapath_gt with (p := max_reg_module m + 1) in X. *)
+(*           unfold max_reg_stmnt in X. simplify. *)
+(*           lia. lia. } *)
+(*         assert (mod_st m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         repeat rewrite find_assocmap_gso by lia. rewrite find_assocmap_gss. *)
+(*         repeat rewrite find_assocmap_gso by lia. rewrite find_assocmap_gss. *)
+(*         apply Int.eq_true. *)
+(*       } *)
+(*       { crush. } *)
+(*       { crush. } *)
+(*       { unfold merge_regs. unfold_merge. simplify. *)
+(*         assert (r < mod_st m). *)
+(*         { unfold module_ordering in *. simplify. *)
+(*           repeat match goal with *)
+(*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *)
+(*                  end. *)
+(*           pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*           simplify. lia. *)
+(*         } *)
+(*         unfold merge_regs in H8. repeat rewrite AssocMapExt.merge_add_assoc in H8. *)
+(*         simplify. rewrite AssocMap.gso in H8 by lia. rewrite AssocMap.gss in H8. *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         repeat rewrite AssocMap.gso by lia. *)
+(*         apply AssocMap.gss. } *)
+(*       { eassumption. } *)
+(*     } *)
+(*     { eauto. } *)
+(*     { econstructor. *)
+(*       { unfold merge_regs. unfold_merge. simplify. *)
+(*         apply match_assocmaps_gss. *)
+(*         unfold merge_regs in H8. repeat rewrite AssocMapExt.merge_add_assoc in H8. *)
+(*         rewrite AssocMap.gso in H8. rewrite AssocMap.gss in H8. inv H8. *)
+(*         remember (max_reg_module m). *)
+(*         assert (mod_st m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         apply match_assocmaps_switch_neq; [|lia]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_switch_neq; [|lia]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_switch_neq; [|lia]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_switch_neq; [|lia]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_switch_neq; [|lia]. *)
+(*         apply match_assocmaps_gt; [lia|]. *)
+(*         apply match_assocmaps_duplicate. *)
+(*         apply match_assocmaps_gss. auto. *)
+(*         assert (r < mod_st m). *)
+(*         { unfold module_ordering in *. simplify. *)
+(*           repeat match goal with *)
+(*                  | H: context[_ <? _] |- _ => apply Pos.ltb_lt in H *)
+(*                  end. *)
+(*           pose proof H3 as X. apply max_reg_stmnt_le_stmnt_tree in X. *)
+(*           simplify. lia. *)
+(*         } lia. *)
+(*       } *)
+(*       { *)
+(*         apply merge_arr_empty. mgen_crush. *)
+(*         apply merge_arr_empty2. mgen_crush. *)
+(*         apply merge_arr_empty2. mgen_crush. *)
+(*         apply merge_arr_empty2. mgen_crush. *)
+(*         mgen_crush. *)
+(*       } *)
+(*       { auto. } *)
+(*       { mgen_crush. } *)
+(*       { mgen_crush. } *)
+(*       { unfold disable_ram. *)
+(*         unfold transf_module; repeat destruct_match; try discriminate; simplify. *)
+(*         unfold merge_regs. unfold_merge. simplify. *)
+(*         assert (mod_st m < max_reg_module m + 1). *)
+(*         { unfold max_reg_module; lia. } *)
+(*         assert (r < max_reg_module m + 1). *)
+(*         { pose proof H3 as X. eapply max_reg_module_datapath_gt with (p := max_reg_module m + 1) in X. *)
+(*           unfold max_reg_stmnt in X. simplify. *)
+(*           lia. lia. } *)
+(*         repeat rewrite find_assocmap_gso by lia. *)
+(*         rewrite find_assocmap_gss. *)
+(*         repeat rewrite find_assocmap_gso by lia. *)
+(*         rewrite find_assocmap_gss. apply Int.eq_true. *)
+(*       } *)
+(*     } *)
+(* Qed. *) Admitted.
 
 Lemma exec_ram_resets_en :
   forall rs ar rs' ar' r,
@@ -2924,16 +2924,16 @@ Lemma exec_ram_resets_en :
 Proof.
   inversion 1; intros; subst; unfold merge_reg_assocs; simplify.
   - rewrite H6. mgen_crush.
-  - unfold merge_regs. rewrite H12. unfold_merge.
-    unfold find_assocmap, AssocMapExt.get_default in *.
-    rewrite AssocMap.gss; auto. rewrite AssocMap.gso; auto. setoid_rewrite H4. apply Int.eq_true.
-    pose proof (ram_ordering r); lia.
-  - unfold merge_regs. rewrite H11. unfold_merge.
-    unfold find_assocmap, AssocMapExt.get_default in *.
-    rewrite AssocMap.gss; auto.
-    repeat rewrite AssocMap.gso by (pose proof (ram_ordering r); lia).
-    setoid_rewrite H3. apply Int.eq_true.
-Qed.
+  (* - unfold merge_regs. rewrite H12. unfold_merge. *)
+(*     unfold find_assocmap, AssocMapExt.get_default in *. *)
+(*     rewrite AssocMap.gss; auto. rewrite AssocMap.gso; auto. setoid_rewrite H4. apply Int.eq_true. *)
+(*     pose proof (ram_ordering r); lia. *)
+(*   - unfold merge_regs. rewrite H11. unfold_merge. *)
+(*     unfold find_assocmap, AssocMapExt.get_default in *. *)
+(*     rewrite AssocMap.gss; auto. *)
+(*     repeat rewrite AssocMap.gso by (pose proof (ram_ordering r); lia). *)
+(*     setoid_rewrite H3. apply Int.eq_true. *)
+(* Qed. *) Admitted.
 
 Lemma disable_ram_set_gso :
   forall rs r i v,
@@ -3202,4 +3202,3 @@ Section CORRECTNESS.
   Qed.
 
 End CORRECTNESS.
-*)
diff --git a/src/hls/PrintDHTL.ml b/src/hls/PrintDHTL.ml
new file mode 100644
index 0000000..e7a1aaf
--- /dev/null
+++ b/src/hls/PrintDHTL.ml
@@ -0,0 +1,72 @@
+(* -*- mode: tuareg -*-
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2019-2020 Yann Herklotz <yann@yannherklotz.com>
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <https://www.gnu.org/licenses/>.
+ *)
+
+open Datatypes
+open Camlcoq
+open AST
+open Clflags
+open Printf
+open Maps
+open AST
+open DHTL
+open PrintAST
+open PrintVerilog
+open VericertClflags
+
+let pstr pp = fprintf pp "%s"
+
+let reg pp r =
+  fprintf pp "x%d" (P.to_int r)
+
+let rec regs pp = function
+  | [] -> ()
+  | [r] -> reg pp r
+  | r1::rl -> fprintf pp "%a, %a" reg r1 regs rl
+
+let print_instruction pp (pc, i) =
+  fprintf pp "%5d:\t%s" pc (pprint_stmnt 0 i)
+
+let print_module pp id f =
+  fprintf pp "%s(%a) {\n" (extern_atom id) regs f.mod_params;
+  let datapath =
+    List.sort
+      (fun (pc1, _) (pc2, _) -> compare pc2 pc1)
+      (List.rev_map
+        (fun (pc, i) -> (P.to_int pc, i))
+        (PTree.elements f.mod_datapath)) in
+  fprintf pp "  datapath {\n";
+  List.iter (print_instruction pp) datapath;
+  fprintf pp "  }\n}\n\n"
+
+let print_globdef pp (id, gd) =
+  match gd with
+  | Gfun(Internal f) -> print_module pp id f
+  | _ -> ()
+
+let print_program pp prog =
+  List.iter (print_globdef pp) prog.prog_defs
+
+let destination : string option ref = ref None
+
+let print_if passno prog =
+  match !destination with
+  | None -> ()
+  | Some f ->
+    let oc = open_out (f ^ "." ^ Z.to_string passno) in
+    print_program oc prog;
+    close_out oc
diff --git a/src/hls/Schedule.ml b/src/hls/Schedule.ml
index 829ded1..f952f60 100644
--- a/src/hls/Schedule.ml
+++ b/src/hls/Schedule.ml
@@ -262,34 +262,38 @@ let read_process command =
   Buffer.contents buffer
 
 let comb_delay = function
-  | RBnop -> 0
+  | RBnop -> 1
   | RBop (_, op, _, _) ->
     (match op with
-     | Omove -> 0
-     | Ointconst _ -> 0
-     | Olongconst _ -> 0
-     | Ocast8signed -> 0
-     | Ocast8unsigned -> 0
-     | Ocast16signed -> 0
-     | Ocast16unsigned -> 0
-     | Oneg -> 0
-     | Onot -> 0
-     | Oor -> 0
-     | Oorimm _ -> 0
-     | Oand -> 0
-     | Oandimm _ -> 0
-     | Oxor -> 0
-     | Oxorimm _ -> 0
-     | Omul -> 8
-     | Omulimm _ -> 8
-     | Omulhs -> 8
-     | Omulhu -> 8
-     | Odiv -> 72
-     | Odivu -> 72
-     | Omod -> 72
-     | Omodu -> 72
+     | Omove -> 1
+     | Ointconst _ -> 1
+     | Olongconst _ -> 1
+     | Ocast8signed -> 1
+     | Ocast8unsigned -> 1
+     | Ocast16signed -> 1
+     | Ocast16unsigned -> 1
+     | Oneg -> 1
+     | Onot -> 1
+     | Oor -> 1
+     | Oorimm _ -> 1
+     | Oand -> 1
+     | Oandimm _ -> 1
+     | Oxor -> 1
+     | Oxorimm _ -> 1
+     | Omul -> 64
+     | Omulimm _ -> 64
+     | Omulhs -> 64
+     | Omulhu -> 64
+     | Odiv -> 576
+     | Odivu -> 576
+     | Omod -> 576
+     | Omodu -> 576
      | _ -> 1)
-  | RBexit _ -> 8
+  | RBexit _ -> 64
+(** Because of the limiations of memory generation we add a large combinational
+    delay for loads and stores. *)
+  | RBload _ -> 64
+  | RBstore _ -> 64
   | _ -> 1
 
 let pipeline_stages = function
@@ -537,6 +541,33 @@ let accumulate_post_exit_deps instrs dfg curri =
       ) dfg (List.mapi (fun i x -> (i, x)) instrs)
   | _ -> dfg
 
+(** At the moment, because of the limitations of the memory generation pass, all
+    the loads and stores need to be placed into their own cycles. *)
+
+let accumulate_pre_mem_deps instrs dfg curri =
+  let i, curr = curri in
+  match curr with
+  | RBstore _
+  | RBload _ ->
+    List.fold_left (fun ndfg -> function (i', instr') ->
+        if i' < i
+        then DFG.add_edge ndfg (gen_vertex instrs i') (gen_vertex instrs i)
+        else ndfg
+      ) dfg (List.mapi (fun i x -> (i, x)) instrs)
+  | _ -> dfg
+
+let accumulate_post_mem_deps instrs dfg curri =
+  let i, curr = curri in
+  match curr with
+  | RBstore _
+  | RBload _ ->
+    List.fold_left (fun ndfg -> function (i', instr') ->
+        if i' > i
+        then DFG.add_edge ndfg (gen_vertex instrs i) (gen_vertex instrs i')
+        else ndfg
+      ) dfg (List.mapi (fun i x -> (i, x)) instrs)
+  | _ -> dfg
+
 let accumulate_WAR_deps instrs dfg curri =
   let i, curr = curri in
   let dst_dep dst =
@@ -613,7 +644,9 @@ let gather_bb_constraints debug bb =
         accumulate_WAR_pred_deps;
         accumulate_WAW_pred_deps;
         accumulate_pre_exit_deps;
-        accumulate_post_exit_deps
+        accumulate_post_exit_deps;
+        (* accumulate_post_mem_deps; *)
+        (* accumulate_pre_mem_deps; *)
       ]
   in
   let dfg''' = remove_unnecessary_deps dfg'' in
@@ -748,7 +781,7 @@ let gather_cfg_constraints (c: GibleSeq.code) constr curr =
     |> add_ctrl_deps n (GibleSeq.all_successors bb
                         |> List.map P.to_int
                         |> List.filter (fun n' -> n' < n))
-    |> add_cycle_constr 8 n dfg
+    |> add_cycle_constr 64 n dfg
     |> add_resource_constr n dfg
 
 let rec intersperse s = function
@@ -793,7 +826,8 @@ let parse_soln (tree, bbtree) s =
      else (tree, bbtree))
 
 let solve_constraints constr =
-  let (fn, oc) = Filename.open_temp_file "vericert_" "_lp_solve" in
+  (* let (fn, oc) = Filename.open_temp_file "vericert_" "_lp_solve" in *)
+  let (fn, oc) = ("vericert_lp_solve.txt", open_out "vericert_lp_solve.txt") in
   fprintf oc "%s\n" (print_lp constr);
   close_out oc;
 
diff --git a/src/hls/Veriloggen.v b/src/hls/Veriloggen.v
index fe8e90c..aba2293 100644
--- a/src/hls/Veriloggen.v
+++ b/src/hls/Veriloggen.v
@@ -25,7 +25,6 @@ Require Import vericert.hls.AssocMap.
 Require Import vericert.hls.HTL.
 Require Import vericert.hls.ValueInt.
 Require Import vericert.hls.Verilog.
-Require Import vericert.hls.FunctionalUnits.
 
 Definition transl_list_fun (a : node * Verilog.stmnt) :=
   let (n, stmnt) := a in
@@ -57,13 +56,13 @@ Definition inst_ram clk ram :=
 Definition transl_module (m : HTL.module) : Verilog.module :=
   let case_el_ctrl := list_to_stmnt (transl_list (PTree.elements m.(mod_controllogic))) in
   let case_el_data := list_to_stmnt (transl_list (PTree.elements m.(mod_datapath))) in
-  let ram := m.(HTL.mod_ram) in
-  let body :=
-        Valways (Vposedge m.(HTL.mod_clk))
-                (Vseq (Vcase (Vvar m.(HTL.mod_st)) case_el_data (Some Vskip))
-                      (Vcond (Vbinop Veq (Vvar m.(HTL.mod_reset)) (Vlit (ZToValue 1)))
-                             (Vblock (Vvar m.(HTL.mod_st)) (Vlit (posToValue m.(HTL.mod_entrypoint))))
-                             (Vcase (Vvar m.(HTL.mod_st)) case_el_ctrl (Some Vskip))))
+  match m.(HTL.mod_ram) with
+  | Some ram =>
+    let body :=
+        Valways (Vposedge m.(HTL.mod_clk)) (Vcond (Vbinop Veq (Vvar m.(HTL.mod_reset)) (Vlit (ZToValue 1)))
+                                                  (Vnonblock (Vvar m.(HTL.mod_st)) (Vlit (posToValue m.(HTL.mod_entrypoint))))
+                                                  (Vcase (Vvar m.(HTL.mod_st)) case_el_ctrl (Some Vskip)))
+                :: Valways (Vposedge m.(HTL.mod_clk)) (Vcase (Vvar m.(HTL.mod_st)) case_el_data (Some Vskip))
                 :: inst_ram m.(HTL.mod_clk) ram
                 :: List.map Vdeclaration (arr_to_Vdeclarr (AssocMap.elements m.(mod_arrdecls))
                                                           ++ scl_to_Vdecl (AssocMap.elements m.(mod_scldecls))) in
@@ -73,11 +72,31 @@ Definition transl_module (m : HTL.module) : Verilog.module :=
                      m.(HTL.mod_finish)
                      m.(HTL.mod_return)
                      m.(HTL.mod_st)
-                     m.(HTL.mod_ram).(ram_mem)
-                     m.(HTL.mod_ram).(ram_size)
+                     m.(HTL.mod_stk)
+                     m.(HTL.mod_stk_len)
                      m.(HTL.mod_params)
                      body
-                     m.(HTL.mod_entrypoint).
+                     m.(HTL.mod_entrypoint)
+  | None =>
+    let body :=
+        Valways (Vposedge m.(HTL.mod_clk)) (Vcond (Vbinop Veq (Vvar m.(HTL.mod_reset)) (Vlit (ZToValue 1)))
+                                                  (Vnonblock (Vvar m.(HTL.mod_st)) (Vlit (posToValue m.(HTL.mod_entrypoint))))
+                                                  (Vcase (Vvar m.(HTL.mod_st)) case_el_ctrl (Some Vskip)))
+                :: Valways (Vposedge m.(HTL.mod_clk)) (Vcase (Vvar m.(HTL.mod_st)) case_el_data (Some Vskip))
+                :: List.map Vdeclaration (arr_to_Vdeclarr (AssocMap.elements m.(mod_arrdecls))
+                                                          ++ scl_to_Vdecl (AssocMap.elements m.(mod_scldecls))) in
+    Verilog.mkmodule m.(HTL.mod_start)
+                     m.(HTL.mod_reset)
+                     m.(HTL.mod_clk)
+                     m.(HTL.mod_finish)
+                     m.(HTL.mod_return)
+                     m.(HTL.mod_st)
+                     m.(HTL.mod_stk)
+                     m.(HTL.mod_stk_len)
+                     m.(HTL.mod_params)
+                     body
+                     m.(HTL.mod_entrypoint)
+  end.
 
 Definition transl_fundef := transf_fundef transl_module.
 
diff --git a/src/hls/Veriloggenproof.v b/src/hls/Veriloggenproof.v
index 90cf4cb..d1494ec 100644
--- a/src/hls/Veriloggenproof.v
+++ b/src/hls/Veriloggenproof.v
@@ -241,7 +241,7 @@ Proof. unfold transl_module; intros; destruct (HTL.mod_ram m) eqn:?; crush. Qed.
 Lemma mod_st_equiv m : mod_st (transl_module m) = HTL.mod_st m.
 Proof. unfold transl_module; intros; destruct (HTL.mod_ram m) eqn:?; crush. Qed.
 
-(*Lemma mod_stk_equiv m : mod_stk (transl_module m) = HTL.mod_stk m.
+Lemma mod_stk_equiv m : mod_stk (transl_module m) = HTL.mod_stk m.
 Proof. unfold transl_module; intros; destruct (HTL.mod_ram m) eqn:?; crush. Qed.
 
 Lemma mod_stk_len_equiv m : mod_stk_len (transl_module m) = HTL.mod_stk_len m.
@@ -335,7 +335,7 @@ Proof.
 Qed.
 
 
-*)Section CORRECTNESS.
+Section CORRECTNESS.
 
   Variable prog: HTL.program.
   Variable tprog: program.
@@ -345,7 +345,7 @@ Qed.
   Let ge : HTL.genv := Globalenvs.Genv.globalenv prog.
   Let tge : genv := Globalenvs.Genv.globalenv tprog.
 
-(*  Lemma symbols_preserved:
+  Lemma symbols_preserved:
     forall (s: AST.ident), Genv.find_symbol tge s = Genv.find_symbol ge s.
   Proof. intros. eapply (Genv.find_symbol_match TRANSL). Qed.
   #[local] Hint Resolve symbols_preserved : verilogproof.
@@ -532,13 +532,13 @@ Qed.
   Proof.
     intros. inv H0. inv H. inv H3. constructor. reflexivity.
   Qed.
-  #[local] Hint Resolve transl_final_states : verilogproof.*)
+  #[local] Hint Resolve transl_final_states : verilogproof.
 
   Theorem transf_program_correct:
     forward_simulation (HTL.semantics prog) (Verilog.semantics tprog).
   Proof.
     eapply Smallstep.forward_simulation_plus; eauto with verilogproof.
-    (*apply senv_preserved.
-  Qed.*) Admitted.
+    apply senv_preserved.
+  Qed.
 
 End CORRECTNESS.