Split proof up into more files

9 files changed, 3935 insertions, 3766 deletions

diff --git a/src/common/NonEmpty.v b/src/common/NonEmpty.v
index cafa7ff..f15bb82 100644
--- a/src/common/NonEmpty.v
+++ b/src/common/NonEmpty.v
@@ -213,3 +213,14 @@ Inductive norepet {A : Type} : non_empty A -> Prop :=
 | norepet_singleton a : norepet (singleton a)
 | list_norepet_cons hd tl :
   ~ In hd tl -> norepet tl -> norepet (hd ::| tl).
+
+Lemma NEin_NEapp5 :
+  forall A (a: A) x y,
+    In a (app x y) ->
+    In a x \/ In a y.
+Proof.
+  induction x; cbn in *; intros.
+  - inv H. inv H1. left. constructor. tauto.
+  - inv H. inv H1. left. constructor; tauto.
+    apply IHx in H. inv H; intuition (constructor; auto).
+Qed.
diff --git a/src/hls/Abstr.v b/src/hls/Abstr.v
index 2653755..e97e907 100644
--- a/src/hls/Abstr.v
+++ b/src/hls/Abstr.v
@@ -1,6 +1,6 @@
 (*
  * Vericert: Verified high-level synthesis.
- * Copyright (C) 2021-2023 Yann Herklotz <yann@yannherklotz.com>
+ * Copyright (C) 2021-2023 Yann Herklotz <git@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
@@ -215,6 +215,69 @@ Definition get_m i := match i with mk_instr_state a b c => c end.
 Definition eval_predf_opt pr p :=
   match p with Some p' => eval_predf pr p' | None => true end.
 
+Lemma get_empty:
+  forall r, empty#r r = NE.singleton (Ptrue, Ebase r).
+Proof. unfold "#r"; intros. rewrite RTree.gempty. trivial. Qed.
+
+Lemma forest_reg_gso:
+  forall (f : forest) w dst dst',
+    dst <> dst' ->
+    (f #r dst <- w) #r dst' = f #r dst'.
+Proof.
+  unfold "#r"; intros.
+  unfold forest_regs. unfold set_forest.
+  rewrite RTree.gso; auto.
+Qed.
+
+Lemma forest_reg_pred:
+  forall (f : forest) w dst dst',
+    (f #r dst <- w) #p dst' = f #p dst'.
+Proof. auto. Qed.
+
+Lemma forest_reg_gss:
+  forall (f : forest) w dst,
+    (f #r dst <- w) #r dst = w.
+Proof.
+  unfold "#r"; intros.
+  unfold forest_regs. unfold set_forest.
+  rewrite RTree.gss; auto.
+Qed.
+
+Lemma forest_pred_gso:
+  forall (f : forest) w dst dst',
+    dst <> dst' ->
+    (f #p dst <- w) #p dst' = f #p dst'.
+Proof.
+  unfold "#p"; intros.
+  unfold forest_preds, set_forest_p, get_forest_p'.
+  rewrite PTree.gso; auto.
+Qed.
+
+Lemma forest_pred_reg:
+  forall (f : forest) w dst dst',
+    (f #p dst <- w) #r dst' = f #r dst'.
+Proof. auto. Qed.
+
+Lemma forest_pred_gss:
+  forall (f : forest) w dst,
+    (f #p dst <- w) #p dst = w.
+Proof.
+  unfold "#p"; intros.
+  unfold forest_preds, set_forest_p, get_forest_p'.
+  rewrite PTree.gss; auto.
+Qed.
+
+Lemma forest_pred_gss2 :
+  forall (f : forest) r p,
+    (forest_preds (f #p r <- p)) ! r = Some p.
+Proof. intros. unfold set_forest_p. simpl. now rewrite PTree.gss. Qed.
+
+Lemma forest_pred_gso2 :
+  forall (f : forest) r w p,
+    r <> w ->
+    (forest_preds (f #p w <- p)) ! r = (forest_preds f) ! r.
+Proof. intros. unfold set_forest_p. simpl. now rewrite PTree.gso by auto. Qed.
+
 (*|
 Finally we want to define the semantics of execution for the expressions with
 symbolic values, so the result of executing the expressions will be an
@@ -415,1762 +478,3 @@ Inductive sem : ctx -> forest -> instr_state * option cf_instr -> Prop :=
     sem ctx f (mk_instr_state rs' pr' m', cf).
 
 End SEMANTICS.
-
-Fixpoint beq_expression (e1 e2: expression) {struct e1}: bool :=
-  match e1, e2 with
-  | Ebase r1, Ebase r2 => if resource_eq r1 r2 then true else false
-  | Eop op1 el1, Eop op2 el2 =>
-    if operation_eq op1 op2 then
-    beq_expression_list el1 el2 else false
-  | Eload chk1 addr1 el1 e1, Eload chk2 addr2 el2 e2 =>
-    if memory_chunk_eq chk1 chk2
-    then if addressing_eq addr1 addr2
-         then if beq_expression_list el1 el2
-              then beq_expression e1 e2 else false else false else false
-  | Estore e1 chk1 addr1 el1 m1, Estore e2 chk2 addr2 el2 m2 =>
-    if memory_chunk_eq chk1 chk2
-    then if addressing_eq addr1 addr2
-         then if beq_expression_list el1 el2
-              then if beq_expression m1 m2
-                   then beq_expression e1 e2 else false else false else false else false
-  | _, _ => false
-  end
-with beq_expression_list (el1 el2: expression_list) {struct el1} : bool :=
-  match el1, el2 with
-  | Enil, Enil => true
-  | Econs e1 t1, Econs e2 t2 => beq_expression e1 e2 && beq_expression_list t1 t2
-  | _, _ => false
-  end
-.
-
-Scheme expression_ind2 := Induction for expression Sort Prop
-  with expression_list_ind2 := Induction for expression_list Sort Prop.
-
-Definition beq_pred_expression (e1 e2: pred_expression) : bool :=
-  match e1, e2 with
-  | PEbase p1, PEbase p2 => if peq p1 p2 then true else false
-  | PEsetpred c1 el1, PEsetpred c2 el2 =>
-    if condition_eq c1 c2
-    then beq_expression_list el1 el2 else false
-  | _, _ => false
-  end.
-
-Definition beq_exit_expression (e1 e2: exit_expression) : bool :=
-  match e1, e2 with
-  | EEbase, EEbase => true
-  | EEexit cf1, EEexit cf2 => if cf_instr_eq cf1 cf2 then true else false
-  | _, _ => false
-  end.
-
-Lemma beq_expression_correct:
-  forall e1 e2, beq_expression e1 e2 = true -> e1 = e2.
-Proof.
-  intro e1;
-  apply expression_ind2 with
-      (P := fun (e1 : expression) =>
-            forall e2, beq_expression e1 e2 = true -> e1 = e2)
-      (P0 := fun (e1 : expression_list) =>
-             forall e2, beq_expression_list e1 e2 = true -> e1 = e2); simplify;
-  try solve [repeat match goal with
-                    | [ H : context[match ?x with _ => _ end] |- _ ] => destruct x eqn:?
-                    | [ H : context[if ?x then _ else _] |- _ ] => destruct x eqn:?
-                    end; subst; f_equal; crush; eauto using Peqb_true_eq].
-Qed.
-
-Lemma beq_expression_refl: forall e, beq_expression e e = true.
-Proof.
-  intros.
-  induction e using expression_ind2 with (P0 := fun el => beq_expression_list el el = true);
-  crush; repeat (destruct_match; crush); [].
-  crush. rewrite IHe. rewrite IHe0. auto.
-Qed.
-
-Lemma beq_expression_list_refl: forall e, beq_expression_list e e = true.
-Proof. induction e; auto. simplify. rewrite beq_expression_refl. auto. Qed.
-
-Lemma beq_expression_correct2:
-  forall e1 e2, beq_expression e1 e2 = false -> e1 <> e2.
-Proof.
-  induction e1 using expression_ind2
-    with (P0 := fun el1 => forall el2, beq_expression_list el1 el2 = false -> el1 <> el2).
-  - intros. simplify. repeat (destruct_match; crush).
-  - intros. simplify. repeat (destruct_match; crush). subst. apply IHe1 in H.
-    unfold not in *. intros. apply H. inv H0. auto.
-  - intros. simplify. repeat (destruct_match; crush); subst.
-    unfold not in *; intros. inv H0. rewrite beq_expression_refl in H. discriminate.
-    unfold not in *; intros. inv H. rewrite beq_expression_list_refl in Heqb. discriminate.
-  - simplify. repeat (destruct_match; crush); subst;
-    unfold not in *; intros.
-    inv H0. rewrite beq_expression_refl in H; crush.
-    inv H. rewrite beq_expression_refl in Heqb0; crush.
-    inv H. rewrite beq_expression_list_refl in Heqb; crush.
-  (* - simplify. repeat (destruct_match; crush); subst. *)
-  (*   unfold not in *; intros. inv H0. rewrite beq_expression_list_refl in H; crush. *)
-  - simplify. repeat (destruct_match; crush); subst.
-  - simplify. repeat (destruct_match; crush); subst.
-    apply andb_false_iff in H. inv H. unfold not in *; intros.
-    inv H. rewrite beq_expression_refl in H0; discriminate.
-    unfold not in *; intros. inv H. rewrite beq_expression_list_refl in H0; discriminate.
-Qed.
-
-Definition expression_dec: forall e1 e2: expression, {e1 = e2} + {e1 <> e2}.
-Proof.
-  intros.
-  destruct (beq_expression e1 e2) eqn:?. apply beq_expression_correct in Heqb. auto.
-  apply beq_expression_correct2 in Heqb. auto.
-Defined.
-
-Lemma beq_expression_list_correct:
-  forall e1 e2, beq_expression_list e1 e2 = true -> e1 = e2.
-Proof.
-  induction e1; crush.
-  - destruct_match; crush.
-  - destruct_match; crush.
-    apply IHe1 in H1; subst.
-    apply beq_expression_correct in H0; subst.
-    trivial.
-Qed.
-
-Lemma beq_expression_list_correct2:
-  forall e1 e2, beq_expression_list e1 e2 = false -> e1 <> e2.
-Proof.
-  induction e1; crush.
-  - destruct_match; crush.
-  - destruct_match; crush.
-    apply andb_false_iff in H. inv H. apply beq_expression_correct2 in H0.
-    unfold not in *; intros. apply H0. inv H. auto.
-    apply IHe1 in H0. unfold not in *; intros. apply H0. inv H.
-    auto.
-Qed.
-
-Lemma beq_pred_expression_correct:
-  forall e1 e2, beq_pred_expression e1 e2 = true -> e1 = e2.
-Proof.
-  destruct e1, e2; crush.
-  - destruct_match; crush.
-  - destruct_match; subst; crush.
-    apply beq_expression_list_correct in H; subst.
-    trivial.
-Qed.
-
-Lemma beq_pred_expression_refl:
-  forall e, beq_pred_expression e e = true.
-Proof.
-  destruct e; crush; destruct_match; crush.
-  apply beq_expression_list_refl.
-Qed.
-
-Lemma beq_pred_expression_correct2:
-  forall e1 e2, beq_pred_expression e1 e2 = false -> e1 <> e2.
-Proof.
-  destruct e1, e2; unfold not; crush.
-  + destruct_match; crush.
-  + destruct_match; crush. inv H0.
-    now rewrite beq_expression_list_refl in H.
-Qed.
-
-Lemma beq_exit_expression_correct:
-  forall e1 e2, beq_exit_expression e1 e2 = true <-> e1 = e2.
-Proof.
-  destruct e1, e2; split; crush;
-  destruct_match; subst; crush.
-Qed.
-
-Definition pred_expr_item_eq (pe1 pe2: pred_op * expression) : bool :=
-  @equiv_dec _ SATSetoid _ (fst pe1) (fst pe2) && beq_expression (snd pe1) (snd pe2).
-
-Definition pred_eexpr_item_eq (pe1 pe2: pred_op * exit_expression) : bool :=
-  @equiv_dec _ SATSetoid _ (fst pe1) (fst pe2) && beq_exit_expression (snd pe1) (snd pe2).
-
-Definition pred_expr_dec: forall (pe1 pe2: pred_op * expression),
-    {pred_expr_item_eq pe1 pe2 = true} + {pred_expr_item_eq pe1 pe2 = false}.
-Proof.
-  intros; destruct (pred_expr_item_eq pe1 pe2) eqn:?; unfold not; [tauto | now right].
-Defined.
-
-Definition pred_expr_dec2: forall (pe1 pe2: pred_op * expression),
-    {pred_expr_item_eq pe1 pe2 = true} + {~ pred_expr_item_eq pe1 pe2 = true}.
-Proof.
-  intros; destruct (pred_expr_item_eq pe1 pe2) eqn:?; unfold not; [tauto | now right].
-Defined.
-
-Definition pred_expression_dec:
-  forall e1 e2: pred_expression, {e1 = e2} + {e1 <> e2}.
-Proof.
-  intros. destruct (beq_pred_expression e1 e2) eqn:?.
-  eauto using beq_pred_expression_correct.
-  eauto using beq_pred_expression_correct2.
-Defined.
-
-Lemma exit_expression_refl:
-  forall e, beq_exit_expression e e = true.
-Proof. destruct e; crush; destruct_match; crush. Qed.
-
-Definition exit_expression_dec:
-  forall e1 e2: exit_expression, {e1 = e2} + {e1 <> e2}.
-Proof.
-  intros. destruct (beq_exit_expression e1 e2) eqn:?.
-  - left. eapply beq_exit_expression_correct; eauto.
-  - right. unfold not; intros.
-    assert (X: ~ (beq_exit_expression e1 e2 = true))
-      by eauto with bool.
-    subst. apply X. apply exit_expression_refl.
-Defined.
-
-Lemma pred_eexpression_dec:
-  forall (e1 e2: exit_expression) (p1 p2: pred_op),
-    {(p1, e1) = (p2, e2)} + {(p1, e1) <> (p2, e2)}.
-Proof.
-  pose proof (Predicate.eq_dec peq).
-  pose proof (exit_expression_dec).
-  decide equality.
-Defined.
-
-(*Fixpoint encode_expression_ne (max: predicate) (pe: pred_expr_ne) (h: hash_tree)
-  : (PTree.t pred_op) * hash_tree :=
-  match pe with
-  | NE.singleton (p, e) =>
-    let (p', h') := hash_value max e h in
-    (Por (Pnot p) (Pvar p'), h')
-  | (p, e) ::| pr =>
-    let (p', h') := hash_value max e h in
-    let (p'', h'') := encode_expression_ne max pr h' in
-    (Pand (Por (Pnot p) (Pvar p')) p'', h'')
-  end.*)
-
-Fixpoint max_pred_expr (pe: pred_expr) : positive :=
-  match pe with
-  | NE.singleton (p, e) => max_predicate p
-  | (p, e) ::| pe' => Pos.max (max_predicate p) (max_pred_expr pe')
-  end.
-
-Definition ge_preserved {A B C D: Type} (ge: Genv.t A B) (tge: Genv.t C D) : Prop :=
-  (forall sp op vl m, Op.eval_operation ge sp op vl m =
-                      Op.eval_operation tge sp op vl m)
-  /\ (forall sp addr vl, Op.eval_addressing ge sp addr vl =
-                         Op.eval_addressing tge sp addr vl).
-
-Lemma ge_preserved_same:
-  forall A B ge, @ge_preserved A B A B ge ge.
-Proof. unfold ge_preserved; auto. Qed.
-#[local] Hint Resolve ge_preserved_same : core.
-
-Inductive match_states : instr_state -> instr_state -> Prop :=
-| match_states_intro:
-  forall ps ps' rs rs' m m',
-    (forall x, rs !! x = rs' !! x) ->
-    (forall x, ps !! x = ps' !! x) ->
-    m = m' ->
-    match_states (mk_instr_state rs ps  m) (mk_instr_state rs' ps' m').
-
-Lemma match_states_refl x : match_states x x.
-Proof. destruct x; constructor; crush. Qed.
-
-Lemma match_states_commut x y : match_states x y -> match_states y x.
-Proof. inversion 1; constructor; crush. Qed.
-
-Lemma match_states_trans x y z :
-  match_states x y -> match_states y z -> match_states x z.
-Proof. repeat inversion 1; constructor; crush. Qed.
-
-#[global] Instance match_states_Equivalence : Equivalence match_states :=
-  { Equivalence_Reflexive := match_states_refl ;
-    Equivalence_Symmetric := match_states_commut ;
-    Equivalence_Transitive := match_states_trans ; }.
-
-Inductive similar {A B} : @ctx A -> @ctx B -> Prop :=
-| similar_intro :
-    forall ist ist' sp ge tge,
-    ge_preserved ge tge ->
-    match_states ist ist' ->
-    similar (mk_ctx ist sp ge) (mk_ctx ist' sp tge).
-
-Lemma ge_preserved_refl:
-  forall A B (a: Genv.t A B), ge_preserved a a.
-Proof. auto. Qed.
-
-Lemma similar_refl:
-  forall A (a: @Abstr.ctx A), similar a a.
-Proof. intros; destruct a; constructor; auto. reflexivity. Qed.
-
-Lemma similar_commut:
-  forall A B (a: @Abstr.ctx A) (b: @Abstr.ctx B), similar a b -> similar b a.
-Proof.
-  inversion 1; constructor; auto.
-  - unfold ge_preserved in *; inv H0; split; intros.
-    rewrite H4; auto. rewrite H5; auto.
-  - symmetry; auto.
-Qed.
-
-Lemma similar_trans:
-  forall A B C (a: @Abstr.ctx A) (b: @Abstr.ctx B) (c: @Abstr.ctx C),
-    similar a b -> similar b c -> similar a c.
-Proof.
-  repeat inversion 1; constructor.
-  - unfold ge_preserved in *; inv H0; inv H9; split; intros.
-    rewrite H11. rewrite H0; auto.
-    rewrite H12. rewrite H2. auto.
-  - transitivity ist'; auto.
-Qed.
-
-Module HashExpr' <: MiniDecidableType.
-  Definition t := expression.
-  Definition eq_dec := expression_dec.
-End HashExpr'.
-
-Module HashExpr := Make_UDT(HashExpr').
-Module Import HT := HashTree(HashExpr).
-
-Module PHashExpr' <: MiniDecidableType.
-  Definition t := pred_expression.
-  Definition eq_dec := pred_expression_dec.
-End PHashExpr'.
-
-Module PHashExpr := Make_UDT(PHashExpr').
-Module PHT := HashTree(PHashExpr).
-
-Module EHashExpr' <: MiniDecidableType.
-  Definition t := exit_expression.
-  Definition eq_dec := exit_expression_dec.
-End EHashExpr'.
-
-Module EHashExpr := Make_UDT(EHashExpr').
-Module EHT := HashTree(EHashExpr).
-
-Fixpoint hash_predicate (max: predicate) (ap: pred_pexpr) (h: PHT.hash_tree)
-  : pred_op * PHT.hash_tree :=
-  match ap with
-  | Ptrue => (Ptrue, h)
-  | Pfalse => (Pfalse, h)
-  | Plit (b, ap') =>
-      let (p', h') := PHT.hash_value max ap' h in
-      (Plit (b, p'), h')
-  | Pand p1 p2 =>
-      let (p1', h') := hash_predicate max p1 h in
-      let (p2', h'') := hash_predicate max p2 h' in
-      (Pand p1' p2', h'')
-  | Por p1 p2 =>
-      let (p1', h') := hash_predicate max p1 h in
-      let (p2', h'') := hash_predicate max p2 h' in
-      (Por p1' p2', h'')
-  end.
-
-Definition predicated_mutexcl {A: Type} (pe: predicated A): Prop :=
-  (forall x y, NE.In x pe -> NE.In y pe -> x <> y -> fst x ⇒ ¬ fst y)
-  /\ NE.norepet pe.
-
-Lemma predicated_cons :
-  forall A (a: pred_op * A) x,
-    predicated_mutexcl (a ::| x) ->
-    predicated_mutexcl x.
-Proof.
-  unfold predicated_mutexcl; intros. inv H. inv H1. split; auto.
-  intros. apply H0; auto; constructor; tauto.
-Qed.
-
-Lemma predicated_singleton :
-  forall A (a: (pred_op * A)), predicated_mutexcl (NE.singleton a).
-Proof.
-  unfold predicated_mutexcl; intros; split; intros.
-  { inv H. now inv H0. }
-  constructor.
-Qed.
-
-(*
-
-Lemma norm_expr_constant :
-  forall x m h t h' e p,
-    HN.norm_expression m x h = (t, h') ->
-    h ! e = Some p ->
-    h' ! e = Some p.
-Proof. Abort.
-
-Definition sat_aequiv ap1 ap2 :=
-  exists h p1 p2,
-    sat_equiv p1 p2
-    /\ hash_predicate 1 ap1 h = (p1, h)
-    /\ hash_predicate 1 ap2 h = (p2, h).
-
-Lemma aequiv_symm : forall a b, sat_aequiv a b -> sat_aequiv b a.
-Proof.
-  unfold sat_aequiv; simplify; do 3 eexists; simplify; [symmetry | |]; eauto.
-Qed.
-
-Lemma existsh :
-  forall ap1,
-  exists h p1,
-    hash_predicate 1 ap1 h = (p1, h).
-Proof. Admitted.
-
-Lemma aequiv_refl : forall a, sat_aequiv a a.
-Proof.
-  unfold sat_aequiv; intros.
-  pose proof (existsh a); simplify.
-  do 3 eexists; simplify; eauto. reflexivity.
-Qed.
-
-Lemma aequiv_trans :
-  forall a b c,
-    sat_aequiv a b ->
-    sat_aequiv b c ->
-    sat_aequiv a c.
-Proof.
-  unfold sat_aequiv; intros.
-  simplify.
-Abort.
-
-Lemma norm_expr_mutexcl :
-  forall m pe h t h' e e' p p',
-    HN.norm_expression m pe h = (t, h') ->
-    predicated_mutexcl pe ->
-    t ! e = Some p ->
-    t ! e' = Some p' ->
-    e <> e' ->
-    p ⇒ ¬ p'.
-Proof. Abort.*)
-
-Definition pred_expr_eqb: forall pe1 pe2: pred_expr,
-  {pe1 = pe2} + {pe1 <> pe2}.
-Proof.
-  pose proof expression_dec.
-  pose proof NE.eq_dec.
-  pose proof (Predicate.eq_dec peq).
-  assert (forall a b: pred_op * expression, {a = b} + {a <> b})
-   by decide equality.
-  decide equality.
-Defined.
-
-Definition pred_pexpr_eqb: forall pe1 pe2: pred_pexpr,
-  {pe1 = pe2} + {pe1 <> pe2}.
-Proof.
-  pose proof pred_expression_dec.
-  pose proof (Predicate.eq_dec pred_expression_dec).
-  apply X.
-Defined.
-
-Definition beq_pred_pexpr (pe1 pe2: pred_pexpr): bool :=
-  if pred_pexpr_eqb pe1 pe2 then true else
-  let (np1, h) := hash_predicate 1 pe1 (PTree.empty _) in
-  let (np2, h') := hash_predicate 1 pe2 h in
-  equiv_check np1 np2.
-
-Lemma inj_asgn_eg : forall a b, (a =? b)%positive = (a =? a)%positive -> a = b.
-Proof.
-  intros. destruct (peq a b); subst.
-  auto. rewrite OrdersEx.Positive_as_OT.eqb_refl in H.
-  now apply Peqb_true_eq.
-Qed.
-
-Lemma inj_asgn :
-  forall a b, (forall (f: positive -> bool), f a = f b) -> a = b.
-Proof. intros. apply inj_asgn_eg. eauto. Qed.
-
-Lemma inj_asgn_false:
-  forall n1 n2 , ~ (forall c: positive -> bool, c n1 = negb (c n2)).
-Proof.
-  unfold not; intros. specialize (H (fun x => true)).
-  simplify. discriminate.
-Qed.
-
-Lemma negb_inj:
-  forall a b,
-    negb a = negb b -> a = b.
-Proof. destruct a, b; crush. Qed.
-
-Lemma sat_predicate_Plit_inj :
-  forall p1 p2,
-    Plit p1 == Plit p2 -> p1 = p2.
-Proof.
-  simplify. destruct p1, p2.
-  destruct b, b0. f_equal. unfold sat_equiv in H. cbn in H. now apply inj_asgn.
-  solve [exfalso; eapply inj_asgn_false; eauto].
-  solve [exfalso; eapply inj_asgn_false; eauto].
-  assert (p = p0). eapply inj_asgn. intros. specialize (H f).
-  apply negb_inj in H. auto. rewrite H0; auto.
-Qed.
-
-Definition ind_preds t :=
-  forall e1 e2 p1 p2 c,
-    e1 <> e2 ->
-    t ! e1 = Some p1 ->
-    t ! e2 = Some p2 ->
-    sat_predicate p1 c = true ->
-    sat_predicate p2 c = false.
-
-Definition ind_preds_l t :=
-  forall (e1: predicate) e2 p1 p2 c,
-    e1 <> e2 ->
-    In (e1, p1) t ->
-    In (e2, p2) t ->
-    sat_predicate p1 c = true ->
-    sat_predicate p2 c = false.
-
-(*Lemma pred_equivalence_Some' :
-  forall ta tb e pe pe',
-    list_norepet (map fst ta) ->
-    list_norepet (map fst tb) ->
-    In (e, pe) ta ->
-    In (e, pe') tb ->
-    fold_right (fun p a => mk_pred_stmnt' (fst p) (snd p) ∧ a) T ta ==
-    fold_right (fun p a => mk_pred_stmnt' (fst p) (snd p) ∧ a) T tb ->
-    pe == pe'.
-Proof.
-  induction ta as [|hd tl Hta]; try solve [crush].
-  - intros * NRP1 NRP2 IN1 IN2 FOLD. inv NRP1. inv IN1.
-    simpl in FOLD.
-
-Lemma pred_equivalence_Some :
-  forall (ta tb: PTree.t pred_op) e pe pe',
-    ta ! e = Some pe ->
-    tb ! e = Some pe' ->
-    mk_pred_stmnt ta == mk_pred_stmnt tb ->
-    pe == pe'.
-Proof.
-  intros * SMEA SMEB EQ. unfold mk_pred_stmnt in *.
-  repeat rewrite PTree.fold_spec in EQ.
-
-Lemma pred_equivalence_None :
-  forall (ta tb: PTree.t pred_op) e pe,
-    (mk_pred_stmnt ta) == (mk_pred_stmnt tb) ->
-    ta ! e = Some pe ->
-    tb ! e = None ->
-    equiv pe ⟂.
-Abort.
-
-Lemma pred_equivalence :
-  forall (ta tb: PTree.t pred_op) e pe,
-    equiv (mk_pred_stmnt ta) (mk_pred_stmnt tb) ->
-    ta ! e = Some pe ->
-    equiv pe ⟂ \/ (exists pe', tb ! e = Some pe' /\ equiv pe pe').
-Proof.
-  intros * EQ SME. destruct (tb ! e) eqn:HTB.
-  { right. econstructor. split; eauto. eapply pred_equivalence_Some; eauto. }
-  { left. eapply pred_equivalence_None; eauto. }
-Qed.*)
-
-Section CORRECT.
-
-  Context {FUN TFUN: Type}.
-
-  Context (ictx: @ctx FUN) (octx: @ctx TFUN) (HSIM: similar ictx octx).
-
-  Lemma sem_value_mem_det:
-    forall e v v' m m',
-      (sem_value ictx e v -> sem_value octx e v' -> v = v')
-      /\ (sem_mem ictx e m -> sem_mem octx e m' -> m = m').
-  Proof using HSIM.
-    induction e using expression_ind2
-      with (P0 := fun p => forall v v',
-                    sem_val_list ictx p v -> sem_val_list octx p v' -> v = v');
-    inv HSIM; match goal with H: context [match_states] |- _ => inv H end; repeat progress simplify;
-    try solve [match goal with
-               | H: sem_value _ _ _, H2: sem_value _ _ _ |- _ => inv H; inv H2; auto
-               | H: sem_mem _ _ _, H2: sem_mem _ _ _ |- _ => inv H; inv H2; auto
-               | H: sem_val_list _ _ _, H2: sem_val_list _ _ _ |- _ => inv H; inv H2; auto
-               end].
-    - repeat match goal with
-             | H: sem_value _ _ _ |- _ => inv H
-             | H: sem_val_list {| ctx_ge := ge; |} ?e ?l1,
-               H2: sem_val_list {| ctx_ge := tge |} ?e ?l2,
-               IH: forall _ _, sem_val_list _ _ _ -> sem_val_list _ _ _ -> _ = _ |- _ =>
-               assert (X: l1 = l2) by (apply IH; auto)
-             | H: ge_preserved _ _ |- _ => inv H
-             | |- context [ctx_rs] => unfold ctx_rs; cbn
-             | H: context [ctx_mem] |- _ => unfold ctx_mem in H; cbn
-             end; crush.
-    - repeat match goal with H: sem_value _ _ _ |- _ => inv H end; simplify;
-      assert (lv0 = lv) by (apply IHe; eauto); subst;
-      match goal with H: ge_preserved _ _ |- _ => inv H end;
-      match goal with H: context [Op.eval_addressing _ _ _ _ = Op.eval_addressing _ _ _ _] |- _
-                      => rewrite H in * end;
-      assert (a0 = a1) by crush;
-      assert (m'2 = m'1) by (apply IHe0; eauto); crush.
-    - inv H0; inv H3. simplify.
-      assert (lv = lv0) by ( apply IHe2; eauto). subst.
-      assert (a1 = a0). { inv H. rewrite H3 in *. crush. }
-      assert (v0 = v1). { apply IHe1; auto. }
-      assert (m'1 = m'2). { apply IHe3; auto. } crush.
-    - inv H0. inv H3. f_equal. apply IHe; auto.
-      apply IHe0; auto.
-  Qed.
-
-  Lemma sem_value_mem_corr:
-    forall e v m,
-      (sem_value ictx e v -> sem_value octx e v)
-      /\ (sem_mem ictx e m -> sem_mem octx e m).
-  Proof using HSIM.
-    induction e using expression_ind2
-      with (P0 := fun p => forall v,
-                    sem_val_list ictx p v -> sem_val_list octx p v);
-    inv HSIM; match goal with H: context [match_states] |- _ => inv H end; repeat progress simplify.
-    - inv H0. unfold ctx_rs, ctx_ps, ctx_mem in *; cbn. rewrite H1. constructor.
-    - inv H0. unfold ctx_rs, ctx_ps, ctx_mem in *; cbn. constructor.
-    - inv H0. apply IHe in H6. econstructor; try eassumption.
-      unfold ctx_rs, ctx_ps, ctx_mem in *; cbn in *. inv H. crush.
-    - inv H0.
-    - inv H0. eapply IHe in H10. eapply IHe0 in H8; auto.
-      econstructor; try eassumption.
-      unfold ctx_rs, ctx_ps, ctx_mem in *; cbn in *. inv H; crush.
-    - inv H0.
-    - inv H0.
-    - inv H0. eapply IHe1 in H11; auto. eapply IHe2 in H12; auto. eapply IHe3 in H9; auto.
-      econstructor; try eassumption.
-      unfold ctx_rs, ctx_ps, ctx_mem in *; cbn in *. inv H; crush.
-    - inv H0. econstructor.
-    - inv H0. eapply IHe in H6; auto. eapply IHe0 in H8.
-      econstructor; eassumption.
-  Qed.
-
-  Lemma sem_value_det:
-    forall e v v', sem_value ictx e v -> sem_value octx e v' -> v = v'.
-  Proof using HSIM.
-    intros. eapply sem_value_mem_det; eauto; apply Mem.empty.
-  Qed.
-
-  Lemma sem_value_corr:
-    forall e v, sem_value ictx e v -> sem_value octx e v.
-  Proof using HSIM.
-    intros. eapply sem_value_mem_corr; eauto; apply Mem.empty.
-  Qed.
-
-  Lemma sem_mem_det:
-    forall e v v', sem_mem ictx e v -> sem_mem octx e v' -> v = v'.
-  Proof using HSIM.
-    intros. eapply sem_value_mem_det; eauto; apply (Vint (Int.repr 0%Z)).
-  Qed.
-
-  Lemma sem_mem_corr:
-    forall e v, sem_mem ictx e v -> sem_mem octx e v.
-  Proof using HSIM.
-    intros. eapply sem_value_mem_corr; eauto; apply (Vint (Int.repr 0%Z)).
-  Qed.
-
-  Lemma sem_val_list_det:
-    forall e l l', sem_val_list ictx e l -> sem_val_list octx e l' -> l = l'.
-  Proof using HSIM.
-    induction e; simplify.
-    - inv H; inv H0; auto.
-    - inv H; inv H0. f_equal. eapply sem_value_det; eauto; try apply Mem.empty.
-      apply IHe; eauto.
-  Qed.
-
-  Lemma sem_val_list_corr:
-    forall e l, sem_val_list ictx e l -> sem_val_list octx e l.
-  Proof using HSIM.
-    induction e; simplify.
-    - inv H; constructor.
-    - inv H. apply sem_value_corr in H3; auto; try apply Mem.empty;
-      apply IHe in H5; constructor; assumption.
-  Qed.
-
-  Lemma sem_pred_det:
-    forall e v v', sem_pred ictx e v -> sem_pred octx e v' -> v = v'.
-  Proof using HSIM.
-    try solve [inversion 1]; pose proof sem_value_det; pose proof sem_val_list_det; inv HSIM;
-      match goal with H: match_states _ _ |- _ => inv H end; simplify.
-    inv H2; inv H5; auto. assert (lv = lv0) by (eapply H0; eauto). subst. unfold ctx_mem in *.
-    crush.
-  Qed.
-
-  Lemma sem_pred_corr:
-    forall e v, sem_pred ictx e v -> sem_pred octx e v.
-  Proof using HSIM.
-    try solve [inversion 1]; pose proof sem_value_corr; pose proof sem_val_list_corr; inv HSIM;
-      match goal with H: match_states _ _ |- _ => inv H end; simplify.
-    inv H2; auto. apply H0 in H5. econstructor; eauto.
-    unfold ctx_ps; cbn. rewrite H4. constructor.
-  Qed.
-
-  Lemma sem_exit_det:
-    forall e v v', sem_exit ictx e v -> sem_exit octx e v' -> v = v'.
-  Proof using HSIM.
-    try solve [inversion 1]; pose proof sem_value_det; pose proof sem_val_list_det; inv HSIM;
-      match goal with H: match_states _ _ |- _ => inv H end; simplify.
-    inv H2; inv H5; auto.
-  Qed.
-
-  Lemma sem_exit_corr:
-    forall e v, sem_exit ictx e v -> sem_exit octx e v.
-  Proof using HSIM.
-    try solve [inversion 1]; pose proof sem_value_corr; pose proof sem_val_list_corr; inv HSIM;
-      match goal with H: match_states _ _ |- _ => inv H end; simplify.
-    inv H2; auto; constructor.
-  Qed.
-
-  Lemma sem_pexpr_det :
-    forall p b1 b2, sem_pexpr ictx p b1 -> sem_pexpr octx p b2 -> b1 = b2.
-  Proof.
-    induction p; crush; inv H; inv H0; firstorder.
-    destruct b.
-    - apply sem_pred_det with (e:=p0); auto.
-    - apply negb_inj. apply sem_pred_det with (e:=p0); auto.
-  Qed.
-
-  Lemma sem_pexpr_corr :
-    forall p b, sem_pexpr ictx p b -> sem_pexpr octx p b.
-  Proof.
-    induction p; crush; inv H; constructor;
-      try solve [try inv H3; firstorder].
-    now apply sem_pred_corr.
-  Qed.
-
-  Lemma sem_pred_exec_beq_correct2 :
-    forall A B (sem: forall G, @Abstr.ctx G -> A -> B -> Prop) a p r R,
-      (forall x y,
-          sem _ ictx x y ->
-          exists y', sem _ octx x y' /\ R y y') ->
-      sem_pred_expr a (sem _) ictx p r ->
-      exists r', sem_pred_expr a (sem _) octx p r' /\ R r r'.
-  Proof.
-    induction p; crush.
-    - inv H0. apply H in H4. simplify.
-      exists x; split; auto.
-      constructor; auto.
-      now apply sem_pexpr_corr.
-    - inv H0.
-      + apply H in H6; simplify.
-        exists x; split; auto.
-        constructor; auto.
-        now apply sem_pexpr_corr.
-      + exploit IHp; auto. exact H6. intros. simplify.
-        exists x; split; auto.
-        apply sem_pred_expr_cons_false; auto.
-        now apply sem_pexpr_corr.
-  Qed.
-  
-  Lemma sem_pred_expr_corr :
-    forall A B (sem: forall G, @Abstr.ctx G -> A -> B -> Prop) a p r,
-      (forall x y, sem _ ictx x y -> sem _ octx x y) ->
-      sem_pred_expr a (sem _) ictx p r ->
-      sem_pred_expr a (sem _) octx p r.
-  Proof.
-    intros.
-    assert
-      (forall x y,
-          sem0 _ ictx x y ->
-          exists y', sem0 _ octx x y' /\ eq y y') by firstorder.
-    pose proof (sem_pred_exec_beq_correct2 _ _ sem0 a p r _ H1 H0).
-    crush.
-  Qed.
-
-  Lemma sem_correct:
-    forall f i cf, sem ictx f (i, cf) -> sem octx f (i, cf).
-  Proof.
-    intros. inv H. constructor.
-    - inv H2. constructor; intros. specialize (H x).
-      apply sem_pred_expr_corr; auto. exact sem_value_corr.
-    - inv H3; constructor; intros. specialize (H x).
-      now apply sem_pexpr_corr.
-    - apply sem_pred_expr_corr; auto. exact sem_mem_corr.
-    - apply sem_pred_expr_corr; auto. exact sem_exit_corr.
-  Qed.
-
-End CORRECT.
-
-Section SEM_PRED_EXEC.
-
-  Context (A: Type).
-  Context (ctx: @Abstr.ctx A).
-
-  Lemma sem_pexpr_negate :
-    forall p b,
-      sem_pexpr ctx p b ->
-      sem_pexpr ctx (¬ p) (negb b).
-  Proof.
-    induction p; crush.
-    - destruct_match. destruct b0; crush. inv Heqp0.
-      constructor. inv H. rewrite negb_involutive. auto.
-      constructor. inv H. auto.
-    - inv H. constructor.
-    - inv H. constructor.
-    - inv H. inv H3.
-      + apply IHp1 in H. solve [constructor; auto].
-      + apply IHp2 in H. solve [constructor; auto].
-      + apply IHp1 in H2. apply IHp2 in H4. solve [constructor; auto].
-    - inv H. inv H3.
-      + apply IHp1 in H. solve [constructor; auto].
-      + apply IHp2 in H. solve [constructor; auto].
-      + apply IHp1 in H2. apply IHp2 in H4. solve [constructor; auto].
-  Qed.
-  
-  Lemma sem_pexpr_negate2 :
-    forall p b,
-      sem_pexpr ctx (¬ p) (negb b) ->
-      sem_pexpr ctx p b.
-  Proof.
-    induction p; crush.
-    - destruct_match. destruct b0; crush. inv Heqp0.
-      constructor. inv H. rewrite negb_involutive in *. auto.
-      constructor. inv H. auto.
-    - inv H. destruct b; try discriminate. constructor.
-    - inv H. destruct b; try discriminate. constructor.
-    - inv H. destruct b; try discriminate.
-      + constructor. inv H1; eauto.
-      + destruct b; try discriminate. constructor; eauto.
-    - inv H. destruct b; try discriminate.
-      + constructor. inv H1; eauto.
-      + destruct b; try discriminate. constructor; eauto.
-  Qed.
-
-  Lemma sem_pexpr_evaluable :
-    forall f_p ps,
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-      forall p, exists b, sem_pexpr ctx (from_pred_op f_p p) b.
-  Proof.
-    induction p; crush.
-    - destruct_match. inv Heqp0. destruct b. econstructor. eauto.
-      econstructor. eapply sem_pexpr_negate. eauto.
-    - econstructor. constructor.
-    - econstructor. constructor.
-    - destruct x0, x; solve [eexists; constructor; auto].
-    - destruct x0, x; solve [eexists; constructor; auto].
-  Qed.
-
-  Lemma sem_pexpr_eval1 :
-    forall f_p ps,
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-      forall p,
-        eval_predf ps p = false ->
-        sem_pexpr ctx (from_pred_op f_p p) false.
-  Proof.
-    induction p; crush.
-    - destruct_match. inv Heqp0.
-      destruct b.
-      + cbn in H0. rewrite <- H0. eauto.
-      + replace false with (negb true) by auto.
-        apply sem_pexpr_negate. cbn in H0.
-        apply negb_true_iff in H0. rewrite negb_involutive in H0.
-        rewrite <- H0. eauto.
-     - constructor.
-     - rewrite eval_predf_Pand in H0.
-       apply andb_false_iff in H0. inv H0. eapply IHp1 in H1.
-       pose proof (sem_pexpr_evaluable _ _ H p2) as EVAL.
-       inversion_clear EVAL as [x EVAL2].
-       replace false with (false && x) by auto.
-       constructor; auto.
-       eapply IHp2 in H1.
-       pose proof (sem_pexpr_evaluable _ _ H p1) as EVAL.
-       inversion_clear EVAL as [x EVAL2].
-       replace false with (x && false) by eauto with bool.
-       apply sem_pexpr_Pand; auto.
-     - rewrite eval_predf_Por in H0.
-       apply orb_false_iff in H0. inv H0.
-       replace false with (false || false) by auto.
-       apply sem_pexpr_Por; auto.
-  Qed.
-
-  Lemma sem_pexpr_eval2 :
-    forall f_p ps,
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-      forall p,
-        eval_predf ps p = true ->
-        sem_pexpr ctx (from_pred_op f_p p) true.
-  Proof.
-    induction p; crush.
-    - destruct_match. inv Heqp0.
-      destruct b.
-      + cbn in H0. rewrite <- H0. eauto.
-      + replace true with (negb false) by auto.
-        apply sem_pexpr_negate. cbn in H0.
-        apply negb_true_iff in H0.
-        rewrite <- H0. eauto.
-     - constructor.
-     - rewrite eval_predf_Pand in H0.
-       apply andb_true_iff in H0. inv H0.
-       replace true with (true && true) by auto.
-       constructor; auto.
-     - rewrite eval_predf_Por in H0.
-       apply orb_true_iff in H0. inv H0. eapply IHp1 in H1.
-       pose proof (sem_pexpr_evaluable _ _ H p2) as EVAL.
-       inversion_clear EVAL as [x EVAL2].
-       replace true with (true || x) by auto.
-       apply sem_pexpr_Por; auto.
-       eapply IHp2 in H1.
-       pose proof (sem_pexpr_evaluable _ _ H p1) as EVAL.
-       inversion_clear EVAL as [x EVAL2].
-       replace true with (x || true) by eauto with bool.
-       apply sem_pexpr_Por; auto.
-  Qed.
-
-  Lemma sem_pexpr_eval :
-    forall f_p ps b,
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-      forall p,
-        eval_predf ps p = b ->
-        sem_pexpr ctx (from_pred_op f_p p) b.
-  Proof.
-    intros; destruct b; eauto using sem_pexpr_eval1, sem_pexpr_eval2.
-  Qed.
-
-  Lemma sem_pexpr_eval_inv :
-    forall f_p ps b,
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-      forall p,
-        sem_pexpr ctx (from_pred_op f_p p) b ->
-        eval_predf ps p = b.
-  Proof.
-    induction p; intros.
-    - cbn in H0. destruct_match. destruct b0; cbn in *.
-      + specialize (H p0). eapply sem_pexpr_det; eauto. apply similar_refl.
-      + rewrite <- negb_involutive in H0. apply sem_pexpr_negate2 in H0.
-        symmetry; apply negb_sym. eapply sem_pexpr_det; eauto.
-        apply similar_refl.
-    - now inv H0.
-    - now inv H0.
-    - inv H0; try inv H4; rewrite eval_predf_Pand.
-      + apply IHp1 in H0. rewrite H0. auto.
-      + apply IHp2 in H0. rewrite H0. auto with bool.
-      + apply IHp2 in H5. apply IHp1 in H3. rewrite H3. rewrite H5. auto.
-    - inv H0; try inv H4; rewrite eval_predf_Por.
-      + apply IHp1 in H0. rewrite H0. auto.
-      + apply IHp2 in H0. rewrite H0. auto with bool.
-      + apply IHp2 in H5. apply IHp1 in H3. rewrite H3. rewrite H5. auto.
-  Qed.
-
-  Context {C B: Type}.
-  Context (f: PTree.t pred_pexpr).
-  Context (ps: PMap.t bool).
-  Context (a_sem: @Abstr.ctx A -> C -> B -> Prop).
-
-  Context (F_EVALULABLE: forall x, sem_pexpr ctx (get_forest_p' x f) ps !! x).
-
-  Lemma sem_pexpr_equiv :
-    forall p1 p2 b,
-      p1 == p2 ->
-      sem_pexpr ctx (from_pred_op f p1) b ->
-      sem_pexpr ctx (from_pred_op f p2) b.
-  Proof.
-    intros.
-    eapply sem_pexpr_eval_inv in H0; eauto.
-    eapply sem_pexpr_eval; eauto.
-  Qed.
-
-End SEM_PRED_EXEC.
-
-Module HashExprNorm(HS: Hashable).
-  Module H := HashTree(HS).
-
-  Definition norm_tree: Type := PTree.t pred_op * H.hash_tree.
-
-  Fixpoint norm_expression (max: predicate) (pe: predicated HS.t) (h: H.hash_tree)
-    : norm_tree :=
-    match pe with
-    | NE.singleton (p, e) =>
-        let (hashed_e, h') := H.hash_value max e h in
-        (PTree.set hashed_e p (PTree.empty _), h')
-    | (p, e) ::| pr =>
-        let (hashed_e, h') := H.hash_value max e h in
-        let (norm_pr, h'') := norm_expression max pr h' in
-        match norm_pr ! hashed_e with
-        | Some pr_op =>
-            (PTree.set hashed_e (pr_op ∨ p) norm_pr, h'')
-        | None =>
-            (PTree.set hashed_e p norm_pr, h'')
-        end
-    end.
-
-  Definition mk_pred_stmnt' (e: predicate) p_e := ¬ p_e ∨ Plit (true, e).
-
-  Definition mk_pred_stmnt t := PTree.fold (fun x a b => mk_pred_stmnt' a b ∧ x) t T.
-
-  Definition mk_pred_stmnt_l (t: list (predicate * pred_op)) :=
-    fold_left (fun x a => uncurry mk_pred_stmnt' a ∧ x) t T.
-
-  Definition encode_expression max pe h :=
-    let (tree, h) := norm_expression max pe h in
-    (mk_pred_stmnt tree, h).
-
-  Definition pred_expr_dec: forall pe1 pe2: predicated HS.t,
-    {pe1 = pe2} + {pe1 <> pe2}.
-  Proof.
-    pose proof HS.eq_dec as X.
-    pose proof (Predicate.eq_dec peq).
-    pose proof (NE.eq_dec _ X).
-    assert (forall a b: pred_op * HS.t, {a = b} + {a <> b})
-     by decide equality.
-    decide equality.
-  Defined.
-
-  Definition beq_pred_expr' (pe1 pe2: predicated HS.t) : bool :=
-    if pred_expr_dec pe1 pe2 then true else
-    let (p1, h) := encode_expression 1%positive pe1 (PTree.empty _) in
-    let (p2, h') := encode_expression 1%positive pe2 h in
-    equiv_check p1 p2.
-
-  Lemma mk_pred_stmnt_equiv' :
-    forall l l' e p,
-      mk_pred_stmnt_l l == mk_pred_stmnt_l l' ->
-      In (e, p) l ->
-      list_norepet (map fst l) ->
-      (exists p', In (e, p') l' /\ p == p')
-      \/ ~ In e (map fst l') /\ p == ⟂.
-  Proof. Abort.
-
-  Lemma mk_pred_stmnt_equiv :
-    forall tree tree',
-      mk_pred_stmnt tree == mk_pred_stmnt tree'.
-  Proof. Abort.
-
-  Definition tree_equiv_check_el (np2: PTree.t pred_op) (n: positive) (p: pred_op): bool :=
-    match np2 ! n with
-    | Some p' => equiv_check p p'
-    | None => equiv_check p ⟂
-    end.
-  
-  Definition tree_equiv_check_None_el (np2: PTree.t pred_op) (n: positive) (p: pred_op): bool :=
-    match np2 ! n with
-    | Some p' => true
-    | None => equiv_check p ⟂
-    end.
-
-  Definition beq_pred_expr (pe1 pe2: predicated HS.t) : bool :=
-    if pred_expr_dec pe1 pe2 then true else
-    let (np1, h) := norm_expression 1 pe1 (PTree.empty _) in
-    let (np2, h') := norm_expression 1 pe2 h in
-    forall_ptree (tree_equiv_check_el np2) np1
-    && forall_ptree (tree_equiv_check_None_el np1) np2.
-
-  Lemma beq_pred_expr_correct:
-    forall np1 np2 e p p',
-      forall_ptree (tree_equiv_check_el np2) np1 = true ->
-      np1 ! e = Some p ->
-      np2 ! e = Some p' ->
-      p == p'.
-  Proof.
-    intros.
-    eapply forall_ptree_true in H; try eassumption.
-    unfold tree_equiv_check_el in H.
-    rewrite H1 in H. now apply equiv_check_correct.
-  Qed.
-
-  Lemma beq_pred_expr_correct2:
-    forall np1 np2 e p,
-      forall_ptree (tree_equiv_check_el np2) np1 = true ->
-      np1 ! e = Some p ->
-      np2 ! e = None ->
-      p == ⟂.
-  Proof.
-    intros.
-    eapply forall_ptree_true in H; try eassumption.
-    unfold tree_equiv_check_el in H.
-    rewrite H1 in H. now apply equiv_check_correct.
-  Qed.
-
-  Lemma beq_pred_expr_correct3:
-    forall np1 np2 e p,
-      forall_ptree (tree_equiv_check_None_el np1) np2 = true ->
-      np1 ! e = None ->
-      np2 ! e = Some p ->
-      p == ⟂.
-  Proof.
-    intros.
-    eapply forall_ptree_true in H; try eassumption.
-    unfold tree_equiv_check_None_el in H.
-    rewrite H0 in H. now apply equiv_check_correct.
-  Qed.
-
-  Section PRED_PROOFS.
-
-  Context {G B: Type}.
-  Context (f: PTree.t pred_pexpr).
-  Context (ps: PMap.t bool).
-  Context (a_sem: @Abstr.ctx G -> HS.t -> B -> Prop).
-  Context (ctx: @Abstr.ctx G).
-
-  Context (F_EVALULABLE: forall x, sem_pexpr ctx (get_forest_p' x f) ps !! x).
-
-  Variant sem_pred_tree: PTree.t HS.t -> PTree.t pred_op -> B -> Prop :=
-  | sem_pred_tree_intro :
-      forall expr e v et pt pr,
-        sem_pexpr ctx (from_pred_op f pr) true ->
-        a_sem ctx expr v ->
-        pt ! e = Some pr ->
-        et ! e = Some expr ->
-        sem_pred_tree et pt v.
-
-  Lemma norm_expression_in :
-    forall pe et pt h x y,
-      H.wf_hash_table h ->
-      norm_expression 1 pe h = (pt, et) ->
-      h ! x = Some y ->
-      et ! x = Some y.
-  Proof.
-    induction pe; crush; repeat (destruct_match; try discriminate; []).
-    - inv H0. eauto using H.hash_constant.
-    - destruct_match.
-      + inv H0. eapply IHpe.
-        eapply H.wf_hash_table_distr; eauto. eauto.
-        eauto using H.hash_constant.
-      + inv H0. eapply IHpe.
-        eapply H.wf_hash_table_distr; eauto. eauto.
-        eauto using H.hash_constant.
-  Qed.
-
-  Lemma norm_expression_exists :
-    forall pe et pt h x y,
-      H.wf_hash_table h ->
-      norm_expression 1 pe h = (pt, et) ->
-      pt ! x = Some y ->
-      exists z, et ! x = Some z.
-  Proof.
-    induction pe; crush; repeat (destruct_match; try discriminate; []).
-    - inv H0. destruct (peq x h0); subst; inv H1.
-      + eexists. eauto using H.hash_value_in.
-      + rewrite PTree.gso in H2 by auto. now rewrite PTree.gempty in H2.
-    - assert (H.wf_hash_table h1) by eauto using H.wf_hash_table_distr.
-      destruct_match; inv H0.
-      + destruct (peq h0 x); subst; eauto. 
-        rewrite PTree.gso in H1 by auto. eauto.
-      + destruct (peq h0 x); subst; eauto.
-        * pose proof Heqp0 as X.
-          eapply H.hash_value_in in Heqp0.
-          eapply norm_expression_in in Heqn; eauto.
-        * rewrite PTree.gso in H1 by auto. eauto.
-  Qed.
-
-  Lemma norm_expression_wf :
-    forall pe et pt h,
-      H.wf_hash_table h ->
-      norm_expression 1 pe h = (pt, et) ->
-      H.wf_hash_table et.
-  Proof.
-    induction pe; crush; repeat (destruct_match; try discriminate; []).
-    - inv H0. eauto using H.wf_hash_table_distr.
-    - destruct_match.
-      + inv H0. eapply IHpe.
-        eapply H.wf_hash_table_distr; eauto. eauto.
-      + inv H0. eapply IHpe.
-        eapply H.wf_hash_table_distr; eauto. eauto.
-  Qed.
-
-  Lemma sem_pred_expr_in_true :
-    forall pe v,
-      sem_pred_expr f a_sem ctx pe v ->
-      exists p e, NE.In (p, e) pe
-                  /\ sem_pexpr ctx (from_pred_op f p) true
-                  /\ a_sem ctx e v.
-  Proof.
-    induction pe; crush.
-    - inv H. do 2 eexists; split; try split; eauto. constructor.
-    - inv H.
-      + do 2 eexists; split; try split; eauto. constructor; tauto.
-      + exploit IHpe; eauto. simplify.
-        do 2 eexists; split; try split; eauto. constructor; tauto.
-  Qed.
-
-  Definition pred_Ht_dec :
-    forall x y: pred_op * HS.t, {x = y} + {x <> y}.
-  Proof.
-    pose proof HS.eq_dec.
-    pose proof (@Predicate.eq_dec positive peq).
-    decide equality.
-  Defined.
-
-  Lemma sem_pred_mutexcl :
-    forall pe p t v,
-      predicated_mutexcl ((p, t) ::| pe) ->
-      sem_pred_expr f a_sem ctx pe v ->
-      sem_pexpr ctx (from_pred_op f p) false.
-  Proof.
-    intros. unfold predicated_mutexcl in H.
-    exploit sem_pred_expr_in_true; eauto; simplify.
-    unfold "⇒" in *. inv H5.
-    destruct (pred_Ht_dec (x, x0) (p, t)); subst.
-    { inv e; exfalso; apply H7; auto. }
-    assert (NE.In (x, x0) ((p, t) ::| pe)) by (constructor; tauto).
-    assert (NE.In (p, t) ((p, t) ::| pe)) by (constructor; tauto).
-    pose proof (H3 _ _ H H5 n).
-    assert (forall c, eval_predf c x = true -> eval_predf c (¬ p) = true)
-      by eauto.
-    eapply sem_pexpr_eval_inv in H1; eauto.
-    eapply sem_pexpr_eval; eauto. apply H9 in H1.
-    unfold eval_predf in *. rewrite negate_correct in H1.
-    symmetry in H1. apply negb_sym in H1. auto.
-  Qed.
-
-  Lemma exec_tree_exec_pe :
-    forall pe et pt v h
-      (MUTEXCL: predicated_mutexcl pe),
-      H.wf_hash_table h ->
-      norm_expression 1 pe h = (pt, et) ->
-      sem_pred_tree et pt v ->
-      sem_pred_expr f a_sem ctx pe v.
-  Proof.
-    induction pe; simplify; repeat (destruct_match; try discriminate; []).
-    - inv Heqp. inv H0. inv H1.
-      destruct (peq e h0); subst.
-      2: { rewrite PTree.gso in H3 by auto.
-           rewrite PTree.gempty in H3. discriminate. }
-      assert (expr = t).
-      { apply H.hash_value_in in Heqp0. rewrite H4 in Heqp0. now inv Heqp0. }
-      subst. constructor; auto. rewrite PTree.gss in H3. inv H3; auto.
-    - inv Heqp. inv H1. destruct_match; inv H0; destruct (peq h0 e); subst.
-      + rewrite PTree.gss in H4. inv H4. inv H2. inv H1.
-        * exploit IHpe. eauto using predicated_cons.
-          eapply H.wf_hash_table_distr; eauto. eauto.
-          econstructor. eauto. eauto. eauto. eauto. intros.
-          assert (sem_pexpr ctx (from_pred_op f p) false)
-            by (eapply sem_pred_mutexcl; eauto).
-          eapply sem_pred_expr_cons_false; auto.
-        * assert (et ! e = Some t).
-          { eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
-            eauto. apply H.hash_value_in in Heqp0.  auto. }
-          rewrite H1 in H5. inv H5.
-          constructor; auto.
-      + exploit IHpe. eauto using predicated_cons.
-        eapply H.wf_hash_table_distr; eauto. eauto.
-        econstructor. eauto. eauto. rewrite PTree.gso in H4; eauto. auto.
-        intros.
-        assert (sem_pexpr ctx (from_pred_op f p) false)
-          by (eapply sem_pred_mutexcl; eauto).
-        eapply sem_pred_expr_cons_false; auto.
-      + rewrite PTree.gss in H4. inv H4.
-        econstructor; auto.
-        assert (et ! e = Some t).
-          { eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
-            eauto. apply H.hash_value_in in Heqp0.  auto. }
-        rewrite H0 in H5; inv H5. auto.
-      + rewrite PTree.gso in H4 by auto.
-        exploit IHpe. eauto using predicated_cons.
-        eapply H.wf_hash_table_distr; eauto. eauto.
-        econstructor. eauto. eauto. eauto. eauto. intros.
-        assert (sem_pexpr ctx (from_pred_op f p) false)
-          by (eapply sem_pred_mutexcl; eauto).
-        eapply sem_pred_expr_cons_false; auto.
-  Qed.
-
-  Lemma exec_pe_exec_tree :
-    forall pe et pt v h
-      (MUTEXCL: predicated_mutexcl pe),
-      H.wf_hash_table h ->
-      norm_expression 1 pe h = (pt, et) ->
-      sem_pred_expr f a_sem ctx pe v ->
-      sem_pred_tree et pt v.
-  Proof.
-    induction pe; simplify; repeat (destruct_match; try discriminate; []).
-    - inv H0. inv H1. econstructor; eauto. apply PTree.gss.
-      eapply H.hash_value_in; eauto.
-    - inv H1.
-      + destruct_match.
-        * inv H0. econstructor.
-          2: { eauto. }
-          2: { apply PTree.gss. }
-          constructor; tauto.
-          eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
-          eauto. eapply H.hash_value_in; eauto.
-        * inv H0. econstructor. eauto. eauto. apply PTree.gss.
-          eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
-          eauto. eapply H.hash_value_in; eauto.
-      + destruct_match.
-        * inv H0. exploit IHpe.
-          eauto using predicated_cons.
-          eapply H.wf_hash_table_distr; eauto.
-          eauto. eauto. intros. inv H0.
-          destruct (peq e h0); subst.
-          -- rewrite H3 in Heqo. inv Heqo.
-             econstructor.
-             3: { apply PTree.gss. }
-             constructor; tauto. eauto. auto.
-          -- econstructor. eauto. eauto. rewrite PTree.gso by eauto. auto.
-             auto.
-        * inv H0. exploit IHpe.
-          eauto using predicated_cons.
-          eapply H.wf_hash_table_distr; eauto.
-          eauto. eauto. intros. inv H0.
-          destruct (peq e h0); subst.
-          -- rewrite H3 in Heqo; discriminate.
-          -- econstructor; eauto. rewrite PTree.gso by auto. auto.
-  Qed.
-
-  Lemma beq_pred_expr_correct_top:
-    forall p1 p2 v
-           (MUTEXCL1: predicated_mutexcl p1)
-           (MUTEXCL2: predicated_mutexcl p2),
-      beq_pred_expr p1 p2 = true ->
-      sem_pred_expr f a_sem ctx p1 v ->
-      sem_pred_expr f a_sem ctx p2 v.
-  Proof.
-    unfold beq_pred_expr; intros.
-    destruct_match; subst; auto.
-    repeat (destruct_match; []).
-    symmetry in H. apply andb_true_eq in H. inv H.
-    symmetry in H1. symmetry in H2.
-    pose proof Heqn0. eapply norm_expression_wf in H.
-    2: { unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3. }
-    eapply exec_tree_exec_pe; eauto.
-    eapply exec_pe_exec_tree in H0; auto.
-    3: { eauto. }
-    2: { unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3. }
-    inv H0. destruct (t0 ! e) eqn:?.
-    - assert (pr == p) by eauto using beq_pred_expr_correct.
-      assert (sem_pexpr ctx (from_pred_op f p) true).
-      { eapply sem_pexpr_eval; eauto. eapply sem_pexpr_eval_inv in H3; eauto. }
-      econstructor. apply H7. eauto. eauto.
-      eapply norm_expression_in; eauto.
-    - assert (pr == ⟂) by eauto using beq_pred_expr_correct2.
-      eapply sem_pexpr_eval_inv in H3; eauto. now rewrite H0 in H3.
-  Qed.
-
-  Lemma beq_pred_expr_correct_top2:
-    forall p1 p2 v
-           (MUTEXCL1: predicated_mutexcl p1)
-           (MUTEXCL2: predicated_mutexcl p2),
-      beq_pred_expr p1 p2 = true ->
-      sem_pred_expr f a_sem ctx p2 v ->
-      sem_pred_expr f a_sem ctx p1 v.
-  Proof.
-    unfold beq_pred_expr; intros.
-    destruct_match; subst; auto.
-    repeat (destruct_match; []).
-    symmetry in H. apply andb_true_eq in H. inv H.
-    symmetry in H1. symmetry in H2.
-    pose proof Heqn0. eapply norm_expression_wf in H.
-    2: { unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3. }
-    eapply exec_tree_exec_pe; auto.
-    2: { eauto. }
-    unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3.
-    eapply exec_pe_exec_tree in H0; auto.
-    3: { eauto. }
-    2: { auto. }
-    inv H0. destruct (t ! e) eqn:?.
-    - assert (p == pr) by eauto using beq_pred_expr_correct.
-      assert (sem_pexpr ctx (from_pred_op f p) true).
-      { eapply sem_pexpr_eval; eauto. eapply sem_pexpr_eval_inv in H3; eauto. }
-      econstructor. apply H7. eauto. eauto.
-      exploit norm_expression_exists.
-      2: { eapply Heqn0. }  unfold H.wf_hash_table; intros * YH.
-      now rewrite PTree.gempty in YH. eauto. simplify.
-      exploit norm_expression_in. 2: { eauto. } auto. eauto. intros.
-      crush.
-    - assert (pr == ⟂) by eauto using beq_pred_expr_correct3.
-      eapply sem_pexpr_eval_inv in H3; eauto. now rewrite H0 in H3.
-  Qed.
-
-  End PRED_PROOFS.
-
-End HashExprNorm.
-
-Module HN := HashExprNorm(HashExpr).
-Module EHN := HashExprNorm(EHashExpr).
-
-Definition and_list {A} (p: list (@Predicate.pred_op A)): @Predicate.pred_op A :=
-  fold_left Pand p T.
-
-Definition or_list {A} (p: list (@Predicate.pred_op A)): @Predicate.pred_op A :=
-  fold_left Por p ⟂.
-
-Definition check_mutexcl {A} (pe: predicated A) :=
-  let preds := map fst (NE.to_list pe) in
-  let pairs := map (fun x => x → or_list (remove (Predicate.eq_dec peq) x preds)) preds in
-  match sat_pred_simple (simplify (negate (and_list pairs))) with
-  | None => true
-  | _ => false
-  end.
-
-Lemma check_mutexcl_correct:
-  forall A (pe: predicated A),
-    check_mutexcl pe = true ->
-    predicated_mutexcl pe.
-Proof. Admitted.
-
-Definition check_mutexcl_tree {A} (f: PTree.t (predicated A)) :=
-  forall_ptree (fun _ => check_mutexcl) f.
-
-Lemma check_mutexcl_tree_correct:
-  forall A (f: PTree.t (predicated A)) i pe,
-    check_mutexcl_tree f = true ->
-    f ! i = Some pe ->
-    predicated_mutexcl pe.
-Proof.
-  unfold check_mutexcl_tree; intros.
-  eapply forall_ptree_true in H; eauto using check_mutexcl_correct.
-Qed.
-
-Definition check f1 f2 :=
-  RTree.beq HN.beq_pred_expr f1.(forest_regs) f2.(forest_regs)
-  && PTree.beq beq_pred_pexpr f1.(forest_preds) f2.(forest_preds)
-  && EHN.beq_pred_expr f1.(forest_exit) f2.(forest_exit)
-  && check_mutexcl_tree f1.(forest_regs)
-  && check_mutexcl_tree f2.(forest_regs)
-  && check_mutexcl f1.(forest_exit)
-  && check_mutexcl f2.(forest_exit).
-
-Lemma sem_pexpr_forward_eval1 :
-  forall A ctx f_p ps,
-    (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-    forall p,
-      @sem_pexpr A ctx (from_pred_op f_p p) false ->
-      eval_predf ps p = false.
-Proof.
-  induction p; crush.
-  - destruct_match. inv Heqp0. destruct b.
-    cbn. specialize (H p0).
-    eapply sem_pexpr_det; eauto. apply similar_refl.
-    specialize (H p0).
-    replace false with (negb true) in H0 by auto.
-    eapply sem_pexpr_negate2 in H0. cbn.
-    symmetry; apply negb_sym. cbn.
-    eapply sem_pexpr_det; eauto. apply similar_refl.
-  - inv H0.
-  - inv H0. inv H2. rewrite eval_predf_Pand. rewrite IHp1; eauto.
-    rewrite eval_predf_Pand. rewrite IHp2; eauto with bool.
-  - inv H0. rewrite eval_predf_Por. rewrite IHp1; eauto.
-Qed.
-
-Lemma sem_pexpr_forward_eval2 :
-  forall A ctx f_p ps,
-    (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-    forall p,
-      @sem_pexpr A ctx (from_pred_op f_p p) true ->
-      eval_predf ps p = true.
-Proof.
-  induction p; crush.
-  - destruct_match. inv Heqp0. destruct b.
-    cbn. specialize (H p0).
-    eapply sem_pexpr_det; eauto. apply similar_refl.
-    cbn. symmetry. apply negb_sym; cbn.
-    replace true with (negb false) in H0 by auto.
-    eapply sem_pexpr_negate2 in H0.
-    eapply sem_pexpr_det; eauto. apply similar_refl.
-  - inv H0.
-  - inv H0. rewrite eval_predf_Pand. rewrite IHp1; eauto.
-  - inv H0. inv H2. rewrite eval_predf_Por. rewrite IHp1; eauto.
-    rewrite eval_predf_Por. rewrite IHp2; eauto with bool.
-Qed.
-
-Lemma sem_pexpr_forward_eval :
-  forall A ctx f_p ps,
-    (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-    forall p b,
-      @sem_pexpr A ctx (from_pred_op f_p p) b ->
-      eval_predf ps p = b.
-Proof.
-  intros; destruct b; eauto using sem_pexpr_forward_eval1, sem_pexpr_forward_eval2.
-Qed.
-
-Lemma get_empty:
-  forall r, empty#r r = NE.singleton (Ptrue, Ebase r).
-Proof. unfold "#r"; intros. rewrite RTree.gempty. trivial. Qed.
-
-Section BOOLEAN_EQUALITY.
-
-  Context {A B: Type}.
-  Context (beqA: A -> B -> bool).
-
-  Fixpoint beq2' (m1: PTree.tree' A) (m2: PTree.tree' B) {struct m1} : bool :=
-    match m1, m2 with
-    | PTree.Node001 r1, PTree.Node001 r2 => beq2' r1 r2
-    | PTree.Node010 x1, PTree.Node010 x2 => beqA x1 x2
-    | PTree.Node011 x1 r1, PTree.Node011 x2 r2 => beqA x1 x2 && beq2' r1 r2
-    | PTree.Node100 l1, PTree.Node100 l2 => beq2' l1 l2
-    | PTree.Node101 l1 r1, PTree.Node101 l2 r2 => beq2' l1 l2 && beq2' r1 r2
-    | PTree.Node110 l1 x1, PTree.Node110 l2 x2 => beqA x1 x2 && beq2' l1 l2
-    | PTree.Node111 l1 x1 r1, PTree.Node111 l2 x2 r2  => beqA x1 x2 && beq2' l1 l2 && beq2' r1 r2
-    | _, _ => false
-    end.
-
-  Definition beq2 (m1: PTree.t A) (m2 : PTree.t B) : bool :=
-    match m1, m2 with
-    | PTree.Empty, PTree.Empty => true
-    | PTree.Nodes m1', PTree.Nodes m2' => beq2' m1' m2'
-    | _, _ => false
-    end.
-
-  Let beq2_optA (o1: option A) (o2: option B) : bool :=
-    match o1, o2 with
-    | None, None => true
-    | Some a1, Some a2 => beqA a1 a2
-    | _, _ => false
-    end.
-
-  Lemma beq_correct_bool:
-    forall m1 m2,
-      beq2 m1 m2 = true <-> (forall x, beq2_optA (m1 ! x) (m2 ! x) = true).
-  Proof.
-    Local Transparent PTree.Node.
-    assert (beq_NN: forall l1 o1 r1 l2 o2 r2,
-               PTree.not_trivially_empty l1 o1 r1 ->
-               PTree.not_trivially_empty l2 o2 r2 ->
-               beq2 (PTree.Node l1 o1 r1) (PTree.Node l2 o2 r2) =
-                 beq2 l1 l2 && beq2_optA o1 o2 && beq2 r1 r2).
-    { intros.
-      destruct l1, o1, r1; try contradiction; destruct l2, o2, r2; try contradiction;
-        simpl; rewrite ? andb_true_r, ? andb_false_r; auto.
-      rewrite andb_comm; auto.
-      f_equal; rewrite andb_comm; auto. }
-    induction m1 using PTree.tree_ind; [|induction m2 using PTree.tree_ind].
-    - intros. simpl; split; intros.
-      + destruct m2; try discriminate. simpl; auto.
-      + replace m2 with (@PTree.Empty B); auto. apply PTree.extensionality; intros x.
-        specialize (H x). destruct (m2 ! x); simpl; easy.
-    - split; intros.
-      + destruct (PTree.Node l o r); try discriminate. simpl; auto.
-      + replace (PTree.Node l o r) with (@PTree.Empty A); auto. apply PTree.extensionality; intros x.
-        specialize (H0 x). destruct ((PTree.Node l o r) ! x); simpl in *; easy.
-    - rewrite beq_NN by auto. split; intros.
-      + InvBooleans. rewrite ! PTree.gNode. destruct x.
-        * apply IHm0; auto.
-        * apply IHm1; auto.
-        * auto.
-      + apply andb_true_intro; split; [apply andb_true_intro; split|].
-        * apply IHm1. intros. specialize (H1 (xO x)); rewrite ! PTree.gNode in H1; auto.
-        * specialize (H1 xH); rewrite ! PTree.gNode in H1; auto.
-        * apply IHm0. intros. specialize (H1 (xI x)); rewrite ! PTree.gNode in H1; auto.
-  Qed.
-
-  Theorem beq2_correct:
-    forall m1 m2,
-      beq2 m1 m2 = true <->
-        (forall (x: PTree.elt),
-            match m1 ! x, m2 ! x with
-            | None, None => True
-            | Some y1, Some y2 => beqA y1 y2 = true
-            | _, _ => False
-            end).
-  Proof.
-    intros. rewrite beq_correct_bool. unfold beq2_optA. split; intros.
-    - specialize (H x). destruct (m1 ! x), (m2 ! x); intuition congruence.
-    - specialize (H x). destruct (m1 ! x), (m2 ! x); intuition auto.
-  Qed.
-
-End BOOLEAN_EQUALITY.
-
-Lemma forest_reg_gso:
-  forall (f : forest) w dst dst',
-    dst <> dst' ->
-    (f #r dst <- w) #r dst' = f #r dst'.
-Proof.
-  unfold "#r"; intros.
-  unfold forest_regs. unfold set_forest.
-  rewrite RTree.gso; auto.
-Qed.
-
-Lemma forest_reg_pred:
-  forall (f : forest) w dst dst',
-    (f #r dst <- w) #p dst' = f #p dst'.
-Proof. auto. Qed.
-
-Lemma forest_reg_gss:
-  forall (f : forest) w dst,
-    (f #r dst <- w) #r dst = w.
-Proof.
-  unfold "#r"; intros.
-  unfold forest_regs. unfold set_forest.
-  rewrite RTree.gss; auto.
-Qed.
-
-Lemma forest_pred_gso:
-  forall (f : forest) w dst dst',
-    dst <> dst' ->
-    (f #p dst <- w) #p dst' = f #p dst'.
-Proof.
-  unfold "#p"; intros.
-  unfold forest_preds, set_forest_p, get_forest_p'.
-  rewrite PTree.gso; auto.
-Qed.
-
-Lemma forest_pred_reg:
-  forall (f : forest) w dst dst',
-    (f #p dst <- w) #r dst' = f #r dst'.
-Proof. auto. Qed.
-
-Lemma forest_pred_gss:
-  forall (f : forest) w dst,
-    (f #p dst <- w) #p dst = w.
-Proof.
-  unfold "#p"; intros.
-  unfold forest_preds, set_forest_p, get_forest_p'.
-  rewrite PTree.gss; auto.
-Qed.
-
-Lemma forest_pred_gss2 :
-  forall (f : forest) r p,
-    (forest_preds (f #p r <- p)) ! r = Some p.
-Proof. intros. unfold set_forest_p. simpl. now rewrite PTree.gss. Qed.
-
-Lemma forest_pred_gso2 :
-  forall (f : forest) r w p,
-    r <> w ->
-    (forest_preds (f #p w <- p)) ! r = (forest_preds f) ! r.
-Proof. intros. unfold set_forest_p. simpl. now rewrite PTree.gso by auto. Qed.
-
-Section GENERIC_CONTEXT.
-
-Context {A: Type}.
-Context (ctx: @ctx A).
-
-(*|
-Suitably restrict the predicate set so that one can evaluate a hashed predicate
-using that predicate set.  However, one issue might be that we do not know that
-all the atoms of the original formula are actually evaluable.
-|*)
-
-Definition match_pred_states
-  (ht: PHT.hash_tree) (p_out: pred_op) (pred_set: predset) :=
-  forall (p: positive) (br: bool) (p_in: pred_expression),
-    PredIn p p_out ->
-    ht ! p = Some p_in ->
-    sem_pred ctx p_in (pred_set !! p).
-
-Lemma eval_hash_predicate :
-  forall max p_in ht p_out ht' br pred_set,
-    hash_predicate max p_in ht = (p_out, ht') ->
-    sem_pexpr ctx p_in br ->
-    match_pred_states ht' p_out pred_set ->
-    eval_predf pred_set p_out = br.
-Proof.
-  induction p_in; simplify.
-  + repeat destruct_match. inv H.
-    unfold eval_predf. cbn.
-    inv H0. inv H4. unfold match_pred_states in H1.
-    specialize (H1 h br).
-Abort.
-
-Lemma sem_pexpr_beq_correct :
-  forall p1 p2 b,
-    beq_pred_pexpr p1 p2 = true ->
-    sem_pexpr ctx p1 b ->
-    sem_pexpr ctx p2 b.
-Proof.
-  unfold beq_pred_pexpr.
-  induction p1; intros; destruct_match; crush.
-  Admitted.
-
-(*|
-This should only require a proof of sem_pexpr_beq_correct, the rest is
-straightforward.
-|*)
-
-Lemma pred_pexpr_beq_pred_pexpr :
-  forall pr a b br,
-    PTree.beq beq_pred_pexpr a b = true ->
-    sem_pexpr ctx (from_pred_op a pr) br ->
-    sem_pexpr ctx (from_pred_op b pr) br.
-Proof.
-  induction pr; crush.
-  - destruct_match. inv Heqp0. destruct b0.
-    + unfold get_forest_p' in *.
-      apply PTree.beq_correct with (x := p0) in H.
-      destruct a ! p0; destruct b ! p0; try (exfalso; assumption); auto.
-      eapply sem_pexpr_beq_correct; eauto.
-    + replace br with (negb (negb br)) by (now apply negb_involutive).
-      replace br with (negb (negb br)) in H0 by (now apply negb_involutive).
-      apply sem_pexpr_negate. apply sem_pexpr_negate2 in H0.
-      unfold get_forest_p' in *.
-      apply PTree.beq_correct with (x := p0) in H.
-      destruct a ! p0; destruct b ! p0; try (exfalso; assumption); auto.
-      eapply sem_pexpr_beq_correct; eauto.
-  - inv H0; try inv H4.
-    + eapply IHpr1 in H0; eauto. apply sem_pexpr_Pand_false; tauto.
-    + eapply IHpr2 in H0; eauto. apply sem_pexpr_Pand_false; tauto.
-    + eapply IHpr1 in H3; eauto. eapply IHpr2 in H5; eauto.
-      apply sem_pexpr_Pand_true; auto.
-  - inv H0; try inv H4.
-    + eapply IHpr1 in H0; eauto. apply sem_pexpr_Por_true; tauto.
-    + eapply IHpr2 in H0; eauto. apply sem_pexpr_Por_true; tauto.
-    + eapply IHpr1 in H3; eauto. eapply IHpr2 in H5; eauto.
-      apply sem_pexpr_Por_false; auto.
-Qed.
-
-(*|
-This lemma requires a theorem that equivalence of symbolic predicates means they
-will be.  This further needs three-valued logic to be able to compare arbitrary
-predicates with each other, that will also show that the predicate will also be
-computable.
-|*)
-
-Lemma sem_pred_exec_beq_correct :
-  forall A B (sem: Abstr.ctx -> A -> B -> Prop) p a b r,
-    PTree.beq beq_pred_pexpr a b = true ->
-    sem_pred_expr a sem ctx p r ->
-    sem_pred_expr b sem ctx p r.
-Proof.
-  induction p; intros; inv H0.
-  - constructor; auto. eapply pred_pexpr_beq_pred_pexpr; eauto.
-  - constructor; auto. eapply pred_pexpr_beq_pred_pexpr; eauto.
-  - apply sem_pred_expr_cons_false; eauto.
-    eapply pred_pexpr_beq_pred_pexpr; eauto.
-Qed.
-
-End GENERIC_CONTEXT.
-
-Lemma tree_beq_pred_pexpr :
-  forall a b x,
-    RTree.beq beq_pred_pexpr (forest_preds a) (forest_preds b) = true ->
-    beq_pred_pexpr a #p x b #p x = true.
-Proof.
-  intros. unfold "#p". unfold get_forest_p'.
-  apply PTree.beq_correct with (x := x) in H.
-  destruct_match; destruct_match; auto.
-  unfold beq_pred_pexpr. destruct_match; auto.
-Qed.
-
-Lemma tree_beq_pred_expr :
-  forall a b x,
-    RTree.beq HN.beq_pred_expr (forest_regs a) (forest_regs b) = true ->
-    HN.beq_pred_expr a #r x b #r x = true.
-Proof.
-  intros. unfold "#r" in *.
-  apply PTree.beq_correct with (x := (R_indexed.index x)) in H.
-  unfold RTree.get in *.
-  unfold pred_expr in *.
-  destruct_match; destruct_match; auto.
-  unfold HN.beq_pred_expr. destruct_match; auto.
-Qed.
-
-Section CORRECT.
-
-Context {FUN TFUN: Type}.
-Context (ictx: @ctx FUN) (octx: @ctx TFUN) (HSIM: similar ictx octx).
-
-Lemma abstr_check_correct :
-  forall i' a b cf,
-    (exists ps, forall x, sem_pexpr ictx (get_forest_p' x (forest_preds a)) ps !! x) ->
-    check a b = true ->
-    sem ictx a (i', cf) ->
-    exists ti', sem octx b (ti', cf) /\ match_states i' ti'.
-Proof.
-  intros * EVALUABLE **. unfold check in H. simplify.
-  inv H0. inv H10. inv H11.
-  eexists; split; constructor; auto.
-  - constructor. intros.
-    eapply sem_pred_exec_beq_correct; eauto.
-    eapply sem_pred_expr_corr; eauto. now apply sem_value_corr.
-    eapply HN.beq_pred_expr_correct_top; eauto.
-    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
-    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
-    eapply tree_beq_pred_expr; eauto.
-  - (* This is where three-valued logic would be needed. *)
-    constructor. intros. apply sem_pexpr_beq_correct with (p1 := a #p x0).
-    apply tree_beq_pred_pexpr; auto.
-    apply sem_pexpr_corr with (ictx:=ictx); auto.
-  - eapply sem_pred_exec_beq_correct; eauto.
-    eapply sem_pred_expr_corr; eauto. now apply sem_mem_corr.
-    eapply HN.beq_pred_expr_correct_top; eauto.
-    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
-    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
-    eapply tree_beq_pred_expr; eauto.
-  - eapply sem_pred_exec_beq_correct; eauto.
-    eapply sem_pred_expr_corr; eauto. now apply sem_exit_corr.
-    eapply EHN.beq_pred_expr_correct_top; eauto using check_mutexcl_correct.
-Qed.
-
-(*|
-Proof Sketch:
-
-Two abstract states can be equivalent, without it being obvious that they can
-actually both be executed assuming one can be executed.  One will therefore have
-to add a few more assumptions to makes it possible to execute the other.
-
-It currently assumes that all the predicates in the predicate tree are
-evaluable, which is actually something that can either be checked, or something
-that can be proven constructively.  I believe that it should already be possible
-using the latter, so here it will only be assumed.
-
-Similarly, the current assumption is that mutual exclusivity of predicates is
-being checked within the ``check`` function, which could possibly also be proven
-constructively about the update function.  This is a simpler short-term fix
-though.
-|*)
-
-End CORRECT.
diff --git a/src/hls/GiblePargen.v b/src/hls/GiblePargen.v
index 3000211..2c7bfc8 100644
--- a/src/hls/GiblePargen.v
+++ b/src/hls/GiblePargen.v
@@ -36,6 +36,8 @@ Require Import vericert.hls.Gible.
 Require Import vericert.hls.Predicate.
 Require Import vericert.hls.Abstr.
 Require Import vericert.common.DecEq.
+Require Import vericert.hls.GiblePargenproofEquiv.
+
 Import NE.NonEmptyNotation.
 
 #[local] Open Scope positive.
@@ -80,6 +82,31 @@ Definition predicated_prod {A B: Type} (p1: predicated A) (p2: predicated B) :=
 Definition predicated_map {A B: Type} (f: A -> B) (p: predicated A)
   : predicated B := NE.map (fun x => (fst x, f (snd x))) p.
 
+Lemma NEin_map :
+  forall A B p y (f: A -> B) a,
+    NE.In (p, y) (predicated_map f a) ->
+    exists x, NE.In (p, x) a /\ y = f x.
+Proof.
+  induction a; intros.
+  - inv H. destruct a. econstructor. split; eauto. constructor.
+  - inv H. inv H1. inv H. destruct a. cbn in *. econstructor; econstructor; eauto.
+    constructor; tauto.
+    specialize (IHa H). inv IHa. inv H0.
+    econstructor; econstructor; eauto. constructor; tauto.
+Qed.
+
+Lemma NEin_map2 :
+  forall A B (f: A -> B) a p y,
+    NE.In (p, y) a ->
+    NE.In (p, f y) (predicated_map f a).
+Proof.
+  induction a; crush.
+  inv H. constructor.
+  inv H. inv H1.
+  - constructor; auto.
+  - constructor; eauto.
+Qed.
+
 Definition cons_pred_expr (pel: pred_expr) (tpel: predicated expression_list) :=
   predicated_map (uncurry Econs) (predicated_prod pel tpel).
 
diff --git a/src/hls/GiblePargenproof.v b/src/hls/GiblePargenproof.v
index 0b9bd78..9e58e03 100644
--- a/src/hls/GiblePargenproof.v
+++ b/src/hls/GiblePargenproof.v
@@ -1,6 +1,6 @@
 (*
  * Vericert: Verified high-level synthesis.
- * Copyright (C) 2020-2023 Yann Herklotz <yann@yannherklotz.com>
+ * Copyright (C) 2020-2023 Yann Herklotz <git@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
@@ -29,10 +29,12 @@ Require Import vericert.common.Vericertlib.
 Require Import vericert.hls.GibleSeq.
 Require Import vericert.hls.GiblePar.
 Require Import vericert.hls.Gible.
+Require Import vericert.hls.GiblePargenproofEquiv.
 Require Import vericert.hls.GiblePargen.
 Require Import vericert.hls.Predicate.
 Require Import vericert.hls.Abstr.
 Require Import vericert.common.Monad.
+Require Import vericert.hls.GiblePargenproofForward.
 
 Module Import OptionExtra := MonadExtra(Option).
 
@@ -45,168 +47,7 @@ Module Import OptionExtra := MonadExtra(Option).
 
 Ltac destr := destruct_match; try discriminate; [].
 
-(*|
-==============
-RTLPargenproof
-==============
-
-RTLBlock to abstract translation
-================================
-
-Correctness of translation from RTLBlock to the abstract interpretation
-language.
-|*)
-
-Definition is_regs i := match i with mk_instr_state rs _ _ => rs end.
-Definition is_mem i := match i with mk_instr_state _ _ m => m end.
-Definition is_ps i := match i with mk_instr_state _ p _ => p end.
-
-Definition evaluable {A B C} (sem: ctx -> B -> C -> Prop) (ctx: @ctx A) p := exists b, sem ctx p b.
-
-Definition p_evaluable {A} := @evaluable A _ _ sem_pexpr.
-
-Definition evaluable_expr {A} := @evaluable A _ _ sem_pred.
-
-Definition all_evaluable {A B} (ctx: @ctx A) f_p (l: predicated B) :=
-  forall p y, NE.In (p, y) l -> p_evaluable ctx (from_pred_op f_p p).
-
-Definition all_evaluable2 {A B C} (ctx: @ctx A) (sem: Abstr.ctx -> B -> C -> Prop) (l: predicated B) :=
-  forall p y, NE.In (p, y) l -> evaluable sem ctx y.
-
-Definition pred_forest_evaluable {A} (ctx: @ctx A) (ps: PTree.t pred_pexpr) :=
-  forall i p, ps ! i = Some p -> p_evaluable ctx p.
-
-Definition forest_evaluable {A} (ctx: @ctx A) (f: forest) :=
-  pred_forest_evaluable ctx f.(forest_preds).
-
-(* Lemma all_evaluable2_NEmap : *)
-(*   forall G A (ctx: @ctx G) (f: (pred_op * A) -> (pred_op * pred_expression)) (x: predicated A), *)
-(*     all_evaluable2 ctx sem_pred (NE.map f x). *)
-(* Proof. *)
-(*   induction x. *)
-
-Lemma all_evaluable_cons :
-  forall A B pr ctx b a,
-    all_evaluable ctx pr (NE.cons a b) ->
-    @all_evaluable A B ctx pr b.
-Proof.
-  unfold all_evaluable; intros.
-  enough (NE.In (p, y) (NE.cons a b)); eauto.
-  constructor; tauto.
-Qed.
-
-Lemma all_evaluable2_cons :
-  forall A B C sem ctx b a,
-    all_evaluable2 ctx sem (NE.cons a b) ->
-    @all_evaluable2 A B C ctx sem b.
-Proof.
-  unfold all_evaluable2; intros.
-  enough (NE.In (p, y) (NE.cons a b)); eauto.
-  constructor; tauto.
-Qed.
-
-Lemma all_evaluable_cons2 :
-  forall A B pr ctx b a p,
-    @all_evaluable A B ctx pr (NE.cons (p, a) b) ->
-    p_evaluable ctx (from_pred_op pr p).
-Proof.
-  unfold all_evaluable; intros.
-  eapply H. constructor; eauto.
-Qed.
-
-Lemma all_evaluable2_cons2 :
-  forall A B C sem ctx b a p,
-    @all_evaluable2 A B C ctx sem (NE.cons (p, a) b) ->
-    evaluable sem ctx a.
-Proof.
-  unfold all_evaluable; intros.
-  eapply H. constructor; eauto.
-Qed.
-
-Lemma all_evaluable_cons3 :
-  forall A B pr ctx b p a,
-    all_evaluable ctx pr b ->
-    p_evaluable ctx (from_pred_op pr p) ->
-    @all_evaluable A B ctx pr (NE.cons (p, a) b).
-Proof.
-  unfold all_evaluable; intros. inv H1. inv H3. inv H1. auto.
-  eauto.
-Qed.
-
-Lemma all_evaluable_singleton :
-  forall A B pr ctx b p,
-    @all_evaluable A B ctx pr (NE.singleton (p, b)) ->
-    p_evaluable ctx (from_pred_op pr p).
-Proof.
-  unfold all_evaluable; intros. eapply H. constructor.
-Qed.
-
-Lemma get_forest_p_evaluable :
-  forall A (ctx: @ctx A) f r,
-    forest_evaluable ctx f ->
-    p_evaluable ctx (f #p r).
-Proof.
-  intros. unfold "#p", get_forest_p'.
-  destruct_match. unfold forest_evaluable in *.
-  unfold pred_forest_evaluable in *. eauto.
-  unfold p_evaluable, evaluable. eexists.
-  constructor. constructor.
-Qed.
-
-Lemma set_forest_p_evaluable :
-  forall A (ctx: @ctx A) f r p,
-    forest_evaluable ctx f ->
-    p_evaluable ctx p ->
-    forest_evaluable ctx (f #p r <- p).
-Proof.
-  unfold forest_evaluable, pred_forest_evaluable; intros.
-  destruct (peq i r); subst.
-  - rewrite forest_pred_gss2 in H1. now inv H1.
-  - rewrite forest_pred_gso2 in H1 by auto; eauto.
-Qed.
-
-Definition check_dest i r' :=
-  match i with
-  | RBop p op rl r => (r =? r')%positive
-  | RBload p chunk addr rl r => (r =? r')%positive
-  | _ => false
-  end.
-
-Lemma check_dest_dec i r :
-  {check_dest i r = true} + {check_dest i r = false}.
-Proof. destruct (check_dest i r); tauto. Qed.
-
-Fixpoint check_dest_l l r :=
-  match l with
-  | nil => false
-  | a :: b => check_dest a r || check_dest_l b r
-  end.
-
-Lemma check_dest_l_forall :
-  forall l r,
-  check_dest_l l r = false ->
-  Forall (fun x => check_dest x r = false) l.
-Proof. induction l; crush. Qed.
-
-Lemma check_dest_l_dec i r :
-  {check_dest_l i r = true} + {check_dest_l i r = false}.
-Proof. destruct (check_dest_l i r); tauto. Qed.
-
-Lemma match_states_list :
-  forall A (rs: Regmap.t A) rs',
-  (forall r, rs !! r = rs' !! r) ->
-  forall l, rs ## l = rs' ## l.
-Proof. induction l; crush. Qed.
-
-Lemma PTree_matches :
-  forall A (v: A) res rs rs',
-  (forall r, rs !! r = rs' !! r) ->
-  forall x, (Regmap.set res v rs) !! x = (Regmap.set res v rs') !! x.
-Proof.
-  intros; destruct (Pos.eq_dec x res); subst;
-  [ repeat rewrite Regmap.gss by auto
-  | repeat rewrite Regmap.gso by auto ]; auto.
-Qed.
+Definition state_lessdef := GiblePargenproofEquiv.match_states.
 
 Definition match_prog (prog : GibleSeq.program) (tprog : GiblePar.program) :=
   match_program (fun cu f tf => transl_fundef f = Errors.OK tf) eq prog tprog.
@@ -355,13 +196,80 @@ Section CORRECTNESS.
   Qed.
   Hint Resolve eval_addressing_eq : rtlgp.
 
-  Lemma ge_preserved_lem:
+(*|
+==============
+RTLPargenproof
+==============
+
+RTLBlock to abstract translation
+================================
+
+Correctness of translation from RTLBlock to the abstract interpretation
+language.
+|*)
+
+  Lemma abstr_seq_reverse_correct :
+    forall sp x i i' ti cf x',
+      abstract_sequence x = Some x' ->
+      sem (mk_ctx i sp ge) x' (i', (Some cf)) ->
+      state_lessdef i ti ->
+     exists ti', SeqBB.step ge sp (Iexec ti) x (Iterm ti' cf)
+             /\ state_lessdef i' ti'.
+  Proof.
+
+(*|
+Proof Sketch:
+
+We do an induction over the list of instructions ``x``.  This is trivial for the
+empty case and then for the inductive case we know that there exists an
+execution that matches the abstract execution, so we need to know that adding
+another instructions to it will still mean that the execution will result in the
+same value.
+
+Arithmetic operations will be a problem because we will have to show that these
+can be executed.  However, this should mostly be a problem in the abstract state
+comparison, because there two abstract states can be equal without one being
+evaluable.
+|*)
+
+  Admitted.
+
+(*|
+This is the top-level lemma which uses the following proofs to complete the
+square:
+
+- ``abstr_sequence_correct``: This is the lemma that states the forward
+  translation form ``GibleSeq`` to ``Abstr`` was correct.
+- ``abstr_check_correct``: This is the lemma that states that if a check between
+  two ``Abstr`` programs succeeds, that they will also behave the same.  This
+  depends on the SAT solver correctness, as the predicates might be
+  syntactically different to each other.
+- ``abstr_seq_reverse_correct``: This is the lemma that shows that the backwards
+  simulation between the abstract translation and the concrete execution also
+  holds.  We only have a translation from the concrete into the abstract, but
+  then prove that if we have an execution in the abstract, we can observe that
+  same execution in the concrete.
+- ``seqbb_step_parbb_step``: Finally, this lemma states that the parallel
+  execution of the basic block is equivalent to the sequential execution of the
+  concatenation of that parallel block.  This is because even in the translation
+  to HTL, the Verilog semantics are sequential within a clock cycle, but will
+  then be parallelised by the synthesis tool.  The argument for why this is
+  still useful is because we are identifying and scheduling instructions into
+  clock cycles.
+|*)
+
+  Definition local_abstr_check_correct :=
+    @abstr_check_correct GibleSeq.fundef GiblePar.fundef.
+
+  Definition local_abstr_check_correct2 :=
+    @abstr_check_correct GibleSeq.fundef GibleSeq.fundef.
+
+  Lemma ge_preserved_local :
     ge_preserved ge tge.
-  Proof using TRANSL.
-    unfold ge_preserved.
-    eauto with rtlgp.
+  Proof.
+    unfold ge_preserved; 
+    eauto using eval_op_eq, eval_addressing_eq.
   Qed.
-  Hint Resolve ge_preserved_lem : rtlgp.
 
   Lemma lessdef_regmap_optget:
     forall or rs rs',
@@ -533,1848 +441,13 @@ Proof. induction 2; try rewrite H; eauto with barg. Qed.
     eapply IHx; eauto.
   Qed.
 
-  Lemma eval_predf_negate :
-    forall ps p,
-      eval_predf ps (negate p) = negb (eval_predf ps p).
-  Proof.
-    unfold eval_predf; intros. rewrite negate_correct. auto.
-  Qed.
-
-  Lemma is_truthy_negate :
-    forall ps p pred,
-      truthy ps p ->
-      falsy ps (combine_pred (Some (negate (Option.default T p))) pred).
-  Proof.
-    inversion 1; subst; simplify.
-    - destruct pred; constructor; auto.
-    - destruct pred; constructor.
-      rewrite eval_predf_Pand. rewrite eval_predf_negate. rewrite H0. auto.
-      rewrite eval_predf_negate. rewrite H0. auto.
-  Qed.
-
-  Lemma sem_pred_expr_NEapp :
-    forall A B C sem f_p ctx a b v,
-      sem_pred_expr f_p sem ctx a v ->
-      @sem_pred_expr A B C f_p sem ctx (NE.app a b) v.
-  Proof.
-    induction a; crush.
-    - inv H. constructor; auto.
-    - inv H. constructor; eauto.
-      eapply sem_pred_expr_cons_false; eauto.
-  Qed.
-
-  Lemma sem_pred_expr_NEapp2 :
-    forall A B C sem f_p ctx a b v ps,
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) (ps !! x)) ->
-      (forall x, NE.In x a -> eval_predf ps (fst x) = false) ->
-      sem_pred_expr f_p sem ctx b v ->
-      @sem_pred_expr A B C f_p sem ctx (NE.app a b) v.
-  Proof.
-    induction a; crush.
-    - assert (IN: NE.In a (NE.singleton a)) by constructor.
-      specialize (H0 _ IN). destruct a.
-      eapply sem_pred_expr_cons_false; eauto. cbn [fst] in *.
-      eapply sem_pexpr_eval; eauto.
-    - assert (NE.In a (NE.cons a a0)) by (constructor; tauto).
-      apply H0 in H2.
-      destruct a. cbn [fst] in *.
-      eapply sem_pred_expr_cons_false.
-      eapply sem_pexpr_eval; eauto. eapply IHa; eauto.
-      intros. eapply H0. constructor; tauto.
-  Qed.
-
-  Lemma sem_pred_expr_NEapp3 :
-    forall A B C sem f_p ctx (a b: predicated B) v,
-      (forall x, NE.In x a -> sem_pexpr ctx (from_pred_op f_p (fst x)) false) ->
-      sem_pred_expr f_p sem ctx b v ->
-      @sem_pred_expr A B C f_p sem ctx (NE.app a b) v.
-  Proof.
-    induction a; crush.
-    - assert (IN: NE.In a (NE.singleton a)) by constructor.
-      specialize (H _ IN). destruct a.
-      eapply sem_pred_expr_cons_false; eauto.
-    - assert (NE.In a (NE.cons a a0)) by (constructor; tauto).
-      apply H in H1.
-      destruct a. cbn [fst] in *.
-      eapply sem_pred_expr_cons_false; auto.
-      eapply IHa; eauto.
-      intros. eapply H. constructor; tauto.
-  Qed.
-
-  Lemma sem_pred_expr_map_not :
-    forall A p ps y x0,
-      eval_predf ps p = false ->
-      NE.In x0 (NE.map (fun x => (p ∧ fst x, snd x)) y) ->
-      eval_predf ps (@fst _ A x0) = false.
-  Proof.
-    induction y; crush.
-    - inv H0. simplify. rewrite eval_predf_Pand. rewrite H. auto.
-    - inv H0. inv H2. cbn -[eval_predf]. rewrite eval_predf_Pand.
-      rewrite H. auto. eauto.
-  Qed.
-
-  Lemma sem_pred_expr_map_Pand :
-    forall A B C sem ctx f_p ps x v p,
-      (forall x : positive, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
-      eval_predf ps p = true ->
-      sem_pred_expr f_p sem ctx x v ->
-      @sem_pred_expr A B C f_p sem ctx
-        (NE.map (fun x0 => (p ∧ fst x0, snd x0)) x) v.
-  Proof.
-    induction x; crush.
-    inv H1. simplify. constructor; eauto.
-    simplify. replace true with (true && true) by auto.
-    constructor; auto.
-    eapply sem_pexpr_eval; eauto.
-    inv H1. simplify. constructor; eauto.
-    simplify. replace true with (true && true) by auto.
-    constructor; auto.
-    eapply sem_pexpr_eval; eauto.
-    eapply sem_pred_expr_cons_false. cbn.
-    replace false with (true && false) by auto. apply sem_pexpr_Pand; auto.
-    eapply sem_pexpr_eval; eauto. eauto.
-  Qed.
-
-  Lemma sem_pred_expr_app_predicated :
-    forall A B C sem ctx f_p y x v p ps,
-      sem_pred_expr f_p sem ctx x v ->
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) (ps !! x)) ->
-      eval_predf ps p = true ->
-      @sem_pred_expr A B C f_p sem ctx (app_predicated p y x) v.
-  Proof.
-    intros * SEM PS EVAL. unfold app_predicated.
-    eapply sem_pred_expr_NEapp2; eauto.
-    intros. eapply sem_pred_expr_map_not; eauto.
-    rewrite eval_predf_negate. rewrite EVAL. auto.
-    eapply sem_pred_expr_map_Pand; eauto.
-  Qed.
-
-  Lemma sem_pred_expr_app_predicated_false :
-    forall A B C sem ctx f_p y x v p ps,
-      sem_pred_expr f_p sem ctx y v ->
-      (forall x, sem_pexpr ctx (get_forest_p' x f_p) (ps !! x)) ->
-      eval_predf ps p = false ->
-      @sem_pred_expr A B C f_p sem ctx (app_predicated p y x) v.
-  Admitted.
-
-  Lemma sem_pred_expr_prune_predicated :
-    forall A B C sem ctx f_p y x v,
-      sem_pred_expr f_p sem ctx x v ->
-      prune_predicated x = Some y ->
-      @sem_pred_expr A B C f_p sem ctx y v.
-  Proof.
-    intros * SEM PRUNE. unfold prune_predicated in *.
-    Admitted.
-
-  Inductive sem_ident {B A: Type} (c: @ctx B) (a: A): A -> Prop :=
-  | sem_ident_intro : sem_ident c a a.
-
-  Lemma sem_pred_expr_pred_ret :
-    forall G A (ctx: @Abstr.ctx G) (i: A) ps,
-      sem_pred_expr ps sem_ident ctx (pred_ret i) i.
-  Proof. intros; constructor; constructor. Qed.
-
-  Lemma sem_pred_expr_ident :
-    forall G A B ps (ctx: @Abstr.ctx G) (l: predicated A) (s: @Abstr.ctx G -> A -> B -> Prop) l_,
-      sem_pred_expr ps sem_ident ctx l l_ ->
-      forall (v: B),
-        s ctx l_ v ->
-        sem_pred_expr ps s ctx l v.
-  Proof.
-    induction 1.
-    - intros. constructor; auto. inv H0. auto.
-    - intros. apply sem_pred_expr_cons_false; auto.
-    - intros. inv H0. constructor; auto.
-  Qed.
-
-  Lemma sem_pred_expr_ident2 :
-    forall G A B ps (ctx: @Abstr.ctx G) (l: predicated A) (s: @Abstr.ctx G -> A -> B -> Prop) (v: B),
-        sem_pred_expr ps s ctx l v ->
-        exists l_, sem_pred_expr ps sem_ident ctx l l_ /\ s ctx l_ v.
-  Proof.
-    induction 1.
-    - exists e; split; auto. constructor; auto. constructor.
-    - inversion_clear IHsem_pred_expr as [x IH].
-      inversion_clear IH as [SEM EVALS].
-      exists x; split; auto. apply sem_pred_expr_cons_false; auto.
-    - exists e; split; auto; constructor; auto; constructor.
-  Qed.
-
-  Fixpoint of_elist (e: expression_list): list expression :=
-    match e with
-    | Econs a b => a :: of_elist b
-    | Enil => nil
-    end.
-
-  Fixpoint to_elist (e: list expression): expression_list :=
-    match e with
-    | a :: b => Econs a (to_elist b)
-    | nil => Enil
-    end.
-
-  Lemma sem_val_list_elist :
-    forall G (ctx: @Abstr.ctx G) l j,
-      sem_val_list ctx (to_elist l) j ->
-      Forall2 (sem_value ctx) l j.
-  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
-
-  Lemma sem_val_list_elist2 :
-    forall G (ctx: @Abstr.ctx G) l j,
-      Forall2 (sem_value ctx) l j ->
-      sem_val_list ctx (to_elist l) j.
-  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
-
-  Lemma sem_val_list_elist3 :
-    forall G (ctx: @Abstr.ctx G) l j,
-      sem_val_list ctx l j ->
-      Forall2 (sem_value ctx) (of_elist l) j.
-  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
-
-  Lemma sem_val_list_elist4 :
-    forall G (ctx: @Abstr.ctx G) l j,
-      Forall2 (sem_value ctx) (of_elist l) j ->
-      sem_val_list ctx l j.
-  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
-
-  Lemma sem_pred_expr_predicated_map :
-    forall A B C pr (f: C -> B) ctx (pred: predicated C) (pred': C),
-      sem_pred_expr pr sem_ident ctx pred pred' ->
-      @sem_pred_expr A _ _ pr sem_ident ctx (predicated_map f pred) (f pred').
-  Proof.
-    induction pred; unfold predicated_map; intros.
-    - inv H. inv H3. constructor; eauto. constructor.
-    - inv H. inv H5. constructor; eauto. constructor.
-      eapply sem_pred_expr_cons_false; eauto.
-  Qed.
-
-  Lemma NEapp_NEmap :
-    forall A B (f: A -> B) a b,
-      NE.map f (NE.app a b) = NE.app (NE.map f a) (NE.map f b).
-  Proof. induction a; crush. Qed.
-
-  Lemma sem_pred_expr_predicated_prod :
-    forall A B C pr ctx (a: predicated C) (b: predicated B) a' b',
-      sem_pred_expr pr sem_ident ctx a a' ->
-      sem_pred_expr pr sem_ident ctx b b' ->
-      @sem_pred_expr A _ _ pr sem_ident ctx (predicated_prod a b) (a', b').
-  Proof.
-    induction a; intros.
-    - inv H. inv H4. unfold predicated_prod.
-      generalize dependent b. induction b; intros.
-      + cbn. destruct_match. inv Heqp. inv H0. inv H6.
-        constructor. simplify. replace true with (true && true) by auto.
-        eapply sem_pexpr_Pand; eauto. constructor.
-      + inv H0. inv H6. cbn. constructor; cbn.
-        replace true with (true && true) by auto.
-        constructor; auto. constructor.
-        eapply sem_pred_expr_cons_false; eauto. cbn.
-        replace false with (true && false) by auto.
-        apply sem_pexpr_Pand; auto.
-    - unfold predicated_prod. simplify.
-      rewrite NEapp_NEmap.
-      inv H. eapply sem_pred_expr_NEapp.
-      { induction b; crush.
-        destruct a. inv H0. constructor.
-        replace true with (true && true) by auto.
-        eapply sem_pexpr_Pand; auto. inv H6. inv H7.
-        constructor.
-
-        destruct a. inv H0. constructor.
-        replace true with (true && true) by auto.
-        constructor; auto. inv H8. inv H6. constructor.
-
-        specialize (IHb H8). eapply sem_pred_expr_cons_false; auto.
-        replace false with (true && false) by auto.
-        apply sem_pexpr_Pand; auto.
-      }
-      { exploit IHa. eauto. eauto. intros.
-        unfold predicated_prod in *.
-        eapply sem_pred_expr_NEapp3; eauto; [].
-        clear H. clear H0.
-        induction b.
-        { intros. inv H. destruct a. simpl.
-          constructor; tauto. }
-        { intros. inv H. inv H1. destruct a. simpl.
-          constructor; tauto. eauto. } }
-  Qed.
-
-  Lemma sem_pred_expr_seq_app :
-    forall G A B (f: predicated (A -> B))
-        ps (ctx: @ctx G) l f_ l_,
-      sem_pred_expr ps sem_ident ctx l l_ ->
-      sem_pred_expr ps sem_ident ctx f f_ ->
-      sem_pred_expr ps sem_ident ctx (seq_app f l) (f_ l_).
-  Proof.
-    unfold seq_app; intros.
-    remember (fun x : (A -> B) * A => fst x (snd x)) as app.
-    replace (f_ l_) with (app (f_, l_)) by (rewrite Heqapp; auto).
-    eapply sem_pred_expr_predicated_map. eapply sem_pred_expr_predicated_prod; auto.
-  Qed.
-
-  Lemma sem_pred_expr_map :
-    forall A B C (ctx: @ctx A) ps (f: B -> C) y v,
-      sem_pred_expr ps sem_ident ctx y v ->
-      sem_pred_expr ps sem_ident ctx (NE.map (fun x => (fst x, f (snd x))) y) (f v).
-  Proof.
-    induction y; crush. inv H. constructor; crush. inv H3. constructor.
-    inv H. inv H5. constructor; eauto. constructor.
-    eapply sem_pred_expr_cons_false; eauto.
-  Qed.
-
-  Lemma sem_pred_expr_flap :
-    forall G A B C (f: predicated (A -> B -> C))
-        ps (ctx: @ctx G) l f_,
-      sem_pred_expr ps sem_ident ctx f f_ ->
-      sem_pred_expr ps sem_ident ctx (flap f l) (f_ l).
-  Proof.
-    induction f. unfold flap2; intros. inv H. inv H3.
-    constructor; eauto. constructor.
-    intros. inv H. cbn.
-    constructor; eauto. inv H5. constructor.
-    eapply sem_pred_expr_cons_false; eauto.
-   Qed.
-
-  Lemma sem_pred_expr_flap2 :
-    forall G A B C (f: predicated (A -> B -> C))
-        ps (ctx: @ctx G) l1 l2 f_,
-      sem_pred_expr ps sem_ident ctx f f_ ->
-      sem_pred_expr ps sem_ident ctx (flap2 f l1 l2) (f_ l1 l2).
-  Proof.
-    induction f. unfold flap2; intros. inv H. inv H3.
-    constructor; eauto. constructor.
-    intros. inv H. cbn.
-    constructor; eauto. inv H5. constructor.
-    eapply sem_pred_expr_cons_false; eauto.
-  Qed.
-
-  Lemma sem_pred_expr_seq_app_val :
-    forall G A B V (s: @Abstr.ctx G -> B -> V -> Prop)
-        (f: predicated (A -> B))
-        ps ctx l v f_ l_,
-      sem_pred_expr ps sem_ident ctx l l_ ->
-      sem_pred_expr ps sem_ident ctx f f_ ->
-      s ctx (f_ l_) v ->
-      sem_pred_expr ps s ctx (seq_app f l) v.
-  Proof.
-    intros. eapply sem_pred_expr_ident; [|eassumption].
-    eapply sem_pred_expr_seq_app; eauto.
-  Qed.
-
-  Fixpoint Eapp a b :=
-    match a with
-    | Enil => b
-    | Econs ax axs => Econs ax (Eapp axs b)
-    end.
-
-  Lemma Eapp_right_nil :
-    forall a, Eapp a Enil = a.
-  Proof. induction a; cbn; try rewrite IHa; auto. Qed.
-
-  Lemma Eapp_left_nil :
-    forall a, Eapp Enil a = a.
-  Proof. auto. Qed.
-
-  Lemma sem_pred_expr_cons_pred_expr :
-    forall A (ctx: @ctx A) pr s s' a e,
-      sem_pred_expr pr sem_ident ctx s s' ->
-      sem_pred_expr pr sem_ident ctx a e ->
-      sem_pred_expr pr sem_ident ctx (cons_pred_expr a s) (Econs e s').
-  Proof.
-    intros. unfold cons_pred_expr.
-    replace (Econs e s') with ((uncurry Econs) (e, s')) by auto.
-    eapply sem_pred_expr_predicated_map.
-    eapply sem_pred_expr_predicated_prod; eauto.
-  Qed.
-
-  Lemma evaluable_singleton :
-    forall A B ctx fp r,
-      @all_evaluable A B ctx fp (NE.singleton (T, r)).
-  Proof.
-    unfold all_evaluable, evaluable; intros.
-    inv H. simpl. exists true. constructor.
-  Qed.
-
-Lemma evaluable_negate :
-  forall G (ctx: @ctx G) p,
-    p_evaluable ctx p ->
-    p_evaluable ctx (¬ p).
-Proof.
-  unfold p_evaluable, evaluable in *; intros.
-  inv H. eapply sem_pexpr_negate in H0. econstructor; eauto.
-Qed.
-
-Lemma predicated_evaluable :
-  forall G (ctx: @ctx G) ps (p: pred_op),
-    pred_forest_evaluable ctx ps ->
-    p_evaluable ctx (from_pred_op ps p).
-Proof.
-  unfold pred_forest_evaluable; intros. induction p; intros; cbn.
-  - repeat destruct_match; subst; unfold get_forest_p'.
-    destruct_match. eapply H; eauto. econstructor. constructor. constructor.
-    eapply evaluable_negate.
-    destruct_match. eapply H; eauto. econstructor. constructor. constructor.
-  - repeat econstructor.
-  - repeat econstructor.
-  - inv IHp1. inv IHp2. econstructor. apply sem_pexpr_Pand; eauto.
-  - inv IHp1. inv IHp2. econstructor. apply sem_pexpr_Por; eauto.
-Qed.
-
-Lemma predicated_evaluable_all :
-  forall A G (ctx: @ctx G) ps (p: predicated A),
-    pred_forest_evaluable ctx ps ->
-    all_evaluable ctx ps p.
-Proof.
-  unfold all_evaluable; intros.
-  eapply predicated_evaluable. eauto.
-Qed.
-
-Lemma predicated_evaluable_all_list :
-  forall A G (ctx: @ctx G) ps (p: list (predicated A)),
-    pred_forest_evaluable ctx ps ->
-    Forall (all_evaluable ctx ps) p.
-Proof.
-  induction p.
-  - intros. constructor.
-  - intros. constructor; eauto. apply predicated_evaluable_all; auto.
-Qed.
-
-Hint Resolve evaluable_singleton : core.
-Hint Resolve predicated_evaluable : core.
-Hint Resolve predicated_evaluable_all : core.
-Hint Resolve predicated_evaluable_all_list : core.
-
-  Lemma sem_pred_expr_fold_right :
-    forall A pr ctx s a a' s',
-      sem_pred_expr pr sem_ident ctx s s' ->
-      Forall2 (sem_pred_expr pr sem_ident ctx) (NE.to_list a) (of_elist a') ->
-      @sem_pred_expr A _ _ pr sem_ident ctx (NE.fold_right cons_pred_expr s a) (Eapp a' s').
-  Proof.
-    induction a; crush. inv H0. inv H5. destruct a'; crush. destruct a'; crush.
-    inv H3. eapply sem_pred_expr_cons_pred_expr; eauto.
-    inv H0. destruct a'; crush. inv H3.
-    eapply sem_pred_expr_cons_pred_expr; eauto.
-  Qed.
-
-  Lemma sem_pred_expr_fold_right2 :
-    forall A pr ctx s a a' s',
-      sem_pred_expr pr sem_ident ctx s s' ->
-      @sem_pred_expr A _ _ pr sem_ident ctx (NE.fold_right cons_pred_expr s a) (Eapp a' s') ->
-      Forall2 (sem_pred_expr pr sem_ident ctx) (NE.to_list a) (of_elist a').
-  Proof.
-    induction a. Admitted.
-
-  Lemma NEof_list_some :
-    forall A a a' (e: A),
-      NE.of_list a = Some a' ->
-      NE.of_list (e :: a) = Some (NE.cons e a').
-  Proof.
-    induction a; [crush|].
-    intros.
-    cbn in H. destruct a0. inv H. auto.
-    destruct_match; [|discriminate].
-    inv H. specialize (IHa n a ltac:(trivial)).
-    cbn. destruct_match. unfold NE.of_list in IHa.
-    fold (@NE.of_list A) in IHa. rewrite IHa in Heqo0. inv Heqo0. auto.
-    unfold NE.of_list in IHa. fold (@NE.of_list A) in IHa. rewrite IHa in Heqo0. inv Heqo0.
-  Qed.
-
-  Lemma NEof_list_contra :
-    forall A b (a: A),
-      ~ NE.of_list (a :: b) = None.
-  Proof.
-    induction b; try solve [crush].
-    intros.
-    specialize (IHb a).
-    enough (X: exists x, NE.of_list (a :: b) = Some x).
-    inversion_clear X as [x X'].
-    erewrite NEof_list_some; eauto; discriminate.
-    destruct (NE.of_list (a :: b)) eqn:?; [eauto|contradiction].
-  Qed.
-
-  Lemma NEof_list_exists :
-    forall A b (a: A),
-      exists x, NE.of_list (a :: b) = Some x.
-  Proof.
-    intros. pose proof (NEof_list_contra _ b a).
-    destruct (NE.of_list (a :: b)); try contradiction.
-    eauto.
-  Qed.
-
-  Lemma NEof_list_exists2 :
-    forall A b (a c: A),
-      exists x,
-        NE.of_list (c :: a :: b) = Some (NE.cons c x)
-        /\ NE.of_list (a :: b) = Some x.
-  Proof.
-    intros. pose proof (NEof_list_exists _ b a).
-    inversion_clear H as [x B].
-    econstructor; split; eauto.
-    eapply NEof_list_some; eauto.
-  Qed.
-
-  Lemma NEof_list_to_list :
-    forall A (x: list A) y,
-      NE.of_list x = Some y ->
-      NE.to_list y = x.
-  Proof.
-    induction x; [crush|].
-    intros. destruct x; [crush|].
-    pose proof (NEof_list_exists2 _ x a0 a).
-    inversion_clear H0 as [x0 [HN1 HN2]]. rewrite HN1 in H. inv H.
-    cbn. f_equal. eauto.
-  Qed.
-
-  Lemma sem_pred_expr_merge :
-    forall G (ctx: @Abstr.ctx G) ps l args,
-      Forall2 (sem_pred_expr ps sem_ident ctx) args l ->
-      sem_pred_expr ps sem_ident ctx (merge args) (to_elist l).
-  Proof.
-    induction l; intros.
-    - inv H. cbn; repeat constructor.
-    - inv H. cbn. unfold merge. Admitted.
-
-  Lemma sem_pred_expr_merge2 :
-    forall A (ctx: @ctx A) pr l l',
-      sem_pred_expr pr sem_ident ctx (merge l) l' ->
-      Forall2 (sem_pred_expr pr sem_ident ctx) l (of_elist l').
-  Proof.
-    induction l; crush.
-    - unfold merge in *; cbn in *.
-      inv H. inv H5. constructor.
-    - unfold merge in H.
-      pose proof (NEof_list_exists _ l a) as Y.
-      inversion_clear Y as [x HNE]. rewrite HNE in H.
-      erewrite <- (NEof_list_to_list _ (a :: l)) by eassumption.
-      apply sem_pred_expr_fold_right2 with (s := (NE.singleton (T, Enil))) (s' := Enil).
-      repeat constructor.
-      rewrite Eapp_right_nil. auto.
-  Qed.
-
-  Lemma sem_merge_list :
-    forall A ctx f rs ps m args,
-      sem ctx f ((mk_instr_state rs ps m), None) ->
-      @sem_pred_expr A _ _ (forest_preds f) sem_val_list ctx
-        (merge (list_translation args f)) (rs ## args).
-  Proof.
-    induction args; crush. cbn. constructor; constructor.
-    unfold merge. specialize (IHargs H).
-    eapply sem_pred_expr_ident2 in IHargs.
-    inversion_clear IHargs as [l_ [HSEM HVAL]].
-    destruct_match; [|exfalso; eapply NEof_list_contra; eauto].
-    destruct args; cbn -[NE.of_list] in *.
-    - unfold merge in *. simplify.
-      inv H. inv H6. specialize (H a).
-      eapply sem_pred_expr_ident2 in H.
-      inversion_clear H as [l_2 [HSEM2 HVAL2]].
-      unfold cons_pred_expr.
-      eapply sem_pred_expr_ident.
-      eapply sem_pred_expr_predicated_map.
-      eapply sem_pred_expr_predicated_prod; [eassumption|repeat constructor].
-      repeat constructor; auto.
-    - pose proof (NEof_list_exists2 _ (list_translation args f) (f #r (Reg r)) (f #r (Reg a))) as Y.
-      inversion_clear Y as [x [Y1 Y2]]. rewrite Heqo in Y1. inv Y1.
-      inversion_clear H as [? ? ? ? ? ? REG PRED MEM EXIT].
-      inversion_clear REG as [? ? ? REG'].
-      inversion_clear PRED as [? ? ? PRED'].
-      pose proof (REG' a) as REGa. pose proof (REG' r) as REGr.
-      exploit sem_pred_expr_ident2; [exact REGa|].
-      intro REGI'; inversion_clear REGI' as [a' [SEMa SEMa']].
-      exploit sem_pred_expr_ident2; [exact REGr|].
-      intro REGI'; inversion_clear REGI' as [r' [SEMr SEMr']].
-      apply sem_pred_expr_ident with (l_ := Econs a' l_); [|constructor; auto].
-      replace (Econs a' l_) with (Eapp (Econs a' l_) Enil) by (now apply Eapp_right_nil).
-      apply sem_pred_expr_fold_right; eauto.
-      repeat constructor.
-      constructor; eauto.
-      erewrite NEof_list_to_list; eauto.
-      eapply sem_pred_expr_merge2; auto.
-  Qed.
-
-  Lemma sem_pred_expr_list_translation :
-    forall G ctx args f i,
-      @sem G ctx f (i, None) ->
-      exists l,
-        Forall2 (sem_pred_expr (forest_preds f) sem_ident ctx) (list_translation args f) l
-        /\ sem_val_list ctx (to_elist l) ((is_rs i)##args).
-  Proof.
-    induction args; intros.
-    - exists nil; cbn; split; auto; constructor.
-    - exploit IHargs; try eassumption; intro EX.
-      inversion_clear EX as [l [FOR SEM]].
-      destruct i as [rs' m' ps'].
-      inversion_clear H as [? ? ? ? ? ? REGSET PREDSET MEM EXIT].
-      inversion_clear REGSET as [? ? ? REG].
-      pose proof (REG a).
-      exploit sem_pred_expr_ident2; eauto; intro IDENT.
-      inversion_clear IDENT as [l_ [SEMP SV]].
-      exists (l_ :: l). split. constructor; auto.
-      cbn; constructor; auto.
-  Qed.
-
-Lemma evaluable_and_true :
-  forall G (ctx: @ctx G) ps p,
-    p_evaluable ctx (from_pred_op ps p) ->
-    p_evaluable ctx (from_pred_op ps (p ∧ T)).
-Proof.
-  intros. unfold evaluable in *. inv H. exists (x && true). cbn.
-  apply sem_pexpr_Pand; auto. constructor.
-Qed.
-
-Lemma NEin_map :
-  forall A B p y (f: A -> B) a,
-    NE.In (p, y) (predicated_map f a) ->
-    exists x, NE.In (p, x) a /\ y = f x.
-Proof.
-  induction a; intros.
-  - inv H. destruct a. econstructor. split; eauto. constructor.
-  - inv H. inv H1. inv H. destruct a. cbn in *. econstructor; econstructor; eauto.
-    constructor; tauto.
-    specialize (IHa H). inv IHa. inv H0.
-    econstructor; econstructor; eauto. constructor; tauto.
-Qed.
-
-Lemma NEin_map2 :
-  forall A B (f: A -> B) a p y,
-    NE.In (p, y) a ->
-    NE.In (p, f y) (predicated_map f a).
-Proof.
-  induction a; crush.
-  inv H. constructor.
-  inv H. inv H1.
-  - constructor; auto.
-  - constructor; eauto.
-Qed.
-
-Lemma all_evaluable_predicated_map :
-  forall A B G (ctx: @ctx G) ps (f: A -> B) p,
-    all_evaluable ctx ps p ->
-    all_evaluable ctx ps (predicated_map f p).
-Proof.
-  induction p.
-  - unfold all_evaluable; intros.
-    exploit NEin_map; eauto; intros. inv H1. inv H2.
-    eapply H; eauto.
-  - intros. cbn.
-    eapply all_evaluable_cons3. eapply IHp. eapply all_evaluable_cons; eauto.
-    cbn. destruct a. cbn in *. eapply all_evaluable_cons2; eauto.
-Qed.
-
-Lemma all_evaluable_predicated_map2 :
-  forall A B G (ctx: @ctx G) ps (f: A -> B) p,
-    all_evaluable ctx ps (predicated_map f p) ->
-    all_evaluable ctx ps p.
-Proof.
-  induction p.
-  - unfold all_evaluable in *; intros.
-    eapply H. eapply NEin_map2; eauto.
-  - intros. cbn. destruct a.
-    cbn in H. pose proof H. eapply all_evaluable_cons in H; eauto.
-    eapply all_evaluable_cons2 in H0; eauto.
-    unfold all_evaluable. specialize (IHp H).
-    unfold all_evaluable in IHp.
-    intros. inv H1. inv H3. inv H1; eauto.
-    specialize (IHp _ _ H1). eauto.
-Qed.
-
-Lemma all_evaluable_map_and :
-  forall A B G (ctx: @ctx G) ps (a: NE.non_empty ((pred_op * A) * (pred_op * B))),
-    (forall p1 x p2 y,
-       NE.In ((p1, x), (p2, y)) a ->
-            p_evaluable ctx (from_pred_op ps p1)
-            /\ p_evaluable ctx (from_pred_op ps p2)) ->
-    all_evaluable ctx ps (NE.map (fun x => match x with ((a, b), (c, d)) => (Pand a c, (b, d)) end) a).
-Proof.
-  induction a.
-  - intros. cbn. repeat destruct_match. inv Heqp.
-    unfold all_evaluable; intros. inv H0.
-    unfold evaluable.
-    exploit H. constructor.
-    intros [Ha Hb]. inv Ha. inv Hb.
-    exists (x && x0). apply sem_pexpr_Pand; auto.
-  - intros. unfold all_evaluable; cbn; intros. inv H0. inv H2.
-    + repeat destruct_match. inv Heqp0. inv H0.
-      specialize (H p2 a1 p3 b ltac:(constructor; eauto)).
-      inv H. inv H0. inv H1. exists (x && x0).
-      apply sem_pexpr_Pand; eauto.
-    + eapply IHa; intros. eapply H. econstructor. right. eauto.
-      eauto.
-Qed.
-
-Lemma all_evaluable_map_add :
-  forall A B G (ctx: @ctx G) ps (a: pred_op * A) (b: predicated B) p1 x p2 y,
-    p_evaluable ctx (from_pred_op ps (fst a)) ->
-    all_evaluable ctx ps b ->
-    NE.In (p1, x, (p2, y)) (NE.map (fun x : pred_op * B => (a, x)) b) ->
-    p_evaluable ctx (from_pred_op ps p1) /\ p_evaluable ctx (from_pred_op ps p2).
-Proof.
-  induction b; intros.
-  - cbn in *. inv H1. unfold all_evaluable in *. specialize (H0 _ _ ltac:(constructor)).
-    auto.
-  - cbn in *. inv H1. inv H3.
-    + inv H1. unfold all_evaluable in H0. specialize (H0 _ _ ltac:(constructor; eauto)); auto.
-    + eapply all_evaluable_cons in H0. specialize (IHb _ _ _ _ H H0 H1). auto.
-Qed.
-
-Lemma NEin_NEapp5 :
-  forall A (a: A) x y,
-    NE.In a (NE.app x y) ->
-    NE.In a x \/ NE.In a y.
-Proof.
-  induction x; crush.
-  - inv H. inv H1. left. constructor. tauto.
-  - inv H. inv H1. left. constructor; tauto.
-    exploit IHx; eauto; intros. inv H0.
-    left. constructor; tauto. tauto.
-Qed.
-
-Lemma all_evaluable_non_empty_prod :
-  forall A B G (ctx: @ctx G) ps p1 x p2 y (a: predicated A) (b: predicated B),
-    all_evaluable ctx ps a ->
-    all_evaluable ctx ps b ->
-    NE.In ((p1, x), (p2, y)) (NE.non_empty_prod a b) ->
-    p_evaluable ctx (from_pred_op ps p1)
-    /\ p_evaluable ctx (from_pred_op ps p2).
-Proof.
-  induction a; intros.
-  - cbn in *. eapply all_evaluable_map_add; eauto. destruct a; cbn in *. eapply H; constructor.
-  - cbn in *. eapply NEin_NEapp5 in H1. inv H1. eapply all_evaluable_map_add; eauto.
-    destruct a; cbn in *. eapply all_evaluable_cons2; eauto.
-    eapply all_evaluable_cons in H. eauto.
-Qed.
-
-Lemma all_evaluable_predicated_prod :
-  forall A B G (ctx: @ctx G) ps (a: predicated A) (b: predicated B),
-    all_evaluable ctx ps a ->
-    all_evaluable ctx ps b ->
-    all_evaluable ctx ps (predicated_prod a b).
-Proof.
-  intros. unfold all_evaluable; intros.
-  unfold predicated_prod in *. exploit all_evaluable_map_and.
-  2: { eauto. }
-  intros. 2: { eauto. }
-Admitted. (* Requires simple lemma to prove, but this lemma is not needed. *)
-
-Lemma cons_pred_expr_evaluable :
-  forall G (ctx: @ctx G) ps a b,
-    all_evaluable ctx ps a ->
-    all_evaluable ctx ps b ->
-    all_evaluable ctx ps (cons_pred_expr a b).
-Proof.
-  unfold cons_pred_expr; intros.
-  apply all_evaluable_predicated_map.
-  now apply all_evaluable_predicated_prod.
-Qed.
-
-Lemma fold_right_all_evaluable :
-  forall G (ctx: @ctx G) ps n,
-    Forall (all_evaluable ctx ps) (NE.to_list n) ->
-    all_evaluable ctx ps (NE.fold_right cons_pred_expr (NE.singleton (T, Enil)) n).
-Proof.
-  induction n; cbn in *; intros.
-  - unfold cons_pred_expr. eapply all_evaluable_predicated_map. eapply all_evaluable_predicated_prod.
-    inv H. auto. unfold all_evaluable; intros. inv H0. exists true. constructor.
-  - inv H. specialize (IHn H3). now eapply cons_pred_expr_evaluable.
-Qed.
-
-Lemma merge_all_evaluable :
-  forall G (ctx: @ctx G) ps,
-    pred_forest_evaluable ctx ps ->
-    forall f args,
-      all_evaluable ctx ps (merge (list_translation args f)).
-Proof.
-  intros. eapply predicated_evaluable_all. eauto.
-Qed.
-
-(*|
-Here we can finally assume that everything in the forest is evaluable, which
-will allow us to prove that translating the list of register accesses will also
-all be evaluable.
-|*)
-
-  Lemma sem_update_Iop :
-    forall A op rs args m v f ps ctx,
-      Op.eval_operation (ctx_ge ctx) (ctx_sp ctx) op rs ## args (is_mem (ctx_is ctx)) = Some v ->
-      sem ctx f ((mk_instr_state rs ps m), None) ->
-      @sem_pred_expr A _ _ (forest_preds f) sem_value ctx
-        (seq_app (pred_ret (Eop op)) (merge (list_translation args f))) v.
-  Proof.
-    intros * EVAL SEM.
-    exploit sem_pred_expr_list_translation; try eassumption.
-    intro H; inversion_clear H as [x [HS HV]].
-    eapply sem_pred_expr_seq_app_val.
-    - cbn in *; eapply sem_pred_expr_merge; eauto.
-    - apply sem_pred_expr_pred_ret.
-    - econstructor; [eauto|]; auto.
-  Qed.
-
-  Lemma sem_update_Iload :
-    forall A rs args m v f ps ctx addr a0 chunk,
-      Op.eval_addressing (ctx_ge ctx) (ctx_sp ctx) addr rs ## args = Some a0 ->
-      Mem.loadv chunk m a0 = Some v ->
-      sem ctx f ((mk_instr_state rs ps m), None) ->
-      @sem_pred_expr A _ _ (forest_preds f) sem_value ctx
-        (seq_app (seq_app (pred_ret (Eload chunk addr)) (merge (list_translation args f))) (f #r Mem)) v.
-  Proof.
-    intros * EVAL MEM SEM.
-    exploit sem_pred_expr_list_translation; try eassumption.
-    intro H; inversion_clear H as [x [HS HV]].
-    inversion SEM as [? ? ? ? ? ? REG PRED HMEM EXIT]; subst.
-    exploit sem_pred_expr_ident2; [eapply HMEM|].
-    intros H; inversion_clear H as [x' [HS' HV']].
-    eapply sem_pred_expr_seq_app_val; eauto.
-    { eapply sem_pred_expr_seq_app; eauto.
-      - eapply sem_pred_expr_merge; eauto.
-      - apply sem_pred_expr_pred_ret.
-    }
-    econstructor; eauto.
-  Qed.
-
-  Lemma storev_valid_pointer1 :
-    forall chunk m m' s d b z,
-      Mem.storev chunk m s d = Some m' ->
-      Mem.valid_pointer m b z = true ->
-      Mem.valid_pointer m' b z = true.
-  Proof using.
-    intros. unfold Mem.storev in *. destruct_match; try discriminate; subst.
-    apply Mem.valid_pointer_nonempty_perm. apply Mem.valid_pointer_nonempty_perm in H0.
-    eapply Mem.perm_store_1; eauto.
-  Qed.
-
-  Lemma storev_valid_pointer2 :
-    forall chunk m m' s d b z,
-      Mem.storev chunk m s d = Some m' ->
-      Mem.valid_pointer m' b z = true ->
-      Mem.valid_pointer m b z = true.
-  Proof using.
-    intros. unfold Mem.storev in *. destruct_match; try discriminate; subst.
-    apply Mem.valid_pointer_nonempty_perm. apply Mem.valid_pointer_nonempty_perm in H0.
-    eapply Mem.perm_store_2; eauto.
-  Qed.
-
-  Definition valid_mem m m' :=
-    forall b z, Mem.valid_pointer m b z = Mem.valid_pointer m' b z.
-
-  #[global] Program Instance valid_mem_Equivalence : Equivalence valid_mem.
-  Next Obligation. unfold valid_mem; auto. Qed. (* Reflexivity *)
-  Next Obligation. unfold valid_mem; auto. Qed. (* Symmetry *)
-  Next Obligation. unfold valid_mem; eauto. Qed. (* Transitity *)
-
-  Lemma storev_valid_pointer :
-    forall chunk m m' s d,
-      Mem.storev chunk m s d = Some m' ->
-      valid_mem m m'.
-  Proof using.
-    unfold valid_mem. symmetry.
-    intros. destruct (Mem.valid_pointer m b z) eqn:?;
-                     eauto using storev_valid_pointer1.
-    apply not_true_iff_false.
-    apply not_true_iff_false in Heqb0.
-    eauto using storev_valid_pointer2.
-  Qed.
-
-  Lemma storev_cmpu_bool :
-    forall m m' c v v0,
-      valid_mem m m' ->
-      Val.cmpu_bool (Mem.valid_pointer m) c v v0 = Val.cmpu_bool (Mem.valid_pointer m') c v v0.
-  Proof using.
-    unfold valid_mem.
-    intros. destruct v, v0; crush.
-    { destruct_match; crush.
-      destruct_match; crush.
-      destruct_match; crush.
-      apply orb_true_iff in H1.
-      inv H1. rewrite H in H2. rewrite H2 in Heqb1.
-      simplify. rewrite H0 in Heqb1. crush.
-      rewrite H in H2. rewrite H2 in Heqb1.
-      rewrite H0 in Heqb1. crush.
-      destruct_match; auto. simplify.
-      apply orb_true_iff in H1.
-      inv H1. rewrite <- H in H2. rewrite H2 in Heqb1.
-      simplify. rewrite H0 in Heqb1. crush.
-      rewrite <- H in H2. rewrite H2 in Heqb1.
-      rewrite H0 in Heqb1. crush. }
-
-    { destruct_match; crush.
-      destruct_match; crush.
-      destruct_match; crush.
-      apply orb_true_iff in H1.
-      inv H1. rewrite H in H2. rewrite H2 in Heqb1.
-      simplify. rewrite H0 in Heqb1. crush.
-      rewrite H in H2. rewrite H2 in Heqb1.
-      rewrite H0 in Heqb1. crush.
-      destruct_match; auto. simplify.
-      apply orb_true_iff in H1.
-      inv H1. rewrite <- H in H2. rewrite H2 in Heqb1.
-      simplify. rewrite H0 in Heqb1. crush.
-      rewrite <- H in H2. rewrite H2 in Heqb1.
-      rewrite H0 in Heqb1. crush. }
-
-    { destruct_match; auto. destruct_match; auto; crush.
-      { destruct_match; crush.
-        { destruct_match; crush.
-          setoid_rewrite H in H0; eauto.
-          setoid_rewrite H in H1; eauto.
-          rewrite H0 in Heqb. rewrite H1 in Heqb; crush.
-        }
-        { destruct_match; crush.
-          setoid_rewrite H in Heqb0; eauto.
-          rewrite H0 in Heqb0. rewrite H1 in Heqb0; crush. } }
-      { destruct_match; crush.
-        { destruct_match; crush.
-          setoid_rewrite H in H0; eauto.
-          setoid_rewrite H in H1; eauto.
-          rewrite H0 in Heqb0. rewrite H1 in Heqb0; crush.
-        }
-        { destruct_match; crush.
-          setoid_rewrite H in Heqb0; eauto.
-          rewrite H0 in Heqb0. rewrite H1 in Heqb0; crush. } } }
-  Qed.
-
-  Lemma storev_eval_condition :
-    forall m m' c rs,
-      valid_mem m m' ->
-      Op.eval_condition c rs m = Op.eval_condition c rs m'.
-  Proof using.
-    intros. destruct c; crush.
-    destruct rs; crush.
-    destruct rs; crush.
-    destruct rs; crush.
-    eapply storev_cmpu_bool; eauto.
-    destruct rs; crush.
-    destruct rs; crush.
-    eapply storev_cmpu_bool; eauto.
-  Qed.
-
-  Lemma eval_operation_valid_pointer :
-    forall A B (ge: Genv.t A B) sp op args m m' v,
-      valid_mem m m' ->
-      Op.eval_operation ge sp op args m' = Some v ->
-      Op.eval_operation ge sp op args m = Some v.
-  Proof.
-    intros * VALID OP. destruct op; auto.
-    - destruct cond; auto; cbn in *.
-      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
-      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
-    - destruct c; auto; cbn in *.
-      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
-      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
-  Qed.
-
-  Lemma bb_memory_consistency_eval_operation :
-    forall A B (ge: Genv.t A B) sp state i state' args op v,
-      step_instr ge sp (Iexec state) i (Iexec state') ->
-      Op.eval_operation ge sp op args (is_mem state) = Some v ->
-      Op.eval_operation ge sp op args (is_mem state') = Some v.
-  Proof.
-    inversion_clear 1; intro EVAL; auto.
-    cbn in *.
-    eapply eval_operation_valid_pointer. unfold valid_mem. symmetry.
-    eapply storev_valid_pointer; eauto.
-    auto.
-  Qed.
-
-  Lemma truthy_dflt :
-    forall ps p,
-      truthy ps p -> eval_predf ps (dfltp p) = true.
-  Proof. intros. destruct p; cbn; inv H; auto. Qed.
-
-  Lemma sem_update_Istore :
-    forall A rs args m v f ps ctx addr a0 chunk m' v'
-      (EVALF: forest_evaluable ctx f),
-      Op.eval_addressing (ctx_ge ctx) (ctx_sp ctx) addr rs ## args = Some a0 ->
-      Mem.storev chunk m a0 v' = Some m' ->
-      sem_value ctx v v' ->
-      sem ctx f ((mk_instr_state rs ps m), None) ->
-      @sem_pred_expr A _ _ (forest_preds f) sem_mem ctx
-        (seq_app (seq_app (pred_ret (Estore v chunk addr))
-          (merge (list_translation args f))) (f #r Mem)) m'.
-  Proof.
-    intros * EVALF EVAL STOREV SEMVAL SEM.
-    exploit sem_merge_list; try eassumption.
-    intro MERGE. exploit sem_pred_expr_ident2; eauto.
-    intro TMP; inversion_clear TMP as [x [HS HV]].
-    inversion_clear SEM as [? ? ? ? ? ? REG PRED HMEM EXIT].
-    exploit sem_pred_expr_ident2; [eapply HMEM|].
-    intros TMP; inversion_clear TMP as [x' [HS' HV']].
-    eapply sem_pred_expr_ident.
-    eapply sem_pred_expr_seq_app; eauto.
-    eapply sem_pred_expr_seq_app; eauto.
-    eapply sem_pred_expr_pred_ret.
-    econstructor; eauto.
-  Qed.
-
-  Lemma sem_update_Iop_top:
-    forall A f p p' f' rs m pr op res args p0 v state,
-      Op.eval_operation (ctx_ge state) (ctx_sp state) op rs ## args m = Some v ->
-      truthy pr p0 ->
-      valid_mem (is_mem (ctx_is state)) m ->
-      sem state f ((mk_instr_state rs pr m), None) ->
-      update (p, f) (RBop p0 op args res) = Some (p', f') ->
-      eval_predf pr p = true ->
-      @sem A state f' (mk_instr_state (rs # res <- v) pr m, None).
-    Proof.
-      intros * EVAL_OP TRUTHY VALID SEM UPD EVAL_PRED.
-      pose proof SEM as SEM2.
-      inversion UPD as [PRUNE]. unfold Option.bind in PRUNE.
-      destr. inversion_clear PRUNE.
-      rename Heqo into PRUNE.
-      inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
-      cbn [is_ps] in *. constructor.
-      + constructor; intro x. inversion_clear REG as [? ? ? REG']. specialize (REG' x).
-        destruct f as [fr fp fe]. cbn [forest_preds set_forest] in *.
-        destruct (peq x res); subst.
-        * rewrite forest_reg_gss in *. rewrite Regmap.gss in *.
-          eapply sem_pred_expr_prune_predicated; eauto.
-          eapply sem_pred_expr_app_predicated; [| |eauto].
-          replace fp with (forest_preds {| forest_regs := fr; forest_preds := fp; forest_exit := fe |}) by auto.
-          eapply sem_update_Iop; eauto. cbn in *.
-          eapply eval_operation_valid_pointer; eauto.
-          inversion_clear SEM2 as [? ? ? ? ? ? REG2 PRED2 MEM2 EXIT2].
-          inversion_clear PRED2; eauto.
-          cbn -[eval_predf]. rewrite eval_predf_Pand.
-          rewrite EVAL_PRED. rewrite truthy_dflt; auto.
-        * rewrite forest_reg_gso. rewrite Regmap.gso; auto.
-          unfold not in *; intros. apply n0. inv H; auto.
-      + constructor; intros. inv PRED. rewrite forest_reg_pred. auto.
-      + rewrite forest_reg_gso; auto; discriminate.
-      + auto.
-  Qed.
-
-  Lemma sem_update_Iload_top:
-    forall A f p p' f' rs m pr res args p0 v state addr a chunk,
-      Op.eval_addressing (ctx_ge state) (ctx_sp state) addr rs ## args = Some a ->
-      Mem.loadv chunk m a = Some v ->
-      truthy pr p0 ->
-      valid_mem (is_mem (ctx_is state)) m ->
-      sem state f ((mk_instr_state rs pr m), None) ->
-      update (p, f) (RBload p0 chunk addr args res) = Some (p', f') ->
-      eval_predf pr p = true ->
-      @sem A state f' (mk_instr_state (rs # res <- v) pr m, None).
-    Proof.
-      intros * EVAL_OP LOAD TRUTHY VALID SEM UPD EVAL_PRED.
-      pose proof SEM as SEM2.
-      inversion UPD as [PRUNE]. unfold Option.bind in PRUNE. destr.
-      inversion_clear PRUNE.
-      rename Heqo into PRUNE.
-      inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
-      cbn [is_ps] in *. constructor.
-      + constructor; intro x. inversion_clear REG as [? ? ? REG']. specialize (REG' x).
-        destruct f as [fr fp fe]. cbn [forest_preds set_forest] in *.
-        destruct (peq x res); subst.
-        * rewrite forest_reg_gss in *. rewrite Regmap.gss in *.
-          eapply sem_pred_expr_prune_predicated; eauto.
-          eapply sem_pred_expr_app_predicated; [| |eauto].
-          replace fp with (forest_preds {| forest_regs := fr; forest_preds := fp; forest_exit := fe |}) by auto.
-          eapply sem_update_Iload; eauto.
-          inversion_clear PRED; eauto.
-          cbn -[eval_predf]. rewrite eval_predf_Pand.
-          rewrite EVAL_PRED. rewrite truthy_dflt; auto.
-        * rewrite forest_reg_gso. rewrite Regmap.gso; auto.
-          unfold not in *; intros. apply n0. inv H; auto.
-      + constructor; intros. inv PRED. rewrite forest_reg_pred. auto.
-      + rewrite forest_reg_gso; auto; discriminate.
-      + auto.
-  Qed.
-
-  Lemma exists_sem_pred :
-    forall A B C (ctx: @ctx A) s pr r v,
-      @sem_pred_expr A B C pr s ctx r v ->
-      exists r',
-        NE.In r' r /\ s ctx (snd r') v.
-  Proof.
-    induction r; crush.
-    - inv H. econstructor. split. constructor. auto.
-    - inv H.
-      + econstructor. split. constructor. left; auto. auto.
-      + exploit IHr; eauto. intros HH. inversion_clear HH as [x HH']. inv HH'.
-        econstructor. split. constructor. right. eauto. auto.
-  Qed.
-
-  Lemma sem_update_Istore_top:
-    forall A f p p' f' rs m pr res args p0 state addr a chunk m',
-      Op.eval_addressing (ctx_ge state) (ctx_sp state) addr rs ## args = Some a ->
-      Mem.storev chunk m a rs !! res = Some m' ->
-      truthy pr p0 ->
-      valid_mem (is_mem (ctx_is state)) m ->
-      sem state f ((mk_instr_state rs pr m), None) ->
-      update (p, f) (RBstore p0 chunk addr args res) = Some (p', f') ->
-      eval_predf pr p = true ->
-      @sem A state f' (mk_instr_state rs pr m', None).
-  Proof.
-    intros * EVAL_OP STORE TRUTHY VALID SEM UPD EVAL_PRED.
-    pose proof SEM as SEM2.
-    inversion UPD as [PRUNE]. unfold Option.bind in PRUNE. destr.
-    inversion_clear PRUNE.
-    rename Heqo into PRUNE.
-    inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
-    cbn [is_ps] in *. constructor.
-    + constructor; intros. inv REG. rewrite forest_reg_gso; eauto. discriminate.
-    + constructor; intros. inv PRED. rewrite forest_reg_pred. auto.
-    + destruct f as [fr fp fm]; cbn -[seq_app] in *.
-      rewrite forest_reg_gss.
-      exploit sem_pred_expr_ident2; [exact MEM|]; intro HSEM_;
-        inversion_clear HSEM_ as [x [HSEM1 HSEM2]].
-      inv REG. specialize (H res).
-      pose proof H as HRES.
-      eapply sem_pred_expr_ident2 in HRES.
-      inversion_clear HRES as [r2 [HRES1 HRES2]].
-      apply exists_sem_pred in H. inversion_clear H as [r' [HNE HVAL]].
-      exploit sem_merge_list. eapply SEM2. instantiate (2 := args). intro HSPE. eapply sem_pred_expr_ident2 in HSPE.
-      inversion_clear HSPE as [l_ [HSPE1 HSPE2]].
-      eapply sem_pred_expr_prune_predicated; eauto.
-      eapply sem_pred_expr_app_predicated.
-      eapply sem_pred_expr_seq_app_val; [solve [eauto]| |].
-      eapply sem_pred_expr_seq_app; [solve [eauto]|].
-      eapply sem_pred_expr_flap2.
-      eapply sem_pred_expr_seq_app; [solve [eauto]|].
-      eapply sem_pred_expr_pred_ret. econstructor. eauto. 3: { eauto. }
-      eauto. auto. eauto. inv PRED. eauto.
-      rewrite eval_predf_Pand. rewrite EVAL_PRED.
-      rewrite truthy_dflt. auto. auto.
-    + auto.
-  Qed.
-
-  Definition predicated_not_inP {A} (p: Gible.predicate) (l: predicated A) :=
-    forall op e, NE.In (op, e) l -> ~ PredIn p op.
-
-  Lemma predicated_not_inP_cons :
-    forall A p (a: (pred_op * A)) l,
-      predicated_not_inP p (NE.cons a l) ->
-      predicated_not_inP p l.
-  Proof.
-    unfold predicated_not_inP; intros. eapply H. econstructor. right; eauto.
-  Qed.
-
-  Lemma sem_pexpr_not_in :
-    forall G (ctx: @ctx G) p0 ps p e b,
-      ~ PredIn p p0 ->
-      sem_pexpr ctx (from_pred_op ps p0) b ->
-      sem_pexpr ctx (from_pred_op (PTree.set p e ps) p0) b.
-  Proof.
-    induction p0; auto; intros.
-    - cbn. destruct p. unfold get_forest_p'.
-      assert (p0 <> p) by
-        (unfold not; intros; apply H; subst; constructor).
-      rewrite PTree.gso; auto.
-    - cbn in *.
-      assert (X: ~ PredIn p p0_1 /\ ~ PredIn p p0_2) by
-        (split; unfold not; intros; apply H; constructor; tauto).
-      inversion_clear X as [X1 X2].
-      inv H0. inv H4.
-      specialize (IHp0_1 _ p e _ X1 H0). constructor. tauto.
-      specialize (IHp0_2 _ p e _ X2 H0). constructor. tauto.
-      constructor; auto.
-    - cbn in *.
-      assert (X: ~ PredIn p p0_1 /\ ~ PredIn p p0_2) by
-        (split; unfold not; intros; apply H; constructor; tauto).
-      inversion_clear X as [X1 X2].
-      inv H0. inv H4.
-      specialize (IHp0_1 _ p e _ X1 H0). constructor. tauto.
-      specialize (IHp0_2 _ p e _ X2 H0). constructor. tauto.
-      constructor; auto.
-  Qed.
-
-  Lemma sem_pred_not_in :
-    forall A B G (ctx: @ctx G) (s: @Abstr.ctx G -> A -> B -> Prop) l v p e ps,
-      sem_pred_expr ps s ctx l v ->
-      predicated_not_inP p l ->
-      sem_pred_expr (PTree.set p e ps) s ctx l v.
-  Proof.
-    induction l.
-    - intros. unfold predicated_not_inP in H0.
-      destruct a. constructor. apply sem_pexpr_not_in.
-      eapply H0. econstructor. inv H. auto. inv H. auto.
-    - intros. inv H. constructor. unfold predicated_not_inP in H0.
-      eapply sem_pexpr_not_in. eapply H0. constructor. left. eauto.
-      auto. auto.
-      apply sem_pred_expr_cons_false. apply sem_pexpr_not_in. eapply H0.
-      constructor. tauto. auto. auto.
-      eapply IHl. eauto. eapply predicated_not_inP_cons; eauto.
-  Qed.
-
-  Lemma pred_not_in_forestP :
-    forall pred f,
-      predicated_not_in_forest pred f = true ->
-      forall x, predicated_not_inP pred (f #r x).
-  Proof. Admitted.
-
-  Lemma pred_not_in_forest_exitP :
-    forall pred f,
-      predicated_not_in_forest pred f = true ->
-      predicated_not_inP pred (forest_exit f).
-  Proof. Admitted.
-
-  Lemma from_predicated_sem_pred_expr :
-    forall A (ctx: @ctx A) preds pe b,
-      sem_pred_expr preds sem_pred ctx pe b ->
-      sem_pexpr ctx (from_predicated true preds pe) b.
-  Proof. Admitted.
-
-  Lemma sem_update_Isetpred:
-    forall A (ctx: @ctx A) f pr p0 c args b rs m,
-      valid_mem (ctx_mem ctx) m ->
-      sem ctx f (mk_instr_state rs pr m, None) ->
-      Op.eval_condition c rs ## args m = Some b ->
-      truthy pr p0 ->
-      sem_pexpr ctx
-      (from_predicated true (forest_preds f) (seq_app (pred_ret (PEsetpred c)) (merge (list_translation args f)))) b.
-  Proof.
-    intros. eapply from_predicated_sem_pred_expr.
-    pose proof (sem_merge_list _ ctx f rs pr m args H0).
-    apply sem_pred_expr_ident2 in H3; simplify.
-    eapply sem_pred_expr_seq_app_val; [eauto| |].
-    constructor. constructor. constructor.
-    econstructor; eauto.
-    erewrite storev_eval_condition; eauto.
-  Qed.
-
-  Lemma sem_update_Isetpred_top:
-    forall A f p p' f' rs m pr args p0 state c pred b,
-      Op.eval_condition c rs ## args m = Some b ->
-      truthy pr p0 ->
-      valid_mem (is_mem (ctx_is state)) m ->
-      sem state f ((mk_instr_state rs pr m), None) ->
-      update (p, f) (RBsetpred p0 c args pred) = Some (p', f') ->
-      eval_predf pr p = true ->
-      @sem A state f' (mk_instr_state rs (pr # pred <- b) m, None).
-  Proof.
-    intros * EVAL_OP TRUTHY VALID SEM UPD EVAL_PRED.
-    pose proof SEM as SEM2.
-    inversion UPD as [PRUNE]. unfold Option.bind in PRUNE. destr. destr.
-    inversion_clear PRUNE.
-    rename Heqo into PRUNE.
-    inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
-    cbn [is_ps] in *. constructor.
-    + constructor. intros. apply sem_pred_not_in. rewrite forest_pred_reg.
-      inv REG. auto. rewrite forest_pred_reg. apply pred_not_in_forestP.
-      unfold assert_ in *. repeat (destruct_match; try discriminate); auto.
-    + constructor; intros. destruct (peq x pred); subst.
-      * rewrite Regmap.gss.
-        rewrite forest_pred_gss.
-        cbn [update] in *. unfold Option.bind in *. destr. destr. inv UPD.
-        replace b with (b && true) by eauto with bool.
-        apply sem_pexpr_Pand.
-        destruct b. constructor. right.
-        eapply sem_update_Isetpred; eauto.
-        constructor. constructor. replace false with (negb true) by auto.
-        apply sem_pexpr_negate. inv TRUTHY. constructor.
-        cbn. eapply sem_pexpr_eval. inv PRED. eauto. auto.
-        replace false with (negb true) by auto.
-        apply sem_pexpr_negate.
-        eapply sem_pexpr_eval. inv PRED. eauto. auto.
-        eapply sem_update_Isetpred; eauto.
-        constructor. constructor. constructor.
-        replace true with (negb false) by auto. apply sem_pexpr_negate.
-        eapply sem_pexpr_eval. inv PRED. eauto. inv TRUTHY. auto. cbn -[eval_predf].
-        rewrite eval_predf_negate. rewrite H; auto.
-        replace true with (negb false) by auto. apply sem_pexpr_negate.
-        eapply sem_pexpr_eval. inv PRED. eauto. rewrite eval_predf_negate.
-        rewrite EVAL_PRED. auto.
-      * rewrite Regmap.gso by auto. inv PRED. specialize (H x).
-        rewrite forest_pred_gso by auto; auto.
-    + rewrite forest_pred_reg. apply sem_pred_not_in. auto. apply pred_not_in_forestP.
-      unfold assert_ in *. now repeat (destruct_match; try discriminate).
-    + cbn -[from_predicated from_pred_op seq_app]. apply sem_pred_not_in; auto.
-      apply pred_not_in_forest_exitP.
-      unfold assert_ in *. now repeat (destruct_match; try discriminate).
-  Qed.
-
-  Lemma sem_pexpr_impl :
-    forall A (state: @ctx A) a b res,
-      sem_pexpr state b res ->
-      sem_pexpr state a true ->
-      sem_pexpr state (a → b) res.
-  Proof.
-    intros. destruct res.
-    constructor; tauto.
-    constructor; auto. replace false with (negb true) by auto.
-    now apply sem_pexpr_negate.
-  Qed.
-
-  Lemma eval_predf_simplify :
-    forall ps x,
-      eval_predf ps (simplify x) = eval_predf ps x.
-  Proof.
-    unfold eval_predf; intros.
-    rewrite simplify_correct. auto.
-  Qed.
-
-  Lemma sem_update_falsy:
-    forall A state f f' rs ps m p a p',
-      instr_falsy ps a ->
-      update (p, f) a = Some (p', f') ->
-      sem state f (mk_instr_state rs ps m, None) ->
-      @sem A state f' (mk_instr_state rs ps m, None).
-  Proof.
-    inversion 1; cbn [update] in *; intros.
-    - unfold Option.bind in *. destr. inv H2.
-      constructor.
-      * constructor. intros. destruct (peq x res); subst.
-        rewrite forest_reg_gss. cbn.
-        eapply sem_pred_expr_prune_predicated; eauto.
-        eapply sem_pred_expr_app_predicated_false. inv H3. inv H8. auto.
-        inv H3. inv H9. eauto. rewrite eval_predf_Pand. cbn -[eval_predf].
-        rewrite H0. auto. 
-        rewrite forest_reg_gso. inv H3. inv H8. auto.
-        unfold not; intros; apply n0. now inv H1.
-      * constructor; intros. rewrite forest_reg_pred. inv H3. inv H9. auto.
-      * rewrite forest_reg_gso. inv H3. auto. unfold not; intros. inversion H1.
-      * inv H3. auto.
-    - unfold Option.bind in *. destr. inv H2.
-      constructor.
-      * constructor. intros. destruct (peq x dst); subst.
-        rewrite forest_reg_gss. cbn.
-        eapply sem_pred_expr_prune_predicated; eauto.
-        eapply sem_pred_expr_app_predicated_false. inv H3. inv H8. auto.
-        inv H3. inv H9. eauto. rewrite eval_predf_Pand. cbn -[eval_predf].
-        rewrite H0. auto. 
-        rewrite forest_reg_gso. inv H3. inv H8. auto.
-        unfold not; intros; apply n0. now inv H1.
-      * constructor; intros. rewrite forest_reg_pred. inv H3. inv H9. auto.
-      * rewrite forest_reg_gso. inv H3. auto. unfold not; intros. inversion H1.
-      * inv H3. auto.
-    - unfold Option.bind in *. destr. inv H2.
-      constructor.
-      * constructor. intros. rewrite forest_reg_gso by discriminate. inv H3. inv H8. auto.
-      * constructor; intros. rewrite forest_reg_pred. inv H3. inv H9. auto.
-      * rewrite forest_reg_gss. cbn. eapply sem_pred_expr_prune_predicated; eauto.
-        eapply sem_pred_expr_app_predicated_false. inv H3. auto. inv H3. inv H9. eauto.
-        rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H0. auto.
-      * inv H3. auto.
-    - unfold Option.bind in *. destr. destr. inv H2.
-      constructor.
-      * constructor; intros. rewrite forest_pred_reg. apply sem_pred_not_in.
-        inv H3. inv H8. auto. apply pred_not_in_forestP. unfold assert_ in Heqo. now destr.
-      * constructor. intros. destruct (peq x pred); subst.
-        rewrite forest_pred_gss. replace (ps !! pred) with (true && ps !! pred) by auto.
-        assert (sem_pexpr state0 (¬ (from_pred_op (forest_preds f) p0 ∧ from_pred_op (forest_preds f) p')) true).
-        { replace true with (negb false) by auto. apply sem_pexpr_negate.
-          constructor. left. eapply sem_pexpr_eval. inv H3. inv H9. eauto.
-          auto.
-        }
-        apply sem_pexpr_Pand. constructor; tauto.
-        apply sem_pexpr_impl. inv H3. inv H10. eauto.
-        { constructor. left. eapply sem_pexpr_eval. inv H3. inv H10. eauto.
-          rewrite eval_predf_negate. rewrite H0. auto.
-        }
-        rewrite forest_pred_gso by auto. inv H3. inv H9. auto.
-      * rewrite forest_pred_reg. apply sem_pred_not_in. inv H3. auto.
-        apply pred_not_in_forestP. unfold assert_ in Heqo. now destr.
-      * apply sem_pred_not_in. inv H3; auto. cbn.
-        apply pred_not_in_forest_exitP. unfold assert_ in Heqo. now destr.
-    - unfold Option.bind in *. destr. inv H2. inv H3. constructor.
-      * constructor. inv H8. auto.
-      * constructor. intros. inv H9. eauto.
-      * auto.
-      * cbn. eapply sem_pred_expr_prune_predicated; [|eauto].
-        eapply sem_pred_expr_app_predicated_false; auto.
-        inv H9. eauto.
-        rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H0. auto.
-  Qed.
-
-  Lemma sem_update_falsy_input:
-    forall A state f f' rs ps m p a p' exitcf,
-      eval_predf ps p = false ->
-      update (p, f) a = Some (p', f') ->
-      sem state f (mk_instr_state rs ps m, exitcf) ->
-      @sem A state f' (mk_instr_state rs ps m, exitcf)
-        /\ eval_predf ps p' = false.
-  Proof.
-    intros; destruct a; cbn [update] in *; intros.
-    - inv H0. auto.
-    - unfold Option.bind in *. destr. inv H0. split; [|solve [auto]].
-      constructor.
-      * constructor. intros. destruct (peq x r); subst.
-        rewrite forest_reg_gss. cbn.
-        eapply sem_pred_expr_prune_predicated; eauto.
-        eapply sem_pred_expr_app_predicated_false. inv H1. inv H7. auto.
-        inv H1. inv H8. eauto. rewrite eval_predf_Pand.
-        rewrite H. eauto with bool.
-        rewrite forest_reg_gso. inv H1. inv H7. auto.
-        unfold not; intros; apply n0. now inv H0.
-      * constructor; intros. rewrite forest_reg_pred. inv H1. inv H8. auto.
-      * rewrite forest_reg_gso. inv H1. auto. unfold not; intros. inversion H0.
-      * inv H1. auto.
-    - unfold Option.bind in *. destr. inv H0. split; [|solve [auto]].
-      constructor.
-      * constructor. intros. destruct (peq x r); subst.
-        rewrite forest_reg_gss. cbn.
-        eapply sem_pred_expr_prune_predicated; eauto.
-        eapply sem_pred_expr_app_predicated_false. inv H1. inv H7. auto.
-        inv H1. inv H8. eauto. rewrite eval_predf_Pand. cbn -[eval_predf].
-        rewrite H. eauto with bool.
-        rewrite forest_reg_gso. inv H1. inv H7. auto.
-        unfold not; intros; apply n0. now inv H0.
-      * constructor; intros. rewrite forest_reg_pred. inv H1. inv H8. auto.
-      * rewrite forest_reg_gso. inv H1. auto. unfold not; intros. inversion H0.
-      * inv H1. auto.
-    - unfold Option.bind in *. destr. inv H0. split; [|solve [auto]].
-      constructor.
-      * constructor. intros. rewrite forest_reg_gso by discriminate. inv H1. inv H7. auto.
-      * constructor; intros. rewrite forest_reg_pred. inv H1. inv H8. auto.
-      * rewrite forest_reg_gss. cbn. eapply sem_pred_expr_prune_predicated; eauto.
-        eapply sem_pred_expr_app_predicated_false. inv H1. auto. inv H1. inv H8. eauto.
-        rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H. eauto with bool.
-      * inv H1. auto.
-    - unfold Option.bind in *. destr. destr. inv H0. split; [|solve [auto]].
-      constructor.
-      * constructor; intros. rewrite forest_pred_reg. apply sem_pred_not_in.
-        inv H1. inv H7. auto. apply pred_not_in_forestP. unfold assert_ in Heqo0. now destr.
-      * constructor. intros. destruct (peq x p0); subst.
-        rewrite forest_pred_gss. replace (ps !! p0) with (true && ps !! p0) by auto.
-        assert (sem_pexpr state0 (¬ (from_pred_op (forest_preds f) (dfltp o) ∧ from_pred_op (forest_preds f) p')) true).
-        { replace true with (negb false) by auto. apply sem_pexpr_negate.
-          constructor. right. eapply sem_pexpr_eval. inv H1. inv H8. eauto.
-          auto.
-        }
-        apply sem_pexpr_Pand. constructor; tauto.
-        apply sem_pexpr_impl. inv H1. inv H9. eauto.
-        { constructor. right. eapply sem_pexpr_eval. inv H1. inv H9. eauto.
-          rewrite eval_predf_negate. rewrite H. auto.
-        }
-        rewrite forest_pred_gso by auto. inv H1. inv H8. auto.
-      * rewrite forest_pred_reg. apply sem_pred_not_in. inv H1. auto.
-        apply pred_not_in_forestP. unfold assert_ in Heqo0. now destr.
-      * apply sem_pred_not_in. inv H1; auto. cbn.
-        apply pred_not_in_forest_exitP. unfold assert_ in Heqo0. now destr.
-    - unfold Option.bind in *. destr. inv H0. inv H1. split.
-      -- constructor.
-         * constructor. inv H7. auto.
-         * constructor. intros. inv H8. eauto.
-         * auto.
-         * cbn. eapply sem_pred_expr_prune_predicated; [|eauto].
-           eapply sem_pred_expr_app_predicated_false; auto.
-           inv H8. eauto.
-           rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H. eauto with bool.
-      -- rewrite eval_predf_simplify. rewrite eval_predf_Pand. rewrite H. eauto with bool.
-  Qed.
-
-  Definition setpred_wf (i: instr): bool :=
-    match i with
-    | RBsetpred (Some op) _ _ p => negb (predin peq p op)
-    | _ => true
-    end.
-
-  Lemma sem_update_instr :
-    forall f i' i'' a sp p i p' f',
-      step_instr ge sp (Iexec i') a (Iexec i'') ->
-      valid_mem (is_mem i) (is_mem i') ->
-      sem (mk_ctx i sp ge) f (i', None) ->
-      update (p, f) a = Some (p', f') ->
-      eval_predf (is_ps i') p = true ->
-      sem (mk_ctx i sp ge) f' (i'', None).
-  Proof.
-    inversion 1; subst; clear H; intros VALID SEM UPD EVAL_PRED; pose proof SEM as SEM2.
-    - inv UPD; auto.
-    - eauto using sem_update_Iop_top.
-    - eauto using sem_update_Iload_top.
-    - eauto using sem_update_Istore_top.
-    - eauto using sem_update_Isetpred_top.
-    - destruct i''. eauto using sem_update_falsy.
-  Qed.
-
-  Lemma Pand_true_left :
-    forall ps a b,
-      eval_predf ps a = false ->
-      eval_predf ps (a ∧ b) = false.
-  Proof.
-    intros.
-    rewrite eval_predf_Pand. now rewrite H.
-  Qed.
-
-  Lemma Pand_true_right :
-    forall ps a b,
-      eval_predf ps b = false ->
-      eval_predf ps (a ∧ b) = false.
-  Proof.
-    intros.
-    rewrite eval_predf_Pand. rewrite H.
-    eauto with bool.
-  Qed.
-
-  Lemma sem_update_instr_term :
-    forall f i' i'' sp i cf p p' p'' f',
-      sem (mk_ctx i sp ge) f (i', None) ->
-      step_instr ge sp (Iexec i') (RBexit p cf) (Iterm i'' cf) ->
-      update (p', f) (RBexit p cf) = Some (p'', f') ->
-      eval_predf (is_ps i') p' = true ->
-      sem (mk_ctx i sp ge) f' (i'', Some cf)
-           /\ eval_predf (is_ps i') p'' = false.
-  Proof.
-    intros. inv H0. simpl in *.
-    unfold Option.bind in *. destruct_match; try discriminate.
-    apply truthy_dflt in H6. inv H1.
-    assert (eval_predf (Gible.is_ps i'') (¬ dfltp p) = false).
-    { rewrite eval_predf_negate. now rewrite negb_false_iff. }
-    apply Pand_true_left with (b := p') in H0.
-    rewrite <- eval_predf_simplify in H0. split; auto.
-    unfold "<-e". destruct i''.
-    inv H. constructor; auto.
-    constructor. inv H9. intros. cbn. eauto.
-    inv H10. constructor; intros. eauto.
-    cbn.
-    eapply sem_pred_expr_prune_predicated; eauto.
-    eapply sem_pred_expr_app_predicated.
-    constructor. constructor. constructor.
-    inv H10. eauto. cbn -[eval_predf] in *.
-    rewrite eval_predf_Pand. rewrite H2. now rewrite H6.
-  Qed.
-
-  Lemma step_instr_lessdef_term :
-    forall sp a i i' ti cf,
-      step_instr ge sp (Iexec i) a (Iterm i' cf) ->
-      Abstr.match_states i ti ->
-      exists ti', step_instr ge sp (Iexec ti) a (Iterm ti' cf) /\ Abstr.match_states i' ti'.
-  Proof.
-    inversion 1; intros; subst.
-    econstructor. split; eauto. constructor.
-    destruct p. constructor. erewrite eval_predf_pr_equiv. inv H4.
-    eauto. inv H6. eauto. constructor.
-  Qed.
-
-  Lemma combined_falsy :
-    forall i o1 o,
-      falsy i o1 ->
-      falsy i (combine_pred o o1).
-  Proof.
-    inversion 1; subst; crush. destruct o; simplify.
-    constructor. rewrite eval_predf_Pand. rewrite H0. crush.
-    constructor. auto.
-  Qed.
-
-  Lemma Abstr_match_states_sem :
-    forall i sp f i' ti cf,
-      sem (mk_ctx i sp ge) f (i', cf) ->
-      Abstr.match_states i ti ->
-      exists ti', sem (mk_ctx ti sp ge) f (ti', cf) /\ Abstr.match_states i' ti'.
-  Proof. Admitted. (* This needs a bit more in Abstr.v *)
-
-  Lemma mfold_left_update_Some :
-    forall xs x v,
-      mfold_left update xs x = Some v ->
-      exists y, x = Some y.
-  Proof.
-    induction xs; intros.
-    { cbn in *. inv H. eauto. }
-    cbn in *. unfold Option.bind in *. exploit IHxs; eauto.
-    intros. simplify. destruct x; crush.
-    eauto.
-  Qed.
-
-  Lemma step_instr_term_exists :
-    forall A B ge sp v x v2 cf,
-      @step_instr A B ge sp (Iexec v) x (Iterm v2 cf) ->
-      exists p, x = RBexit p cf.
-  Proof using. inversion 1; eauto. Qed.
-
-  Lemma eval_predf_update_true :
-    forall i i' curr_p next_p f f_next instr sp,
-      update (curr_p, f) instr = Some (next_p, f_next) ->
-      step_instr ge sp (Iexec i) instr (Iexec i') ->
-      eval_predf (is_ps i) curr_p = true ->
-      eval_predf (is_ps i') next_p = true.
-  Proof.
-    intros * UPD STEP EVAL. destruct instr; cbn [update] in UPD;
-      try solve [unfold Option.bind in *; try destr; inv UPD; inv STEP; auto].
-    - unfold Option.bind in *. destr. destr. inv UPD. inv STEP; auto. cbn [is_ps] in *.
-      unfold is_initial_pred_and_notin in Heqo1. unfold assert_ in Heqo1. destr. destr.
-      destr. destr. destr. destr. subst. assert (~ PredIn p2 next_p).
-      unfold not; intros. apply negb_true_iff in Heqb0. apply not_true_iff_false in Heqb0.
-      apply Heqb0. now apply predin_PredIn. rewrite eval_predf_not_PredIn; auto.
-    - unfold Option.bind in *. destr. inv UPD. inv STEP. inv H3. cbn.
-      rewrite eval_predf_simplify. rewrite eval_predf_Pand. rewrite eval_predf_negate.
-      destruct i'; cbn in *. rewrite H0. auto.
-  Qed.
-
-  Lemma forest_evaluable_regset :
-    forall A f (ctx: @ctx A) n x,
-      forest_evaluable ctx f ->
-      forest_evaluable ctx f #r x <- n.
-  Proof.
-    unfold forest_evaluable, pred_forest_evaluable; intros.
-    eapply H. eauto.
-  Qed.
-
-  Lemma evaluable_impl :
-    forall A (ctx: @ctx A) a b,
-      p_evaluable ctx a ->
-      p_evaluable ctx b ->
-      p_evaluable ctx (a → b).
-  Proof.
-    unfold evaluable.
-    inversion_clear 1 as [b1 SEM1].
-    inversion_clear 1 as [b2 SEM2].
-    unfold Pimplies.
-    econstructor. apply sem_pexpr_Por;
-    eauto using sem_pexpr_negate.
-  Qed.
-
-  Lemma parts_evaluable :
-    forall A (ctx: @ctx A) b p0,
-      evaluable sem_pred ctx p0 ->
-      evaluable sem_pexpr ctx (Plit (b, p0)).
-  Proof.
-    intros. unfold evaluable in *. inv H.
-    destruct b. do 2 econstructor. eauto.
-    exists (negb x). constructor. rewrite negb_involutive. auto.
-  Qed.
-
-  Lemma p_evaluable_Pand :
-    forall A (ctx: @ctx A) a b,
-      p_evaluable ctx a ->
-      p_evaluable ctx b ->
-      p_evaluable ctx (a ∧ b).
-  Proof.
-    intros. inv H. inv H0.
-    econstructor. apply sem_pexpr_Pand; eauto.
-  Qed.
-
-  Lemma from_predicated_evaluable :
-    forall A (ctx: @ctx A) f b a,
-      pred_forest_evaluable ctx f ->
-      all_evaluable2 ctx sem_pred a ->
-      p_evaluable ctx (from_predicated b f a).
-  Proof.
-    induction a.
-    cbn. destruct_match; intros.
-    eapply evaluable_impl.
-    eauto using predicated_evaluable.
-    unfold all_evaluable2 in H0. unfold p_evaluable.
-    eapply parts_evaluable. eapply H0. econstructor.
-
-    intros. cbn. destruct_match.
-    eapply p_evaluable_Pand.
-    eapply all_evaluable2_cons2 in H0.
-    eapply evaluable_impl.
-    eauto using predicated_evaluable.
-    unfold all_evaluable2 in H0. unfold p_evaluable.
-    eapply parts_evaluable. eapply H0.
-    eapply all_evaluable2_cons in H0. eauto.
-  Qed.
-
-  Lemma seq_app_cons :
-    forall A B  f a l p0 p1,
-      @seq_app A B (pred_ret f) (NE.cons a l) = NE.cons p0 p1 ->
-      @seq_app A B (pred_ret f) l = p1.
-  Proof. intros. cbn in *. inv H. eauto. Qed.
-
-  Lemma p_evaluable_imp :
-    forall A (ctx: @ctx A) a b,
-      sem_pexpr ctx a false ->
-      p_evaluable ctx (a → b).
-  Proof.
-    intros. unfold "→".
-    unfold p_evaluable, evaluable. exists true.
-    constructor. replace true with (negb false) by trivial. left.
-    now apply sem_pexpr_negate.
-  Qed.
-
-  Lemma sem_update_valid_mem :
-    forall i i' i'' curr_p next_p f f_next instr sp,
-      step_instr ge sp (Iexec i') instr (Iexec i'') ->
-      update (curr_p, f) instr = Some (next_p, f_next) ->
-      sem (mk_ctx i sp ge) f (i', None) ->
-      valid_mem (is_mem i') (is_mem i'').
-  Proof.
-    inversion 1; crush.
-    unfold Option.bind in *. destr. inv H7.
-    eapply storev_valid_pointer; eauto.
-  Qed.
-
-  Lemma eval_predf_lessdef :
-    forall p a b,
-      Abstr.match_states a b ->
-      eval_predf (is_ps a) p = eval_predf (is_ps b) p.
-  Proof using.
-    induction p; crush.
-    - inv H. simpl. unfold eval_predf. simpl.
-      repeat destr. inv Heqp0. rewrite H1. auto.
-    - rewrite !eval_predf_Pand.
-      erewrite IHp1 by eassumption.
-      now erewrite IHp2 by eassumption.
-    - rewrite !eval_predf_Por.
-      erewrite IHp1 by eassumption.
-      now erewrite IHp2 by eassumption.
-  Qed.
-
-(*|
-``abstr_fold_falsy``: This lemma states that when we are at the end of an
-execution, the values in the register map do not continue to change.
-|*)
-
-  Lemma abstr_fold_falsy :
-    forall A ilist i sp ge f res p f' p',
-      @sem A (mk_ctx i sp ge) f res ->
-      mfold_left update ilist (Some (p, f)) = Some (p', f') ->
-      eval_predf (is_ps (fst res)) p = false ->
-      sem (mk_ctx i sp ge) f' res.
-  Proof.
-    induction ilist.
-    - intros. cbn in *. inv H0. auto.
-    - intros. cbn -[update] in H0.
-      exploit mfold_left_update_Some. eauto. intros. inv H2.
-      rewrite H3 in H0. destruct x.
-      destruct res. destruct i0.
-      exploit sem_update_falsy_input; try eassumption; intros.
-      inversion_clear H2.
-      eapply IHilist; eassumption.
-  Qed.
-
-  Lemma abstr_fold_correct :
-    forall sp x i i' i'' cf f p f' curr_p
-        (VALID: valid_mem (is_mem i) (is_mem i')),
-      SeqBB.step ge sp (Iexec i') x (Iterm i'' cf) ->
-      sem (mk_ctx i sp ge) f (i', None) ->
-      eval_predf (is_ps i') curr_p = true ->
-      mfold_left update x (Some (curr_p, f)) = Some (p, f') ->
-      forall ti,
-        Abstr.match_states i ti ->
-        exists ti', sem (mk_ctx ti sp ge) f' (ti', Some cf)
-               /\ Abstr.match_states i'' ti'
-               /\ valid_mem (is_mem i) (is_mem i'').
-  Proof.
-    induction x as [| x xs IHx ]; intros; cbn -[update] in *; inv H; cbn [fst snd] in *.
-    - (* inductive case *)
-      exploit mfold_left_update_Some; eauto; intros Hexists;
-        inversion Hexists as [[curr_p_inter f_inter] EXEQ]; clear Hexists.
-        exploit eval_predf_update_true;
-        eauto; intros EVALTRUE.
-      rewrite EXEQ in H2. eapply IHx in H2; cbn [fst snd] in *.
-      eauto.
-      transitivity (is_mem i'); auto.
-      eapply sem_update_valid_mem; eauto.
-      eauto.
-      eapply sem_update_instr; eauto. eauto. eauto.
-    - (* terminal case *)
-      exploit mfold_left_update_Some; eauto; intros Hexists;
-        inversion Hexists as [[curr_p_inter f_inter] EXEQ]; clear Hexists. rewrite EXEQ in H2.
-      exploit Abstr_match_states_sem; (* TODO *)
-      eauto; intros H; inversion H as [v [Hi LESSDEF]]; clear H.
-      exploit step_instr_lessdef_term;
-      eauto; intros H; inversion H as [v2 [Hi2 LESSDEF2]]; clear H.
-      exploit step_instr_term_exists; eauto; inversion 1 as [? ?]; subst; clear H.
-      erewrite eval_predf_lessdef in H1 by eassumption.
-      exploit sem_update_instr_term;
-      eauto; intros [A B].
-      exists v2.
-      exploit abstr_fold_falsy.
-      apply A.
-      eassumption. auto. cbn. inversion Hi2; subst. auto. intros.
-      split; auto. split; auto.
-      inversion H7; subst; auto.
-  Qed.
-
-  Lemma sem_regset_empty :
-    forall A ctx, @sem_regset A ctx empty (ctx_rs ctx).
-  Proof using.
-    intros; constructor; intros.
-    constructor; auto. constructor.
-    constructor.
-  Qed.
-
-  Lemma sem_predset_empty :
-    forall A ctx, @sem_predset A ctx empty (ctx_ps ctx).
-  Proof using.
-    intros; constructor; intros.
-    constructor; auto. constructor.
-  Qed.
-
-  Lemma sem_empty :
-    forall A ctx, @sem A ctx empty (ctx_is ctx, None).
-  Proof using.
-    intros. destruct ctx. destruct ctx_is.
-    constructor; try solve [constructor; constructor; crush].
-    eapply sem_regset_empty.
-    eapply sem_predset_empty.
-  Qed.
-
-  Lemma abstr_sequence_correct :
-    forall sp x i i'' cf x',
-      SeqBB.step ge sp (Iexec i) x (Iterm i'' cf) ->
-      abstract_sequence x = Some x' ->
-      forall ti,
-        Abstr.match_states i ti ->
-        exists ti', sem (mk_ctx ti sp ge) x' (ti', Some cf)
-               /\ Abstr.match_states i'' ti'.
-  Proof.
-    unfold abstract_sequence. intros. unfold Option.map in H0.
-    destruct_match; try easy.
-    destruct p as [p TMP]; simplify.
-    exploit abstr_fold_correct; eauto; crush.
-    { apply sem_empty. }
-    exists x0. auto.
-  Qed.
-
-  Lemma abstr_seq_reverse_correct :
-    forall sp x i i' ti cf x',
-      abstract_sequence x = Some x' ->
-      sem (mk_ctx i sp ge) x' (i', (Some cf)) ->
-      Abstr.match_states i ti ->
-     exists ti', SeqBB.step ge sp (Iexec ti) x (Iterm ti' cf)
-             /\ Abstr.match_states i' ti'.
-  Proof.
-
-(*|
-Proof Sketch:
-
-We do an induction over the list of instructions ``x``.  This is trivial for the
-empty case and then for the inductive case we know that there exists an
-execution that matches the abstract execution, so we need to know that adding
-another instructions to it will still mean that the execution will result in the
-same value.
-
-Arithmetic operations will be a problem because we will have to show that these
-can be executed.  However, this should mostly be a problem in the abstract state
-comparison, because there two abstract states can be equal without one being
-evaluable.
-|*)
-
-  Admitted.
-
-(*|
-This is the top-level lemma which uses the following proofs to complete the
-square:
-
-- ``abstr_sequence_correct``: This is the lemma that states the forward
-  translation form ``GibleSeq`` to ``Abstr`` was correct.
-- ``abstr_check_correct``: This is the lemma that states that if a check between
-  two ``Abstr`` programs succeeds, that they will also behave the same.  This
-  depends on the SAT solver correctness, as the predicates might be
-  syntactically different to each other.
-- ``abstr_seq_reverse_correct``: This is the lemma that shows that the backwards
-  simulation between the abstract translation and the concrete execution also
-  holds.  We only have a translation from the concrete into the abstract, but
-  then prove that if we have an execution in the abstract, we can observe that
-  same execution in the concrete.
-- ``seqbb_step_parbb_step``: Finally, this lemma states that the parallel
-  execution of the basic block is equivalent to the sequential execution of the
-  concatenation of that parallel block.  This is because even in the translation
-  to HTL, the Verilog semantics are sequential within a clock cycle, but will
-  then be parallelised by the synthesis tool.  The argument for why this is
-  still useful is because we are identifying and scheduling instructions into
-  clock cycles.
-|*)
-
-  Definition local_abstr_check_correct :=
-    @abstr_check_correct GibleSeq.fundef GiblePar.fundef.
-
-  Definition local_abstr_check_correct2 :=
-    @abstr_check_correct GibleSeq.fundef GibleSeq.fundef.
-
-  Lemma ge_preserved_local :
-    ge_preserved ge tge.
-  Proof.
-    unfold ge_preserved; 
-    eauto using Op.eval_operation_preserved, Op.eval_addressing_preserved.
-  Qed.
-
   Lemma schedule_oracle_correct :
     forall x y sp i i' ti cf,
       schedule_oracle x y = true ->
       SeqBB.step ge sp (Iexec i) x (Iterm i' cf) ->
-      Abstr.match_states i ti ->
+      state_lessdef i ti ->
       exists ti', ParBB.step tge sp (Iexec ti) y (Iterm ti' cf)
-             /\ Abstr.match_states i' ti'.
+             /\ state_lessdef i' ti'.
   Proof.
     unfold schedule_oracle; intros. repeat (destruct_match; try discriminate). simplify.
     exploit abstr_sequence_correct; eauto; simplify.
@@ -2406,7 +479,7 @@ Proof Sketch:  Trivial because of structural equality.
   Lemma match_states_stepBB :
     forall s f sp pc rs pr m sf' f' trs tps tm rs' pr' m' trs' tpr' tm',
       match_states (GibleSeq.State s f sp pc rs pr m) (State sf' f' sp pc trs tps tm) ->
-      Abstr.match_states (mk_instr_state rs' pr' m') (mk_instr_state trs' tpr' tm') ->
+      state_lessdef (mk_instr_state rs' pr' m') (mk_instr_state trs' tpr' tm') ->
       match_states (GibleSeq.State s f sp pc rs' pr' m') (State sf' f' sp pc trs' tpr' tm').
   Proof.
     inversion 1; subst; simplify.
diff --git a/src/hls/GiblePargenproofBackwards.v b/src/hls/GiblePargenproofBackwards.v
new file mode 100644
index 0000000..50b733a
--- /dev/null
+++ b/src/hls/GiblePargenproofBackwards.v
@@ -0,0 +1,49 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2023 Yann Herklotz <git@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.backend.Registers.
+Require Import compcert.common.AST.
+Require Import compcert.common.Errors.
+Require Import compcert.common.Linking.
+Require Import compcert.common.Globalenvs.
+Require Import compcert.common.Memory.
+Require Import compcert.common.Values.
+Require Import compcert.lib.Maps.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.GibleSeq.
+Require Import vericert.hls.GiblePar.
+Require Import vericert.hls.Gible.
+Require Import vericert.hls.GiblePargenproofEquiv.
+Require Import vericert.hls.GiblePargen.
+Require Import vericert.hls.Predicate.
+Require Import vericert.hls.Abstr.
+Require Import vericert.common.Monad.
+
+Module Import OptionExtra := MonadExtra(Option).
+
+#[local] Open Scope positive.
+#[local] Open Scope forest.
+#[local] Open Scope pred_op.
+
+#[local] Opaque simplify.
+#[local] Opaque deep_simplify.
+
+#[local] Ltac destr := destruct_match; try discriminate; [].
+
+Definition state_lessdef := GiblePargenproofEquiv.match_states.
diff --git a/src/hls/GiblePargenproofEquiv.v b/src/hls/GiblePargenproofEquiv.v
new file mode 100644
index 0000000..5f28d53
--- /dev/null
+++ b/src/hls/GiblePargenproofEquiv.v
@@ -0,0 +1,1736 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2023 Yann Herklotz <git@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.Logic.Decidable.
+Require Import Coq.Structures.Equalities.
+
+Require Import compcert.backend.Registers.
+Require Import compcert.common.AST.
+Require Import compcert.common.Globalenvs.
+Require Import 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.verilog.Op.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.GibleSeq.
+Require Import vericert.hls.GiblePar.
+Require Import vericert.hls.Gible.
+Require Import vericert.hls.HashTree.
+Require Import vericert.hls.Predicate.
+Require Import vericert.common.DecEq.
+Require Import vericert.hls.Abstr.
+Require vericert.common.NonEmpty.
+Module NE := NonEmpty.
+Import NE.NonEmptyNotation.
+
+#[local] Open Scope non_empty_scope.
+#[local] Open Scope positive.
+#[local] Open Scope pred_op.
+#[local] Open Scope forest.
+
+Fixpoint beq_expression (e1 e2: expression) {struct e1}: bool :=
+  match e1, e2 with
+  | Ebase r1, Ebase r2 => if resource_eq r1 r2 then true else false
+  | Eop op1 el1, Eop op2 el2 =>
+    if operation_eq op1 op2 then
+    beq_expression_list el1 el2 else false
+  | Eload chk1 addr1 el1 e1, Eload chk2 addr2 el2 e2 =>
+    if memory_chunk_eq chk1 chk2
+    then if addressing_eq addr1 addr2
+         then if beq_expression_list el1 el2
+              then beq_expression e1 e2 else false else false else false
+  | Estore e1 chk1 addr1 el1 m1, Estore e2 chk2 addr2 el2 m2 =>
+    if memory_chunk_eq chk1 chk2
+    then if addressing_eq addr1 addr2
+         then if beq_expression_list el1 el2
+              then if beq_expression m1 m2
+                   then beq_expression e1 e2 else false else false else false else false
+  | _, _ => false
+  end
+with beq_expression_list (el1 el2: expression_list) {struct el1} : bool :=
+  match el1, el2 with
+  | Enil, Enil => true
+  | Econs e1 t1, Econs e2 t2 => beq_expression e1 e2 && beq_expression_list t1 t2
+  | _, _ => false
+  end
+.
+
+Scheme expression_ind2 := Induction for expression Sort Prop
+  with expression_list_ind2 := Induction for expression_list Sort Prop.
+Definition beq_pred_expression (e1 e2: pred_expression) : bool :=
+  match e1, e2 with
+  | PEbase p1, PEbase p2 => if peq p1 p2 then true else false
+  | PEsetpred c1 el1, PEsetpred c2 el2 =>
+    if condition_eq c1 c2
+    then beq_expression_list el1 el2 else false
+  | _, _ => false
+  end.
+
+Definition beq_exit_expression (e1 e2: exit_expression) : bool :=
+  match e1, e2 with
+  | EEbase, EEbase => true
+  | EEexit cf1, EEexit cf2 => if cf_instr_eq cf1 cf2 then true else false
+  | _, _ => false
+  end.
+
+Lemma beq_expression_correct:
+  forall e1 e2, beq_expression e1 e2 = true -> e1 = e2.
+Proof.
+  intro e1;
+  apply expression_ind2 with
+      (P := fun (e1 : expression) =>
+            forall e2, beq_expression e1 e2 = true -> e1 = e2)
+      (P0 := fun (e1 : expression_list) =>
+             forall e2, beq_expression_list e1 e2 = true -> e1 = e2); simplify;
+  try solve [repeat match goal with
+                    | [ H : context[match ?x with _ => _ end] |- _ ] => destruct x eqn:?
+                    | [ H : context[if ?x then _ else _] |- _ ] => destruct x eqn:?
+                    end; subst; f_equal; crush; eauto using Peqb_true_eq].
+Qed.
+
+Lemma beq_expression_refl: forall e, beq_expression e e = true.
+Proof.
+  intros.
+  induction e using expression_ind2 with (P0 := fun el => beq_expression_list el el = true);
+  crush; repeat (destruct_match; crush); [].
+  crush. rewrite IHe. rewrite IHe0. auto.
+Qed.
+
+Lemma beq_expression_list_refl: forall e, beq_expression_list e e = true.
+Proof. induction e; auto. simplify. rewrite beq_expression_refl. auto. Qed.
+
+Lemma beq_expression_correct2:
+  forall e1 e2, beq_expression e1 e2 = false -> e1 <> e2.
+Proof.
+  induction e1 using expression_ind2
+    with (P0 := fun el1 => forall el2, beq_expression_list el1 el2 = false -> el1 <> el2).
+  - intros. simplify. repeat (destruct_match; crush).
+  - intros. simplify. repeat (destruct_match; crush). subst. apply IHe1 in H.
+    unfold not in *. intros. apply H. inv H0. auto.
+  - intros. simplify. repeat (destruct_match; crush); subst.
+    unfold not in *; intros. inv H0. rewrite beq_expression_refl in H. discriminate.
+    unfold not in *; intros. inv H. rewrite beq_expression_list_refl in Heqb. discriminate.
+  - simplify. repeat (destruct_match; crush); subst;
+    unfold not in *; intros.
+    inv H0. rewrite beq_expression_refl in H; crush.
+    inv H. rewrite beq_expression_refl in Heqb0; crush.
+    inv H. rewrite beq_expression_list_refl in Heqb; crush.
+  (* - simplify. repeat (destruct_match; crush); subst. *)
+  (*   unfold not in *; intros. inv H0. rewrite beq_expression_list_refl in H; crush. *)
+  - simplify. repeat (destruct_match; crush); subst.
+  - simplify. repeat (destruct_match; crush); subst.
+    apply andb_false_iff in H. inv H. unfold not in *; intros.
+    inv H. rewrite beq_expression_refl in H0; discriminate.
+    unfold not in *; intros. inv H. rewrite beq_expression_list_refl in H0; discriminate.
+Qed.
+
+Definition expression_dec: forall e1 e2: expression, {e1 = e2} + {e1 <> e2}.
+Proof.
+  intros.
+  destruct (beq_expression e1 e2) eqn:?. apply beq_expression_correct in Heqb. auto.
+  apply beq_expression_correct2 in Heqb. auto.
+Defined.
+
+Lemma beq_expression_list_correct:
+  forall e1 e2, beq_expression_list e1 e2 = true -> e1 = e2.
+Proof.
+  induction e1; crush.
+  - destruct_match; crush.
+  - destruct_match; crush.
+    apply IHe1 in H1; subst.
+    apply beq_expression_correct in H0; subst.
+    trivial.
+Qed.
+
+Lemma beq_expression_list_correct2:
+  forall e1 e2, beq_expression_list e1 e2 = false -> e1 <> e2.
+Proof.
+  induction e1; crush.
+  - destruct_match; crush.
+  - destruct_match; crush.
+    apply andb_false_iff in H. inv H. apply beq_expression_correct2 in H0.
+    unfold not in *; intros. apply H0. inv H. auto.
+    apply IHe1 in H0. unfold not in *; intros. apply H0. inv H.
+    auto.
+Qed.
+
+Lemma beq_pred_expression_correct:
+  forall e1 e2, beq_pred_expression e1 e2 = true -> e1 = e2.
+Proof.
+  destruct e1, e2; crush.
+  - destruct_match; crush.
+  - destruct_match; subst; crush.
+    apply beq_expression_list_correct in H; subst.
+    trivial.
+Qed.
+
+Lemma beq_pred_expression_refl:
+  forall e, beq_pred_expression e e = true.
+Proof.
+  destruct e; crush; destruct_match; crush.
+  apply beq_expression_list_refl.
+Qed.
+
+Lemma beq_pred_expression_correct2:
+  forall e1 e2, beq_pred_expression e1 e2 = false -> e1 <> e2.
+Proof.
+  destruct e1, e2; unfold not; crush.
+  + destruct_match; crush.
+  + destruct_match; crush. inv H0.
+    now rewrite beq_expression_list_refl in H.
+Qed.
+
+Lemma beq_exit_expression_correct:
+  forall e1 e2, beq_exit_expression e1 e2 = true <-> e1 = e2.
+Proof.
+  destruct e1, e2; split; crush;
+  destruct_match; subst; crush.
+Qed.
+
+Definition pred_expr_item_eq (pe1 pe2: pred_op * expression) : bool :=
+  @equiv_dec _ SATSetoid _ (fst pe1) (fst pe2) && beq_expression (snd pe1) (snd pe2).
+
+Definition pred_eexpr_item_eq (pe1 pe2: pred_op * exit_expression) : bool :=
+  @equiv_dec _ SATSetoid _ (fst pe1) (fst pe2) && beq_exit_expression (snd pe1) (snd pe2).
+
+Definition pred_expr_dec: forall (pe1 pe2: pred_op * expression),
+    {pred_expr_item_eq pe1 pe2 = true} + {pred_expr_item_eq pe1 pe2 = false}.
+Proof.
+  intros; destruct (pred_expr_item_eq pe1 pe2) eqn:?; unfold not; [tauto | now right].
+Defined.
+
+Definition pred_expr_dec2: forall (pe1 pe2: pred_op * expression),
+    {pred_expr_item_eq pe1 pe2 = true} + {~ pred_expr_item_eq pe1 pe2 = true}.
+Proof.
+  intros; destruct (pred_expr_item_eq pe1 pe2) eqn:?; unfold not; [tauto | now right].
+Defined.
+
+Definition pred_expression_dec:
+  forall e1 e2: pred_expression, {e1 = e2} + {e1 <> e2}.
+Proof.
+  intros. destruct (beq_pred_expression e1 e2) eqn:?.
+  eauto using beq_pred_expression_correct.
+  eauto using beq_pred_expression_correct2.
+Defined.
+
+Lemma exit_expression_refl:
+  forall e, beq_exit_expression e e = true.
+Proof. destruct e; crush; destruct_match; crush. Qed.
+
+Definition exit_expression_dec:
+  forall e1 e2: exit_expression, {e1 = e2} + {e1 <> e2}.
+Proof.
+  intros. destruct (beq_exit_expression e1 e2) eqn:?.
+  - left. eapply beq_exit_expression_correct; eauto.
+  - right. unfold not; intros.
+    assert (X: ~ (beq_exit_expression e1 e2 = true))
+      by eauto with bool.
+    subst. apply X. apply exit_expression_refl.
+Defined.
+
+Lemma pred_eexpression_dec:
+  forall (e1 e2: exit_expression) (p1 p2: pred_op),
+    {(p1, e1) = (p2, e2)} + {(p1, e1) <> (p2, e2)}.
+Proof.
+  pose proof (Predicate.eq_dec peq).
+  pose proof (exit_expression_dec).
+  decide equality.
+Defined.
+
+(*Fixpoint encode_expression_ne (max: predicate) (pe: pred_expr_ne) (h: hash_tree)
+  : (PTree.t pred_op) * hash_tree :=
+  match pe with
+  | NE.singleton (p, e) =>
+    let (p', h') := hash_value max e h in
+    (Por (Pnot p) (Pvar p'), h')
+  | (p, e) ::| pr =>
+    let (p', h') := hash_value max e h in
+    let (p'', h'') := encode_expression_ne max pr h' in
+    (Pand (Por (Pnot p) (Pvar p')) p'', h'')
+  end.*)
+
+Fixpoint max_pred_expr (pe: pred_expr) : positive :=
+  match pe with
+  | NE.singleton (p, e) => max_predicate p
+  | (p, e) ::| pe' => Pos.max (max_predicate p) (max_pred_expr pe')
+  end.
+
+Definition ge_preserved {A B C D: Type} (ge: Genv.t A B) (tge: Genv.t C D) : Prop :=
+  (forall sp op vl m, Op.eval_operation ge sp op vl m =
+                      Op.eval_operation tge sp op vl m)
+  /\ (forall sp addr vl, Op.eval_addressing ge sp addr vl =
+                         Op.eval_addressing tge sp addr vl).
+
+Lemma ge_preserved_same:
+  forall A B ge, @ge_preserved A B A B ge ge.
+Proof. unfold ge_preserved; auto. Qed.
+#[local] Hint Resolve ge_preserved_same : core.
+
+Inductive match_states : instr_state -> instr_state -> Prop :=
+| match_states_intro:
+  forall ps ps' rs rs' m m',
+    (forall x, rs !! x = rs' !! x) ->
+    (forall x, ps !! x = ps' !! x) ->
+    m = m' ->
+    match_states (mk_instr_state rs ps  m) (mk_instr_state rs' ps' m').
+
+Lemma match_states_refl x : match_states x x.
+Proof. destruct x; constructor; crush. Qed.
+
+Lemma match_states_commut x y : match_states x y -> match_states y x.
+Proof. inversion 1; constructor; crush. Qed.
+
+Lemma match_states_trans x y z :
+  match_states x y -> match_states y z -> match_states x z.
+Proof. repeat inversion 1; constructor; crush. Qed.
+
+#[global] Instance match_states_Equivalence : Equivalence match_states :=
+  { Equivalence_Reflexive := match_states_refl ;
+    Equivalence_Symmetric := match_states_commut ;
+    Equivalence_Transitive := match_states_trans ; }.
+
+Inductive similar {A B} : @ctx A -> @ctx B -> Prop :=
+| similar_intro :
+    forall ist ist' sp ge tge,
+    ge_preserved ge tge ->
+    match_states ist ist' ->
+    similar (mk_ctx ist sp ge) (mk_ctx ist' sp tge).
+
+Lemma ge_preserved_refl:
+  forall A B (a: Genv.t A B), ge_preserved a a.
+Proof. auto. Qed.
+
+Lemma similar_refl:
+  forall A (a: @Abstr.ctx A), similar a a.
+Proof. intros; destruct a; constructor; auto. reflexivity. Qed.
+
+Lemma similar_commut:
+  forall A B (a: @Abstr.ctx A) (b: @Abstr.ctx B), similar a b -> similar b a.
+Proof.
+  inversion 1; constructor; auto.
+  - unfold ge_preserved in *; inv H0; split; intros.
+    rewrite H4; auto. rewrite H5; auto.
+  - symmetry; auto.
+Qed.
+
+Lemma similar_trans:
+  forall A B C (a: @Abstr.ctx A) (b: @Abstr.ctx B) (c: @Abstr.ctx C),
+    similar a b -> similar b c -> similar a c.
+Proof.
+  repeat inversion 1; constructor.
+  - unfold ge_preserved in *; inv H0; inv H9; split; intros.
+    rewrite H11. rewrite H0; auto.
+    rewrite H12. rewrite H2. auto.
+  - transitivity ist'; auto.
+Qed.
+
+Module HashExpr' <: MiniDecidableType.
+  Definition t := expression.
+  Definition eq_dec := expression_dec.
+End HashExpr'.
+
+Module HashExpr := Make_UDT(HashExpr').
+Module Import HT := HashTree(HashExpr).
+
+Module PHashExpr' <: MiniDecidableType.
+  Definition t := pred_expression.
+  Definition eq_dec := pred_expression_dec.
+End PHashExpr'.
+
+Module PHashExpr := Make_UDT(PHashExpr').
+Module PHT := HashTree(PHashExpr).
+
+Module EHashExpr' <: MiniDecidableType.
+  Definition t := exit_expression.
+  Definition eq_dec := exit_expression_dec.
+End EHashExpr'.
+
+Module EHashExpr := Make_UDT(EHashExpr').
+Module EHT := HashTree(EHashExpr).
+
+Fixpoint hash_predicate (max: predicate) (ap: pred_pexpr) (h: PHT.hash_tree)
+  : pred_op * PHT.hash_tree :=
+  match ap with
+  | Ptrue => (Ptrue, h)
+  | Pfalse => (Pfalse, h)
+  | Plit (b, ap') =>
+      let (p', h') := PHT.hash_value max ap' h in
+      (Plit (b, p'), h')
+  | Pand p1 p2 =>
+      let (p1', h') := hash_predicate max p1 h in
+      let (p2', h'') := hash_predicate max p2 h' in
+      (Pand p1' p2', h'')
+  | Por p1 p2 =>
+      let (p1', h') := hash_predicate max p1 h in
+      let (p2', h'') := hash_predicate max p2 h' in
+      (Por p1' p2', h'')
+  end.
+
+Definition predicated_mutexcl {A: Type} (pe: predicated A): Prop :=
+  (forall x y, NE.In x pe -> NE.In y pe -> x <> y -> fst x ⇒ ¬ fst y)
+  /\ NE.norepet pe.
+
+Lemma predicated_cons :
+  forall A (a: pred_op * A) x,
+    predicated_mutexcl (a ::| x) ->
+    predicated_mutexcl x.
+Proof.
+  unfold predicated_mutexcl; intros. inv H. inv H1. split; auto.
+  intros. apply H0; auto; constructor; tauto.
+Qed.
+
+Lemma predicated_singleton :
+  forall A (a: (pred_op * A)), predicated_mutexcl (NE.singleton a).
+Proof.
+  unfold predicated_mutexcl; intros; split; intros.
+  { inv H. now inv H0. }
+  constructor.
+Qed.
+
+(*
+
+Lemma norm_expr_constant :
+  forall x m h t h' e p,
+    HN.norm_expression m x h = (t, h') ->
+    h ! e = Some p ->
+    h' ! e = Some p.
+Proof. Abort.
+
+Definition sat_aequiv ap1 ap2 :=
+  exists h p1 p2,
+    sat_equiv p1 p2
+    /\ hash_predicate 1 ap1 h = (p1, h)
+    /\ hash_predicate 1 ap2 h = (p2, h).
+
+Lemma aequiv_symm : forall a b, sat_aequiv a b -> sat_aequiv b a.
+Proof.
+  unfold sat_aequiv; simplify; do 3 eexists; simplify; [symmetry | |]; eauto.
+Qed.
+
+Lemma existsh :
+  forall ap1,
+  exists h p1,
+    hash_predicate 1 ap1 h = (p1, h).
+Proof. Admitted.
+
+Lemma aequiv_refl : forall a, sat_aequiv a a.
+Proof.
+  unfold sat_aequiv; intros.
+  pose proof (existsh a); simplify.
+  do 3 eexists; simplify; eauto. reflexivity.
+Qed.
+
+Lemma aequiv_trans :
+  forall a b c,
+    sat_aequiv a b ->
+    sat_aequiv b c ->
+    sat_aequiv a c.
+Proof.
+  unfold sat_aequiv; intros.
+  simplify.
+Abort.
+
+Lemma norm_expr_mutexcl :
+  forall m pe h t h' e e' p p',
+    HN.norm_expression m pe h = (t, h') ->
+    predicated_mutexcl pe ->
+    t ! e = Some p ->
+    t ! e' = Some p' ->
+    e <> e' ->
+    p ⇒ ¬ p'.
+Proof. Abort.*)
+
+Definition pred_expr_eqb: forall pe1 pe2: pred_expr,
+  {pe1 = pe2} + {pe1 <> pe2}.
+Proof.
+  pose proof expression_dec.
+  pose proof NE.eq_dec.
+  pose proof (Predicate.eq_dec peq).
+  assert (forall a b: pred_op * expression, {a = b} + {a <> b})
+   by decide equality.
+  decide equality.
+Defined.
+
+Definition pred_pexpr_eqb: forall pe1 pe2: pred_pexpr,
+  {pe1 = pe2} + {pe1 <> pe2}.
+Proof.
+  pose proof pred_expression_dec.
+  pose proof (Predicate.eq_dec pred_expression_dec).
+  apply X.
+Defined.
+
+Definition beq_pred_pexpr (pe1 pe2: pred_pexpr): bool :=
+  if pred_pexpr_eqb pe1 pe2 then true else
+  let (np1, h) := hash_predicate 1 pe1 (PTree.empty _) in
+  let (np2, h') := hash_predicate 1 pe2 h in
+  equiv_check np1 np2.
+
+Lemma inj_asgn_eg : forall a b, (a =? b)%positive = (a =? a)%positive -> a = b.
+Proof.
+  intros. destruct (peq a b); subst.
+  auto. rewrite OrdersEx.Positive_as_OT.eqb_refl in H.
+  now apply Peqb_true_eq.
+Qed.
+
+Lemma inj_asgn :
+  forall a b, (forall (f: positive -> bool), f a = f b) -> a = b.
+Proof. intros. apply inj_asgn_eg. eauto. Qed.
+
+Lemma inj_asgn_false:
+  forall n1 n2 , ~ (forall c: positive -> bool, c n1 = negb (c n2)).
+Proof.
+  unfold not; intros. specialize (H (fun x => true)).
+  simplify. discriminate.
+Qed.
+
+Lemma negb_inj:
+  forall a b,
+    negb a = negb b -> a = b.
+Proof. destruct a, b; crush. Qed.
+
+Lemma sat_predicate_Plit_inj :
+  forall p1 p2,
+    Plit p1 == Plit p2 -> p1 = p2.
+Proof.
+  simplify. destruct p1, p2.
+  destruct b, b0. f_equal. unfold sat_equiv in H. cbn in H. now apply inj_asgn.
+  solve [exfalso; eapply inj_asgn_false; eauto].
+  solve [exfalso; eapply inj_asgn_false; eauto].
+  assert (p = p0). eapply inj_asgn. intros. specialize (H f).
+  apply negb_inj in H. auto. rewrite H0; auto.
+Qed.
+
+Definition ind_preds t :=
+  forall e1 e2 p1 p2 c,
+    e1 <> e2 ->
+    t ! e1 = Some p1 ->
+    t ! e2 = Some p2 ->
+    sat_predicate p1 c = true ->
+    sat_predicate p2 c = false.
+
+Definition ind_preds_l t :=
+  forall (e1: predicate) e2 p1 p2 c,
+    e1 <> e2 ->
+    In (e1, p1) t ->
+    In (e2, p2) t ->
+    sat_predicate p1 c = true ->
+    sat_predicate p2 c = false.
+
+(*Lemma pred_equivalence_Some' :
+  forall ta tb e pe pe',
+    list_norepet (map fst ta) ->
+    list_norepet (map fst tb) ->
+    In (e, pe) ta ->
+    In (e, pe') tb ->
+    fold_right (fun p a => mk_pred_stmnt' (fst p) (snd p) ∧ a) T ta ==
+    fold_right (fun p a => mk_pred_stmnt' (fst p) (snd p) ∧ a) T tb ->
+    pe == pe'.
+Proof.
+  induction ta as [|hd tl Hta]; try solve [crush].
+  - intros * NRP1 NRP2 IN1 IN2 FOLD. inv NRP1. inv IN1.
+    simpl in FOLD.
+
+Lemma pred_equivalence_Some :
+  forall (ta tb: PTree.t pred_op) e pe pe',
+    ta ! e = Some pe ->
+    tb ! e = Some pe' ->
+    mk_pred_stmnt ta == mk_pred_stmnt tb ->
+    pe == pe'.
+Proof.
+  intros * SMEA SMEB EQ. unfold mk_pred_stmnt in *.
+  repeat rewrite PTree.fold_spec in EQ.
+
+Lemma pred_equivalence_None :
+  forall (ta tb: PTree.t pred_op) e pe,
+    (mk_pred_stmnt ta) == (mk_pred_stmnt tb) ->
+    ta ! e = Some pe ->
+    tb ! e = None ->
+    equiv pe ⟂.
+Abort.
+
+Lemma pred_equivalence :
+  forall (ta tb: PTree.t pred_op) e pe,
+    equiv (mk_pred_stmnt ta) (mk_pred_stmnt tb) ->
+    ta ! e = Some pe ->
+    equiv pe ⟂ \/ (exists pe', tb ! e = Some pe' /\ equiv pe pe').
+Proof.
+  intros * EQ SME. destruct (tb ! e) eqn:HTB.
+  { right. econstructor. split; eauto. eapply pred_equivalence_Some; eauto. }
+  { left. eapply pred_equivalence_None; eauto. }
+Qed.*)
+
+Section CORRECT.
+
+  Context {FUN TFUN: Type}.
+
+  Context (ictx: @ctx FUN) (octx: @ctx TFUN) (HSIM: similar ictx octx).
+
+  Lemma sem_value_mem_det:
+    forall e v v' m m',
+      (sem_value ictx e v -> sem_value octx e v' -> v = v')
+      /\ (sem_mem ictx e m -> sem_mem octx e m' -> m = m').
+  Proof using HSIM.
+    induction e using expression_ind2
+      with (P0 := fun p => forall v v',
+                    sem_val_list ictx p v -> sem_val_list octx p v' -> v = v');
+    inv HSIM; match goal with H: context [match_states] |- _ => inv H end; repeat progress simplify;
+    try solve [match goal with
+               | H: sem_value _ _ _, H2: sem_value _ _ _ |- _ => inv H; inv H2; auto
+               | H: sem_mem _ _ _, H2: sem_mem _ _ _ |- _ => inv H; inv H2; auto
+               | H: sem_val_list _ _ _, H2: sem_val_list _ _ _ |- _ => inv H; inv H2; auto
+               end].
+    - repeat match goal with
+             | H: sem_value _ _ _ |- _ => inv H
+             | H: sem_val_list {| ctx_ge := ge; |} ?e ?l1,
+               H2: sem_val_list {| ctx_ge := tge |} ?e ?l2,
+               IH: forall _ _, sem_val_list _ _ _ -> sem_val_list _ _ _ -> _ = _ |- _ =>
+               assert (X: l1 = l2) by (apply IH; auto)
+             | H: ge_preserved _ _ |- _ => inv H
+             | |- context [ctx_rs] => unfold ctx_rs; cbn
+             | H: context [ctx_mem] |- _ => unfold ctx_mem in H; cbn
+             end; crush.
+    - repeat match goal with H: sem_value _ _ _ |- _ => inv H end; simplify;
+      assert (lv0 = lv) by (apply IHe; eauto); subst;
+      match goal with H: ge_preserved _ _ |- _ => inv H end;
+      match goal with H: context [Op.eval_addressing _ _ _ _ = Op.eval_addressing _ _ _ _] |- _
+                      => rewrite H in * end;
+      assert (a0 = a1) by crush;
+      assert (m'2 = m'1) by (apply IHe0; eauto); crush.
+    - inv H0; inv H3. simplify.
+      assert (lv = lv0) by ( apply IHe2; eauto). subst.
+      assert (a1 = a0). { inv H. rewrite H3 in *. crush. }
+      assert (v0 = v1). { apply IHe1; auto. }
+      assert (m'1 = m'2). { apply IHe3; auto. } crush.
+    - inv H0. inv H3. f_equal. apply IHe; auto.
+      apply IHe0; auto.
+  Qed.
+
+  Lemma sem_value_mem_corr:
+    forall e v m,
+      (sem_value ictx e v -> sem_value octx e v)
+      /\ (sem_mem ictx e m -> sem_mem octx e m).
+  Proof using HSIM.
+    induction e using expression_ind2
+      with (P0 := fun p => forall v,
+                    sem_val_list ictx p v -> sem_val_list octx p v);
+    inv HSIM; match goal with H: context [match_states] |- _ => inv H end; repeat progress simplify.
+    - inv H0. unfold ctx_rs, ctx_ps, ctx_mem in *; cbn. rewrite H1. constructor.
+    - inv H0. unfold ctx_rs, ctx_ps, ctx_mem in *; cbn. constructor.
+    - inv H0. apply IHe in H6. econstructor; try eassumption.
+      unfold ctx_rs, ctx_ps, ctx_mem in *; cbn in *. inv H. crush.
+    - inv H0.
+    - inv H0. eapply IHe in H10. eapply IHe0 in H8; auto.
+      econstructor; try eassumption.
+      unfold ctx_rs, ctx_ps, ctx_mem in *; cbn in *. inv H; crush.
+    - inv H0.
+    - inv H0.
+    - inv H0. eapply IHe1 in H11; auto. eapply IHe2 in H12; auto. eapply IHe3 in H9; auto.
+      econstructor; try eassumption.
+      unfold ctx_rs, ctx_ps, ctx_mem in *; cbn in *. inv H; crush.
+    - inv H0. econstructor.
+    - inv H0. eapply IHe in H6; auto. eapply IHe0 in H8.
+      econstructor; eassumption.
+  Qed.
+
+  Lemma sem_value_det:
+    forall e v v', sem_value ictx e v -> sem_value octx e v' -> v = v'.
+  Proof using HSIM.
+    intros. eapply sem_value_mem_det; eauto; apply Mem.empty.
+  Qed.
+
+  Lemma sem_value_corr:
+    forall e v, sem_value ictx e v -> sem_value octx e v.
+  Proof using HSIM.
+    intros. eapply sem_value_mem_corr; eauto; apply Mem.empty.
+  Qed.
+
+  Lemma sem_mem_det:
+    forall e v v', sem_mem ictx e v -> sem_mem octx e v' -> v = v'.
+  Proof using HSIM.
+    intros. eapply sem_value_mem_det; eauto; apply (Vint (Int.repr 0%Z)).
+  Qed.
+
+  Lemma sem_mem_corr:
+    forall e v, sem_mem ictx e v -> sem_mem octx e v.
+  Proof using HSIM.
+    intros. eapply sem_value_mem_corr; eauto; apply (Vint (Int.repr 0%Z)).
+  Qed.
+
+  Lemma sem_val_list_det:
+    forall e l l', sem_val_list ictx e l -> sem_val_list octx e l' -> l = l'.
+  Proof using HSIM.
+    induction e; simplify.
+    - inv H; inv H0; auto.
+    - inv H; inv H0. f_equal. eapply sem_value_det; eauto; try apply Mem.empty.
+      apply IHe; eauto.
+  Qed.
+
+  Lemma sem_val_list_corr:
+    forall e l, sem_val_list ictx e l -> sem_val_list octx e l.
+  Proof using HSIM.
+    induction e; simplify.
+    - inv H; constructor.
+    - inv H. apply sem_value_corr in H3; auto; try apply Mem.empty;
+      apply IHe in H5; constructor; assumption.
+  Qed.
+
+  Lemma sem_pred_det:
+    forall e v v', sem_pred ictx e v -> sem_pred octx e v' -> v = v'.
+  Proof using HSIM.
+    try solve [inversion 1]; pose proof sem_value_det; pose proof sem_val_list_det; inv HSIM;
+      match goal with H: match_states _ _ |- _ => inv H end; simplify.
+    inv H2; inv H5; auto. assert (lv = lv0) by (eapply H0; eauto). subst. unfold ctx_mem in *.
+    crush.
+  Qed.
+
+  Lemma sem_pred_corr:
+    forall e v, sem_pred ictx e v -> sem_pred octx e v.
+  Proof using HSIM.
+    try solve [inversion 1]; pose proof sem_value_corr; pose proof sem_val_list_corr; inv HSIM;
+      match goal with H: match_states _ _ |- _ => inv H end; simplify.
+    inv H2; auto. apply H0 in H5. econstructor; eauto.
+    unfold ctx_ps; cbn. rewrite H4. constructor.
+  Qed.
+
+  Lemma sem_exit_det:
+    forall e v v', sem_exit ictx e v -> sem_exit octx e v' -> v = v'.
+  Proof using HSIM.
+    try solve [inversion 1]; pose proof sem_value_det; pose proof sem_val_list_det; inv HSIM;
+      match goal with H: match_states _ _ |- _ => inv H end; simplify.
+    inv H2; inv H5; auto.
+  Qed.
+
+  Lemma sem_exit_corr:
+    forall e v, sem_exit ictx e v -> sem_exit octx e v.
+  Proof using HSIM.
+    try solve [inversion 1]; pose proof sem_value_corr; pose proof sem_val_list_corr; inv HSIM;
+      match goal with H: match_states _ _ |- _ => inv H end; simplify.
+    inv H2; auto; constructor.
+  Qed.
+
+  Lemma sem_pexpr_det :
+    forall p b1 b2, sem_pexpr ictx p b1 -> sem_pexpr octx p b2 -> b1 = b2.
+  Proof.
+    induction p; crush; inv H; inv H0; firstorder.
+    destruct b.
+    - apply sem_pred_det with (e:=p0); auto.
+    - apply negb_inj. apply sem_pred_det with (e:=p0); auto.
+  Qed.
+
+  Lemma sem_pexpr_corr :
+    forall p b, sem_pexpr ictx p b -> sem_pexpr octx p b.
+  Proof.
+    induction p; crush; inv H; constructor;
+      try solve [try inv H3; firstorder].
+    now apply sem_pred_corr.
+  Qed.
+
+  Lemma sem_pred_exec_beq_correct2 :
+    forall A B (sem: forall G, @Abstr.ctx G -> A -> B -> Prop) a p r R,
+      (forall x y,
+          sem _ ictx x y ->
+          exists y', sem _ octx x y' /\ R y y') ->
+      sem_pred_expr a (sem _) ictx p r ->
+      exists r', sem_pred_expr a (sem _) octx p r' /\ R r r'.
+  Proof.
+    induction p; crush.
+    - inv H0. apply H in H4. simplify.
+      exists x; split; auto.
+      constructor; auto.
+      now apply sem_pexpr_corr.
+    - inv H0.
+      + apply H in H6; simplify.
+        exists x; split; auto.
+        constructor; auto.
+        now apply sem_pexpr_corr.
+      + exploit IHp; auto. exact H6. intros. simplify.
+        exists x; split; auto.
+        apply sem_pred_expr_cons_false; auto.
+        now apply sem_pexpr_corr.
+  Qed.
+  
+  Lemma sem_pred_expr_corr :
+    forall A B (sem: forall G, @Abstr.ctx G -> A -> B -> Prop) a p r,
+      (forall x y, sem _ ictx x y -> sem _ octx x y) ->
+      sem_pred_expr a (sem _) ictx p r ->
+      sem_pred_expr a (sem _) octx p r.
+  Proof.
+    intros.
+    assert
+      (forall x y,
+          sem _ ictx x y ->
+          exists y', sem _ octx x y' /\ eq y y') by firstorder.
+    pose proof (sem_pred_exec_beq_correct2 _ _ sem a p r _ H1 H0).
+    crush.
+  Qed.
+
+  Lemma sem_correct:
+    forall f i cf, sem ictx f (i, cf) -> sem octx f (i, cf).
+  Proof.
+    intros. inv H. constructor.
+    - inv H2. constructor; intros. specialize (H x).
+      apply sem_pred_expr_corr; auto. exact sem_value_corr.
+    - inv H3; constructor; intros. specialize (H x).
+      now apply sem_pexpr_corr.
+    - apply sem_pred_expr_corr; auto. exact sem_mem_corr.
+    - apply sem_pred_expr_corr; auto. exact sem_exit_corr.
+  Qed.
+
+End CORRECT.
+
+Section SEM_PRED_EXEC.
+
+  Context (A: Type).
+  Context (ctx: @Abstr.ctx A).
+
+  Lemma sem_pexpr_negate :
+    forall p b,
+      sem_pexpr ctx p b ->
+      sem_pexpr ctx (¬ p) (negb b).
+  Proof.
+    induction p; crush.
+    - destruct_match. destruct b0; crush. inv Heqp0.
+      constructor. inv H. rewrite negb_involutive. auto.
+      constructor. inv H. auto.
+    - inv H. constructor.
+    - inv H. constructor.
+    - inv H. inv H3.
+      + apply IHp1 in H. solve [constructor; auto].
+      + apply IHp2 in H. solve [constructor; auto].
+      + apply IHp1 in H2. apply IHp2 in H4. solve [constructor; auto].
+    - inv H. inv H3.
+      + apply IHp1 in H. solve [constructor; auto].
+      + apply IHp2 in H. solve [constructor; auto].
+      + apply IHp1 in H2. apply IHp2 in H4. solve [constructor; auto].
+  Qed.
+  
+  Lemma sem_pexpr_negate2 :
+    forall p b,
+      sem_pexpr ctx (¬ p) (negb b) ->
+      sem_pexpr ctx p b.
+  Proof.
+    induction p; crush.
+    - destruct_match. destruct b0; crush. inv Heqp0.
+      constructor. inv H. rewrite negb_involutive in *. auto.
+      constructor. inv H. auto.
+    - inv H. destruct b; try discriminate. constructor.
+    - inv H. destruct b; try discriminate. constructor.
+    - inv H. destruct b; try discriminate.
+      + constructor. inv H1; eauto.
+      + destruct b; try discriminate. constructor; eauto.
+    - inv H. destruct b; try discriminate.
+      + constructor. inv H1; eauto.
+      + destruct b; try discriminate. constructor; eauto.
+  Qed.
+
+  Lemma sem_pexpr_evaluable :
+    forall f_p ps,
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+      forall p, exists b, sem_pexpr ctx (from_pred_op f_p p) b.
+  Proof.
+    induction p; crush.
+    - destruct_match. inv Heqp0. destruct b. econstructor. eauto.
+      econstructor. eapply sem_pexpr_negate. eauto.
+    - econstructor. constructor.
+    - econstructor. constructor.
+    - destruct x0, x; solve [eexists; constructor; auto].
+    - destruct x0, x; solve [eexists; constructor; auto].
+  Qed.
+
+  Lemma sem_pexpr_eval1 :
+    forall f_p ps,
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+      forall p,
+        eval_predf ps p = false ->
+        sem_pexpr ctx (from_pred_op f_p p) false.
+  Proof.
+    induction p; crush.
+    - destruct_match. inv Heqp0.
+      destruct b.
+      + cbn in H0. rewrite <- H0. eauto.
+      + replace false with (negb true) by auto.
+        apply sem_pexpr_negate. cbn in H0.
+        apply negb_true_iff in H0. rewrite negb_involutive in H0.
+        rewrite <- H0. eauto.
+     - constructor.
+     - rewrite eval_predf_Pand in H0.
+       apply andb_false_iff in H0. inv H0. eapply IHp1 in H1.
+       pose proof (sem_pexpr_evaluable _ _ H p2) as EVAL.
+       inversion_clear EVAL as [x EVAL2].
+       replace false with (false && x) by auto.
+       constructor; auto.
+       eapply IHp2 in H1.
+       pose proof (sem_pexpr_evaluable _ _ H p1) as EVAL.
+       inversion_clear EVAL as [x EVAL2].
+       replace false with (x && false) by eauto with bool.
+       apply sem_pexpr_Pand; auto.
+     - rewrite eval_predf_Por in H0.
+       apply orb_false_iff in H0. inv H0.
+       replace false with (false || false) by auto.
+       apply sem_pexpr_Por; auto.
+  Qed.
+
+  Lemma sem_pexpr_eval2 :
+    forall f_p ps,
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+      forall p,
+        eval_predf ps p = true ->
+        sem_pexpr ctx (from_pred_op f_p p) true.
+  Proof.
+    induction p; crush.
+    - destruct_match. inv Heqp0.
+      destruct b.
+      + cbn in H0. rewrite <- H0. eauto.
+      + replace true with (negb false) by auto.
+        apply sem_pexpr_negate. cbn in H0.
+        apply negb_true_iff in H0.
+        rewrite <- H0. eauto.
+     - constructor.
+     - rewrite eval_predf_Pand in H0.
+       apply andb_true_iff in H0. inv H0.
+       replace true with (true && true) by auto.
+       constructor; auto.
+     - rewrite eval_predf_Por in H0.
+       apply orb_true_iff in H0. inv H0. eapply IHp1 in H1.
+       pose proof (sem_pexpr_evaluable _ _ H p2) as EVAL.
+       inversion_clear EVAL as [x EVAL2].
+       replace true with (true || x) by auto.
+       apply sem_pexpr_Por; auto.
+       eapply IHp2 in H1.
+       pose proof (sem_pexpr_evaluable _ _ H p1) as EVAL.
+       inversion_clear EVAL as [x EVAL2].
+       replace true with (x || true) by eauto with bool.
+       apply sem_pexpr_Por; auto.
+  Qed.
+
+  Lemma sem_pexpr_eval :
+    forall f_p ps b,
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+      forall p,
+        eval_predf ps p = b ->
+        sem_pexpr ctx (from_pred_op f_p p) b.
+  Proof.
+    intros; destruct b; eauto using sem_pexpr_eval1, sem_pexpr_eval2.
+  Qed.
+
+  Lemma sem_pexpr_eval_inv :
+    forall f_p ps b,
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+      forall p,
+        sem_pexpr ctx (from_pred_op f_p p) b ->
+        eval_predf ps p = b.
+  Proof.
+    induction p; intros.
+    - cbn in H0. destruct_match. destruct b0; cbn in *.
+      + specialize (H p0). eapply sem_pexpr_det; eauto. apply similar_refl.
+      + rewrite <- negb_involutive in H0. apply sem_pexpr_negate2 in H0.
+        symmetry; apply negb_sym. eapply sem_pexpr_det; eauto.
+        apply similar_refl.
+    - now inv H0.
+    - now inv H0.
+    - inv H0; try inv H4; rewrite eval_predf_Pand.
+      + apply IHp1 in H0. rewrite H0. auto.
+      + apply IHp2 in H0. rewrite H0. auto with bool.
+      + apply IHp2 in H5. apply IHp1 in H3. rewrite H3. rewrite H5. auto.
+    - inv H0; try inv H4; rewrite eval_predf_Por.
+      + apply IHp1 in H0. rewrite H0. auto.
+      + apply IHp2 in H0. rewrite H0. auto with bool.
+      + apply IHp2 in H5. apply IHp1 in H3. rewrite H3. rewrite H5. auto.
+  Qed.
+
+  Context {C B: Type}.
+  Context (f: PTree.t pred_pexpr).
+  Context (ps: PMap.t bool).
+  Context (a_sem: @Abstr.ctx A -> C -> B -> Prop).
+
+  Context (F_EVALULABLE: forall x, sem_pexpr ctx (get_forest_p' x f) ps !! x).
+
+  Lemma sem_pexpr_equiv :
+    forall p1 p2 b,
+      p1 == p2 ->
+      sem_pexpr ctx (from_pred_op f p1) b ->
+      sem_pexpr ctx (from_pred_op f p2) b.
+  Proof.
+    intros.
+    eapply sem_pexpr_eval_inv in H0; eauto.
+    eapply sem_pexpr_eval; eauto.
+  Qed.
+
+End SEM_PRED_EXEC.
+
+Module HashExprNorm(HS: Hashable).
+  Module H := HashTree(HS).
+
+  Definition norm_tree: Type := PTree.t pred_op * H.hash_tree.
+
+  Fixpoint norm_expression (max: predicate) (pe: predicated HS.t) (h: H.hash_tree)
+    : norm_tree :=
+    match pe with
+    | NE.singleton (p, e) =>
+        let (hashed_e, h') := H.hash_value max e h in
+        (PTree.set hashed_e p (PTree.empty _), h')
+    | (p, e) ::| pr =>
+        let (hashed_e, h') := H.hash_value max e h in
+        let (norm_pr, h'') := norm_expression max pr h' in
+        match norm_pr ! hashed_e with
+        | Some pr_op =>
+            (PTree.set hashed_e (pr_op ∨ p) norm_pr, h'')
+        | None =>
+            (PTree.set hashed_e p norm_pr, h'')
+        end
+    end.
+
+  Definition mk_pred_stmnt' (e: predicate) p_e := ¬ p_e ∨ Plit (true, e).
+
+  Definition mk_pred_stmnt t := PTree.fold (fun x a b => mk_pred_stmnt' a b ∧ x) t T.
+
+  Definition mk_pred_stmnt_l (t: list (predicate * pred_op)) :=
+    fold_left (fun x a => uncurry mk_pred_stmnt' a ∧ x) t T.
+
+  Definition encode_expression max pe h :=
+    let (tree, h) := norm_expression max pe h in
+    (mk_pred_stmnt tree, h).
+
+  Definition pred_expr_dec: forall pe1 pe2: predicated HS.t,
+    {pe1 = pe2} + {pe1 <> pe2}.
+  Proof.
+    pose proof HS.eq_dec as X.
+    pose proof (Predicate.eq_dec peq).
+    pose proof (NE.eq_dec _ X).
+    assert (forall a b: pred_op * HS.t, {a = b} + {a <> b})
+     by decide equality.
+    decide equality.
+  Defined.
+
+  Definition beq_pred_expr' (pe1 pe2: predicated HS.t) : bool :=
+    if pred_expr_dec pe1 pe2 then true else
+    let (p1, h) := encode_expression 1%positive pe1 (PTree.empty _) in
+    let (p2, h') := encode_expression 1%positive pe2 h in
+    equiv_check p1 p2.
+
+  Lemma mk_pred_stmnt_equiv' :
+    forall l l' e p,
+      mk_pred_stmnt_l l == mk_pred_stmnt_l l' ->
+      In (e, p) l ->
+      list_norepet (map fst l) ->
+      (exists p', In (e, p') l' /\ p == p')
+      \/ ~ In e (map fst l') /\ p == ⟂.
+  Proof. Abort.
+
+  Lemma mk_pred_stmnt_equiv :
+    forall tree tree',
+      mk_pred_stmnt tree == mk_pred_stmnt tree'.
+  Proof. Abort.
+
+  Definition tree_equiv_check_el (np2: PTree.t pred_op) (n: positive) (p: pred_op): bool :=
+    match np2 ! n with
+    | Some p' => equiv_check p p'
+    | None => equiv_check p ⟂
+    end.
+  
+  Definition tree_equiv_check_None_el (np2: PTree.t pred_op) (n: positive) (p: pred_op): bool :=
+    match np2 ! n with
+    | Some p' => true
+    | None => equiv_check p ⟂
+    end.
+
+  Definition beq_pred_expr (pe1 pe2: predicated HS.t) : bool :=
+    if pred_expr_dec pe1 pe2 then true else
+    let (np1, h) := norm_expression 1 pe1 (PTree.empty _) in
+    let (np2, h') := norm_expression 1 pe2 h in
+    forall_ptree (tree_equiv_check_el np2) np1
+    && forall_ptree (tree_equiv_check_None_el np1) np2.
+
+  Lemma beq_pred_expr_correct:
+    forall np1 np2 e p p',
+      forall_ptree (tree_equiv_check_el np2) np1 = true ->
+      np1 ! e = Some p ->
+      np2 ! e = Some p' ->
+      p == p'.
+  Proof.
+    intros.
+    eapply forall_ptree_true in H; try eassumption.
+    unfold tree_equiv_check_el in H.
+    rewrite H1 in H. now apply equiv_check_correct.
+  Qed.
+
+  Lemma beq_pred_expr_correct2:
+    forall np1 np2 e p,
+      forall_ptree (tree_equiv_check_el np2) np1 = true ->
+      np1 ! e = Some p ->
+      np2 ! e = None ->
+      p == ⟂.
+  Proof.
+    intros.
+    eapply forall_ptree_true in H; try eassumption.
+    unfold tree_equiv_check_el in H.
+    rewrite H1 in H. now apply equiv_check_correct.
+  Qed.
+
+  Lemma beq_pred_expr_correct3:
+    forall np1 np2 e p,
+      forall_ptree (tree_equiv_check_None_el np1) np2 = true ->
+      np1 ! e = None ->
+      np2 ! e = Some p ->
+      p == ⟂.
+  Proof.
+    intros.
+    eapply forall_ptree_true in H; try eassumption.
+    unfold tree_equiv_check_None_el in H.
+    rewrite H0 in H. now apply equiv_check_correct.
+  Qed.
+
+  Section PRED_PROOFS.
+
+  Context {G B: Type}.
+  Context (f: PTree.t pred_pexpr).
+  Context (ps: PMap.t bool).
+  Context (a_sem: @Abstr.ctx G -> HS.t -> B -> Prop).
+  Context (ctx: @Abstr.ctx G).
+
+  Context (F_EVALULABLE: forall x, sem_pexpr ctx (get_forest_p' x f) ps !! x).
+
+  Variant sem_pred_tree: PTree.t HS.t -> PTree.t pred_op -> B -> Prop :=
+  | sem_pred_tree_intro :
+      forall expr e v et pt pr,
+        sem_pexpr ctx (from_pred_op f pr) true ->
+        a_sem ctx expr v ->
+        pt ! e = Some pr ->
+        et ! e = Some expr ->
+        sem_pred_tree et pt v.
+
+  Lemma norm_expression_in :
+    forall pe et pt h x y,
+      H.wf_hash_table h ->
+      norm_expression 1 pe h = (pt, et) ->
+      h ! x = Some y ->
+      et ! x = Some y.
+  Proof.
+    induction pe; crush; repeat (destruct_match; try discriminate; []).
+    - inv H0. eauto using H.hash_constant.
+    - destruct_match.
+      + inv H0. eapply IHpe.
+        eapply H.wf_hash_table_distr; eauto. eauto.
+        eauto using H.hash_constant.
+      + inv H0. eapply IHpe.
+        eapply H.wf_hash_table_distr; eauto. eauto.
+        eauto using H.hash_constant.
+  Qed.
+
+  Lemma norm_expression_exists :
+    forall pe et pt h x y,
+      H.wf_hash_table h ->
+      norm_expression 1 pe h = (pt, et) ->
+      pt ! x = Some y ->
+      exists z, et ! x = Some z.
+  Proof.
+    induction pe; crush; repeat (destruct_match; try discriminate; []).
+    - inv H0. destruct (peq x h0); subst; inv H1.
+      + eexists. eauto using H.hash_value_in.
+      + rewrite PTree.gso in H2 by auto. now rewrite PTree.gempty in H2.
+    - assert (H.wf_hash_table h1) by eauto using H.wf_hash_table_distr.
+      destruct_match; inv H0.
+      + destruct (peq h0 x); subst; eauto. 
+        rewrite PTree.gso in H1 by auto. eauto.
+      + destruct (peq h0 x); subst; eauto.
+        * pose proof Heqp0 as X.
+          eapply H.hash_value_in in Heqp0.
+          eapply norm_expression_in in Heqn; eauto.
+        * rewrite PTree.gso in H1 by auto. eauto.
+  Qed.
+
+  Lemma norm_expression_wf :
+    forall pe et pt h,
+      H.wf_hash_table h ->
+      norm_expression 1 pe h = (pt, et) ->
+      H.wf_hash_table et.
+  Proof.
+    induction pe; crush; repeat (destruct_match; try discriminate; []).
+    - inv H0. eauto using H.wf_hash_table_distr.
+    - destruct_match.
+      + inv H0. eapply IHpe.
+        eapply H.wf_hash_table_distr; eauto. eauto.
+      + inv H0. eapply IHpe.
+        eapply H.wf_hash_table_distr; eauto. eauto.
+  Qed.
+
+  Lemma sem_pred_expr_in_true :
+    forall pe v,
+      sem_pred_expr f a_sem ctx pe v ->
+      exists p e, NE.In (p, e) pe
+                  /\ sem_pexpr ctx (from_pred_op f p) true
+                  /\ a_sem ctx e v.
+  Proof.
+    induction pe; crush.
+    - inv H. do 2 eexists; split; try split; eauto. constructor.
+    - inv H.
+      + do 2 eexists; split; try split; eauto. constructor; tauto.
+      + exploit IHpe; eauto. simplify.
+        do 2 eexists; split; try split; eauto. constructor; tauto.
+  Qed.
+
+  Definition pred_Ht_dec :
+    forall x y: pred_op * HS.t, {x = y} + {x <> y}.
+  Proof.
+    pose proof HS.eq_dec.
+    pose proof (@Predicate.eq_dec positive peq).
+    decide equality.
+  Defined.
+
+  Lemma sem_pred_mutexcl :
+    forall pe p t v,
+      predicated_mutexcl ((p, t) ::| pe) ->
+      sem_pred_expr f a_sem ctx pe v ->
+      sem_pexpr ctx (from_pred_op f p) false.
+  Proof.
+    intros. unfold predicated_mutexcl in H.
+    exploit sem_pred_expr_in_true; eauto; simplify.
+    unfold "⇒" in *. inv H5.
+    destruct (pred_Ht_dec (x, x0) (p, t)); subst.
+    { inv e; exfalso; apply H7; auto. }
+    assert (NE.In (x, x0) ((p, t) ::| pe)) by (constructor; tauto).
+    assert (NE.In (p, t) ((p, t) ::| pe)) by (constructor; tauto).
+    pose proof (H3 _ _ H H5 n).
+    assert (forall c, eval_predf c x = true -> eval_predf c (¬ p) = true)
+      by eauto.
+    eapply sem_pexpr_eval_inv in H1; eauto.
+    eapply sem_pexpr_eval; eauto. apply H9 in H1.
+    unfold eval_predf in *. rewrite negate_correct in H1.
+    symmetry in H1. apply negb_sym in H1. auto.
+  Qed.
+
+  Lemma exec_tree_exec_pe :
+    forall pe et pt v h
+      (MUTEXCL: predicated_mutexcl pe),
+      H.wf_hash_table h ->
+      norm_expression 1 pe h = (pt, et) ->
+      sem_pred_tree et pt v ->
+      sem_pred_expr f a_sem ctx pe v.
+  Proof.
+    induction pe; simplify; repeat (destruct_match; try discriminate; []).
+    - inv Heqp. inv H0. inv H1.
+      destruct (peq e h0); subst.
+      2: { rewrite PTree.gso in H3 by auto.
+           rewrite PTree.gempty in H3. discriminate. }
+      assert (expr = t).
+      { apply H.hash_value_in in Heqp0. rewrite H4 in Heqp0. now inv Heqp0. }
+      subst. constructor; auto. rewrite PTree.gss in H3. inv H3; auto.
+    - inv Heqp. inv H1. destruct_match; inv H0; destruct (peq h0 e); subst.
+      + rewrite PTree.gss in H4. inv H4. inv H2. inv H1.
+        * exploit IHpe. eauto using predicated_cons.
+          eapply H.wf_hash_table_distr; eauto. eauto.
+          econstructor. eauto. eauto. eauto. eauto. intros.
+          assert (sem_pexpr ctx (from_pred_op f p) false)
+            by (eapply sem_pred_mutexcl; eauto).
+          eapply sem_pred_expr_cons_false; auto.
+        * assert (et ! e = Some t).
+          { eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
+            eauto. apply H.hash_value_in in Heqp0.  auto. }
+          rewrite H1 in H5. inv H5.
+          constructor; auto.
+      + exploit IHpe. eauto using predicated_cons.
+        eapply H.wf_hash_table_distr; eauto. eauto.
+        econstructor. eauto. eauto. rewrite PTree.gso in H4; eauto. auto.
+        intros.
+        assert (sem_pexpr ctx (from_pred_op f p) false)
+          by (eapply sem_pred_mutexcl; eauto).
+        eapply sem_pred_expr_cons_false; auto.
+      + rewrite PTree.gss in H4. inv H4.
+        econstructor; auto.
+        assert (et ! e = Some t).
+          { eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
+            eauto. apply H.hash_value_in in Heqp0.  auto. }
+        rewrite H0 in H5; inv H5. auto.
+      + rewrite PTree.gso in H4 by auto.
+        exploit IHpe. eauto using predicated_cons.
+        eapply H.wf_hash_table_distr; eauto. eauto.
+        econstructor. eauto. eauto. eauto. eauto. intros.
+        assert (sem_pexpr ctx (from_pred_op f p) false)
+          by (eapply sem_pred_mutexcl; eauto).
+        eapply sem_pred_expr_cons_false; auto.
+  Qed.
+
+  Lemma exec_pe_exec_tree :
+    forall pe et pt v h
+      (MUTEXCL: predicated_mutexcl pe),
+      H.wf_hash_table h ->
+      norm_expression 1 pe h = (pt, et) ->
+      sem_pred_expr f a_sem ctx pe v ->
+      sem_pred_tree et pt v.
+  Proof.
+    induction pe; simplify; repeat (destruct_match; try discriminate; []).
+    - inv H0. inv H1. econstructor; eauto. apply PTree.gss.
+      eapply H.hash_value_in; eauto.
+    - inv H1.
+      + destruct_match.
+        * inv H0. econstructor.
+          2: { eauto. }
+          2: { apply PTree.gss. }
+          constructor; tauto.
+          eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
+          eauto. eapply H.hash_value_in; eauto.
+        * inv H0. econstructor. eauto. eauto. apply PTree.gss.
+          eapply norm_expression_in. eapply H.wf_hash_table_distr; eauto.
+          eauto. eapply H.hash_value_in; eauto.
+      + destruct_match.
+        * inv H0. exploit IHpe.
+          eauto using predicated_cons.
+          eapply H.wf_hash_table_distr; eauto.
+          eauto. eauto. intros. inv H0.
+          destruct (peq e h0); subst.
+          -- rewrite H3 in Heqo. inv Heqo.
+             econstructor.
+             3: { apply PTree.gss. }
+             constructor; tauto. eauto. auto.
+          -- econstructor. eauto. eauto. rewrite PTree.gso by eauto. auto.
+             auto.
+        * inv H0. exploit IHpe.
+          eauto using predicated_cons.
+          eapply H.wf_hash_table_distr; eauto.
+          eauto. eauto. intros. inv H0.
+          destruct (peq e h0); subst.
+          -- rewrite H3 in Heqo; discriminate.
+          -- econstructor; eauto. rewrite PTree.gso by auto. auto.
+  Qed.
+
+  Lemma beq_pred_expr_correct_top:
+    forall p1 p2 v
+           (MUTEXCL1: predicated_mutexcl p1)
+           (MUTEXCL2: predicated_mutexcl p2),
+      beq_pred_expr p1 p2 = true ->
+      sem_pred_expr f a_sem ctx p1 v ->
+      sem_pred_expr f a_sem ctx p2 v.
+  Proof.
+    unfold beq_pred_expr; intros.
+    destruct_match; subst; auto.
+    repeat (destruct_match; []).
+    symmetry in H. apply andb_true_eq in H. inv H.
+    symmetry in H1. symmetry in H2.
+    pose proof Heqn0. eapply norm_expression_wf in H.
+    2: { unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3. }
+    eapply exec_tree_exec_pe; eauto.
+    eapply exec_pe_exec_tree in H0; auto.
+    3: { eauto. }
+    2: { unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3. }
+    inv H0. destruct (t0 ! e) eqn:?.
+    - assert (pr == p) by eauto using beq_pred_expr_correct.
+      assert (sem_pexpr ctx (from_pred_op f p) true).
+      { eapply sem_pexpr_eval; eauto. eapply sem_pexpr_eval_inv in H3; eauto. }
+      econstructor. apply H7. eauto. eauto.
+      eapply norm_expression_in; eauto.
+    - assert (pr == ⟂) by eauto using beq_pred_expr_correct2.
+      eapply sem_pexpr_eval_inv in H3; eauto. now rewrite H0 in H3.
+  Qed.
+
+  Lemma beq_pred_expr_correct_top2:
+    forall p1 p2 v
+           (MUTEXCL1: predicated_mutexcl p1)
+           (MUTEXCL2: predicated_mutexcl p2),
+      beq_pred_expr p1 p2 = true ->
+      sem_pred_expr f a_sem ctx p2 v ->
+      sem_pred_expr f a_sem ctx p1 v.
+  Proof.
+    unfold beq_pred_expr; intros.
+    destruct_match; subst; auto.
+    repeat (destruct_match; []).
+    symmetry in H. apply andb_true_eq in H. inv H.
+    symmetry in H1. symmetry in H2.
+    pose proof Heqn0. eapply norm_expression_wf in H.
+    2: { unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3. }
+    eapply exec_tree_exec_pe; auto.
+    2: { eauto. }
+    unfold H.wf_hash_table; intros. now rewrite PTree.gempty in H3.
+    eapply exec_pe_exec_tree in H0; auto.
+    3: { eauto. }
+    2: { auto. }
+    inv H0. destruct (t ! e) eqn:?.
+    - assert (p == pr) by eauto using beq_pred_expr_correct.
+      assert (sem_pexpr ctx (from_pred_op f p) true).
+      { eapply sem_pexpr_eval; eauto. eapply sem_pexpr_eval_inv in H3; eauto. }
+      econstructor. apply H7. eauto. eauto.
+      exploit norm_expression_exists.
+      2: { eapply Heqn0. }  unfold H.wf_hash_table; intros * YH.
+      now rewrite PTree.gempty in YH. eauto. simplify.
+      exploit norm_expression_in. 2: { eauto. } auto. eauto. intros.
+      crush.
+    - assert (pr == ⟂) by eauto using beq_pred_expr_correct3.
+      eapply sem_pexpr_eval_inv in H3; eauto. now rewrite H0 in H3.
+  Qed.
+
+  End PRED_PROOFS.
+
+End HashExprNorm.
+
+Module HN := HashExprNorm(HashExpr).
+Module EHN := HashExprNorm(EHashExpr).
+
+Definition check_mutexcl {A} (pe: predicated A) :=
+  let preds := map fst (NE.to_list pe) in
+  let pairs := map (fun x => x → or_list (remove (Predicate.eq_dec peq) x preds)) preds in
+  match sat_pred_simple (simplify (negate (and_list pairs))) with
+  | None => true
+  | _ => false
+  end.
+
+Lemma check_mutexcl_correct:
+  forall A (pe: predicated A),
+    check_mutexcl pe = true ->
+    predicated_mutexcl pe.
+Proof. Admitted.
+
+Definition check_mutexcl_tree {A} (f: PTree.t (predicated A)) :=
+  forall_ptree (fun _ => check_mutexcl) f.
+
+Lemma check_mutexcl_tree_correct:
+  forall A (f: PTree.t (predicated A)) i pe,
+    check_mutexcl_tree f = true ->
+    f ! i = Some pe ->
+    predicated_mutexcl pe.
+Proof.
+  unfold check_mutexcl_tree; intros.
+  eapply forall_ptree_true in H; eauto using check_mutexcl_correct.
+Qed.
+
+Definition check f1 f2 :=
+  RTree.beq HN.beq_pred_expr f1.(forest_regs) f2.(forest_regs)
+  && PTree.beq beq_pred_pexpr f1.(forest_preds) f2.(forest_preds)
+  && EHN.beq_pred_expr f1.(forest_exit) f2.(forest_exit)
+  && check_mutexcl_tree f1.(forest_regs)
+  && check_mutexcl_tree f2.(forest_regs)
+  && check_mutexcl f1.(forest_exit)
+  && check_mutexcl f2.(forest_exit).
+
+Lemma sem_pexpr_forward_eval1 :
+  forall A ctx f_p ps,
+    (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+    forall p,
+      @sem_pexpr A ctx (from_pred_op f_p p) false ->
+      eval_predf ps p = false.
+Proof.
+  induction p; crush.
+  - destruct_match. inv Heqp0. destruct b.
+    cbn. specialize (H p0).
+    eapply sem_pexpr_det; eauto. apply similar_refl.
+    specialize (H p0).
+    replace false with (negb true) in H0 by auto.
+    eapply sem_pexpr_negate2 in H0. cbn.
+    symmetry; apply negb_sym. cbn.
+    eapply sem_pexpr_det; eauto. apply similar_refl.
+  - inv H0.
+  - inv H0. inv H2. rewrite eval_predf_Pand. rewrite IHp1; eauto.
+    rewrite eval_predf_Pand. rewrite IHp2; eauto with bool.
+  - inv H0. rewrite eval_predf_Por. rewrite IHp1; eauto.
+Qed.
+
+Lemma sem_pexpr_forward_eval2 :
+  forall A ctx f_p ps,
+    (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+    forall p,
+      @sem_pexpr A ctx (from_pred_op f_p p) true ->
+      eval_predf ps p = true.
+Proof.
+  induction p; crush.
+  - destruct_match. inv Heqp0. destruct b.
+    cbn. specialize (H p0).
+    eapply sem_pexpr_det; eauto. apply similar_refl.
+    cbn. symmetry. apply negb_sym; cbn.
+    replace true with (negb false) in H0 by auto.
+    eapply sem_pexpr_negate2 in H0.
+    eapply sem_pexpr_det; eauto. apply similar_refl.
+  - inv H0.
+  - inv H0. rewrite eval_predf_Pand. rewrite IHp1; eauto.
+  - inv H0. inv H2. rewrite eval_predf_Por. rewrite IHp1; eauto.
+    rewrite eval_predf_Por. rewrite IHp2; eauto with bool.
+Qed.
+
+Lemma sem_pexpr_forward_eval :
+  forall A ctx f_p ps,
+    (forall x, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+    forall p b,
+      @sem_pexpr A ctx (from_pred_op f_p p) b ->
+      eval_predf ps p = b.
+Proof.
+  intros; destruct b; eauto using sem_pexpr_forward_eval1, sem_pexpr_forward_eval2.
+Qed.
+
+Section BOOLEAN_EQUALITY.
+
+  Context {A B: Type}.
+  Context (beqA: A -> B -> bool).
+
+  Fixpoint beq2' (m1: PTree.tree' A) (m2: PTree.tree' B) {struct m1} : bool :=
+    match m1, m2 with
+    | PTree.Node001 r1, PTree.Node001 r2 => beq2' r1 r2
+    | PTree.Node010 x1, PTree.Node010 x2 => beqA x1 x2
+    | PTree.Node011 x1 r1, PTree.Node011 x2 r2 => beqA x1 x2 && beq2' r1 r2
+    | PTree.Node100 l1, PTree.Node100 l2 => beq2' l1 l2
+    | PTree.Node101 l1 r1, PTree.Node101 l2 r2 => beq2' l1 l2 && beq2' r1 r2
+    | PTree.Node110 l1 x1, PTree.Node110 l2 x2 => beqA x1 x2 && beq2' l1 l2
+    | PTree.Node111 l1 x1 r1, PTree.Node111 l2 x2 r2  => beqA x1 x2 && beq2' l1 l2 && beq2' r1 r2
+    | _, _ => false
+    end.
+
+  Definition beq2 (m1: PTree.t A) (m2 : PTree.t B) : bool :=
+    match m1, m2 with
+    | PTree.Empty, PTree.Empty => true
+    | PTree.Nodes m1', PTree.Nodes m2' => beq2' m1' m2'
+    | _, _ => false
+    end.
+
+  Let beq2_optA (o1: option A) (o2: option B) : bool :=
+    match o1, o2 with
+    | None, None => true
+    | Some a1, Some a2 => beqA a1 a2
+    | _, _ => false
+    end.
+
+  Lemma beq_correct_bool:
+    forall m1 m2,
+      beq2 m1 m2 = true <-> (forall x, beq2_optA (m1 ! x) (m2 ! x) = true).
+  Proof.
+    Local Transparent PTree.Node.
+    assert (beq_NN: forall l1 o1 r1 l2 o2 r2,
+               PTree.not_trivially_empty l1 o1 r1 ->
+               PTree.not_trivially_empty l2 o2 r2 ->
+               beq2 (PTree.Node l1 o1 r1) (PTree.Node l2 o2 r2) =
+                 beq2 l1 l2 && beq2_optA o1 o2 && beq2 r1 r2).
+    { intros.
+      destruct l1, o1, r1; try contradiction; destruct l2, o2, r2; try contradiction;
+        simpl; rewrite ? andb_true_r, ? andb_false_r; auto.
+      rewrite andb_comm; auto.
+      f_equal; rewrite andb_comm; auto. }
+    induction m1 using PTree.tree_ind; [|induction m2 using PTree.tree_ind].
+    - intros. simpl; split; intros.
+      + destruct m2; try discriminate. simpl; auto.
+      + replace m2 with (@PTree.Empty B); auto. apply PTree.extensionality; intros x.
+        specialize (H x). destruct (m2 ! x); simpl; easy.
+    - split; intros.
+      + destruct (PTree.Node l o r); try discriminate. simpl; auto.
+      + replace (PTree.Node l o r) with (@PTree.Empty A); auto. apply PTree.extensionality; intros x.
+        specialize (H0 x). destruct ((PTree.Node l o r) ! x); simpl in *; easy.
+    - rewrite beq_NN by auto. split; intros.
+      + InvBooleans. rewrite ! PTree.gNode. destruct x.
+        * apply IHm0; auto.
+        * apply IHm1; auto.
+        * auto.
+      + apply andb_true_intro; split; [apply andb_true_intro; split|].
+        * apply IHm1. intros. specialize (H1 (xO x)); rewrite ! PTree.gNode in H1; auto.
+        * specialize (H1 xH); rewrite ! PTree.gNode in H1; auto.
+        * apply IHm0. intros. specialize (H1 (xI x)); rewrite ! PTree.gNode in H1; auto.
+  Qed.
+
+  Theorem beq2_correct:
+    forall m1 m2,
+      beq2 m1 m2 = true <->
+        (forall (x: PTree.elt),
+            match m1 ! x, m2 ! x with
+            | None, None => True
+            | Some y1, Some y2 => beqA y1 y2 = true
+            | _, _ => False
+            end).
+  Proof.
+    intros. rewrite beq_correct_bool. unfold beq2_optA. split; intros.
+    - specialize (H x). destruct (m1 ! x), (m2 ! x); intuition congruence.
+    - specialize (H x). destruct (m1 ! x), (m2 ! x); intuition auto.
+  Qed.
+
+End BOOLEAN_EQUALITY.
+
+Section GENERIC_CONTEXT.
+
+Context {A: Type}.
+Context (ctx: @ctx A).
+
+(*|
+Suitably restrict the predicate set so that one can evaluate a hashed predicate
+using that predicate set.  However, one issue might be that we do not know that
+all the atoms of the original formula are actually evaluable.
+|*)
+
+Definition match_pred_states
+  (ht: PHT.hash_tree) (p_out: pred_op) (pred_set: predset) :=
+  forall (p: positive) (br: bool) (p_in: pred_expression),
+    PredIn p p_out ->
+    ht ! p = Some p_in ->
+    sem_pred ctx p_in (pred_set !! p).
+
+Lemma eval_hash_predicate :
+  forall max p_in ht p_out ht' br pred_set,
+    hash_predicate max p_in ht = (p_out, ht') ->
+    sem_pexpr ctx p_in br ->
+    match_pred_states ht' p_out pred_set ->
+    eval_predf pred_set p_out = br.
+Proof.
+  induction p_in; simplify.
+  + repeat destruct_match. inv H.
+    unfold eval_predf. cbn.
+    inv H0. inv H4. unfold match_pred_states in H1.
+    specialize (H1 h br).
+Abort.
+
+Lemma sem_pexpr_beq_correct :
+  forall p1 p2 b,
+    beq_pred_pexpr p1 p2 = true ->
+    sem_pexpr ctx p1 b ->
+    sem_pexpr ctx p2 b.
+Proof.
+  unfold beq_pred_pexpr.
+  induction p1; intros; destruct_match; crush.
+  Admitted.
+
+(*|
+This should only require a proof of sem_pexpr_beq_correct, the rest is
+straightforward.
+|*)
+
+Lemma pred_pexpr_beq_pred_pexpr :
+  forall pr a b br,
+    PTree.beq beq_pred_pexpr a b = true ->
+    sem_pexpr ctx (from_pred_op a pr) br ->
+    sem_pexpr ctx (from_pred_op b pr) br.
+Proof.
+  induction pr; crush.
+  - destruct_match. inv Heqp0. destruct b0.
+    + unfold get_forest_p' in *.
+      apply PTree.beq_correct with (x := p0) in H.
+      destruct a ! p0; destruct b ! p0; try (exfalso; assumption); auto.
+      eapply sem_pexpr_beq_correct; eauto.
+    + replace br with (negb (negb br)) by (now apply negb_involutive).
+      replace br with (negb (negb br)) in H0 by (now apply negb_involutive).
+      apply sem_pexpr_negate. apply sem_pexpr_negate2 in H0.
+      unfold get_forest_p' in *.
+      apply PTree.beq_correct with (x := p0) in H.
+      destruct a ! p0; destruct b ! p0; try (exfalso; assumption); auto.
+      eapply sem_pexpr_beq_correct; eauto.
+  - inv H0; try inv H4.
+    + eapply IHpr1 in H0; eauto. apply sem_pexpr_Pand_false; tauto.
+    + eapply IHpr2 in H0; eauto. apply sem_pexpr_Pand_false; tauto.
+    + eapply IHpr1 in H3; eauto. eapply IHpr2 in H5; eauto.
+      apply sem_pexpr_Pand_true; auto.
+  - inv H0; try inv H4.
+    + eapply IHpr1 in H0; eauto. apply sem_pexpr_Por_true; tauto.
+    + eapply IHpr2 in H0; eauto. apply sem_pexpr_Por_true; tauto.
+    + eapply IHpr1 in H3; eauto. eapply IHpr2 in H5; eauto.
+      apply sem_pexpr_Por_false; auto.
+Qed.
+
+(*|
+This lemma requires a theorem that equivalence of symbolic predicates means they
+will be.  This further needs three-valued logic to be able to compare arbitrary
+predicates with each other, that will also show that the predicate will also be
+computable.
+|*)
+
+Lemma sem_pred_exec_beq_correct :
+  forall A B (sem: Abstr.ctx -> A -> B -> Prop) p a b r,
+    PTree.beq beq_pred_pexpr a b = true ->
+    sem_pred_expr a sem ctx p r ->
+    sem_pred_expr b sem ctx p r.
+Proof.
+  induction p; intros; inv H0.
+  - constructor; auto. eapply pred_pexpr_beq_pred_pexpr; eauto.
+  - constructor; auto. eapply pred_pexpr_beq_pred_pexpr; eauto.
+  - apply sem_pred_expr_cons_false; eauto.
+    eapply pred_pexpr_beq_pred_pexpr; eauto.
+Qed.
+
+End GENERIC_CONTEXT.
+
+Lemma tree_beq_pred_pexpr :
+  forall a b x,
+    RTree.beq beq_pred_pexpr (forest_preds a) (forest_preds b) = true ->
+    beq_pred_pexpr a #p x b #p x = true.
+Proof.
+  intros. unfold "#p". unfold get_forest_p'.
+  apply PTree.beq_correct with (x := x) in H.
+  destruct_match; destruct_match; auto.
+  unfold beq_pred_pexpr. destruct_match; auto.
+Qed.
+
+Lemma tree_beq_pred_expr :
+  forall a b x,
+    RTree.beq HN.beq_pred_expr (forest_regs a) (forest_regs b) = true ->
+    HN.beq_pred_expr a #r x b #r x = true.
+Proof.
+  intros. unfold "#r" in *.
+  apply PTree.beq_correct with (x := (R_indexed.index x)) in H.
+  unfold RTree.get in *.
+  unfold pred_expr in *.
+  destruct_match; destruct_match; auto.
+  unfold HN.beq_pred_expr. destruct_match; auto.
+Qed.
+
+Section CORRECT.
+
+Context {FUN TFUN: Type}.
+Context (ictx: @ctx FUN) (octx: @ctx TFUN) (HSIM: similar ictx octx).
+
+Lemma abstr_check_correct :
+  forall i' a b cf,
+    (exists ps, forall x, sem_pexpr ictx (get_forest_p' x (forest_preds a)) ps !! x) ->
+    check a b = true ->
+    sem ictx a (i', cf) ->
+    exists ti', sem octx b (ti', cf) /\ match_states i' ti'.
+Proof.
+  intros * EVALUABLE **. unfold check in H. simplify.
+  inv H0. inv H10. inv H11.
+  eexists; split; constructor; auto.
+  - constructor. intros.
+    eapply sem_pred_exec_beq_correct; eauto.
+    eapply sem_pred_expr_corr; eauto. now apply sem_value_corr.
+    eapply HN.beq_pred_expr_correct_top; eauto.
+    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
+    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
+    eapply tree_beq_pred_expr; eauto.
+  - (* This is where three-valued logic would be needed. *)
+    constructor. intros. apply sem_pexpr_beq_correct with (p1 := a #p x0).
+    apply tree_beq_pred_pexpr; auto.
+    apply sem_pexpr_corr with (ictx:=ictx); auto.
+  - eapply sem_pred_exec_beq_correct; eauto.
+    eapply sem_pred_expr_corr; eauto. now apply sem_mem_corr.
+    eapply HN.beq_pred_expr_correct_top; eauto.
+    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
+    { unfold "#r"; destruct_match; eauto using check_mutexcl_tree_correct, predicated_singleton. }
+    eapply tree_beq_pred_expr; eauto.
+  - eapply sem_pred_exec_beq_correct; eauto.
+    eapply sem_pred_expr_corr; eauto. now apply sem_exit_corr.
+    eapply EHN.beq_pred_expr_correct_top; eauto using check_mutexcl_correct.
+Qed.
+
+(*|
+Proof Sketch:
+
+Two abstract states can be equivalent, without it being obvious that they can
+actually both be executed assuming one can be executed.  One will therefore have
+to add a few more assumptions to makes it possible to execute the other.
+
+It currently assumes that all the predicates in the predicate tree are
+evaluable, which is actually something that can either be checked, or something
+that can be proven constructively.  I believe that it should already be possible
+using the latter, so here it will only be assumed.
+
+Similarly, the current assumption is that mutual exclusivity of predicates is
+being checked within the ``check`` function, which could possibly also be proven
+constructively about the update function.  This is a simpler short-term fix
+though.
+|*)
+
+End CORRECT.
diff --git a/src/hls/GiblePargenproofEvaluable.v b/src/hls/GiblePargenproofEvaluable.v
new file mode 100644
index 0000000..9013cd5
--- /dev/null
+++ b/src/hls/GiblePargenproofEvaluable.v
@@ -0,0 +1,395 @@
+Require Import compcert.backend.Registers.
+Require Import compcert.common.AST.
+Require Import compcert.common.Errors.
+Require Import compcert.common.Linking.
+Require Import compcert.common.Globalenvs.
+Require Import compcert.common.Memory.
+Require Import compcert.common.Values.
+Require Import compcert.lib.Maps.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.GibleSeq.
+Require Import vericert.hls.GiblePar.
+Require Import vericert.hls.Gible.
+Require Import vericert.hls.GiblePargenproofEquiv.
+Require Import vericert.hls.GiblePargen.
+Require Import vericert.hls.Predicate.
+Require Import vericert.hls.Abstr.
+Require Import vericert.common.Monad.
+
+#[local] Open Scope positive.
+#[local] Open Scope forest.
+#[local] Open Scope pred_op.
+
+#[local] Opaque simplify.
+#[local] Opaque deep_simplify.
+
+
+Definition evaluable {A B C} (sem: ctx -> B -> C -> Prop) (ctx: @ctx A) p := exists b, sem ctx p b.
+
+Definition p_evaluable {A} := @evaluable A _ _ sem_pexpr.
+
+Definition evaluable_expr {A} := @evaluable A _ _ sem_pred.
+
+Definition all_evaluable {A B} (ctx: @ctx A) f_p (l: predicated B) :=
+  forall p y, NE.In (p, y) l -> p_evaluable ctx (from_pred_op f_p p).
+
+Definition all_evaluable2 {A B C} (ctx: @ctx A) (sem: Abstr.ctx -> B -> C -> Prop) (l: predicated B) :=
+  forall p y, NE.In (p, y) l -> evaluable sem ctx y.
+
+Definition pred_forest_evaluable {A} (ctx: @ctx A) (ps: PTree.t pred_pexpr) :=
+  forall i p, ps ! i = Some p -> p_evaluable ctx p.
+
+Definition forest_evaluable {A} (ctx: @ctx A) (f: forest) :=
+  pred_forest_evaluable ctx f.(forest_preds).
+
+Lemma all_evaluable_cons :
+  forall A B pr ctx b a,
+    all_evaluable ctx pr (NE.cons a b) ->
+    @all_evaluable A B ctx pr b.
+Proof.
+  unfold all_evaluable; intros.
+  enough (NE.In (p, y) (NE.cons a b)); eauto.
+  constructor; tauto.
+Qed.
+
+Lemma all_evaluable2_cons :
+  forall A B C sem ctx b a,
+    all_evaluable2 ctx sem (NE.cons a b) ->
+    @all_evaluable2 A B C ctx sem b.
+Proof.
+  unfold all_evaluable2; intros.
+  enough (NE.In (p, y) (NE.cons a b)); eauto.
+  constructor; tauto.
+Qed.
+
+Lemma all_evaluable_cons2 :
+  forall A B pr ctx b a p,
+    @all_evaluable A B ctx pr (NE.cons (p, a) b) ->
+    p_evaluable ctx (from_pred_op pr p).
+Proof.
+  unfold all_evaluable; intros.
+  eapply H. constructor; eauto.
+Qed.
+
+Lemma all_evaluable2_cons2 :
+  forall A B C sem ctx b a p,
+    @all_evaluable2 A B C ctx sem (NE.cons (p, a) b) ->
+    evaluable sem ctx a.
+Proof.
+  unfold all_evaluable; intros.
+  eapply H. constructor; eauto.
+Qed.
+
+Lemma all_evaluable_cons3 :
+  forall A B pr ctx b p a,
+    all_evaluable ctx pr b ->
+    p_evaluable ctx (from_pred_op pr p) ->
+    @all_evaluable A B ctx pr (NE.cons (p, a) b).
+Proof.
+  unfold all_evaluable; intros. inv H1. inv H3. inv H1. auto.
+  eauto.
+Qed.
+
+Lemma all_evaluable_singleton :
+  forall A B pr ctx b p,
+    @all_evaluable A B ctx pr (NE.singleton (p, b)) ->
+    p_evaluable ctx (from_pred_op pr p).
+Proof.
+  unfold all_evaluable; intros. eapply H. constructor.
+Qed.
+
+Lemma get_forest_p_evaluable :
+  forall A (ctx: @ctx A) f r,
+    forest_evaluable ctx f ->
+    p_evaluable ctx (f #p r).
+Proof.
+  intros. unfold "#p", get_forest_p'.
+  destruct_match. unfold forest_evaluable in *.
+  unfold pred_forest_evaluable in *. eauto.
+  unfold p_evaluable, evaluable. eexists.
+  constructor. constructor.
+Qed.
+
+Lemma set_forest_p_evaluable :
+  forall A (ctx: @ctx A) f r p,
+    forest_evaluable ctx f ->
+    p_evaluable ctx p ->
+    forest_evaluable ctx (f #p r <- p).
+Proof.
+  unfold forest_evaluable, pred_forest_evaluable; intros.
+  destruct (peq i r); subst.
+  - rewrite forest_pred_gss2 in H1. now inv H1.
+  - rewrite forest_pred_gso2 in H1 by auto; eauto.
+Qed.
+
+  Lemma evaluable_singleton :
+    forall A B ctx fp r,
+      @all_evaluable A B ctx fp (NE.singleton (T, r)).
+  Proof.
+    unfold all_evaluable, evaluable; intros.
+    inv H. simpl. exists true. constructor.
+  Qed.
+
+Lemma evaluable_negate :
+  forall G (ctx: @ctx G) p,
+    p_evaluable ctx p ->
+    p_evaluable ctx (¬ p).
+Proof.
+  unfold p_evaluable, evaluable in *; intros.
+  inv H. eapply sem_pexpr_negate in H0. econstructor; eauto.
+Qed.
+
+Lemma predicated_evaluable :
+  forall G (ctx: @ctx G) ps (p: pred_op),
+    pred_forest_evaluable ctx ps ->
+    p_evaluable ctx (from_pred_op ps p).
+Proof.
+  unfold pred_forest_evaluable; intros. induction p; intros; cbn.
+  - repeat destruct_match; subst; unfold get_forest_p'.
+    destruct_match. eapply H; eauto. econstructor. constructor. constructor.
+    eapply evaluable_negate.
+    destruct_match. eapply H; eauto. econstructor. constructor. constructor.
+  - repeat econstructor.
+  - repeat econstructor.
+  - inv IHp1. inv IHp2. econstructor. apply sem_pexpr_Pand; eauto.
+  - inv IHp1. inv IHp2. econstructor. apply sem_pexpr_Por; eauto.
+Qed.
+
+Lemma predicated_evaluable_all :
+  forall A G (ctx: @ctx G) ps (p: predicated A),
+    pred_forest_evaluable ctx ps ->
+    all_evaluable ctx ps p.
+Proof.
+  unfold all_evaluable; intros.
+  eapply predicated_evaluable. eauto.
+Qed.
+
+Lemma predicated_evaluable_all_list :
+  forall A G (ctx: @ctx G) ps (p: list (predicated A)),
+    pred_forest_evaluable ctx ps ->
+    Forall (all_evaluable ctx ps) p.
+Proof.
+  induction p.
+  - intros. constructor.
+  - intros. constructor; eauto. apply predicated_evaluable_all; auto.
+Qed.
+
+#[local] Hint Resolve evaluable_singleton : core.
+#[local] Hint Resolve predicated_evaluable : core.
+#[local] Hint Resolve predicated_evaluable_all : core.
+#[local] Hint Resolve predicated_evaluable_all_list : core.
+
+Lemma evaluable_and_true :
+  forall G (ctx: @ctx G) ps p,
+    p_evaluable ctx (from_pred_op ps p) ->
+    p_evaluable ctx (from_pred_op ps (p ∧ T)).
+Proof.
+  intros. unfold evaluable in *. inv H. exists (x && true). cbn.
+  apply sem_pexpr_Pand; auto. constructor.
+Qed.
+
+Lemma all_evaluable_predicated_map :
+  forall A B G (ctx: @ctx G) ps (f: A -> B) p,
+    all_evaluable ctx ps p ->
+    all_evaluable ctx ps (predicated_map f p).
+Proof.
+  induction p.
+  - unfold all_evaluable; intros.
+    exploit NEin_map; eauto; intros. inv H1. inv H2.
+    eapply H; eauto.
+  - intros. cbn.
+    eapply all_evaluable_cons3. eapply IHp. eapply all_evaluable_cons; eauto.
+    cbn. destruct a. cbn in *. eapply all_evaluable_cons2; eauto.
+Qed.
+
+Lemma all_evaluable_predicated_map2 :
+  forall A B G (ctx: @ctx G) ps (f: A -> B) p,
+    all_evaluable ctx ps (predicated_map f p) ->
+    all_evaluable ctx ps p.
+Proof.
+  induction p.
+  - unfold all_evaluable in *; intros.
+    eapply H. eapply NEin_map2; eauto.
+  - intros. cbn. destruct a.
+    cbn in H. pose proof H. eapply all_evaluable_cons in H; eauto.
+    eapply all_evaluable_cons2 in H0; eauto.
+    unfold all_evaluable. specialize (IHp H).
+    unfold all_evaluable in IHp.
+    intros. inv H1. inv H3. inv H1; eauto.
+    specialize (IHp _ _ H1). eauto.
+Qed.
+
+Lemma all_evaluable_map_and :
+  forall A B G (ctx: @ctx G) ps (a: NE.non_empty ((pred_op * A) * (pred_op * B))),
+    (forall p1 x p2 y,
+       NE.In ((p1, x), (p2, y)) a ->
+            p_evaluable ctx (from_pred_op ps p1)
+            /\ p_evaluable ctx (from_pred_op ps p2)) ->
+    all_evaluable ctx ps (NE.map (fun x => match x with ((a, b), (c, d)) => (Pand a c, (b, d)) end) a).
+Proof.
+  induction a.
+  - intros. cbn. repeat destruct_match. inv Heqp.
+    unfold all_evaluable; intros. inv H0.
+    unfold evaluable.
+    exploit H. constructor.
+    intros [Ha Hb]. inv Ha. inv Hb.
+    exists (x && x0). apply sem_pexpr_Pand; auto.
+  - intros. unfold all_evaluable; cbn; intros. inv H0. inv H2.
+    + repeat destruct_match. inv Heqp0. inv H0.
+      specialize (H p2 a1 p3 b ltac:(constructor; eauto)).
+      inv H. inv H0. inv H1. exists (x && x0).
+      apply sem_pexpr_Pand; eauto.
+    + eapply IHa; intros. eapply H. econstructor. right. eauto.
+      eauto.
+Qed.
+
+Lemma all_evaluable_map_add :
+  forall A B G (ctx: @ctx G) ps (a: pred_op * A) (b: predicated B) p1 x p2 y,
+    p_evaluable ctx (from_pred_op ps (fst a)) ->
+    all_evaluable ctx ps b ->
+    NE.In (p1, x, (p2, y)) (NE.map (fun x : pred_op * B => (a, x)) b) ->
+    p_evaluable ctx (from_pred_op ps p1) /\ p_evaluable ctx (from_pred_op ps p2).
+Proof.
+  induction b; intros.
+  - cbn in *. inv H1. unfold all_evaluable in *. specialize (H0 _ _ ltac:(constructor)).
+    auto.
+  - cbn in *. inv H1. inv H3.
+    + inv H1. unfold all_evaluable in H0. specialize (H0 _ _ ltac:(constructor; eauto)); auto.
+    + eapply all_evaluable_cons in H0. specialize (IHb _ _ _ _ H H0 H1). auto.
+Qed.
+
+Lemma all_evaluable_non_empty_prod :
+  forall A B G (ctx: @ctx G) ps p1 x p2 y (a: predicated A) (b: predicated B),
+    all_evaluable ctx ps a ->
+    all_evaluable ctx ps b ->
+    NE.In ((p1, x), (p2, y)) (NE.non_empty_prod a b) ->
+    p_evaluable ctx (from_pred_op ps p1)
+    /\ p_evaluable ctx (from_pred_op ps p2).
+Proof.
+  induction a; intros.
+  - cbn in *. eapply all_evaluable_map_add; eauto. destruct a; cbn in *. eapply H; constructor.
+  - cbn in *. eapply NE.NEin_NEapp5 in H1. inv H1. eapply all_evaluable_map_add; eauto.
+    destruct a; cbn in *. eapply all_evaluable_cons2; eauto.
+    eapply all_evaluable_cons in H. eauto.
+Qed.
+
+Lemma all_evaluable_predicated_prod :
+  forall A B G (ctx: @ctx G) ps (a: predicated A) (b: predicated B),
+    all_evaluable ctx ps a ->
+    all_evaluable ctx ps b ->
+    all_evaluable ctx ps (predicated_prod a b).
+Proof.
+  intros. unfold all_evaluable; intros.
+  unfold predicated_prod in *. exploit all_evaluable_map_and.
+  2: { eauto. }
+  intros. 2: { eauto. }
+Admitted. (* Requires simple lemma to prove, but this lemma is not needed. *)
+
+Lemma cons_pred_expr_evaluable :
+  forall G (ctx: @ctx G) ps a b,
+    all_evaluable ctx ps a ->
+    all_evaluable ctx ps b ->
+    all_evaluable ctx ps (cons_pred_expr a b).
+Proof.
+  unfold cons_pred_expr; intros.
+  apply all_evaluable_predicated_map.
+  now apply all_evaluable_predicated_prod.
+Qed.
+
+Lemma fold_right_all_evaluable :
+  forall G (ctx: @ctx G) ps n,
+    Forall (all_evaluable ctx ps) (NE.to_list n) ->
+    all_evaluable ctx ps (NE.fold_right cons_pred_expr (NE.singleton (T, Enil)) n).
+Proof.
+  induction n; cbn in *; intros.
+  - unfold cons_pred_expr. eapply all_evaluable_predicated_map. eapply all_evaluable_predicated_prod.
+    inv H. auto. unfold all_evaluable; intros. inv H0. exists true. constructor.
+  - inv H. specialize (IHn H3). now eapply cons_pred_expr_evaluable.
+Qed.
+
+Lemma merge_all_evaluable :
+  forall G (ctx: @ctx G) ps,
+    pred_forest_evaluable ctx ps ->
+    forall f args,
+      all_evaluable ctx ps (merge (list_translation args f)).
+Proof.
+  intros. eapply predicated_evaluable_all. eauto.
+Qed.
+
+  Lemma forest_evaluable_regset :
+    forall A f (ctx: @ctx A) n x,
+      forest_evaluable ctx f ->
+      forest_evaluable ctx f #r x <- n.
+  Proof.
+    unfold forest_evaluable, pred_forest_evaluable; intros.
+    eapply H. eauto.
+  Qed.
+
+  Lemma evaluable_impl :
+    forall A (ctx: @ctx A) a b,
+      p_evaluable ctx a ->
+      p_evaluable ctx b ->
+      p_evaluable ctx (a → b).
+  Proof.
+    unfold evaluable.
+    inversion_clear 1 as [b1 SEM1].
+    inversion_clear 1 as [b2 SEM2].
+    unfold Pimplies.
+    econstructor. apply sem_pexpr_Por;
+    eauto using sem_pexpr_negate.
+  Qed.
+
+  Lemma parts_evaluable :
+    forall A (ctx: @ctx A) b p0,
+      evaluable sem_pred ctx p0 ->
+      evaluable sem_pexpr ctx (Plit (b, p0)).
+  Proof.
+    intros. unfold evaluable in *. inv H.
+    destruct b. do 2 econstructor. eauto.
+    exists (negb x). constructor. rewrite negb_involutive. auto.
+  Qed.
+
+  Lemma p_evaluable_Pand :
+    forall A (ctx: @ctx A) a b,
+      p_evaluable ctx a ->
+      p_evaluable ctx b ->
+      p_evaluable ctx (a ∧ b).
+  Proof.
+    intros. inv H. inv H0.
+    econstructor. apply sem_pexpr_Pand; eauto.
+  Qed.
+
+  Lemma from_predicated_evaluable :
+    forall A (ctx: @ctx A) f b a,
+      pred_forest_evaluable ctx f ->
+      all_evaluable2 ctx sem_pred a ->
+      p_evaluable ctx (from_predicated b f a).
+  Proof.
+    induction a.
+    cbn. destruct_match; intros.
+    eapply evaluable_impl.
+    eauto using predicated_evaluable.
+    unfold all_evaluable2 in H0. unfold p_evaluable.
+    eapply parts_evaluable. eapply H0. econstructor.
+
+    intros. cbn. destruct_match.
+    eapply p_evaluable_Pand.
+    eapply all_evaluable2_cons2 in H0.
+    eapply evaluable_impl.
+    eauto using predicated_evaluable.
+    unfold all_evaluable2 in H0. unfold p_evaluable.
+    eapply parts_evaluable. eapply H0.
+    eapply all_evaluable2_cons in H0. eauto.
+  Qed.
+
+  Lemma p_evaluable_imp :
+    forall A (ctx: @ctx A) a b,
+      sem_pexpr ctx a false ->
+      p_evaluable ctx (a → b).
+  Proof.
+    intros. unfold "→".
+    unfold p_evaluable, evaluable. exists true.
+    constructor. replace true with (negb false) by trivial. left.
+    now apply sem_pexpr_negate.
+  Qed.
diff --git a/src/hls/GiblePargenproofForward.v b/src/hls/GiblePargenproofForward.v
new file mode 100644
index 0000000..8222513
--- /dev/null
+++ b/src/hls/GiblePargenproofForward.v
@@ -0,0 +1,1568 @@
+(*
+ * Vericert: Verified high-level synthesis.
+ * Copyright (C) 2023 Yann Herklotz <git@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.backend.Registers.
+Require Import compcert.common.AST.
+Require Import compcert.common.Errors.
+Require Import compcert.common.Linking.
+Require Import compcert.common.Globalenvs.
+Require Import compcert.common.Memory.
+Require Import compcert.common.Values.
+Require Import compcert.lib.Maps.
+
+Require Import vericert.common.Vericertlib.
+Require Import vericert.hls.GibleSeq.
+Require Import vericert.hls.GiblePar.
+Require Import vericert.hls.Gible.
+Require Import vericert.hls.GiblePargenproofEquiv.
+Require Import vericert.hls.GiblePargen.
+Require Import vericert.hls.Predicate.
+Require Import vericert.hls.Abstr.
+Require Import vericert.common.Monad.
+
+Module Import OptionExtra := MonadExtra(Option).
+
+#[local] Open Scope positive.
+#[local] Open Scope forest.
+#[local] Open Scope pred_op.
+
+#[local] Opaque simplify.
+#[local] Opaque deep_simplify.
+
+#[local] Ltac destr := destruct_match; try discriminate; [].
+
+Definition state_lessdef := GiblePargenproofEquiv.match_states.
+
+Definition is_regs i := match i with mk_instr_state rs _ _ => rs end.
+Definition is_mem i := match i with mk_instr_state _ _ m => m end.
+Definition is_ps i := match i with mk_instr_state _ p _ => p end.
+
+Definition check_dest i r' :=
+  match i with
+  | RBop p op rl r => (r =? r')%positive
+  | RBload p chunk addr rl r => (r =? r')%positive
+  | _ => false
+  end.
+
+Lemma check_dest_dec i r :
+  {check_dest i r = true} + {check_dest i r = false}.
+Proof. destruct (check_dest i r); tauto. Qed.
+
+Fixpoint check_dest_l l r :=
+  match l with
+  | nil => false
+  | a :: b => check_dest a r || check_dest_l b r
+  end.
+
+Lemma check_dest_l_forall :
+  forall l r,
+  check_dest_l l r = false ->
+  Forall (fun x => check_dest x r = false) l.
+Proof. induction l; crush. Qed.
+
+Lemma check_dest_l_dec i r :
+  {check_dest_l i r = true} + {check_dest_l i r = false}.
+Proof. destruct (check_dest_l i r); tauto. Qed.
+
+Lemma match_states_list :
+  forall A (rs: Regmap.t A) rs',
+  (forall r, rs !! r = rs' !! r) ->
+  forall l, rs ## l = rs' ## l.
+Proof. induction l; crush. Qed.
+
+Lemma PTree_matches :
+  forall A (v: A) res rs rs',
+  (forall r, rs !! r = rs' !! r) ->
+  forall x, (Regmap.set res v rs) !! x = (Regmap.set res v rs') !! x.
+Proof.
+  intros; destruct (Pos.eq_dec x res); subst;
+  [ repeat rewrite Regmap.gss by auto
+  | repeat rewrite Regmap.gso by auto ]; auto.
+Qed.
+
+Section CORRECTNESS.
+
+  Context (prog: GibleSeq.program) (tprog : GiblePar.program).
+
+  Let ge : GibleSeq.genv := Globalenvs.Genv.globalenv prog.
+  Let tge : GiblePar.genv := Globalenvs.Genv.globalenv tprog.
+
+  Lemma eval_predf_negate :
+    forall ps p,
+      eval_predf ps (negate p) = negb (eval_predf ps p).
+  Proof.
+    unfold eval_predf; intros. rewrite negate_correct. auto.
+  Qed.
+
+  Lemma is_truthy_negate :
+    forall ps p pred,
+      truthy ps p ->
+      falsy ps (combine_pred (Some (negate (Option.default T p))) pred).
+  Proof.
+    inversion 1; subst; simplify.
+    - destruct pred; constructor; auto.
+    - destruct pred; constructor.
+      rewrite eval_predf_Pand. rewrite eval_predf_negate. rewrite H0. auto.
+      rewrite eval_predf_negate. rewrite H0. auto.
+  Qed.
+
+  Lemma sem_pred_expr_NEapp :
+    forall A B C sem f_p ctx a b v,
+      sem_pred_expr f_p sem ctx a v ->
+      @sem_pred_expr A B C f_p sem ctx (NE.app a b) v.
+  Proof.
+    induction a; crush.
+    - inv H. constructor; auto.
+    - inv H. constructor; eauto.
+      eapply sem_pred_expr_cons_false; eauto.
+  Qed.
+
+  Lemma sem_pred_expr_NEapp2 :
+    forall A B C sem f_p ctx a b v ps,
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) (ps !! x)) ->
+      (forall x, NE.In x a -> eval_predf ps (fst x) = false) ->
+      sem_pred_expr f_p sem ctx b v ->
+      @sem_pred_expr A B C f_p sem ctx (NE.app a b) v.
+  Proof.
+    induction a; crush.
+    - assert (IN: NE.In a (NE.singleton a)) by constructor.
+      specialize (H0 _ IN). destruct a.
+      eapply sem_pred_expr_cons_false; eauto. cbn [fst] in *.
+      eapply sem_pexpr_eval; eauto.
+    - assert (NE.In a (NE.cons a a0)) by (constructor; tauto).
+      apply H0 in H2.
+      destruct a. cbn [fst] in *.
+      eapply sem_pred_expr_cons_false.
+      eapply sem_pexpr_eval; eauto. eapply IHa; eauto.
+      intros. eapply H0. constructor; tauto.
+  Qed.
+
+  Lemma sem_pred_expr_NEapp3 :
+    forall A B C sem f_p ctx (a b: predicated B) v,
+      (forall x, NE.In x a -> sem_pexpr ctx (from_pred_op f_p (fst x)) false) ->
+      sem_pred_expr f_p sem ctx b v ->
+      @sem_pred_expr A B C f_p sem ctx (NE.app a b) v.
+  Proof.
+    induction a; crush.
+    - assert (IN: NE.In a (NE.singleton a)) by constructor.
+      specialize (H _ IN). destruct a.
+      eapply sem_pred_expr_cons_false; eauto.
+    - assert (NE.In a (NE.cons a a0)) by (constructor; tauto).
+      apply H in H1.
+      destruct a. cbn [fst] in *.
+      eapply sem_pred_expr_cons_false; auto.
+      eapply IHa; eauto.
+      intros. eapply H. constructor; tauto.
+  Qed.
+
+  Lemma sem_pred_expr_map_not :
+    forall A p ps y x0,
+      eval_predf ps p = false ->
+      NE.In x0 (NE.map (fun x => (p ∧ fst x, snd x)) y) ->
+      eval_predf ps (@fst _ A x0) = false.
+  Proof.
+    induction y; crush.
+    - inv H0. simplify. rewrite eval_predf_Pand. rewrite H. auto.
+    - inv H0. inv H2. cbn -[eval_predf]. rewrite eval_predf_Pand.
+      rewrite H. auto. eauto.
+  Qed.
+
+  Lemma sem_pred_expr_map_Pand :
+    forall A B C sem ctx f_p ps x v p,
+      (forall x : positive, sem_pexpr ctx (get_forest_p' x f_p) ps !! x) ->
+      eval_predf ps p = true ->
+      sem_pred_expr f_p sem ctx x v ->
+      @sem_pred_expr A B C f_p sem ctx
+        (NE.map (fun x0 => (p ∧ fst x0, snd x0)) x) v.
+  Proof.
+    induction x; crush.
+    inv H1. simplify. constructor; eauto.
+    simplify. replace true with (true && true) by auto.
+    constructor; auto.
+    eapply sem_pexpr_eval; eauto.
+    inv H1. simplify. constructor; eauto.
+    simplify. replace true with (true && true) by auto.
+    constructor; auto.
+    eapply sem_pexpr_eval; eauto.
+    eapply sem_pred_expr_cons_false. cbn.
+    replace false with (true && false) by auto. apply sem_pexpr_Pand; auto.
+    eapply sem_pexpr_eval; eauto. eauto.
+  Qed.
+
+  Lemma sem_pred_expr_app_predicated :
+    forall A B C sem ctx f_p y x v p ps,
+      sem_pred_expr f_p sem ctx x v ->
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) (ps !! x)) ->
+      eval_predf ps p = true ->
+      @sem_pred_expr A B C f_p sem ctx (app_predicated p y x) v.
+  Proof.
+    intros * SEM PS EVAL. unfold app_predicated.
+    eapply sem_pred_expr_NEapp2; eauto.
+    intros. eapply sem_pred_expr_map_not; eauto.
+    rewrite eval_predf_negate. rewrite EVAL. auto.
+    eapply sem_pred_expr_map_Pand; eauto.
+  Qed.
+
+  Lemma sem_pred_expr_app_predicated_false :
+    forall A B C sem ctx f_p y x v p ps,
+      sem_pred_expr f_p sem ctx y v ->
+      (forall x, sem_pexpr ctx (get_forest_p' x f_p) (ps !! x)) ->
+      eval_predf ps p = false ->
+      @sem_pred_expr A B C f_p sem ctx (app_predicated p y x) v.
+  Admitted.
+
+  Lemma sem_pred_expr_prune_predicated :
+    forall A B C sem ctx f_p y x v,
+      sem_pred_expr f_p sem ctx x v ->
+      prune_predicated x = Some y ->
+      @sem_pred_expr A B C f_p sem ctx y v.
+  Proof.
+    intros * SEM PRUNE. unfold prune_predicated in *.
+    Admitted.
+
+  Inductive sem_ident {B A: Type} (c: @ctx B) (a: A): A -> Prop :=
+  | sem_ident_intro : sem_ident c a a.
+
+  Lemma sem_pred_expr_pred_ret :
+    forall G A (ctx: @Abstr.ctx G) (i: A) ps,
+      sem_pred_expr ps sem_ident ctx (pred_ret i) i.
+  Proof. intros; constructor; constructor. Qed.
+
+  Lemma sem_pred_expr_ident :
+    forall G A B ps (ctx: @Abstr.ctx G) (l: predicated A) (s: @Abstr.ctx G -> A -> B -> Prop) l_,
+      sem_pred_expr ps sem_ident ctx l l_ ->
+      forall (v: B),
+        s ctx l_ v ->
+        sem_pred_expr ps s ctx l v.
+  Proof.
+    induction 1.
+    - intros. constructor; auto. inv H0. auto.
+    - intros. apply sem_pred_expr_cons_false; auto.
+    - intros. inv H0. constructor; auto.
+  Qed.
+
+  Lemma sem_pred_expr_ident2 :
+    forall G A B ps (ctx: @Abstr.ctx G) (l: predicated A) (s: @Abstr.ctx G -> A -> B -> Prop) (v: B),
+        sem_pred_expr ps s ctx l v ->
+        exists l_, sem_pred_expr ps sem_ident ctx l l_ /\ s ctx l_ v.
+  Proof.
+    induction 1.
+    - exists e; split; auto. constructor; auto. constructor.
+    - inversion_clear IHsem_pred_expr as [x IH].
+      inversion_clear IH as [SEM EVALS].
+      exists x; split; auto. apply sem_pred_expr_cons_false; auto.
+    - exists e; split; auto; constructor; auto; constructor.
+  Qed.
+
+  Fixpoint of_elist (e: expression_list): list expression :=
+    match e with
+    | Econs a b => a :: of_elist b
+    | Enil => nil
+    end.
+
+  Fixpoint to_elist (e: list expression): expression_list :=
+    match e with
+    | a :: b => Econs a (to_elist b)
+    | nil => Enil
+    end.
+
+  Lemma sem_val_list_elist :
+    forall G (ctx: @Abstr.ctx G) l j,
+      sem_val_list ctx (to_elist l) j ->
+      Forall2 (sem_value ctx) l j.
+  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
+
+  Lemma sem_val_list_elist2 :
+    forall G (ctx: @Abstr.ctx G) l j,
+      Forall2 (sem_value ctx) l j ->
+      sem_val_list ctx (to_elist l) j.
+  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
+
+  Lemma sem_val_list_elist3 :
+    forall G (ctx: @Abstr.ctx G) l j,
+      sem_val_list ctx l j ->
+      Forall2 (sem_value ctx) (of_elist l) j.
+  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
+
+  Lemma sem_val_list_elist4 :
+    forall G (ctx: @Abstr.ctx G) l j,
+      Forall2 (sem_value ctx) (of_elist l) j ->
+      sem_val_list ctx l j.
+  Proof. induction l; intros; cbn in *; inversion H; constructor; eauto. Qed.
+
+  Lemma sem_pred_expr_predicated_map :
+    forall A B C pr (f: C -> B) ctx (pred: predicated C) (pred': C),
+      sem_pred_expr pr sem_ident ctx pred pred' ->
+      @sem_pred_expr A _ _ pr sem_ident ctx (predicated_map f pred) (f pred').
+  Proof.
+    induction pred; unfold predicated_map; intros.
+    - inv H. inv H3. constructor; eauto. constructor.
+    - inv H. inv H5. constructor; eauto. constructor.
+      eapply sem_pred_expr_cons_false; eauto.
+  Qed.
+
+  Lemma NEapp_NEmap :
+    forall A B (f: A -> B) a b,
+      NE.map f (NE.app a b) = NE.app (NE.map f a) (NE.map f b).
+  Proof. induction a; crush. Qed.
+
+  Lemma sem_pred_expr_predicated_prod :
+    forall A B C pr ctx (a: predicated C) (b: predicated B) a' b',
+      sem_pred_expr pr sem_ident ctx a a' ->
+      sem_pred_expr pr sem_ident ctx b b' ->
+      @sem_pred_expr A _ _ pr sem_ident ctx (predicated_prod a b) (a', b').
+  Proof.
+    induction a; intros.
+    - inv H. inv H4. unfold predicated_prod.
+      generalize dependent b. induction b; intros.
+      + cbn. destruct_match. inv Heqp. inv H0. inv H6.
+        constructor. simplify. replace true with (true && true) by auto.
+        eapply sem_pexpr_Pand; eauto. constructor.
+      + inv H0. inv H6. cbn. constructor; cbn.
+        replace true with (true && true) by auto.
+        constructor; auto. constructor.
+        eapply sem_pred_expr_cons_false; eauto. cbn.
+        replace false with (true && false) by auto.
+        apply sem_pexpr_Pand; auto.
+    - unfold predicated_prod. simplify.
+      rewrite NEapp_NEmap.
+      inv H. eapply sem_pred_expr_NEapp.
+      { induction b; crush.
+        destruct a. inv H0. constructor.
+        replace true with (true && true) by auto.
+        eapply sem_pexpr_Pand; auto. inv H6. inv H7.
+        constructor.
+
+        destruct a. inv H0. constructor.
+        replace true with (true && true) by auto.
+        constructor; auto. inv H8. inv H6. constructor.
+
+        specialize (IHb H8). eapply sem_pred_expr_cons_false; auto.
+        replace false with (true && false) by auto.
+        apply sem_pexpr_Pand; auto.
+      }
+      { exploit IHa. eauto. eauto. intros.
+        unfold predicated_prod in *.
+        eapply sem_pred_expr_NEapp3; eauto; [].
+        clear H. clear H0.
+        induction b.
+        { intros. inv H. destruct a. simpl.
+          constructor; tauto. }
+        { intros. inv H. inv H1. destruct a. simpl.
+          constructor; tauto. eauto. } }
+  Qed.
+
+  Lemma sem_pred_expr_seq_app :
+    forall G A B (f: predicated (A -> B))
+        ps (ctx: @ctx G) l f_ l_,
+      sem_pred_expr ps sem_ident ctx l l_ ->
+      sem_pred_expr ps sem_ident ctx f f_ ->
+      sem_pred_expr ps sem_ident ctx (seq_app f l) (f_ l_).
+  Proof.
+    unfold seq_app; intros.
+    remember (fun x : (A -> B) * A => fst x (snd x)) as app.
+    replace (f_ l_) with (app (f_, l_)) by (rewrite Heqapp; auto).
+    eapply sem_pred_expr_predicated_map. eapply sem_pred_expr_predicated_prod; auto.
+  Qed.
+
+  Lemma sem_pred_expr_map :
+    forall A B C (ctx: @ctx A) ps (f: B -> C) y v,
+      sem_pred_expr ps sem_ident ctx y v ->
+      sem_pred_expr ps sem_ident ctx (NE.map (fun x => (fst x, f (snd x))) y) (f v).
+  Proof.
+    induction y; crush. inv H. constructor; crush. inv H3. constructor.
+    inv H. inv H5. constructor; eauto. constructor.
+    eapply sem_pred_expr_cons_false; eauto.
+  Qed.
+
+  Lemma sem_pred_expr_flap :
+    forall G A B C (f: predicated (A -> B -> C))
+        ps (ctx: @ctx G) l f_,
+      sem_pred_expr ps sem_ident ctx f f_ ->
+      sem_pred_expr ps sem_ident ctx (flap f l) (f_ l).
+  Proof.
+    induction f. unfold flap2; intros. inv H. inv H3.
+    constructor; eauto. constructor.
+    intros. inv H. cbn.
+    constructor; eauto. inv H5. constructor.
+    eapply sem_pred_expr_cons_false; eauto.
+   Qed.
+
+  Lemma sem_pred_expr_flap2 :
+    forall G A B C (f: predicated (A -> B -> C))
+        ps (ctx: @ctx G) l1 l2 f_,
+      sem_pred_expr ps sem_ident ctx f f_ ->
+      sem_pred_expr ps sem_ident ctx (flap2 f l1 l2) (f_ l1 l2).
+  Proof.
+    induction f. unfold flap2; intros. inv H. inv H3.
+    constructor; eauto. constructor.
+    intros. inv H. cbn.
+    constructor; eauto. inv H5. constructor.
+    eapply sem_pred_expr_cons_false; eauto.
+  Qed.
+
+  Lemma sem_pred_expr_seq_app_val :
+    forall G A B V (s: @Abstr.ctx G -> B -> V -> Prop)
+        (f: predicated (A -> B))
+        ps ctx l v f_ l_,
+      sem_pred_expr ps sem_ident ctx l l_ ->
+      sem_pred_expr ps sem_ident ctx f f_ ->
+      s ctx (f_ l_) v ->
+      sem_pred_expr ps s ctx (seq_app f l) v.
+  Proof.
+    intros. eapply sem_pred_expr_ident; [|eassumption].
+    eapply sem_pred_expr_seq_app; eauto.
+  Qed.
+
+  Fixpoint Eapp a b :=
+    match a with
+    | Enil => b
+    | Econs ax axs => Econs ax (Eapp axs b)
+    end.
+
+  Lemma Eapp_right_nil :
+    forall a, Eapp a Enil = a.
+  Proof. induction a; cbn; try rewrite IHa; auto. Qed.
+
+  Lemma Eapp_left_nil :
+    forall a, Eapp Enil a = a.
+  Proof. auto. Qed.
+
+  Lemma sem_pred_expr_cons_pred_expr :
+    forall A (ctx: @ctx A) pr s s' a e,
+      sem_pred_expr pr sem_ident ctx s s' ->
+      sem_pred_expr pr sem_ident ctx a e ->
+      sem_pred_expr pr sem_ident ctx (cons_pred_expr a s) (Econs e s').
+  Proof.
+    intros. unfold cons_pred_expr.
+    replace (Econs e s') with ((uncurry Econs) (e, s')) by auto.
+    eapply sem_pred_expr_predicated_map.
+    eapply sem_pred_expr_predicated_prod; eauto.
+  Qed.
+
+  Lemma sem_pred_expr_fold_right :
+    forall A pr ctx s a a' s',
+      sem_pred_expr pr sem_ident ctx s s' ->
+      Forall2 (sem_pred_expr pr sem_ident ctx) (NE.to_list a) (of_elist a') ->
+      @sem_pred_expr A _ _ pr sem_ident ctx (NE.fold_right cons_pred_expr s a) (Eapp a' s').
+  Proof.
+    induction a; crush. inv H0. inv H5. destruct a'; crush. destruct a'; crush.
+    inv H3. eapply sem_pred_expr_cons_pred_expr; eauto.
+    inv H0. destruct a'; crush. inv H3.
+    eapply sem_pred_expr_cons_pred_expr; eauto.
+  Qed.
+
+  Lemma sem_pred_expr_fold_right2 :
+    forall A pr ctx s a a' s',
+      sem_pred_expr pr sem_ident ctx s s' ->
+      @sem_pred_expr A _ _ pr sem_ident ctx (NE.fold_right cons_pred_expr s a) (Eapp a' s') ->
+      Forall2 (sem_pred_expr pr sem_ident ctx) (NE.to_list a) (of_elist a').
+  Proof.
+    induction a. Admitted.
+
+  Lemma NEof_list_some :
+    forall A a a' (e: A),
+      NE.of_list a = Some a' ->
+      NE.of_list (e :: a) = Some (NE.cons e a').
+  Proof.
+    induction a; [crush|].
+    intros.
+    cbn in H. destruct a0. inv H. auto.
+    destruct_match; [|discriminate].
+    inv H. specialize (IHa n a ltac:(trivial)).
+    cbn. destruct_match. unfold NE.of_list in IHa.
+    fold (@NE.of_list A) in IHa. rewrite IHa in Heqo0. inv Heqo0. auto.
+    unfold NE.of_list in IHa. fold (@NE.of_list A) in IHa. rewrite IHa in Heqo0. inv Heqo0.
+  Qed.
+
+  Lemma NEof_list_contra :
+    forall A b (a: A),
+      ~ NE.of_list (a :: b) = None.
+  Proof.
+    induction b; try solve [crush].
+    intros.
+    specialize (IHb a).
+    enough (X: exists x, NE.of_list (a :: b) = Some x).
+    inversion_clear X as [x X'].
+    erewrite NEof_list_some; eauto; discriminate.
+    destruct (NE.of_list (a :: b)) eqn:?; [eauto|contradiction].
+  Qed.
+
+  Lemma NEof_list_exists :
+    forall A b (a: A),
+      exists x, NE.of_list (a :: b) = Some x.
+  Proof.
+    intros. pose proof (NEof_list_contra _ b a).
+    destruct (NE.of_list (a :: b)); try contradiction.
+    eauto.
+  Qed.
+
+  Lemma NEof_list_exists2 :
+    forall A b (a c: A),
+      exists x,
+        NE.of_list (c :: a :: b) = Some (NE.cons c x)
+        /\ NE.of_list (a :: b) = Some x.
+  Proof.
+    intros. pose proof (NEof_list_exists _ b a).
+    inversion_clear H as [x B].
+    econstructor; split; eauto.
+    eapply NEof_list_some; eauto.
+  Qed.
+
+  Lemma NEof_list_to_list :
+    forall A (x: list A) y,
+      NE.of_list x = Some y ->
+      NE.to_list y = x.
+  Proof.
+    induction x; [crush|].
+    intros. destruct x; [crush|].
+    pose proof (NEof_list_exists2 _ x a0 a).
+    inversion_clear H0 as [x0 [HN1 HN2]]. rewrite HN1 in H. inv H.
+    cbn. f_equal. eauto.
+  Qed.
+
+  Lemma sem_pred_expr_merge :
+    forall G (ctx: @Abstr.ctx G) ps l args,
+      Forall2 (sem_pred_expr ps sem_ident ctx) args l ->
+      sem_pred_expr ps sem_ident ctx (merge args) (to_elist l).
+  Proof.
+    induction l; intros.
+    - inv H. cbn; repeat constructor.
+    - inv H. cbn. unfold merge. Admitted.
+
+  Lemma sem_pred_expr_merge2 :
+    forall A (ctx: @ctx A) pr l l',
+      sem_pred_expr pr sem_ident ctx (merge l) l' ->
+      Forall2 (sem_pred_expr pr sem_ident ctx) l (of_elist l').
+  Proof.
+    induction l; crush.
+    - unfold merge in *; cbn in *.
+      inv H. inv H5. constructor.
+    - unfold merge in H.
+      pose proof (NEof_list_exists _ l a) as Y.
+      inversion_clear Y as [x HNE]. rewrite HNE in H.
+      erewrite <- (NEof_list_to_list _ (a :: l)) by eassumption.
+      apply sem_pred_expr_fold_right2 with (s := (NE.singleton (T, Enil))) (s' := Enil).
+      repeat constructor.
+      rewrite Eapp_right_nil. auto.
+  Qed.
+
+  Lemma sem_merge_list :
+    forall A ctx f rs ps m args,
+      sem ctx f ((mk_instr_state rs ps m), None) ->
+      @sem_pred_expr A _ _ (forest_preds f) sem_val_list ctx
+        (merge (list_translation args f)) (rs ## args).
+  Proof.
+    induction args; crush. cbn. constructor; constructor.
+    unfold merge. specialize (IHargs H).
+    eapply sem_pred_expr_ident2 in IHargs.
+    inversion_clear IHargs as [l_ [HSEM HVAL]].
+    destruct_match; [|exfalso; eapply NEof_list_contra; eauto].
+    destruct args; cbn -[NE.of_list] in *.
+    - unfold merge in *. simplify.
+      inv H. inv H6. specialize (H a).
+      eapply sem_pred_expr_ident2 in H.
+      inversion_clear H as [l_2 [HSEM2 HVAL2]].
+      unfold cons_pred_expr.
+      eapply sem_pred_expr_ident.
+      eapply sem_pred_expr_predicated_map.
+      eapply sem_pred_expr_predicated_prod; [eassumption|repeat constructor].
+      repeat constructor; auto.
+    - pose proof (NEof_list_exists2 _ (list_translation args f) (f #r (Reg r)) (f #r (Reg a))) as Y.
+      inversion_clear Y as [x [Y1 Y2]]. rewrite Heqo in Y1. inv Y1.
+      inversion_clear H as [? ? ? ? ? ? REG PRED MEM EXIT].
+      inversion_clear REG as [? ? ? REG'].
+      inversion_clear PRED as [? ? ? PRED'].
+      pose proof (REG' a) as REGa. pose proof (REG' r) as REGr.
+      exploit sem_pred_expr_ident2; [exact REGa|].
+      intro REGI'; inversion_clear REGI' as [a' [SEMa SEMa']].
+      exploit sem_pred_expr_ident2; [exact REGr|].
+      intro REGI'; inversion_clear REGI' as [r' [SEMr SEMr']].
+      apply sem_pred_expr_ident with (l_ := Econs a' l_); [|constructor; auto].
+      replace (Econs a' l_) with (Eapp (Econs a' l_) Enil) by (now apply Eapp_right_nil).
+      apply sem_pred_expr_fold_right; eauto.
+      repeat constructor.
+      constructor; eauto.
+      erewrite NEof_list_to_list; eauto.
+      eapply sem_pred_expr_merge2; auto.
+  Qed.
+
+  Lemma sem_pred_expr_list_translation :
+    forall G ctx args f i,
+      @sem G ctx f (i, None) ->
+      exists l,
+        Forall2 (sem_pred_expr (forest_preds f) sem_ident ctx) (list_translation args f) l
+        /\ sem_val_list ctx (to_elist l) ((is_rs i)##args).
+  Proof.
+    induction args; intros.
+    - exists nil; cbn; split; auto; constructor.
+    - exploit IHargs; try eassumption; intro EX.
+      inversion_clear EX as [l [FOR SEM]].
+      destruct i as [rs' m' ps'].
+      inversion_clear H as [? ? ? ? ? ? REGSET PREDSET MEM EXIT].
+      inversion_clear REGSET as [? ? ? REG].
+      pose proof (REG a).
+      exploit sem_pred_expr_ident2; eauto; intro IDENT.
+      inversion_clear IDENT as [l_ [SEMP SV]].
+      exists (l_ :: l). split. constructor; auto.
+      cbn; constructor; auto.
+  Qed.
+
+(*|
+Here we can finally assume that everything in the forest is evaluable, which
+will allow us to prove that translating the list of register accesses will also
+all be evaluable.
+|*)
+
+  Lemma sem_update_Iop :
+    forall A op rs args m v f ps ctx,
+      Op.eval_operation (ctx_ge ctx) (ctx_sp ctx) op rs ## args (is_mem (ctx_is ctx)) = Some v ->
+      sem ctx f ((mk_instr_state rs ps m), None) ->
+      @sem_pred_expr A _ _ (forest_preds f) sem_value ctx
+        (seq_app (pred_ret (Eop op)) (merge (list_translation args f))) v.
+  Proof.
+    intros * EVAL SEM.
+    exploit sem_pred_expr_list_translation; try eassumption.
+    intro H; inversion_clear H as [x [HS HV]].
+    eapply sem_pred_expr_seq_app_val.
+    - cbn in *; eapply sem_pred_expr_merge; eauto.
+    - apply sem_pred_expr_pred_ret.
+    - econstructor; [eauto|]; auto.
+  Qed.
+
+  Lemma sem_update_Iload :
+    forall A rs args m v f ps ctx addr a0 chunk,
+      Op.eval_addressing (ctx_ge ctx) (ctx_sp ctx) addr rs ## args = Some a0 ->
+      Mem.loadv chunk m a0 = Some v ->
+      sem ctx f ((mk_instr_state rs ps m), None) ->
+      @sem_pred_expr A _ _ (forest_preds f) sem_value ctx
+        (seq_app (seq_app (pred_ret (Eload chunk addr)) (merge (list_translation args f))) (f #r Mem)) v.
+  Proof.
+    intros * EVAL MEM SEM.
+    exploit sem_pred_expr_list_translation; try eassumption.
+    intro H; inversion_clear H as [x [HS HV]].
+    inversion SEM as [? ? ? ? ? ? REG PRED HMEM EXIT]; subst.
+    exploit sem_pred_expr_ident2; [eapply HMEM|].
+    intros H; inversion_clear H as [x' [HS' HV']].
+    eapply sem_pred_expr_seq_app_val; eauto.
+    { eapply sem_pred_expr_seq_app; eauto.
+      - eapply sem_pred_expr_merge; eauto.
+      - apply sem_pred_expr_pred_ret.
+    }
+    econstructor; eauto.
+  Qed.
+
+  Lemma storev_valid_pointer1 :
+    forall chunk m m' s d b z,
+      Mem.storev chunk m s d = Some m' ->
+      Mem.valid_pointer m b z = true ->
+      Mem.valid_pointer m' b z = true.
+  Proof using.
+    intros. unfold Mem.storev in *. destruct_match; try discriminate; subst.
+    apply Mem.valid_pointer_nonempty_perm. apply Mem.valid_pointer_nonempty_perm in H0.
+    eapply Mem.perm_store_1; eauto.
+  Qed.
+
+  Lemma storev_valid_pointer2 :
+    forall chunk m m' s d b z,
+      Mem.storev chunk m s d = Some m' ->
+      Mem.valid_pointer m' b z = true ->
+      Mem.valid_pointer m b z = true.
+  Proof using.
+    intros. unfold Mem.storev in *. destruct_match; try discriminate; subst.
+    apply Mem.valid_pointer_nonempty_perm. apply Mem.valid_pointer_nonempty_perm in H0.
+    eapply Mem.perm_store_2; eauto.
+  Qed.
+
+  Definition valid_mem m m' :=
+    forall b z, Mem.valid_pointer m b z = Mem.valid_pointer m' b z.
+
+  #[global] Program Instance valid_mem_Equivalence : Equivalence valid_mem.
+  Next Obligation. unfold valid_mem; auto. Qed. (* Reflexivity *)
+  Next Obligation. unfold valid_mem; auto. Qed. (* Symmetry *)
+  Next Obligation. unfold valid_mem; eauto. Qed. (* Transitity *)
+
+  Lemma storev_valid_pointer :
+    forall chunk m m' s d,
+      Mem.storev chunk m s d = Some m' ->
+      valid_mem m m'.
+  Proof using.
+    unfold valid_mem. symmetry.
+    intros. destruct (Mem.valid_pointer m b z) eqn:?;
+                     eauto using storev_valid_pointer1.
+    apply not_true_iff_false.
+    apply not_true_iff_false in Heqb0.
+    eauto using storev_valid_pointer2.
+  Qed.
+
+  Lemma storev_cmpu_bool :
+    forall m m' c v v0,
+      valid_mem m m' ->
+      Val.cmpu_bool (Mem.valid_pointer m) c v v0 = Val.cmpu_bool (Mem.valid_pointer m') c v v0.
+  Proof using.
+    unfold valid_mem.
+    intros. destruct v, v0; crush.
+    { destruct_match; crush.
+      destruct_match; crush.
+      destruct_match; crush.
+      apply orb_true_iff in H1.
+      inv H1. rewrite H in H2. rewrite H2 in Heqb1.
+      simplify. rewrite H0 in Heqb1. crush.
+      rewrite H in H2. rewrite H2 in Heqb1.
+      rewrite H0 in Heqb1. crush.
+      destruct_match; auto. simplify.
+      apply orb_true_iff in H1.
+      inv H1. rewrite <- H in H2. rewrite H2 in Heqb1.
+      simplify. rewrite H0 in Heqb1. crush.
+      rewrite <- H in H2. rewrite H2 in Heqb1.
+      rewrite H0 in Heqb1. crush. }
+
+    { destruct_match; crush.
+      destruct_match; crush.
+      destruct_match; crush.
+      apply orb_true_iff in H1.
+      inv H1. rewrite H in H2. rewrite H2 in Heqb1.
+      simplify. rewrite H0 in Heqb1. crush.
+      rewrite H in H2. rewrite H2 in Heqb1.
+      rewrite H0 in Heqb1. crush.
+      destruct_match; auto. simplify.
+      apply orb_true_iff in H1.
+      inv H1. rewrite <- H in H2. rewrite H2 in Heqb1.
+      simplify. rewrite H0 in Heqb1. crush.
+      rewrite <- H in H2. rewrite H2 in Heqb1.
+      rewrite H0 in Heqb1. crush. }
+
+    { destruct_match; auto. destruct_match; auto; crush.
+      { destruct_match; crush.
+        { destruct_match; crush.
+          setoid_rewrite H in H0; eauto.
+          setoid_rewrite H in H1; eauto.
+          rewrite H0 in Heqb. rewrite H1 in Heqb; crush.
+        }
+        { destruct_match; crush.
+          setoid_rewrite H in Heqb0; eauto.
+          rewrite H0 in Heqb0. rewrite H1 in Heqb0; crush. } }
+      { destruct_match; crush.
+        { destruct_match; crush.
+          setoid_rewrite H in H0; eauto.
+          setoid_rewrite H in H1; eauto.
+          rewrite H0 in Heqb0. rewrite H1 in Heqb0; crush.
+        }
+        { destruct_match; crush.
+          setoid_rewrite H in Heqb0; eauto.
+          rewrite H0 in Heqb0. rewrite H1 in Heqb0; crush. } } }
+  Qed.
+
+  Lemma storev_eval_condition :
+    forall m m' c rs,
+      valid_mem m m' ->
+      Op.eval_condition c rs m = Op.eval_condition c rs m'.
+  Proof using.
+    intros. destruct c; crush.
+    destruct rs; crush.
+    destruct rs; crush.
+    destruct rs; crush.
+    eapply storev_cmpu_bool; eauto.
+    destruct rs; crush.
+    destruct rs; crush.
+    eapply storev_cmpu_bool; eauto.
+  Qed.
+
+  Lemma eval_operation_valid_pointer :
+    forall A B (ge: Genv.t A B) sp op args m m' v,
+      valid_mem m m' ->
+      Op.eval_operation ge sp op args m' = Some v ->
+      Op.eval_operation ge sp op args m = Some v.
+  Proof.
+    intros * VALID OP. destruct op; auto.
+    - destruct cond; auto; cbn in *.
+      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
+      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
+    - destruct c; auto; cbn in *.
+      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
+      + repeat destruct_match; auto. setoid_rewrite <- storev_cmpu_bool in OP; eauto.
+  Qed.
+
+  Lemma bb_memory_consistency_eval_operation :
+    forall A B (ge: Genv.t A B) sp state i state' args op v,
+      step_instr ge sp (Iexec state) i (Iexec state') ->
+      Op.eval_operation ge sp op args (is_mem state) = Some v ->
+      Op.eval_operation ge sp op args (is_mem state') = Some v.
+  Proof.
+    inversion_clear 1; intro EVAL; auto.
+    cbn in *.
+    eapply eval_operation_valid_pointer. unfold valid_mem. symmetry.
+    eapply storev_valid_pointer; eauto.
+    auto.
+  Qed.
+
+  Lemma truthy_dflt :
+    forall ps p,
+      truthy ps p -> eval_predf ps (dfltp p) = true.
+  Proof. intros. destruct p; cbn; inv H; auto. Qed.
+
+  Lemma sem_update_Istore :
+    forall A rs args m v f ps ctx addr a0 chunk m' v',
+      Op.eval_addressing (ctx_ge ctx) (ctx_sp ctx) addr rs ## args = Some a0 ->
+      Mem.storev chunk m a0 v' = Some m' ->
+      sem_value ctx v v' ->
+      sem ctx f ((mk_instr_state rs ps m), None) ->
+      @sem_pred_expr A _ _ (forest_preds f) sem_mem ctx
+        (seq_app (seq_app (pred_ret (Estore v chunk addr))
+          (merge (list_translation args f))) (f #r Mem)) m'.
+  Proof.
+    intros * EVAL STOREV SEMVAL SEM.
+    exploit sem_merge_list; try eassumption.
+    intro MERGE. exploit sem_pred_expr_ident2; eauto.
+    intro TMP; inversion_clear TMP as [x [HS HV]].
+    inversion_clear SEM as [? ? ? ? ? ? REG PRED HMEM EXIT].
+    exploit sem_pred_expr_ident2; [eapply HMEM|].
+    intros TMP; inversion_clear TMP as [x' [HS' HV']].
+    eapply sem_pred_expr_ident.
+    eapply sem_pred_expr_seq_app; eauto.
+    eapply sem_pred_expr_seq_app; eauto.
+    eapply sem_pred_expr_pred_ret.
+    econstructor; eauto.
+  Qed.
+
+  Lemma sem_update_Iop_top:
+    forall A f p p' f' rs m pr op res args p0 v state,
+      Op.eval_operation (ctx_ge state) (ctx_sp state) op rs ## args m = Some v ->
+      truthy pr p0 ->
+      valid_mem (is_mem (ctx_is state)) m ->
+      sem state f ((mk_instr_state rs pr m), None) ->
+      update (p, f) (RBop p0 op args res) = Some (p', f') ->
+      eval_predf pr p = true ->
+      @sem A state f' (mk_instr_state (rs # res <- v) pr m, None).
+    Proof.
+      intros * EVAL_OP TRUTHY VALID SEM UPD EVAL_PRED.
+      pose proof SEM as SEM2.
+      inversion UPD as [PRUNE]. unfold Option.bind in PRUNE.
+      destr. inversion_clear PRUNE.
+      rename Heqo into PRUNE.
+      inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
+      cbn [is_ps] in *. constructor.
+      + constructor; intro x. inversion_clear REG as [? ? ? REG']. specialize (REG' x).
+        destruct f as [fr fp fe]. cbn [forest_preds set_forest] in *.
+        destruct (peq x res); subst.
+        * rewrite forest_reg_gss in *. rewrite Regmap.gss in *.
+          eapply sem_pred_expr_prune_predicated; eauto.
+          eapply sem_pred_expr_app_predicated; [| |eauto].
+          replace fp with (forest_preds {| forest_regs := fr; forest_preds := fp; forest_exit := fe |}) by auto.
+          eapply sem_update_Iop; eauto. cbn in *.
+          eapply eval_operation_valid_pointer; eauto.
+          inversion_clear SEM2 as [? ? ? ? ? ? REG2 PRED2 MEM2 EXIT2].
+          inversion_clear PRED2; eauto.
+          cbn -[eval_predf]. rewrite eval_predf_Pand.
+          rewrite EVAL_PRED. rewrite truthy_dflt; auto.
+        * rewrite forest_reg_gso. rewrite Regmap.gso; auto.
+          unfold not in *; intros. apply n0. inv H; auto.
+      + constructor; intros. inv PRED. rewrite forest_reg_pred. auto.
+      + rewrite forest_reg_gso; auto; discriminate.
+      + auto.
+  Qed.
+
+  Lemma sem_update_Iload_top:
+    forall A f p p' f' rs m pr res args p0 v state addr a chunk,
+      Op.eval_addressing (ctx_ge state) (ctx_sp state) addr rs ## args = Some a ->
+      Mem.loadv chunk m a = Some v ->
+      truthy pr p0 ->
+      valid_mem (is_mem (ctx_is state)) m ->
+      sem state f ((mk_instr_state rs pr m), None) ->
+      update (p, f) (RBload p0 chunk addr args res) = Some (p', f') ->
+      eval_predf pr p = true ->
+      @sem A state f' (mk_instr_state (rs # res <- v) pr m, None).
+    Proof.
+      intros * EVAL_OP LOAD TRUTHY VALID SEM UPD EVAL_PRED.
+      pose proof SEM as SEM2.
+      inversion UPD as [PRUNE]. unfold Option.bind in PRUNE. destr.
+      inversion_clear PRUNE.
+      rename Heqo into PRUNE.
+      inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
+      cbn [is_ps] in *. constructor.
+      + constructor; intro x. inversion_clear REG as [? ? ? REG']. specialize (REG' x).
+        destruct f as [fr fp fe]. cbn [forest_preds set_forest] in *.
+        destruct (peq x res); subst.
+        * rewrite forest_reg_gss in *. rewrite Regmap.gss in *.
+          eapply sem_pred_expr_prune_predicated; eauto.
+          eapply sem_pred_expr_app_predicated; [| |eauto].
+          replace fp with (forest_preds {| forest_regs := fr; forest_preds := fp; forest_exit := fe |}) by auto.
+          eapply sem_update_Iload; eauto.
+          inversion_clear PRED; eauto.
+          cbn -[eval_predf]. rewrite eval_predf_Pand.
+          rewrite EVAL_PRED. rewrite truthy_dflt; auto.
+        * rewrite forest_reg_gso. rewrite Regmap.gso; auto.
+          unfold not in *; intros. apply n0. inv H; auto.
+      + constructor; intros. inv PRED. rewrite forest_reg_pred. auto.
+      + rewrite forest_reg_gso; auto; discriminate.
+      + auto.
+  Qed.
+
+  Lemma exists_sem_pred :
+    forall A B C (ctx: @ctx A) s pr r v,
+      @sem_pred_expr A B C pr s ctx r v ->
+      exists r',
+        NE.In r' r /\ s ctx (snd r') v.
+  Proof.
+    induction r; crush.
+    - inv H. econstructor. split. constructor. auto.
+    - inv H.
+      + econstructor. split. constructor. left; auto. auto.
+      + exploit IHr; eauto. intros HH. inversion_clear HH as [x HH']. inv HH'.
+        econstructor. split. constructor. right. eauto. auto.
+  Qed.
+
+  Lemma sem_update_Istore_top:
+    forall A f p p' f' rs m pr res args p0 state addr a chunk m',
+      Op.eval_addressing (ctx_ge state) (ctx_sp state) addr rs ## args = Some a ->
+      Mem.storev chunk m a rs !! res = Some m' ->
+      truthy pr p0 ->
+      valid_mem (is_mem (ctx_is state)) m ->
+      sem state f ((mk_instr_state rs pr m), None) ->
+      update (p, f) (RBstore p0 chunk addr args res) = Some (p', f') ->
+      eval_predf pr p = true ->
+      @sem A state f' (mk_instr_state rs pr m', None).
+  Proof.
+    intros * EVAL_OP STORE TRUTHY VALID SEM UPD EVAL_PRED.
+    pose proof SEM as SEM2.
+    inversion UPD as [PRUNE]. unfold Option.bind in PRUNE. destr.
+    inversion_clear PRUNE.
+    rename Heqo into PRUNE.
+    inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
+    cbn [is_ps] in *. constructor.
+    + constructor; intros. inv REG. rewrite forest_reg_gso; eauto. discriminate.
+    + constructor; intros. inv PRED. rewrite forest_reg_pred. auto.
+    + destruct f as [fr fp fm]; cbn -[seq_app] in *.
+      rewrite forest_reg_gss.
+      exploit sem_pred_expr_ident2; [exact MEM|]; intro HSEM_;
+        inversion_clear HSEM_ as [x [HSEM1 HSEM2]].
+      inv REG. specialize (H res).
+      pose proof H as HRES.
+      eapply sem_pred_expr_ident2 in HRES.
+      inversion_clear HRES as [r2 [HRES1 HRES2]].
+      apply exists_sem_pred in H. inversion_clear H as [r' [HNE HVAL]].
+      exploit sem_merge_list. eapply SEM2. instantiate (2 := args). intro HSPE. eapply sem_pred_expr_ident2 in HSPE.
+      inversion_clear HSPE as [l_ [HSPE1 HSPE2]].
+      eapply sem_pred_expr_prune_predicated; eauto.
+      eapply sem_pred_expr_app_predicated.
+      eapply sem_pred_expr_seq_app_val; [solve [eauto]| |].
+      eapply sem_pred_expr_seq_app; [solve [eauto]|].
+      eapply sem_pred_expr_flap2.
+      eapply sem_pred_expr_seq_app; [solve [eauto]|].
+      eapply sem_pred_expr_pred_ret. econstructor. eauto. 3: { eauto. }
+      eauto. auto. eauto. inv PRED. eauto.
+      rewrite eval_predf_Pand. rewrite EVAL_PRED.
+      rewrite truthy_dflt. auto. auto.
+    + auto.
+  Qed.
+
+  Definition predicated_not_inP {A} (p: Gible.predicate) (l: predicated A) :=
+    forall op e, NE.In (op, e) l -> ~ PredIn p op.
+
+  Lemma predicated_not_inP_cons :
+    forall A p (a: (pred_op * A)) l,
+      predicated_not_inP p (NE.cons a l) ->
+      predicated_not_inP p l.
+  Proof.
+    unfold predicated_not_inP; intros. eapply H. econstructor. right; eauto.
+  Qed.
+
+  Lemma sem_pexpr_not_in :
+    forall G (ctx: @ctx G) p0 ps p e b,
+      ~ PredIn p p0 ->
+      sem_pexpr ctx (from_pred_op ps p0) b ->
+      sem_pexpr ctx (from_pred_op (PTree.set p e ps) p0) b.
+  Proof.
+    induction p0; auto; intros.
+    - cbn. destruct p. unfold get_forest_p'.
+      assert (p0 <> p) by
+        (unfold not; intros; apply H; subst; constructor).
+      rewrite PTree.gso; auto.
+    - cbn in *.
+      assert (X: ~ PredIn p p0_1 /\ ~ PredIn p p0_2) by
+        (split; unfold not; intros; apply H; constructor; tauto).
+      inversion_clear X as [X1 X2].
+      inv H0. inv H4.
+      specialize (IHp0_1 _ p e _ X1 H0). constructor. tauto.
+      specialize (IHp0_2 _ p e _ X2 H0). constructor. tauto.
+      constructor; auto.
+    - cbn in *.
+      assert (X: ~ PredIn p p0_1 /\ ~ PredIn p p0_2) by
+        (split; unfold not; intros; apply H; constructor; tauto).
+      inversion_clear X as [X1 X2].
+      inv H0. inv H4.
+      specialize (IHp0_1 _ p e _ X1 H0). constructor. tauto.
+      specialize (IHp0_2 _ p e _ X2 H0). constructor. tauto.
+      constructor; auto.
+  Qed.
+
+  Lemma sem_pred_not_in :
+    forall A B G (ctx: @ctx G) (s: @Abstr.ctx G -> A -> B -> Prop) l v p e ps,
+      sem_pred_expr ps s ctx l v ->
+      predicated_not_inP p l ->
+      sem_pred_expr (PTree.set p e ps) s ctx l v.
+  Proof.
+    induction l.
+    - intros. unfold predicated_not_inP in H0.
+      destruct a. constructor. apply sem_pexpr_not_in.
+      eapply H0. econstructor. inv H. auto. inv H. auto.
+    - intros. inv H. constructor. unfold predicated_not_inP in H0.
+      eapply sem_pexpr_not_in. eapply H0. constructor. left. eauto.
+      auto. auto.
+      apply sem_pred_expr_cons_false. apply sem_pexpr_not_in. eapply H0.
+      constructor. tauto. auto. auto.
+      eapply IHl. eauto. eapply predicated_not_inP_cons; eauto.
+  Qed.
+
+  Lemma pred_not_in_forestP :
+    forall pred f,
+      predicated_not_in_forest pred f = true ->
+      forall x, predicated_not_inP pred (f #r x).
+  Proof. Admitted.
+
+  Lemma pred_not_in_forest_exitP :
+    forall pred f,
+      predicated_not_in_forest pred f = true ->
+      predicated_not_inP pred (forest_exit f).
+  Proof. Admitted.
+
+  Lemma from_predicated_sem_pred_expr :
+    forall A (ctx: @ctx A) preds pe b,
+      sem_pred_expr preds sem_pred ctx pe b ->
+      sem_pexpr ctx (from_predicated true preds pe) b.
+  Proof. Admitted.
+
+  Lemma sem_update_Isetpred:
+    forall A (ctx: @ctx A) f pr p0 c args b rs m,
+      valid_mem (ctx_mem ctx) m ->
+      sem ctx f (mk_instr_state rs pr m, None) ->
+      Op.eval_condition c rs ## args m = Some b ->
+      truthy pr p0 ->
+      sem_pexpr ctx
+      (from_predicated true (forest_preds f) (seq_app (pred_ret (PEsetpred c)) (merge (list_translation args f)))) b.
+  Proof.
+    intros. eapply from_predicated_sem_pred_expr.
+    pose proof (sem_merge_list _ ctx f rs pr m args H0).
+    apply sem_pred_expr_ident2 in H3; simplify.
+    eapply sem_pred_expr_seq_app_val; [eauto| |].
+    constructor. constructor. constructor.
+    econstructor; eauto.
+    erewrite storev_eval_condition; eauto.
+  Qed.
+
+  Lemma sem_update_Isetpred_top:
+    forall A f p p' f' rs m pr args p0 state c pred b,
+      Op.eval_condition c rs ## args m = Some b ->
+      truthy pr p0 ->
+      valid_mem (is_mem (ctx_is state)) m ->
+      sem state f ((mk_instr_state rs pr m), None) ->
+      update (p, f) (RBsetpred p0 c args pred) = Some (p', f') ->
+      eval_predf pr p = true ->
+      @sem A state f' (mk_instr_state rs (pr # pred <- b) m, None).
+  Proof.
+    intros * EVAL_OP TRUTHY VALID SEM UPD EVAL_PRED.
+    pose proof SEM as SEM2.
+    inversion UPD as [PRUNE]. unfold Option.bind in PRUNE. destr. destr.
+    inversion_clear PRUNE.
+    rename Heqo into PRUNE.
+    inversion_clear SEM as [? ? ? ? ? ? REG PRED MEM EXIT].
+    cbn [is_ps] in *. constructor.
+    + constructor. intros. apply sem_pred_not_in. rewrite forest_pred_reg.
+      inv REG. auto. rewrite forest_pred_reg. apply pred_not_in_forestP.
+      unfold assert_ in *. repeat (destruct_match; try discriminate); auto.
+    + constructor; intros. destruct (peq x pred); subst.
+      * rewrite Regmap.gss.
+        rewrite forest_pred_gss.
+        cbn [update] in *. unfold Option.bind in *. destr. destr. inv UPD.
+        replace b with (b && true) by eauto with bool.
+        apply sem_pexpr_Pand.
+        destruct b. constructor. right.
+        eapply sem_update_Isetpred; eauto.
+        constructor. constructor. replace false with (negb true) by auto.
+        apply sem_pexpr_negate. inv TRUTHY. constructor.
+        cbn. eapply sem_pexpr_eval. inv PRED. eauto. auto.
+        replace false with (negb true) by auto.
+        apply sem_pexpr_negate.
+        eapply sem_pexpr_eval. inv PRED. eauto. auto.
+        eapply sem_update_Isetpred; eauto.
+        constructor. constructor. constructor.
+        replace true with (negb false) by auto. apply sem_pexpr_negate.
+        eapply sem_pexpr_eval. inv PRED. eauto. inv TRUTHY. auto. cbn -[eval_predf].
+        rewrite eval_predf_negate. rewrite H; auto.
+        replace true with (negb false) by auto. apply sem_pexpr_negate.
+        eapply sem_pexpr_eval. inv PRED. eauto. rewrite eval_predf_negate.
+        rewrite EVAL_PRED. auto.
+      * rewrite Regmap.gso by auto. inv PRED. specialize (H x).
+        rewrite forest_pred_gso by auto; auto.
+    + rewrite forest_pred_reg. apply sem_pred_not_in. auto. apply pred_not_in_forestP.
+      unfold assert_ in *. now repeat (destruct_match; try discriminate).
+    + cbn -[from_predicated from_pred_op seq_app]. apply sem_pred_not_in; auto.
+      apply pred_not_in_forest_exitP.
+      unfold assert_ in *. now repeat (destruct_match; try discriminate).
+  Qed.
+
+  Lemma sem_pexpr_impl :
+    forall A (state: @ctx A) a b res,
+      sem_pexpr state b res ->
+      sem_pexpr state a true ->
+      sem_pexpr state (a → b) res.
+  Proof.
+    intros. destruct res.
+    constructor; tauto.
+    constructor; auto. replace false with (negb true) by auto.
+    now apply sem_pexpr_negate.
+  Qed.
+
+  Lemma eval_predf_simplify :
+    forall ps x,
+      eval_predf ps (simplify x) = eval_predf ps x.
+  Proof.
+    unfold eval_predf; intros.
+    rewrite simplify_correct. auto.
+  Qed.
+
+  Lemma sem_update_falsy:
+    forall A state f f' rs ps m p a p',
+      instr_falsy ps a ->
+      update (p, f) a = Some (p', f') ->
+      sem state f (mk_instr_state rs ps m, None) ->
+      @sem A state f' (mk_instr_state rs ps m, None).
+  Proof.
+    inversion 1; cbn [update] in *; intros.
+    - unfold Option.bind in *. destr. inv H2.
+      constructor.
+      * constructor. intros. destruct (peq x res); subst.
+        rewrite forest_reg_gss. cbn.
+        eapply sem_pred_expr_prune_predicated; eauto.
+        eapply sem_pred_expr_app_predicated_false. inv H3. inv H8. auto.
+        inv H3. inv H9. eauto. rewrite eval_predf_Pand. cbn -[eval_predf].
+        rewrite H0. auto. 
+        rewrite forest_reg_gso. inv H3. inv H8. auto.
+        unfold not; intros; apply n0. now inv H1.
+      * constructor; intros. rewrite forest_reg_pred. inv H3. inv H9. auto.
+      * rewrite forest_reg_gso. inv H3. auto. unfold not; intros. inversion H1.
+      * inv H3. auto.
+    - unfold Option.bind in *. destr. inv H2.
+      constructor.
+      * constructor. intros. destruct (peq x dst); subst.
+        rewrite forest_reg_gss. cbn.
+        eapply sem_pred_expr_prune_predicated; eauto.
+        eapply sem_pred_expr_app_predicated_false. inv H3. inv H8. auto.
+        inv H3. inv H9. eauto. rewrite eval_predf_Pand. cbn -[eval_predf].
+        rewrite H0. auto. 
+        rewrite forest_reg_gso. inv H3. inv H8. auto.
+        unfold not; intros; apply n0. now inv H1.
+      * constructor; intros. rewrite forest_reg_pred. inv H3. inv H9. auto.
+      * rewrite forest_reg_gso. inv H3. auto. unfold not; intros. inversion H1.
+      * inv H3. auto.
+    - unfold Option.bind in *. destr. inv H2.
+      constructor.
+      * constructor. intros. rewrite forest_reg_gso by discriminate. inv H3. inv H8. auto.
+      * constructor; intros. rewrite forest_reg_pred. inv H3. inv H9. auto.
+      * rewrite forest_reg_gss. cbn. eapply sem_pred_expr_prune_predicated; eauto.
+        eapply sem_pred_expr_app_predicated_false. inv H3. auto. inv H3. inv H9. eauto.
+        rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H0. auto.
+      * inv H3. auto.
+    - unfold Option.bind in *. destr. destr. inv H2.
+      constructor.
+      * constructor; intros. rewrite forest_pred_reg. apply sem_pred_not_in.
+        inv H3. inv H8. auto. apply pred_not_in_forestP. unfold assert_ in Heqo. now destr.
+      * constructor. intros. destruct (peq x pred); subst.
+        rewrite forest_pred_gss. replace (ps !! pred) with (true && ps !! pred) by auto.
+        assert (sem_pexpr state0 (¬ (from_pred_op (forest_preds f) p0 ∧ from_pred_op (forest_preds f) p')) true).
+        { replace true with (negb false) by auto. apply sem_pexpr_negate.
+          constructor. left. eapply sem_pexpr_eval. inv H3. inv H9. eauto.
+          auto.
+        }
+        apply sem_pexpr_Pand. constructor; tauto.
+        apply sem_pexpr_impl. inv H3. inv H10. eauto.
+        { constructor. left. eapply sem_pexpr_eval. inv H3. inv H10. eauto.
+          rewrite eval_predf_negate. rewrite H0. auto.
+        }
+        rewrite forest_pred_gso by auto. inv H3. inv H9. auto.
+      * rewrite forest_pred_reg. apply sem_pred_not_in. inv H3. auto.
+        apply pred_not_in_forestP. unfold assert_ in Heqo. now destr.
+      * apply sem_pred_not_in. inv H3; auto. cbn.
+        apply pred_not_in_forest_exitP. unfold assert_ in Heqo. now destr.
+    - unfold Option.bind in *. destr. inv H2. inv H3. constructor.
+      * constructor. inv H8. auto.
+      * constructor. intros. inv H9. eauto.
+      * auto.
+      * cbn. eapply sem_pred_expr_prune_predicated; [|eauto].
+        eapply sem_pred_expr_app_predicated_false; auto.
+        inv H9. eauto.
+        rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H0. auto.
+  Qed.
+
+  Lemma sem_update_falsy_input:
+    forall A state f f' rs ps m p a p' exitcf,
+      eval_predf ps p = false ->
+      update (p, f) a = Some (p', f') ->
+      sem state f (mk_instr_state rs ps m, exitcf) ->
+      @sem A state f' (mk_instr_state rs ps m, exitcf)
+        /\ eval_predf ps p' = false.
+  Proof.
+    intros; destruct a; cbn [update] in *; intros.
+    - inv H0. auto.
+    - unfold Option.bind in *. destr. inv H0. split; [|solve [auto]].
+      constructor.
+      * constructor. intros. destruct (peq x r); subst.
+        rewrite forest_reg_gss. cbn.
+        eapply sem_pred_expr_prune_predicated; eauto.
+        eapply sem_pred_expr_app_predicated_false. inv H1. inv H7. auto.
+        inv H1. inv H8. eauto. rewrite eval_predf_Pand.
+        rewrite H. eauto with bool.
+        rewrite forest_reg_gso. inv H1. inv H7. auto.
+        unfold not; intros; apply n0. now inv H0.
+      * constructor; intros. rewrite forest_reg_pred. inv H1. inv H8. auto.
+      * rewrite forest_reg_gso. inv H1. auto. unfold not; intros. inversion H0.
+      * inv H1. auto.
+    - unfold Option.bind in *. destr. inv H0. split; [|solve [auto]].
+      constructor.
+      * constructor. intros. destruct (peq x r); subst.
+        rewrite forest_reg_gss. cbn.
+        eapply sem_pred_expr_prune_predicated; eauto.
+        eapply sem_pred_expr_app_predicated_false. inv H1. inv H7. auto.
+        inv H1. inv H8. eauto. rewrite eval_predf_Pand. cbn -[eval_predf].
+        rewrite H. eauto with bool.
+        rewrite forest_reg_gso. inv H1. inv H7. auto.
+        unfold not; intros; apply n0. now inv H0.
+      * constructor; intros. rewrite forest_reg_pred. inv H1. inv H8. auto.
+      * rewrite forest_reg_gso. inv H1. auto. unfold not; intros. inversion H0.
+      * inv H1. auto.
+    - unfold Option.bind in *. destr. inv H0. split; [|solve [auto]].
+      constructor.
+      * constructor. intros. rewrite forest_reg_gso by discriminate. inv H1. inv H7. auto.
+      * constructor; intros. rewrite forest_reg_pred. inv H1. inv H8. auto.
+      * rewrite forest_reg_gss. cbn. eapply sem_pred_expr_prune_predicated; eauto.
+        eapply sem_pred_expr_app_predicated_false. inv H1. auto. inv H1. inv H8. eauto.
+        rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H. eauto with bool.
+      * inv H1. auto.
+    - unfold Option.bind in *. destr. destr. inv H0. split; [|solve [auto]].
+      constructor.
+      * constructor; intros. rewrite forest_pred_reg. apply sem_pred_not_in.
+        inv H1. inv H7. auto. apply pred_not_in_forestP. unfold assert_ in Heqo0. now destr.
+      * constructor. intros. destruct (peq x p0); subst.
+        rewrite forest_pred_gss. replace (ps !! p0) with (true && ps !! p0) by auto.
+        assert (sem_pexpr state0 (¬ (from_pred_op (forest_preds f) (dfltp o) ∧ from_pred_op (forest_preds f) p')) true).
+        { replace true with (negb false) by auto. apply sem_pexpr_negate.
+          constructor. right. eapply sem_pexpr_eval. inv H1. inv H8. eauto.
+          auto.
+        }
+        apply sem_pexpr_Pand. constructor; tauto.
+        apply sem_pexpr_impl. inv H1. inv H9. eauto.
+        { constructor. right. eapply sem_pexpr_eval. inv H1. inv H9. eauto.
+          rewrite eval_predf_negate. rewrite H. auto.
+        }
+        rewrite forest_pred_gso by auto. inv H1. inv H8. auto.
+      * rewrite forest_pred_reg. apply sem_pred_not_in. inv H1. auto.
+        apply pred_not_in_forestP. unfold assert_ in Heqo0. now destr.
+      * apply sem_pred_not_in. inv H1; auto. cbn.
+        apply pred_not_in_forest_exitP. unfold assert_ in Heqo0. now destr.
+    - unfold Option.bind in *. destr. inv H0. inv H1. split.
+      -- constructor.
+         * constructor. inv H7. auto.
+         * constructor. intros. inv H8. eauto.
+         * auto.
+         * cbn. eapply sem_pred_expr_prune_predicated; [|eauto].
+           eapply sem_pred_expr_app_predicated_false; auto.
+           inv H8. eauto.
+           rewrite eval_predf_Pand. cbn -[eval_predf]. rewrite H. eauto with bool.
+      -- rewrite eval_predf_simplify. rewrite eval_predf_Pand. rewrite H. eauto with bool.
+  Qed.
+
+  Definition setpred_wf (i: instr): bool :=
+    match i with
+    | RBsetpred (Some op) _ _ p => negb (predin peq p op)
+    | _ => true
+    end.
+
+  Lemma sem_update_instr :
+    forall f i' i'' a sp p i p' f',
+      step_instr ge sp (Iexec i') a (Iexec i'') ->
+      valid_mem (is_mem i) (is_mem i') ->
+      sem (mk_ctx i sp ge) f (i', None) ->
+      update (p, f) a = Some (p', f') ->
+      eval_predf (is_ps i') p = true ->
+      sem (mk_ctx i sp ge) f' (i'', None).
+  Proof.
+    inversion 1; subst; clear H; intros VALID SEM UPD EVAL_PRED; pose proof SEM as SEM2.
+    - inv UPD; auto.
+    - eauto using sem_update_Iop_top.
+    - eauto using sem_update_Iload_top.
+    - eauto using sem_update_Istore_top.
+    - eauto using sem_update_Isetpred_top.
+    - destruct i''. eauto using sem_update_falsy.
+  Qed.
+
+  Lemma Pand_true_left :
+    forall ps a b,
+      eval_predf ps a = false ->
+      eval_predf ps (a ∧ b) = false.
+  Proof.
+    intros.
+    rewrite eval_predf_Pand. now rewrite H.
+  Qed.
+
+  Lemma Pand_true_right :
+    forall ps a b,
+      eval_predf ps b = false ->
+      eval_predf ps (a ∧ b) = false.
+  Proof.
+    intros.
+    rewrite eval_predf_Pand. rewrite H.
+    eauto with bool.
+  Qed.
+
+  Lemma sem_update_instr_term :
+    forall f i' i'' sp i cf p p' p'' f',
+      sem (mk_ctx i sp ge) f (i', None) ->
+      step_instr ge sp (Iexec i') (RBexit p cf) (Iterm i'' cf) ->
+      update (p', f) (RBexit p cf) = Some (p'', f') ->
+      eval_predf (is_ps i') p' = true ->
+      sem (mk_ctx i sp ge) f' (i'', Some cf)
+           /\ eval_predf (is_ps i') p'' = false.
+  Proof.
+    intros. inv H0. simpl in *.
+    unfold Option.bind in *. destruct_match; try discriminate.
+    apply truthy_dflt in H6. inv H1.
+    assert (eval_predf (Gible.is_ps i'') (¬ dfltp p) = false).
+    { rewrite eval_predf_negate. now rewrite negb_false_iff. }
+    apply Pand_true_left with (b := p') in H0.
+    rewrite <- eval_predf_simplify in H0. split; auto.
+    unfold "<-e". destruct i''.
+    inv H. constructor; auto.
+    constructor. inv H9. intros. cbn. eauto.
+    inv H10. constructor; intros. eauto.
+    cbn.
+    eapply sem_pred_expr_prune_predicated; eauto.
+    eapply sem_pred_expr_app_predicated.
+    constructor. constructor. constructor.
+    inv H10. eauto. cbn -[eval_predf] in *.
+    rewrite eval_predf_Pand. rewrite H2. now rewrite H6.
+  Qed.
+
+  Lemma step_instr_lessdef_term :
+    forall sp a i i' ti cf,
+      step_instr ge sp (Iexec i) a (Iterm i' cf) ->
+      state_lessdef i ti ->
+      exists ti', step_instr ge sp (Iexec ti) a (Iterm ti' cf) /\ state_lessdef i' ti'.
+  Proof.
+    inversion 1; intros; subst.
+    econstructor. split; eauto. constructor.
+    destruct p. constructor. erewrite eval_predf_pr_equiv. inv H4.
+    eauto. inv H6. eauto. constructor.
+  Qed.
+
+  Lemma combined_falsy :
+    forall i o1 o,
+      falsy i o1 ->
+      falsy i (combine_pred o o1).
+  Proof.
+    inversion 1; subst; crush. destruct o; simplify.
+    constructor. rewrite eval_predf_Pand. rewrite H0. crush.
+    constructor. auto.
+  Qed.
+
+  Lemma Abstr_match_states_sem :
+    forall i sp f i' ti cf,
+      sem (mk_ctx i sp ge) f (i', cf) ->
+      state_lessdef i ti ->
+      exists ti', sem (mk_ctx ti sp ge) f (ti', cf) /\ state_lessdef i' ti'.
+  Proof. Admitted. (* This needs a bit more in Abstr.v *)
+
+  Lemma mfold_left_update_Some :
+    forall xs x v,
+      mfold_left update xs x = Some v ->
+      exists y, x = Some y.
+  Proof.
+    induction xs; intros.
+    { cbn in *. inv H. eauto. }
+    cbn in *. unfold Option.bind in *. exploit IHxs; eauto.
+    intros. simplify. destruct x; crush.
+    eauto.
+  Qed.
+
+  Lemma step_instr_term_exists :
+    forall A B ge sp v x v2 cf,
+      @step_instr A B ge sp (Iexec v) x (Iterm v2 cf) ->
+      exists p, x = RBexit p cf.
+  Proof using. inversion 1; eauto. Qed.
+
+  Lemma eval_predf_update_true :
+    forall i i' curr_p next_p f f_next instr sp,
+      update (curr_p, f) instr = Some (next_p, f_next) ->
+      step_instr ge sp (Iexec i) instr (Iexec i') ->
+      eval_predf (is_ps i) curr_p = true ->
+      eval_predf (is_ps i') next_p = true.
+  Proof.
+    intros * UPD STEP EVAL. destruct instr; cbn [update] in UPD;
+      try solve [unfold Option.bind in *; try destr; inv UPD; inv STEP; auto].
+    - unfold Option.bind in *. destr. destr. inv UPD. inv STEP; auto. cbn [is_ps] in *.
+      unfold is_initial_pred_and_notin in Heqo1. unfold assert_ in Heqo1. destr. destr.
+      destr. destr. destr. destr. subst. assert (~ PredIn p2 next_p).
+      unfold not; intros. apply negb_true_iff in Heqb0. apply not_true_iff_false in Heqb0.
+      apply Heqb0. now apply predin_PredIn. rewrite eval_predf_not_PredIn; auto.
+    - unfold Option.bind in *. destr. inv UPD. inv STEP. inv H3. cbn.
+      rewrite eval_predf_simplify. rewrite eval_predf_Pand. rewrite eval_predf_negate.
+      destruct i'; cbn in *. rewrite H0. auto.
+  Qed.
+
+  Lemma seq_app_cons :
+    forall A B  f a l p0 p1,
+      @seq_app A B (pred_ret f) (NE.cons a l) = NE.cons p0 p1 ->
+      @seq_app A B (pred_ret f) l = p1.
+  Proof. intros. cbn in *. inv H. eauto. Qed.
+
+  Lemma sem_update_valid_mem :
+    forall i i' i'' curr_p next_p f f_next instr sp,
+      step_instr ge sp (Iexec i') instr (Iexec i'') ->
+      update (curr_p, f) instr = Some (next_p, f_next) ->
+      sem (mk_ctx i sp ge) f (i', None) ->
+      valid_mem (is_mem i') (is_mem i'').
+  Proof.
+    inversion 1; crush.
+    unfold Option.bind in *. destr. inv H7.
+    eapply storev_valid_pointer; eauto.
+  Qed.
+
+  Lemma eval_predf_lessdef :
+    forall p a b,
+      state_lessdef a b ->
+      eval_predf (is_ps a) p = eval_predf (is_ps b) p.
+  Proof using.
+    induction p; crush.
+    - inv H. simpl. unfold eval_predf. simpl.
+      repeat destr. inv Heqp0. rewrite H1. auto.
+    - rewrite !eval_predf_Pand.
+      erewrite IHp1 by eassumption.
+      now erewrite IHp2 by eassumption.
+    - rewrite !eval_predf_Por.
+      erewrite IHp1 by eassumption.
+      now erewrite IHp2 by eassumption.
+  Qed.
+
+(*|
+``abstr_fold_falsy``: This lemma states that when we are at the end of an
+execution, the values in the register map do not continue to change.
+|*)
+
+  Lemma abstr_fold_falsy :
+    forall A ilist i sp ge f res p f' p',
+      @sem A (mk_ctx i sp ge) f res ->
+      mfold_left update ilist (Some (p, f)) = Some (p', f') ->
+      eval_predf (is_ps (fst res)) p = false ->
+      sem (mk_ctx i sp ge) f' res.
+  Proof.
+    induction ilist.
+    - intros. cbn in *. inv H0. auto.
+    - intros. cbn -[update] in H0.
+      exploit mfold_left_update_Some. eauto. intros. inv H2.
+      rewrite H3 in H0. destruct x.
+      destruct res. destruct i0.
+      exploit sem_update_falsy_input; try eassumption; intros.
+      inversion_clear H2.
+      eapply IHilist; eassumption.
+  Qed.
+
+  Lemma abstr_fold_correct :
+    forall sp x i i' i'' cf f p f' curr_p
+        (VALID: valid_mem (is_mem i) (is_mem i')),
+      SeqBB.step ge sp (Iexec i') x (Iterm i'' cf) ->
+      sem (mk_ctx i sp ge) f (i', None) ->
+      eval_predf (is_ps i') curr_p = true ->
+      mfold_left update x (Some (curr_p, f)) = Some (p, f') ->
+      forall ti,
+        state_lessdef i ti ->
+        exists ti', sem (mk_ctx ti sp ge) f' (ti', Some cf)
+               /\ state_lessdef i'' ti'
+               /\ valid_mem (is_mem i) (is_mem i'').
+  Proof.
+    induction x as [| x xs IHx ]; intros; cbn -[update] in *; inv H; cbn [fst snd] in *.
+    - (* inductive case *)
+      exploit mfold_left_update_Some; eauto; intros Hexists;
+        inversion Hexists as [[curr_p_inter f_inter] EXEQ]; clear Hexists.
+        exploit eval_predf_update_true;
+        eauto; intros EVALTRUE.
+      rewrite EXEQ in H2. eapply IHx in H2; cbn [fst snd] in *.
+      eauto.
+      transitivity (is_mem i'); auto.
+      eapply sem_update_valid_mem; eauto.
+      eauto.
+      eapply sem_update_instr; eauto. eauto. eauto.
+    - (* terminal case *)
+      exploit mfold_left_update_Some; eauto; intros Hexists;
+        inversion Hexists as [[curr_p_inter f_inter] EXEQ]; clear Hexists. rewrite EXEQ in H2.
+      exploit Abstr_match_states_sem; (* TODO *)
+      eauto; intros H; inversion H as [v [Hi LESSDEF]]; clear H.
+      exploit step_instr_lessdef_term;
+      eauto; intros H; inversion H as [v2 [Hi2 LESSDEF2]]; clear H.
+      exploit step_instr_term_exists; eauto; inversion 1 as [? ?]; subst; clear H.
+      erewrite eval_predf_lessdef in H1 by eassumption.
+      exploit sem_update_instr_term;
+      eauto; intros [A B].
+      exists v2.
+      exploit abstr_fold_falsy.
+      apply A.
+      eassumption. auto. cbn. inversion Hi2; subst. auto. intros.
+      split; auto. split; auto.
+      inversion H7; subst; auto.
+  Qed.
+
+  Lemma sem_regset_empty :
+    forall A ctx, @sem_regset A ctx empty (ctx_rs ctx).
+  Proof using.
+    intros; constructor; intros.
+    constructor; auto. constructor.
+    constructor.
+  Qed.
+
+  Lemma sem_predset_empty :
+    forall A ctx, @sem_predset A ctx empty (ctx_ps ctx).
+  Proof using.
+    intros; constructor; intros.
+    constructor; auto. constructor.
+  Qed.
+
+  Lemma sem_empty :
+    forall A ctx, @sem A ctx empty (ctx_is ctx, None).
+  Proof using.
+    intros. destruct ctx. destruct ctx_is.
+    constructor; try solve [constructor; constructor; crush].
+    eapply sem_regset_empty.
+    eapply sem_predset_empty.
+  Qed.
+
+  Lemma abstr_sequence_correct :
+    forall sp x i i'' cf x',
+      SeqBB.step ge sp (Iexec i) x (Iterm i'' cf) ->
+      abstract_sequence x = Some x' ->
+      forall ti,
+        state_lessdef i ti ->
+        exists ti', sem (mk_ctx ti sp ge) x' (ti', Some cf)
+               /\ state_lessdef i'' ti'.
+  Proof.
+    unfold abstract_sequence. intros. unfold Option.map in H0.
+    destruct_match; try easy.
+    destruct p as [p TMP]; simplify.
+    exploit abstr_fold_correct; eauto; crush.
+    { apply sem_empty. }
+    exists x0. auto.
+  Qed.
+
+End CORRECTNESS.
diff --git a/src/hls/Predicate.v b/src/hls/Predicate.v
index f99fa4f..92ad03f 100644
--- a/src/hls/Predicate.v
+++ b/src/hls/Predicate.v
@@ -879,3 +879,9 @@ Proof.
   pose proof (sat_predicateP_det a p _ _ H1 H0).
   rewrite H in H3. now rewrite H3 in H2.
 Qed.
+
+Definition and_list {A} (p: list (@pred_op A)): @pred_op A :=
+  fold_left Pand p T.
+
+Definition or_list {A} (p: list (@pred_op A)): @pred_op A :=
+  fold_left Por p ⟂.