(* Do not edit this file, it was generated automatically *)
Require Import VST.floyd.proofauto.
Require Import VST.progs64.union.
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.

Import Memdata.

Definition Gprog : funspecs := nil.

Definition g_spec :=
 DECLARE _g
 WITH i: Z
 PRE [ size_t]
   PROP() PARAMS(Vptrofs (Ptrofs.repr i)) SEP()
 POST [ size_t ]
   PROP() RETURN (Vptrofs (Ptrofs.repr i)) SEP().

Lemma body_g: semax_body Vprog Gprog f_g g_spec.
Proof.
start_function.
forward.
forward.
forward.
cancel.
Qed.

Definition unconst_spec :=
 DECLARE _unconst
 WITH p: val
 PRE [ tptr tschar ]
   PROP() PARAMS(p) SEP()
 POST [ tptr tschar ]
   PROP() RETURN (p) SEP().

Lemma unconst_aux:
  forall (x: val) v,
      data_at Tsh (Tunion _const_or_not noattr) (inl x) v =
      data_at Tsh (Tunion _const_or_not noattr) (inr x) v.
Proof. reflexivity. Qed.

Lemma body_unconst: semax_body Vprog Gprog f_unconst unconst_spec.
Proof.
start_function.
forward.
rewrite unconst_aux.
forward.
forward.
cancel.
Qed.

Lemma decode_float32_int32:
  forall (bl: list memval) (x: float32),
 size_chunk Mfloat32 = Z.of_nat (Datatypes.length bl) ->
 decode_val Mfloat32 bl = Vsingle x ->
 decode_val Mint32 bl = Vint (Float32.to_bits x).
Proof.
intros.
unfold decode_val,decode_int,rev_if_be in *.
destruct (proj_bytes bl) eqn:?H.
inv H0.
rewrite Float32.to_of_bits. auto.
inv H0.
Qed.

Lemma NOT_decode_int32_float32:
  Archi.ptr64=false ->
 ~ (forall (bl: list memval) (x: float32),
     size_chunk Mfloat32 = Z.of_nat (Datatypes.length bl) ->
     decode_val Mint32 bl = Vint (Float32.to_bits x) ->
     decode_val Mfloat32 bl = Vsingle x).
(* This lemma illustrates a problem: it is NOT the case that
   if (bl: list memval) decodes to Vint (Float32.to_bits x)
  then it also decodes to  Vsingle x.
  See https://github.com/AbsInt/CompCert/issues/207  for a description
  of the problem; and see https://github.com/PrincetonUniversity/VST/issues/429
  for a description of the solution,  forward_store_union_hack  *)
Proof.
intro Hp.
intro.
set (x := Float32.zero). (* nothing special about zero, any value would do *)
set (i := Float32.to_bits x).
set (bl := [Fragment (Vint i) Q32 3; Fragment (Vint i) Q32 2; Fragment (Vint i) Q32 1; Fragment (Vint i) Q32 0]).
specialize (H bl x).
specialize (H (eq_refl _)).
assert (decode_val Mint32 bl = Vint (Float32.to_bits x)).
unfold decode_val, bl.
rewrite Hp.
simpl.
destruct (Val.eq (Vint i) (Vint i)); [ | congruence].
destruct (quantity_eq Q32 Q32); [ | congruence].
simpl.
reflexivity.
specialize (H H0).
clear - H. subst bl i.
unfold decode_val in H.
simpl in H. inversion H.
Qed.

Module FABS_STUFF.

Lemma shift_pos_succ:
  forall k j, (shift_pos (Pos.succ k) j = (shift_pos k j)~0)%positive.
Proof.
intros.
change ((shift_pos k j)~0)%positive
with (2 * (shift_pos k j))%positive.
apply Pos2Z.inj.
rewrite Pos2Z.inj_mul.
rewrite !shift_pos_correct.
rewrite Z.mul_assoc.
f_equal.
rewrite <- !two_power_pos_correct.
rewrite <- Pos.add_1_l.
rewrite two_power_pos_is_exp.
reflexivity.
Qed.

Lemma nan_pl_range:
 forall k p, Binary.nan_pl k p = true ->
 Z.pos p < 2 ^ (k-1).
Proof.
intros.
unfold Binary.nan_pl in H.
apply Z.ltb_lt in H.
revert k H; induction p; simpl; intros.
-
rewrite Pos2Z.inj_succ in H.
specialize (IHp (k-1)).
spec IHp; [lia | ].
replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
rewrite Pos2Z.inj_xI.
lia.
-
rewrite Pos2Z.inj_succ in H.
specialize (IHp (k-1)).
spec IHp; [lia | ].
replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
rewrite Pos2Z.inj_xO.
lia.
-
replace (2^(k-1)) with (2^1 * 2^(k-1-1)).
2:{ rewrite <- Z.pow_add_r by lia. f_equal. lia. }
change (2^1) with 2.
assert (0 < 2 ^ (k-1-1)).
apply Z.pow_pos_nonneg; lia.
lia.
Qed.

Definition abs_nan (any_nan: {x : Bits.binary32 | Binary.is_nan 24 128 x = true}) (f: Binary.binary_float 24 128)   :=
match f with
| @Binary.B754_nan _ _ _ p H =>
    exist (fun x : Binary.binary_float 24 128 => Binary.is_nan 24 128 x = true)
      (Binary.B754_nan 24 128 false p H) eq_refl
| _ => any_nan
end.

Lemma bounded_mantissa:
  forall prec emax m e, Binary.bounded prec emax m e = true ->
    Z.pos m < 2 ^ prec.
Proof.
intros.
unfold Binary.bounded in H.
rewrite andb_true_iff in H.
destruct H as [H H0].
apply Z.leb_le in H0.
unfold Binary.canonical_mantissa in H.
apply Zeq_bool_eq in H.
unfold FLT.FLT_exp in H.
rewrite Digits.Zpos_digits2_pos in H.
pose proof (Z.max_lub_l (Digits.Zdigits Zaux.radix2 (Z.pos m) + e - prec)
      (3 - emax - prec) e).
spec H1; [ lia | ].
clear H.
assert (Digits.Zdigits Zaux.radix2 (Z.pos m) <= prec) by lia.
clear - H.
apply Digits.Zpower_gt_Zdigits in H.
apply H.
Qed.

Lemma binary32_abs_lemma:
 forall (x : Bits.binary32)
      (any_nan : {x : Bits.binary32 | Binary.is_nan 24 128 x = true}),
  Bits.b32_of_bits (Bits.bits_of_b32 x mod 2 ^ 31) =
  Binary.Babs 24 128 (abs_nan any_nan) x.
Proof.
intros.
destruct x.
- (* B754_zero *)
destruct s; reflexivity.
- (* B754_infinity *)
destruct s; reflexivity.
- (* B754_nan *)
assert (Hpl := nan_pl_range _ _ e).
unfold Bits.b32_of_bits, Binary.Babs, Bits.bits_of_b32, Bits.bits_of_binary_float.
assert (Bits.join_bits 23 8 s (Z.pos pl) (2 ^ 8 - 1) mod 2 ^ 31 =
            Bits.join_bits 23 8 false (Z.pos pl) (2 ^ 8 - 1)).  {
 unfold Bits.join_bits.
rewrite !Z.shiftl_mul_pow2 by computable.
rewrite Z.add_0_l.
rewrite Z.mul_add_distr_r.
rewrite <- Z.add_assoc.
rewrite Z.add_mod by (compute; lia).
replace (((if s then 2 ^ 8 else 0) * 2 ^ 23) mod 2 ^ 31) with 0
  by (destruct s; reflexivity).
rewrite Z.add_0_l.
rewrite Z.mod_mod by lia.
apply Z.mod_small.
lia.
}
rewrite H; clear H.
transitivity (Binary.B754_nan 24 128 false pl e); [ | reflexivity].
clear.
replace (Bits.join_bits 23 8 false (Z.pos pl) (2 ^ 8 - 1))
   with (Bits.bits_of_binary_float 23 8 (Binary.B754_nan 24 128 false pl e)).
apply (Bits.binary_float_of_bits_of_binary_float 23 8 eq_refl eq_refl eq_refl).
reflexivity.
- (* B754_finite *)
unfold Binary.Babs.
clear.
unfold Bits.b32_of_bits, Binary.Babs, Bits.bits_of_b32, Bits.bits_of_binary_float.
pose proof (bounded_mantissa _ _ _ _ e0).
destruct (0 <=? Z.pos m - 2 ^ 23) eqn:?H.
+
apply Z.leb_le in H0.
assert (Z.pos m - 2^23 < 2^23) by lia.
replace (Bits.join_bits 23 8 s (Z.pos m - 2 ^ 23)
                 (e - (3 - 2 ^ (8 - 1) - (23 + 1)) + 1) mod  2 ^ 31)
   with (Bits.bits_of_binary_float 23 8 (Binary.B754_finite 24 128 false m e e0)).
apply (Bits.binary_float_of_bits_of_binary_float 23 8 eq_refl eq_refl eq_refl).
unfold Bits.bits_of_binary_float.
pose proof H0.
apply Z.leb_le in H2. rewrite H2. clear H2.
forget (Z.pos m - 2^23)  as i.
unfold Binary.bounded in e0.
rewrite andb_true_iff in e0.
destruct e0 as [H' ?H].
assert (-149 <= e). {
 clear - H'.
 unfold Binary.canonical_mantissa in H'.
apply Zeq_bool_eq in H'.
unfold FLT.FLT_exp in H'.
rewrite Digits.Zpos_digits2_pos in H'.
pose proof (Z.max_lub_r (Digits.Zdigits Zaux.radix2 (Z.pos m) + e - 24)
      (3 - 128 - 24) e).
spec H; lia.
}
clear H'.
apply Z.leb_le in H2.
simpl Z.sub.
replace (e - -149 + 1) with (e+150) by lia.
unfold Bits.join_bits.
rewrite !Z.shiftl_mul_pow2 by lia.
rewrite Z.add_0_l.
set (e' := e+150).
rewrite Z.mul_add_distr_r.
rewrite <- Z.add_assoc.
rewrite Z.add_mod by (compute; lia).
replace (((if s then 2 ^ 8 else 0) * 2 ^ 23) mod 2 ^ 31)
  with 0 by (destruct s; reflexivity).
rewrite Z.add_0_l.
rewrite Z.mod_mod by lia.
rewrite (Z.mod_small); auto.
subst e'.
lia.
+
replace (Bits.join_bits 23 8 s (Z.pos m) 0 mod 2 ^ 31)
 with (Bits.join_bits 23 8 false (Z.pos m) 0).
replace (Bits.join_bits 23 8 false (Z.pos m) 0)
   with (Bits.bits_of_binary_float 23 8 (Binary.B754_finite 24 128 false m e e0)).
apply (Bits.binary_float_of_bits_of_binary_float 23 8 eq_refl eq_refl eq_refl).
unfold Bits.bits_of_binary_float.
rewrite H0. auto.
clear H0.
unfold Bits.join_bits.
rewrite Z.add_mod by (compute; lia).
rewrite (Z.mod_small (Z.pos m)) by lia.
rewrite !Z.add_0_r.
replace (Z.shiftl (if s then 2 ^ 8 else 0) 23 mod 2 ^ 31) with 0 by (destruct s; reflexivity).
simpl Z.shiftl.
symmetry.
apply Z.mod_small.
lia.
Qed.

Lemma fabs_float32_lemma:
  forall x: float32,
  Float32.of_bits (Int.and (Float32.to_bits x) (Int.repr 2147483647)) =
  Float32.abs x.
Proof.
intros.
Transparent Float32.of_bits.
Transparent Float32.to_bits.
Transparent Float32.abs.
unfold Float32.of_bits, Float32.to_bits, Float32.abs.
Opaque Float32.of_bits.
Opaque Float32.to_bits.
Opaque Float32.abs.
rewrite and_repr.
change 2147483647 with (Z.ones 31).
rewrite Z.land_ones by computable.
rewrite Int.unsigned_repr
 by (pose proof (Z_mod_lt (Bits.bits_of_b32 x) (2 ^ 31) (eq_refl _)); rep_lia).
apply binary32_abs_lemma.
Qed.

End FABS_STUFF.

Module Single.

Definition fabs_single_spec :=
 DECLARE _fabs_single
 WITH x: float32
 PRE [ Tfloat F32 noattr]
   PROP() PARAMS (Vsingle x) SEP()
 POST [ Tfloat F32 noattr ]
   PROP() RETURN (Vsingle (Float32.abs x)) SEP().

Lemma body_fabs_single: semax_body Vprog Gprog f_fabs_single fabs_single_spec.
Proof.
start_function.
forward.
forward.
forward.
forward.
forward.
entailer!.
f_equal.
apply FABS_STUFF.fabs_float32_lemma.
Qed.
End Single.

Module Float.

 (* This experiment shows what kind of error message you get
   if you put the wrong LOCAL precondition.
   In fact, Vfloat x is wrong, leading to an unsatisfying precondition,
   it must be Vsingle. *)

Definition fabs_single_spec :=
 DECLARE _fabs_single
 WITH x: float
 PRE [ Tfloat F32 noattr]
   PROP() PARAMS (Vfloat x) SEP()
 POST [ Tfloat F32 noattr ]
   PROP() RETURN (Vfloat (Float.abs x)) SEP().

Lemma body_fabs_single: semax_body Vprog Gprog f_fabs_single fabs_single_spec.
Proof.
try (start_function; fail 99).
Abort.

End Float.


(**********************************************************************************
 * The PEDANTIC (Proof Engine for Deductive Automation using Non-deterministic
 * Traversal of Instruction Code) verification framework
 *
 * Developed by Kenneth Roe
 * For more information, check out www.cs.jhu.edu/~roe
 *
 * TreeTraversal.v
 * This file contains the proof of correctness of a tree traversal algorithm using
 * the PEDANTIC verification framework.
 *
 **********************************************************************************)

Require Export SfLib.
Require Export SfLibExtras.
Require Export ImpHeap.
Require Export AbsState.
Require Export AbsExecute.
Require Export AbsStateInstance.
Require Export Simplify.
Require Export Eqdep.
Require Export StateImplication.
Require Export Classical.
Require Export Unfold.
Require Export Fold.
Require Export merge.
Require Export ProgramTactics.
Require Export SatSolverDefs.
Require Export SatSolverAux1.

Opaque basicEval.
Opaque invariant.
Opaque haveVarInvariant.

Definition x := 1.

Theorem varNeqBacktrack : varx <> backtrack.
Proof.
    admit.
Admitted.

Theorem validRefTheorem4 : forall s n b, id -> nat -> realizeState (AbsUpdateVar invariant assignments_to_do_head !!(todo))
        nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b todo) :: @NatValue unit todo_var_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem5 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsUpdateVar invariant assignments_to_do_head !!(todo))
           !!(todo) ++++ #todo_var_offset !!(varx)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b todo) :: @NatValue unit todo_val_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem7: forall s n b, id -> nat -> realizeState
        (AbsUpdateVar
           ([!!(ssss)] **
            AbsUpdateWithLoc
              (AbsUpdateWithLoc
                 (AbsUpdateWithLoc
                    (AbsUpdateWithLoc
                       ([!!(assignments_to_do_tail)] ** invariant)
                       varx !!(assignments_to_do_tail) ++++ #todo_var_offset)
                    valuex !!(assignments_to_do_tail) ++++ #todo_val_offset)
                 prop !!(assignments_to_do_tail) ++++ #todo_unit_offset)
              ssss !!(assignments_to_do_tail) ++++ #prev_offset)
           assignments_to_do_tail !!(ssss)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b ssss) :: @NatValue unit next_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem existsTheorem1 : exists s : state,
     realizeState
       (AbsMagicWand
          (AbsUpdateLoc
             (AbsUpdateVar
                ([!!(ssss)] **
                 AbsUpdateWithLoc
                   (AbsUpdateWithLoc
                      (AbsUpdateWithLoc
                         (AbsUpdateWithLoc
                            ([!!(assignments_to_do_tail)] ** invariant)
                            varx
                            !!(assignments_to_do_tail) ++++ #todo_var_offset)
                         valuex
                         !!(assignments_to_do_tail) ++++ #todo_val_offset)
                      prop !!(assignments_to_do_tail) ++++ #todo_unit_offset)
                   ssss !!(assignments_to_do_tail) ++++ #prev_offset)
                assignments_to_do_tail !!(ssss)) !!(ssss) ++++ #next_offset
             #0)
          (AbsExistsT
             (AbsExistsT
                (AbsExistsT
                   (AbsExistsT
                      (AbsExistsT
                         (AbsExistsT
                            (v(0) ++++ #4 |-> v(5) **
                             v(0) ++++ #3 |-> v(4) **
                             v(0) ++++ #2 |-> v(3) **
                             v(0) ++++ #1 |-> v(2) **
                             v(0) ++++ #0 |-> v(1) ** [!!(ssss) ==== v(0)]))))))))
       nil s.
Proof.
    admit.
Admitted.

Theorem existsTheorem2 : exists s : state,
     realizeState
       (AbsMagicWand
          ([~~ !!(ssss)] **
           AbsUpdateWithLoc
             (AbsUpdateWithLoc
                (AbsUpdateWithLoc
                   (AbsUpdateWithLoc
                      ([!!(assignments_to_do_tail)] ** invariant)
                      varx !!(assignments_to_do_tail) ++++ #todo_var_offset)
                   valuex !!(assignments_to_do_tail) ++++ #todo_val_offset)
                prop !!(assignments_to_do_tail) ++++ #todo_unit_offset)
             ssss !!(assignments_to_do_tail) ++++ #prev_offset)
          (AbsExistsT
             (AbsExistsT
                (AbsExistsT
                   (AbsExistsT
                      (AbsExistsT
                         (AbsExistsT
                            (v(0) ++++ #4 |-> v(5) **
                             v(0) ++++ #3 |-> v(4) **
                             v(0) ++++ #2 |-> v(3) **
                             v(0) ++++ #1 |-> v(2) **
                             v(0) ++++ #0 |-> v(1) ** [!!(ssss) ==== v(0)]))))))))
       nil s.
Proof.

    admit.
Admitted.

Theorem mergeTheorem4 : mergeStates
     (AbsMagicWand
        (AbsUpdateLoc
           (AbsUpdateVar
              ([!!(ssss)] **
               AbsUpdateWithLoc
                 (AbsUpdateWithLoc
                    (AbsUpdateWithLoc
                       (AbsUpdateWithLoc
                          ([!!(assignments_to_do_tail)] ** invariant)
                          varx
                          !!(assignments_to_do_tail) ++++ #todo_var_offset)
                       valuex
                       !!(assignments_to_do_tail) ++++ #todo_val_offset)
                    prop !!(assignments_to_do_tail) ++++ #todo_unit_offset)
                 ssss !!(assignments_to_do_tail) ++++ #prev_offset)
              assignments_to_do_tail !!(ssss)) !!(ssss) ++++ #next_offset
           #0)
        (AbsExistsT
           (AbsExistsT
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (v(0) ++++ #4 |-> v(5) **
                           v(0) ++++ #3 |-> v(4) **
                           v(0) ++++ #2 |-> v(3) **
                           v(0) ++++ #1 |-> v(2) **
                           v(0) ++++ #0 |-> v(1) ** [!!(ssss) ==== v(0)]))))))))
     (AbsUpdateVar
        (AbsUpdateVar
           (AbsMagicWand
              ([~~ !!(ssss)] **
               AbsUpdateWithLoc
                 (AbsUpdateWithLoc
                    (AbsUpdateWithLoc
                       (AbsUpdateWithLoc
                          ([!!(assignments_to_do_tail)] ** invariant)
                          varx
                          !!(assignments_to_do_tail) ++++ #todo_var_offset)
                       valuex
                       !!(assignments_to_do_tail) ++++ #todo_val_offset)
                    prop !!(assignments_to_do_tail) ++++ #todo_unit_offset)
                 ssss !!(assignments_to_do_tail) ++++ #prev_offset)
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (v(0) ++++ #4 |-> v(5) **
                                 v(0) ++++ #3 |-> v(4) **
                                 v(0) ++++ #2 |-> v(3) **
                                 v(0) ++++ #1 |-> v(2) **
                                 v(0) ++++ #0 |-> v(1) **
                                 [!!(ssss) ==== v(0)]))))))))
           assignments_to_do_head #0) assignments_to_do_tail
        #0) invariant.
Proof.
    admit.
Admitted.

Theorem existsTheorem3 : exists s : state,
     realizeState
       (AbsMagicWand
          (AbsUpdateWithLoc ([!!(assignments_to_do_head)] ** invariantNoTail)
             todo !!(assignments_to_do_head) ++++ #next_offset)
          (AbsExistsT
             (AbsExistsT
                (AbsExistsT
                   (AbsExistsT
                      (AbsExistsT
                         (AbsExistsT
                            (v(0) ++++ #4 |-> v(5) **
                             v(0) ++++ #3 |-> v(4) **
                             v(0) ++++ #2 |-> v(3) **
                             v(0) ++++ #1 |-> v(2) **
                             v(0) ++++ #0 |-> v(1) **
                             [!!(assignments_to_do_head) ==== v(0)]))))))))
       nil s.
Proof.

    admit.
Admitted.

Theorem entailment3 : forall s : state,
   realizeState
     (AbsUpdateVar
        (AbsMagicWand
           (AbsUpdateWithLoc
              ([!!(assignments_to_do_head)] ** invariantNoTail)
              todo !!(assignments_to_do_head) ++++ #next_offset)
           (AbsExistsT
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (v(0) ++++ #4 |-> v(5) **
                              v(0) ++++ #3 |-> v(4) **
                              v(0) ++++ #2 |-> v(3) **
                              v(0) ++++ #1 |-> v(2) **
                              v(0) ++++ #0 |-> v(1) **
                              [!!(assignments_to_do_head) ==== v(0)]))))))))
        assignments_to_do_head !!(todo)) nil s ->
   realizeState invariantNoTail nil s.
Proof.

    admit.
Admitted.

Theorem entailment4 : forall x0 : state,
   realizeState
     ([~~ !!(ssss) ==== !!(valuex)] **
      [!!(ssss)] **
      AbsUpdateWithLoc invariant ssss !!(assignments) ++++ !!(varx)) nil x0 ->
   realizeState invariantNoTail nil x0.
Proof.

    admit.
Admitted.

Theorem validRefTheorem8 : forall s n b, id -> nat -> realizeState
        (AbsUpdateWithLoc
           (AbsUpdateWithLoc
              ([!!(stack) //\\ (!!(ssss) \\// !!(vvvv) ==== #2)] ** invariant)
              kkkk !!(stack) ++++ #next_offset) vvvv
           !!(stack) ++++ #stack_var_offset) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b assignments) :: @NatValue unit (b vvvv) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem existsTheorem4 : exists s : state,
     realizeState
       (AbsMagicWand
          (AbsUpdateLoc
             (AbsUpdateWithLoc
                (AbsUpdateWithLoc
                   ([!!(stack) //\\ (!!(ssss) \\// !!(vvvv) ==== #2)] **
                    invariant) kkkk !!(stack) ++++ #next_offset)
                vvvv !!(stack) ++++ #stack_var_offset)
             !!(assignments) ++++ !!(vvvv) #0)
          (AbsExistsT
             (AbsExistsT
                (AbsExistsT
                   (AbsExistsT
                      (AbsExistsT
                         (v(0) ++++ #3 |-> v(4) **
                          v(0) ++++ #2 |-> v(3) **
                          v(0) ++++ #1 |-> v(2) **
                          v(0) ++++ #0 |-> v(1) ** [!!(stack) ==== v(0)])))))))
       nil s.
Proof.
    admit.
Admitted.

Theorem entailment5: forall s : state,
   realizeState
     (AbsUpdateWithLoc
        (AbsUpdateWithLoc
           (AbsUpdateVar
              (AbsMagicWand
                 (AbsUpdateLoc
                    (AbsUpdateWithLoc
                       (AbsUpdateWithLoc
                          ([!!(stack) //\\ (!!(ssss) \\// !!(vvvv) ==== #2)] **
                           invariant) kkkk !!(stack) ++++ #next_offset)
                       vvvv !!(stack) ++++ #stack_var_offset)
                    !!(assignments) ++++ !!(vvvv) #0)
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (v(0) ++++ #3 |-> v(4) **
                                 v(0) ++++ #2 |-> v(3) **
                                 v(0) ++++ #1 |-> v(2) **
                                 v(0) ++++ #0 |-> v(1) **
                                 [!!(stack) ==== v(0)])))))))
              stack !!(kkkk)) ssss !!(stack) ++++ #stack_prop_offset)
        vvvv !!(stack) ++++ #stack_val_offset) nil s ->
   realizeState invariant nil s.
Proof.

    admit.
Admitted.

Theorem entailment6 : forall x0 : state,
   realizeState
     (AbsUpdateWithLoc
        (AbsUpdateWithLoc
           (AbsUpdateVar ([~~ !!(assignments_to_do_head)] ** invariantNoTail)
              assignments_to_do_tail #0) ssss
           !!(stack) ++++ #stack_prop_offset) vvvv
        !!(stack) ++++ #stack_val_offset) nil x0 ->
   realizeState invariant nil x0.
Proof.
    admit.
Admitted.

Theorem validRefTheorem9 : forall s n b, id -> nat -> realizeState
        ([~~ !!(stack) ==== #0] **
         [~~ (convertToAbsExp (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] **
         invariant) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b stack) :: @NatValue unit stack_val_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem10 : forall s n b, id -> nat -> realizeState
        (AbsUpdateWithLoc
           (AbsUpdateLoc
              ([~~ !!(stack) ==== #0] **
               [~~
                (convertToAbsExp
                   (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] **
               invariant) !!(stack) ++++ #stack_val_offset
              #2) vvvv !!(stack) ++++ #stack_var_offset) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b assignments) :: @NatValue unit (b vvvv) :: nil) -> heap_p s n <> None.
Proof.
    intros s n b H H0.

    admit.
Admitted.

Theorem mergeReturn1 : mergeReturnStates invariant
     ([!!(stack) ==== #0] **
      [~~ (convertToAbsExp (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] **
      invariant) invariant (#0 :: #1 :: nil) (#0 :: nil)
     (#0 :: #1 :: nil).
Proof.

    admit.
Admitted.

Theorem mergeReturn2 : mergeReturnStates invariant invariant invariant
     (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Theorem mergeTheorem5 : mergeStates
     ([!!(ssss) ==== !!(valuex)] **
      [!!(ssss)] **
      AbsUpdateWithLoc invariant ssss !!(assignments) ++++ !!(varx))
     (AbsUpdateVar
        (AbsUpdateLoc
           (AbsUpdateWithLoc
              (AbsUpdateLoc
                 ([~~ !!(stack) ==== #0] **
                  [~~
                   (convertToAbsExp
                      (ALand (!stack) (ALor (!ssss) (!vvvv === A2))))] **
                  invariant) !!(stack) ++++ #stack_val_offset
                 #2) vvvv !!(stack) ++++ #stack_var_offset)
           !!(assignments) ++++ !!(vvvv) #2) backtrack
        #1) invariant.
Proof.

    admit.
Admitted.

Theorem validRefTheorem11 : forall s n b, id -> nat -> realizeState
        ([~~ !!(ssss)] **
         AbsUpdateWithLoc invariant ssss !!(assignments) ++++ !!(varx)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b assignments) :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem12 : forall s n b, id -> nat -> realizeState
        (AbsExistsT
           (AbsExistsT
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (v(0) ++++ #3 |-> v(4) **
                        v(0) ++++ #2 |-> v(3) **
                        v(0) ++++ #1 |-> v(2) **
                        v(0) ++++ #0 |-> v(1) **
                        [!!(ssss) ==== v(0)] **
                        AbsExistsT
                          (AbsUpdateLoc
                             ([~~ v(5)] **
                              AbsUpdateWithLoc
                                (pushAbsVarState
                                   (pushAbsVarState
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (quantifyAbsVarState invariant
                                                  ssss))))))
                                ssss !!(assignments) ++++ !!(varx))
                             !!(assignments) ++++ !!(varx)
                             !!(valuex)))))))) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b ssss) :: @NatValue unit next_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem13 : forall s n b, id -> nat -> realizeState
        (AbsUpdateVar
           (AbsUpdateLoc
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (v(0) ++++ #3 |-> v(4) **
                              v(0) ++++ #2 |-> v(3) **
                              v(0) ++++ #1 |-> v(2) **
                              v(0) ++++ #0 |-> v(1) **
                              [!!(ssss) ==== v(0)] **
                              AbsExistsT
                                (AbsUpdateLoc
                                   ([~~ v(5)] **
                                    AbsUpdateWithLoc
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  invariant
                                                  ssss))))))
                                      ssss !!(assignments) ++++ !!(varx))
                                   !!(assignments) ++++ !!(varx)
                                   !!(valuex))))))))
              !!(ssss) ++++ #next_offset !!(stack))
           stack !!(ssss)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b ssss) :: @NatValue unit stack_var_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem14 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsUpdateVar
              (AbsUpdateLoc
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (v(0) ++++ #3 |-> v(4) **
                                 v(0) ++++ #2 |-> v(3) **
                                 v(0) ++++ #1 |-> v(2) **
                                 v(0) ++++ #0 |-> v(1) **
                                 [!!(ssss) ==== v(0)] **
                                 AbsExistsT
                                   (AbsUpdateLoc
                                      ([~~ v(5)] **
                                       AbsUpdateWithLoc
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  invariant
                                                  ssss))))))
                                         ssss !!(assignments) ++++ !!(varx))
                                      !!(assignments) ++++ !!(varx)
                                      !!(valuex))))))))
                 !!(ssss) ++++ #next_offset !!(stack))
              stack !!(ssss)) !!(ssss) ++++ #stack_var_offset
           !!(varx)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b ssss) :: @NatValue unit stack_val_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem15 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateVar
                 (AbsUpdateLoc
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (AbsExistsT
                                   (v(0) ++++ #3 |-> v(4) **
                                    v(0) ++++ #2 |-> v(3) **
                                    v(0) ++++ #1 |-> v(2) **
                                    v(0) ++++ #0 |-> v(1) **
                                    [!!(ssss) ==== v(0)] **
                                    AbsExistsT
                                      (AbsUpdateLoc
                                         ([~~ v(5)] **
                                          AbsUpdateWithLoc
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  invariant
                                                  ssss))))))
                                            ssss
                                            !!(assignments) ++++ !!(varx))
                                         !!(assignments) ++++ !!(varx)
                                         !!(valuex))))))))
                    !!(ssss) ++++ #next_offset !!(stack))
                 stack !!(ssss)) !!(ssss) ++++ #stack_var_offset
              !!(varx)) !!(ssss) ++++ #stack_val_offset
           !!(valuex)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b ssss) :: @NatValue unit stack_prop_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem mergeTheorem6 : mergeStates
     (AbsUpdateVar
        ([!!(ssss) //\\ !!(vvvv) ==== #2] **
         AbsUpdateWithLoc
           (AbsUpdateWithLoc
              (AbsUpdateVar ([~~ #3 <<<< !!(jjjj)] ** invariantWLIT1)
                 jjjj !!(jjjj) ++++ #1) ssss
              (!!(clause) ++++ #positive_lit_offset) ++++ !!(jjjj))
           vvvv !!(assignments) ++++ !!(jjjj)) skip
        #1)
     ([~~ (!!(ssss) //\\ !!(vvvv) ==== #2)] **
      AbsUpdateWithLoc
        (AbsUpdateWithLoc
           (AbsUpdateVar ([~~ #3 <<<< !!(jjjj)] ** invariantWLIT1)
              jjjj !!(jjjj) ++++ #1) ssss
           (!!(clause) ++++ #positive_lit_offset) ++++ !!(jjjj))
        vvvv !!(assignments) ++++ !!(jjjj)) invariantWLIT1.
Proof.
    admit.
Admitted.

Theorem mergeTheorem7 : mergeStates
     (AbsUpdateVar
        ([!!(ssss) //\\ !!(vvvv) ==== #1] **
         AbsUpdateWithLoc invariantWLIT1 ssss
           (!!(clause) ++++ #negative_lit_offset) ++++ !!(jjjj))
        skip #1)
     ([~~ (!!(ssss) //\\ !!(vvvv) ==== #1)] **
      AbsUpdateWithLoc invariantWLIT1 ssss
        (!!(clause) ++++ #negative_lit_offset) ++++ !!(jjjj)) invariantWLIT1.
Proof.

    admit.
Admitted.

Theorem mergeTheorem8 : mergeStates
     (AbsUpdateVar
        (AbsUpdateVar
           ([!!(vvvv) //\\ !!(ssss) ==== #0] **
            AbsUpdateWithLoc invariantWLIT1 ssss
              (!!(clause) ++++ #watch_var_offset) ++++ !!(jjjj))
           non_watch !!(jjjj)) skip #1)
     ([~~ (!!(vvvv) //\\ !!(ssss) ==== #0)] **
      AbsUpdateWithLoc invariantWLIT1 ssss
        (!!(clause) ++++ #watch_var_offset) ++++ !!(jjjj)) invariantWLIT1.
Proof.

    admit.
Admitted.

Theorem entailment7 : forall x0 : state,
   realizeState
     (AbsUpdateVar
        (AbsUpdateVar
           (AbsUpdateVar
              ([!!(valuex) ==== #2 //\\ !!(ssss) \\//
                !!(valuex) ==== #1 //\\ !!(vvvv)] **
               AbsUpdateWithLoc
                 (AbsUpdateWithLoc
                    (AbsUpdateWithLoc ([!!(clause)] ** invariantWL)
                       nc (!!(clause) ++++ #watch_next_offset) ++++ !!(varx))
                    ssss (!!(clause) ++++ #negative_lit_offset) ++++ !!(varx))
                 vvvv (!!(clause) ++++ #positive_lit_offset) ++++ !!(varx))
              skip #0) skip #0) jjjj #0) nil x0 ->
   realizeState invariantWLIT1 nil x0.
Proof.
    admit.
Admitted.

Theorem validRefTheorem16 : forall s n b, id -> nat -> realizeState
        (AbsUpdateWithLoc
           ([!!(skip)] **
            [~~ !!(skip)] **
            [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
           ssss !!(watches) ++++ !!(non_watch)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (basicEval assignments_to_do_head
            (NatValue (b clause) :: NatValue watch_next_offset :: nil)
          :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem17 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsUpdateWithLoc
              ([!!(skip)] **
               [~~ !!(skip)] **
               [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
              ssss !!(watches) ++++ !!(non_watch))
           (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch)
           !!(ssss)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (basicEval assignments_to_do_head
            (NatValue (b clause) :: NatValue watch_var_offset :: nil)
          :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem18 : forall s n b, id -> nat -> realizeState
        ([!!(ssss)] **
         AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateWithLoc
                 ([!!(skip)] **
                  [~~ !!(skip)] **
                  [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
                 ssss !!(watches) ++++ !!(non_watch))
              (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch)
              !!(ssss))
           (!!(clause) ++++ #watch_var_offset) ++++ !!(non_watch)
           #1) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (basicEval assignments_to_do_head
            (NatValue (b ssss) :: NatValue watch_prev_offset :: nil)
          :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem mergeTheorem9 : mergeStates
     (AbsUpdateLoc
        ([!!(ssss)] **
         AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateWithLoc
                 ([!!(skip)] **
                  [~~ !!(skip)] **
                  [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
                 ssss !!(watches) ++++ !!(non_watch))
              (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch)
              !!(ssss))
           (!!(clause) ++++ #watch_var_offset) ++++ !!(non_watch)
           #1) (!!(ssss) ++++ #watch_prev_offset) ++++ !!(non_watch)
        !!(clause))
     ([~~ !!(ssss)] **
      AbsUpdateLoc
        (AbsUpdateLoc
           (AbsUpdateWithLoc
              ([!!(skip)] **
               [~~ !!(skip)] **
               [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
              ssss !!(watches) ++++ !!(non_watch))
           (!!(clause) ++++ #watch_next_offset) ++++ !!(non_watch)
           !!(ssss)) (!!(clause) ++++ #watch_var_offset) ++++ !!(non_watch)
        #1) invariantWLIT1.
Proof.

    admit.
Admitted.

Theorem validRefTheorem19 : forall s n b, id -> nat -> realizeState invariantWLIT1 nil s -> NatValue n =
       basicEval assignments_to_do_head
         (NatValue (b watches) :: @NatValue unit (b non_watch) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem20 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch)
           !!(clause)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (basicEval assignments_to_do_head
            (NatValue (b clause) :: NatValue watch_var_offset :: nil)
          :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem21 : forall s n b, id -> nat -> realizeState
        ([!!(ssss)] **
         AbsUpdateWithLoc
           (AbsUpdateWithLoc
              (AbsUpdateLoc
                 (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch)
                    !!(clause))
                 (!!(clause) ++++ #watch_var_offset) ++++ !!(varx)
                 #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx))
           vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (basicEval assignments_to_do_head
            (NatValue (b ssss) :: NatValue watch_next_offset :: nil)
          :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem22 : forall s n b, id -> nat -> realizeState
        ([~~ !!(ssss)] **
         AbsUpdateWithLoc
           (AbsUpdateWithLoc
              (AbsUpdateLoc
                 (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch)
                    !!(clause))
                 (!!(clause) ++++ #watch_var_offset) ++++ !!(varx)
                 #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx))
           vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b watches) :: NatValue (b varx) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem mergeTheorem10 : mergeStates
     (AbsUpdateLoc
        ([!!(ssss)] **
         AbsUpdateWithLoc
           (AbsUpdateWithLoc
              (AbsUpdateLoc
                 (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch)
                    !!(clause))
                 (!!(clause) ++++ #watch_var_offset) ++++ !!(varx)
                 #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx))
           vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx))
        (!!(ssss) ++++ #watch_next_offset) ++++ !!(varx)
        !!(vvvv))
     (AbsUpdateLoc
        ([~~ !!(ssss)] **
         AbsUpdateWithLoc
           (AbsUpdateWithLoc
              (AbsUpdateLoc
                 (AbsUpdateLoc invariantWLIT1 !!(watches) ++++ !!(non_watch)
                    !!(clause))
                 (!!(clause) ++++ #watch_var_offset) ++++ !!(varx)
                 #0) ssss (!!(clause) ++++ #watch_prev_offset) ++++ !!(varx))
           vvvv (!!(clause) ++++ #watch_next_offset) ++++ !!(varx))
        !!(watches) ++++ !!(varx) !!(vvvv)) invariantWLIT1.
Proof.
    admit.
Admitted.

Theorem validRefTheorem23 : forall s n b, id -> nat -> realizeState ([!!(vvvv)] ** invariantWLIT1) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (basicEval assignments_to_do_head
            (NatValue (b vvvv) :: NatValue watch_prev_offset :: nil)
          :: @NatValue unit (b varx) :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem mergeTheorem11 : mergeStates
     (AbsUpdateLoc ([!!(vvvv)] ** invariantWLIT1)
        (!!(vvvv) ++++ #watch_prev_offset) ++++ !!(varx)
        !!(ssss)) ([~~ !!(vvvv)] ** invariantWLIT1) invariantWLIT1.
Proof.
    admit.
Admitted.

Theorem mergeTheorem12 : mergeStates
     (AbsUpdateVar
        ([!!(ssss)] **
         AbsUpdateWithLoc
           (AbsUpdateVar
              ([!!(ssss) //\\ !!(jjjj) ==== #0] **
               AbsUpdateWithLoc
                 (AbsUpdateWithLoc ([~~ #3 <<<< !!(kkkk)] ** invariantWLIT2)
                    ssss (!!(clause) ++++ #watch_var_offset) ++++ !!(kkkk))
                 jjjj !!(assignments) ++++ !!(kkkk))
              vvvv !!(kkkk)) ssss
           (!!(clause) ++++ #positive_lit_offset) ++++ !!(vvvv))
        val #2)
     ([~~ !!(ssss)] **
      AbsUpdateWithLoc
        (AbsUpdateVar
           ([!!(ssss) //\\ !!(jjjj) ==== #0] **
            AbsUpdateWithLoc
              (AbsUpdateWithLoc ([~~ #3 <<<< !!(kkkk)] ** invariantWLIT2)
                 ssss (!!(clause) ++++ #watch_var_offset) ++++ !!(kkkk))
              jjjj !!(assignments) ++++ !!(kkkk)) vvvv
           !!(kkkk)) ssss
        (!!(clause) ++++ #positive_lit_offset) ++++ !!(vvvv)) invariantWLIT2.
Proof.
    admit.
Admitted.

Theorem mergeTheorem13 : mergeStates
     (AbsUpdateVar
        ([!!(ssss)] **
         AbsUpdateWithLoc invariantWLIT2 ssss
           (!!(clause) ++++ #negative_lit_offset) ++++ !!(vvvv))
        val #1)
     ([~~ !!(ssss)] **
      AbsUpdateWithLoc invariantWLIT2 ssss
        (!!(clause) ++++ #negative_lit_offset) ++++ !!(vvvv)) invariantWLIT2.
Proof.
    admit.
Admitted.

Theorem mergeTheorem14 : mergeStates invariantWLIT2
     ([~~ (!!(ssss) //\\ !!(jjjj) ==== #0)] **
      AbsUpdateWithLoc
        (AbsUpdateWithLoc ([~~ #3 <<<< !!(kkkk)] ** invariantWLIT2)
           ssss (!!(clause) ++++ #watch_var_offset) ++++ !!(kkkk))
        jjjj !!(assignments) ++++ !!(kkkk)) invariantWLIT2.
Proof.
    admit.
Admitted.

Theorem entailment8 : forall s : state,
   realizeState (AbsUpdateVar invariantWLIT2 kkkk !!(kkkk) ++++ #1) nil s ->
   realizeState invariantWLIT2 nil s.
Proof.
    admit.
Admitted.

Theorem entailment9 : forall x0 : state,
   realizeState
     (AbsUpdateVar
        ([~~ !!(skip)] **
         [~~ !!(skip)] **
         [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
        kkkk #0) nil x0 -> realizeState invariantWLIT2 nil x0.
Proof.

    admit.
Admitted.

Theorem validRefTheorem24 : forall s n b, id -> nat -> realizeState
        (AbsExistsT
           (AbsExistsT
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (v(0) ++++ #4 |-> v(5) **
                           v(0) ++++ #3 |-> v(4) **
                           v(0) ++++ #2 |-> v(3) **
                           v(0) ++++ #1 |-> v(2) **
                           v(0) ++++ #0 |-> v(1) **
                           [!!(todo) ==== v(0)] **
                           AbsExistsT
                             (pushAbsVarState
                                (pushAbsVarState
                                   (pushAbsVarState
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (quantifyAbsVarState
                                                  ([
                                                  ~~
                                                  (convertToAbsExp
                                                  (!(kkkk) <<= A3))] **
                                                  invariantWLIT2)
                                                  todo)))))))))))))) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b todo) :: NatValue next_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem25 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsExistsT
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (v(0) ++++ #4 |-> v(5) **
                              v(0) ++++ #3 |-> v(4) **
                              v(0) ++++ #2 |-> v(3) **
                              v(0) ++++ #1 |-> v(2) **
                              v(0) ++++ #0 |-> v(1) **
                              [!!(todo) ==== v(0)] **
                              AbsExistsT
                                (pushAbsVarState
                                   (pushAbsVarState
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  ([
                                                  ~~ (convertToAbsExp (!(kkkk) <<= A3))] **
                                                  invariantWLIT2)
                                                  todo))))))))))))))
           !!(todo) ++++ #next_offset !!(assignments_to_do_head)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b todo) :: NatValue prev_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem26 : forall s n b, id -> nat -> realizeState
        ([!!(assignments_to_do_tail)] **
         AbsUpdateLoc
           (AbsUpdateLoc
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (v(0) ++++ #4 |-> v(5) **
                                 v(0) ++++ #3 |-> v(4) **
                                 v(0) ++++ #2 |-> v(3) **
                                 v(0) ++++ #1 |-> v(2) **
                                 v(0) ++++ #0 |-> v(1) **
                                 [!!(todo) ==== v(0)] **
                                 AbsExistsT
                                   (pushAbsVarState
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  ([~~ (convertToAbsExp (!(kkkk) <<= A3))] ** invariantWLIT2)
                                                  todo))))))))))))))
              !!(todo) ++++ #next_offset !!(assignments_to_do_head))
           !!(todo) ++++ #prev_offset #0) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b assignments_to_do_head) :: NatValue prev_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem mergeTheorem15 : mergeStates
     (AbsUpdateLoc
        ([!!(assignments_to_do_tail)] **
         AbsUpdateLoc
           (AbsUpdateLoc
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (v(0) ++++ #4 |-> v(5) **
                                 v(0) ++++ #3 |-> v(4) **
                                 v(0) ++++ #2 |-> v(3) **
                                 v(0) ++++ #1 |-> v(2) **
                                 v(0) ++++ #0 |-> v(1) **
                                 [!!(todo) ==== v(0)] **
                                 AbsExistsT
                                   (pushAbsVarState
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  ([~~ (convertToAbsExp (!(kkkk) <<= A3))] ** invariantWLIT2)
                                                  todo))))))))))))))
              !!(todo) ++++ #next_offset !!(assignments_to_do_head))
           !!(todo) ++++ #prev_offset #0)
        !!(assignments_to_do_head) ++++ #prev_offset
        !!(todo))
     (AbsUpdateVar
        ([~~ !!(assignments_to_do_tail)] **
         AbsUpdateLoc
           (AbsUpdateLoc
              (AbsExistsT
                 (AbsExistsT
                    (AbsExistsT
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (v(0) ++++ #4 |-> v(5) **
                                 v(0) ++++ #3 |-> v(4) **
                                 v(0) ++++ #2 |-> v(3) **
                                 v(0) ++++ #1 |-> v(2) **
                                 v(0) ++++ #0 |-> v(1) **
                                 [!!(todo) ==== v(0)] **
                                 AbsExistsT
                                   (pushAbsVarState
                                      (pushAbsVarState
                                         (pushAbsVarState
                                            (pushAbsVarState
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  ([~~ (convertToAbsExp (!(kkkk) <<= A3))] ** invariantWLIT2)
                                                  todo))))))))))))))
              !!(todo) ++++ #next_offset !!(assignments_to_do_head))
           !!(todo) ++++ #prev_offset #0) assignments_to_do_tail
        !!(todo)) invariantWLIT2.
Proof.
    admit.
Admitted.

Theorem validRefTheorem27 : forall s n b, id -> nat -> realizeState
        (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b todo) :: NatValue todo_var_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem28 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo))
           !!(todo) ++++ #todo_var_offset !!(vvvv)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b todo) :: NatValue todo_val_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem validRefTheorem29 : forall s n b, id -> nat -> realizeState
        (AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo))
              !!(todo) ++++ #todo_var_offset !!(vvvv))
           !!(todo) ++++ #todo_val_offset !!(val)) nil s -> NatValue n =
       basicEval assignments_to_do_head
         (@NatValue unit (b todo) :: NatValue todo_unit_offset :: nil) -> heap_p s n <> None.
Proof.
    admit.
Admitted.

Theorem mergeTheorem16 : mergeStates invariantWLIT1
     (AbsUpdateLoc
        (AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateVar invariantWLIT2 assignments_to_do_head !!(todo))
              !!(todo) ++++ #todo_var_offset !!(vvvv))
           !!(todo) ++++ #todo_val_offset !!(val))
        !!(todo) ++++ #todo_unit_offset #1) invariantWLIT1.
Proof.
    admit.
Admitted.

Theorem mergeTheorem17 : mergeStates
     ([!!(skip)] ** [~~ (convertToAbsExp (!jjjj <<= A3))] ** invariantWLIT1)
     invariantWLIT1 invariantWLIT1.
Proof.
    admit.
Admitted.

Theorem mergeReturn3 : mergeReturnStates invariant invariant invariant
     (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Theorem mergeTheorem18 : mergeStates invariantWLIT1
     ([~~
       (!!(valuex) ==== #2 //\\ !!(ssss) \\//
        !!(valuex) ==== #1 //\\ !!(vvvv))] **
      AbsUpdateWithLoc
        (AbsUpdateWithLoc
           (AbsUpdateWithLoc ([!!(clause)] ** invariantWL)
              nc (!!(clause) ++++ #watch_next_offset) ++++ !!(varx))
           ssss (!!(clause) ++++ #negative_lit_offset) ++++ !!(varx))
        vvvv (!!(clause) ++++ #positive_lit_offset) ++++ !!(varx))
     invariantWL.
Proof.
    admit.
Admitted.

Theorem entailment10 : forall s : state,
   realizeState (AbsUpdateVar invariantWL clause !!(nc)) nil s ->
   realizeState invariantWL nil s.
Proof.
    admit.
Admitted.

Theorem equivEvalList1 : forall s : state,
   realizeState invariant nil s ->
   realizeState invariant nil s ->
   equivEvalList (fst s) (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Set Printing Depth 1000.

Theorem entailment11 : forall x0 : state,
   realizeState
     (AbsUpdateWithLoc
        (AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateLoc
                 (AbsUpdateVar
                    (AbsUpdateLoc
                       (AbsExistsT
                          (AbsExistsT
                             (AbsExistsT
                                (AbsExistsT
                                   (AbsExistsT
                                      (v(0) ++++ #3 |-> v(4) **
                                       v(0) ++++ #2 |-> v(3) **
                                       v(0) ++++ #1 |-> v(2) **
                                       v(0) ++++ #0 |-> v(1) **
                                       [!!(ssss) ==== v(0)] **
                                       AbsExistsT
                                         (AbsUpdateLoc
                                            ([~~ v(5)] **
                                             AbsUpdateWithLoc
                                               (pushAbsVarState
                                                  (pushAbsVarState
                                                  (pushAbsVarState
                                                  (pushAbsVarState
                                                  (pushAbsVarState
                                                  (quantifyAbsVarState
                                                  invariant
                                                  ssss))))))
                                               ssss
                                               !!(assignments) ++++ !!(varx))
                                            !!(assignments) ++++ !!(varx)
                                            !!(valuex))))))))
                       !!(ssss) ++++ #next_offset !!(stack))
                    stack !!(ssss)) !!(ssss) ++++ #stack_var_offset
                 !!(varx)) !!(ssss) ++++ #stack_val_offset
              !!(valuex)) !!(ssss) ++++ #stack_prop_offset
           !!(prop)) clause !!(watches) ++++ !!(varx)) nil x0 ->
   realizeState invariantWL nil x0.
Proof.

    admit.
Admitted.

Theorem mergeReturn4 : mergeReturnStates invariant invariant invariant
     (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Theorem mergeTheorem19 : mergeStates invariant ([~~ (convertToAbsExp (!clause))] ** invariantWL)
     invariant.
Proof.
    admit.
Admitted.

Theorem entailment12 : forall x0 : state,
   realizeState
     (AbsUpdateLoc
        (AbsUpdateLoc
           (AbsUpdateLoc
              (AbsUpdateVar invariant assignments_to_do_head !!(todo))
              !!(todo) ++++ #todo_var_offset !!(varx))
           !!(todo) ++++ #todo_val_offset !!(valuex))
        !!(todo) ++++ #todo_unit_offset #0) nil x0 ->
   realizeState invariant nil x0.
Proof.
    admit.
Admitted.

Theorem mergeReturn5 : mergeReturnStates ([!!(have_var) ==== #0] ** invariant) invariant
     invariant (#1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Theorem mergeReturn6 : mergeReturnStates invariant invariant invariant
     (#0 :: #1 :: nil) (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Theorem entailment13 : forall s : state,
   realizeState
     ([~~ (convertToAbsExp (!assignments_to_do_tail))] ** invariant) nil s ->
   realizeState invariant nil s.
Proof.
    admit.
Admitted.

Theorem entailment14 : forall x0 : state,
   realizeState (AbsUpdateVar invariant backtrack #0) nil x0 ->
   realizeState invariant nil x0.
Proof.
    admit.
Admitted.

Theorem mergeReturn7 : mergeReturnStates AbsNone invariant invariant (#0 :: nil)
     (#0 :: #1 :: nil) (#0 :: #1 :: nil).
Proof.
    admit.
Admitted.

Theorem entailment15 : forall s : state,
   realizeState ([~~ (convertToAbsExp A1)] ** invariant) nil s ->
   realizeState (finalState 0) nil s.
Proof.
    admit.
Admitted.

Theorem entailment16 : forall s : state,
   realizeState invariant nil s -> realizeState (finalState 0) nil s.
Proof.
    admit.
Admitted.

Theorem SatProgramWorks :
    exists x, {{(AbsClosure invariant ((!!clauses)::(!!assignments_to_do_head)::(!!stack)::(!!assignments)::(!!watches)::nil))}}Program{{(finalState x) return (#0::#1::nil) with (finalState x)}}.
Proof.
    unfold Program.
    eapply ex_intro.
    eapply strengthenPost.
    eapply compose.
    pcrunch.
    eapply while with (invariant := loopInvariant).  eapply sbasic.
    instantiate ( 1:= invariant).

    eapply strengthenPost.
    pcrunch.
eapply preCond1. apply H0.

    eapply preCond2. apply (fun x => 0). apply H. apply H0.

    eapply while with (invariant := haveVarInvariant). eapply sbasic.
    instantiate ( 1 := invariant ).

    eapply strengthenPost.
    pcrunch.
    apply mergeTheorem1.
    apply entailment1.

    intros. inversion H. intros. inversion H.

    apply entailment2. apply (fun x => 0, fun x => None).
    instantiate (1 := invariant).
    apply mergeTheorem2.
    eapply validRefTheorem1. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem2. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem3. apply (Id 0). apply n. apply H. apply H0.
    instantiate (1 := invariant).
    apply mergeTheorem3.

    (*eapply validRefTheorem4. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem5. apply (Id 0). apply n. apply H. apply H0.

    admit.

    eapply while with (invariant :=invariant). eapply sbasic.
    instantiate (1 := invariant). instantiate (1 := (#0::#1::nil)).
    eapply strengthenPost. pcrunch.

    eapply validRefTheorem7. apply (Id 0). apply n. apply H. apply H0.

    apply existsTheorem1.
    apply existsTheorem2.

    instantiate (1 := invariant).
    apply mergeTheorem4.

    eapply while with (invariant := invariantNoTail). eapply sbasic.
    eapply strengthenPost. pcrunch.
    eapply existsTheorem3.
    apply entailment3.

    intros. inversion H. intros. inversion H.
    apply entailment4.

    pcrunch.

    eapply while with (invariant := invariant). eapply sbasic.
    eapply strengthenPost. pcrunch.

    eapply validRefTheorem8. apply (Id 0). apply n. apply H. apply H0.
    apply existsTheorem4.
    apply entailment5.

    intros. inversion H.
    intros. inversion H.
    apply entailment6.
    eapply validRefTheorem9. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem10. apply (Id 0). apply n. apply H. apply H0.

    instantiate (1 := (#0::#1::nil)). instantiate (1 := (#0::#1::nil)).
    instantiate (1 := invariant). instantiate (1 := invariant).
    apply mergeReturn1.

    instantiate (1 := (#0::#1::nil)). instantiate (1 := (#0::#1::nil)).
    instantiate (1 := invariant). instantiate (1 := invariant).
    apply mergeReturn2.

    instantiate (1 := invariant).
    apply mergeTheorem5.
    eapply validRefTheorem11. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem12. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem13. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem14. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem15. apply (Id 0). apply n. apply H. apply H0.

    eapply while with (invariant := invariantWL). eapply sbasic.
    eapply strengthenPost. pcrunch.

    eapply while with (invariant := invariantWLIT1). eapply sbasic.
    eapply strengthenPost. pcrunch.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem6.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem7.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem8.

    intros. apply H.

    intros. inversion H.
    intros. inversion H.

    apply entailment7.
    eapply validRefTheorem16. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem17. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem18. apply (Id 0). apply n. apply H. apply H0.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem9.

    eapply validRefTheorem19. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem20. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem21. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem22. apply (Id 0). apply n. apply H. apply H0.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem10.

    eapply validRefTheorem23. apply (Id 0). apply n. apply H. apply H0.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem11.

    eapply while with (invariant := invariantWLIT2). eapply sbasic.
    eapply strengthenPost. pcrunch.

    instantiate (1 := invariantWLIT2).
    apply mergeTheorem12.

    instantiate (1 := invariantWLIT2).
    apply mergeTheorem13.

    instantiate (1 := invariantWLIT2).
    apply mergeTheorem14.

    apply entailment8.

    intros. inversion H.
    intros. inversion H.

    apply entailment9.

    eapply validRefTheorem24. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem25. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem26. apply (Id 0). apply n. apply H. apply H0.

    instantiate (1 := invariantWLIT2).
    apply mergeTheorem15.

    eapply validRefTheorem27. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem28. apply (Id 0). apply n. apply H. apply H0.
    eapply validRefTheorem29. apply (Id 0). apply n. apply H. apply H0.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem16.

    instantiate (1 := invariantWLIT1).
    apply mergeTheorem17.

    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := invariant).
    instantiate (1 := invariant).
    instantiate (1 := invariant).
    apply mergeReturn3.

    instantiate (1 := invariantWL).
    apply mergeTheorem18.

    apply entailment10.

    intros. apply H.
    instantiate (1 := (#0::#1::nil)).
    apply equivEvalList1.

    apply entailment11.

    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := invariant).
    apply mergeReturn4.
    instantiate (1 := invariant).
    apply mergeTheorem19.

    intros. apply H.
    intros. apply H.

    apply equivEvalList1.

    apply entailment12.

    instantiate (1 := (#0)::(#1)::nil). instantiate (1 := invariant).
    apply mergeReturn5.

    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := invariant).
    apply mergeReturn6.

    apply entailment13.

    intros. apply H.

    apply equivEvalList1.

    apply entailment14.

    instantiate (1 := (#0)::(#1)::nil).
    instantiate (1 := invariant).
    apply mergeReturn7. instantiate (1 := 0).

    apply entailment15.
    apply entailment16.
    intros. apply equivEvalList1. apply H. apply H.

    Grab Existential Variables.

    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).
    apply (nil).*)

    admit.
Admitted.


Require Import Coq.Lists.List.
Import ListNotations.

Require Import Tactics.
Require Import Sequence.
Require Import Syntax.
Require Import Subst.
Require Import SimpSub.
Require Import Promote.
Require Import Hygiene.
Require Import Rules.
Require Import DerivedRules.
Require Defs.
Require Import Obligations.
Require Import Morphism.
Require Import DefsEquiv.
Require Import Equivalence.

Require Import ValidationUtil.

Lemma futureKind_valid : futureKind_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G i k triv0 triv1 H0 H1.
  valid_rewrite.
  constructor.
  apply tr_fut_kind_formation; eauto using deq_intro.
  Qed.

Lemma futureKindEq_valid : futureKindEq_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G i k l triv0 triv1 H1 H2.
  valid_rewrite.
  constructor.
  apply tr_fut_kind_formation; eauto using deq_intro; eauto using deq.
Qed.

Lemma futureForm_valid : futureForm_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a triv0 H.
  valid_rewrite.
  constructor; eauto using deqtype_intro.
  Qed.

Lemma futureEq_valid : futureEq_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a b triv0 H.
  valid_rewrite.
  constructor; eauto using deqtype_intro.
  Qed.

Lemma futureFormUniv_valid : futureFormUniv_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a i triv0 triv1 H1 H2.
  valid_rewrite.
  constructor.
  eapply tr_fut_formation_univ; eauto using deq_intro.
  Qed.

Lemma futureEqUniv_valid : futureEqUniv_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a b i triv0 triv1 H1 H2.
  valid_rewrite.
  constructor.
  eapply tr_fut_formation_univ; eauto using deq_intro.
  Qed.

Lemma futureIntroOf_valid : futureIntroOf_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G  a m triv0 H.
  valid_rewrite.
  constructor.
  eapply tr_fut_intro; eauto using deq_intro.
Qed.

Lemma futureIntroEq_valid : futureIntroEq_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G  a m triv0 H.
  valid_rewrite.
  constructor.
  eapply tr_fut_intro; eauto using deq_intro.
Qed.

Lemma futureIntro_valid : futureIntro_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a m H.
  valid_rewrite.
  eapply tr_fut_intro; eauto using deq_intro.
Qed.

Lemma futureElimOf_valid : futureElimOf_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a b m p triv0 triv1 triv2 H0 H1 H2.
  valid_rewrite.
  constructor.
  eapply tr_fut_elim; eauto using deq_intro; eauto using deqtype_intro.
Qed.

Lemma futureElimEq_valid : futureElimEq_obligation.
 unfoldtop. autounfold with valid_hint.
  intros G a b m n p q triv0 triv1 triv2 H0 H1 H2.
  valid_rewrite.
  constructor.
  eapply tr_fut_elim; eauto using deq_intro; eauto using deqtype_intro.
Qed.

Lemma futureElimIstype_valid : futureElimIstype_obligation.
 unfoldtop. autounfold with valid_hint.
  intros G a b m triv0 triv1 triv2 H0 H1 H2.
  valid_rewrite.
  eapply tr_fut_elim_eqtype; eauto using deq_intro; eauto using deqtype_intro.
Qed.

Lemma futureElimEqtype_valid : futureElimEqtype_obligation.
 unfoldtop. autounfold with valid_hint.
  intros G a b c m n triv0 triv1 triv2 H0 H1 H2.
  valid_rewrite.
  eapply tr_fut_elim_eqtype; eauto using deq_intro; eauto using deqtype_intro.
Qed.

Lemma futureEta_valid : futureEta_obligation.
  unfoldtop. autounfold with valid_hint.
  intros G a m triv0 H.
  valid_rewrite.
  constructor.
  eapply tr_fut_eta; eauto using deq_intro.
Qed.

Lemma futureLeft_valid : futureLeft_obligation.
 unfoldtop. autounfold with valid_hint.
  intros G1 G2 a b triv0 m H0 H1.
  valid_rewrite.
  match goal with |- tr ?G ?J =>
                  assert (equivctx G
    (G2 ++
     hyp_tm (fut a) :: G1)
                         ) as Hctx end.

  { apply equivctx_refl. }
  apply tr_fut_eta_hyp; auto.
  eauto using deqtype_intro.
Qed.

Lemma tr_future_sub :
  forall G a b,
    tr (promote G) (dsubtype a b)
    -> tr G (dsubtype (fut a) (fut b)).
Proof.
intros G a b Ha.
apply tr_subtype_intro.
  {
  apply tr_fut_formation.
  eapply tr_subtype_istype1; eauto.
  }

  {
  apply tr_fut_formation.
  eapply tr_subtype_istype2; eauto.
  }
simpsub.
apply (tr_fut_ext _ _ (subst sh1 a) (subst sh1 a)).
  {
  eapply hypothesis; eauto using index_0.
  }

  {
  eapply hypothesis; eauto using index_0.
  }
replace (next (prev (var 0))) with (@subst1 obj (prev (var 0)) (next (var 0))).
2:{
  simpsub.
  auto.
  }
replace (fut (subst sh1 b)) with (subst1 (prev (var 0)) (fut (subst (sh 2) b))).
2:{
  simpsub.
  auto.
  }
apply (tr_fut_elim _ (var 0) (var 0) (subst sh1 a) (next (var 0)) (next (var 0)) (fut (subst (sh 2) b))).
  {
  eapply hypothesis; eauto using index_0.
  }

  {
  cbn.
  fold (promote G).
  eapply (weakening _ [_] []).
    {
    cbn [length Dots.unlift].
    simpsub.
    auto.
    }

    {
    cbn [length Dots.unlift].
    simpsub.
    auto.
    }
  cbn [length Dots.unlift].
  simpsub.
  cbn [List.app].
  eapply tr_subtype_istype1; eauto.
  }
apply tr_fut_intro.
cbn.
fold (promote G).
eapply (weakening _ [_] [_]).
  {
  cbn [length Dots.unlift].
  simpsub.
  auto.
  }

  {
  cbn [length Dots.unlift].
  simpsub.
  auto.
  }
cbn [length Dots.unlift].
simpsub.
cbn [List.app].
apply (tr_subtype_elim _ (subst sh1 a)).
  {
  eapply (weakening _ [_] []).
    {
    cbn [length Dots.unlift].
    simpsub.
    auto.
    }

    {
    cbn [length Dots.unlift].
    simpsub.
    auto.
    }
  cbn [length Dots.unlift].
  simpsub.
  cbn [List.app].
  exact Ha.
  }

  {
  eapply hypothesis; eauto using index_0.
  }
Qed.

Hint Rewrite def_fut def_letnext : prepare.

Lemma futureSub_valid : futureSub_obligation.
Proof.
prepare.
intros G a b ext0 H.
apply tr_future_sub; auto.
Qed.

Lemma futureElimOfLetnext_valid : futureElimOfLetnext_obligation.
Proof.
prepare.
intros G a b m p ext2 ext1 ext0 Ha Hm Hp.
eapply tr_fut_elim; eauto.
Qed.

Lemma futureElimOfLetnextNondep_valid : futureElimOfLetnextNondep_obligation.
Proof.
prepare.
intros G a b m p ext2 ext1 ext0 Ha Hm Hp.
replace b with (subst1 (prev m) (subst sh1 b)) by (simpsub; reflexivity).
eapply tr_fut_elim; eauto.
Qed.

Lemma futureElimIstypeLetnext_valid : futureElimIstypeLetnext_obligation.
Proof.
prepare.
intros G a b m ext2 ext1 ext0 Ha Hm Hb.
eapply tr_fut_elim_eqtype; eauto.
Qed.

Lemma futureExt_valid : futureExt_obligation.
Proof.
prepare.
intros G a m n ext2 ext1 ext0 Hm Hn Hmn.
eapply tr_fut_ext; eauto.
apply tr_fut_intro; auto.
Qed.


Require Import compcert.lib.Coqlib.
Require Import compcert.lib.Maps.
Require Import compcert.lib.Integers.

Require Import compcert.common.AST.
Require Import compcert.common.Values.
Require Import compcert.common.Globalenvs.
Require Import compcert.common.Memory.
Require Import compcert.common.Events.
Require Import compcert.common.Errors.
Require Import compcert.common.Switch.
Require Import compcert.common.Smallstep.

Require Import List.
Import ListNotations.
Require Import Arith.
Require Import Ring.

Require Import StructTact.StructTactics.
Require Import StructTact.Util.

Require Import oeuf.Metadata.
Require Import oeuf.OpaqueTypes.
Require Import oeuf.MemInjProps.

Require Import oeuf.EricTact.
Require Import oeuf.StuartTact.

(* Computation will be over higher level values, i.e. Constr and Close *)
(* We will need a way to relate those to lower level values *)
(* That relation will have type hval -> rval -> mem -> Prop *)
(* since high level values will have to live in memory *)

Definition function_name := ident.

Inductive value :=
| Constr (tag : int) (args : list value) (* A constructor applied to some values *)
(* At this level we have a Z tag  *)
(* corresponds with lower level switch semantics nicely *)
| Close (f : function_name) (free : list value) (* a closure value *)
(* free is the list of values closed over, referred to inside as upvars *)
| Opaque (ty : opaque_type_name) (v : opaque_type_denote ty)
.

(* Thanks Stuart *)
Definition value_rect_mut (P : value -> Type) (Pl : list value -> Type)
           (HConstr : forall tag args, Pl args -> P (Constr tag args))
           (HClose : forall fname args, Pl args -> P (Close fname args))
           (HOpaque :  forall ty v, P (Opaque ty v))
    (Hnil :     Pl [])
    (Hcons :    forall e es, P e -> Pl es -> Pl (e :: es))
    (v : value) : P v :=
    let fix go v :=
        let fix go_list vs :=
            match vs as vs_ return Pl vs_ with
            | [] => Hnil
            | v :: vs => Hcons v vs (go v) (go_list vs)
            end in
        match v as v_ return P v_ with
        | Constr tag args => HConstr tag args (go_list args)
        | Close f args => HClose f args (go_list args)
        | Opaque ty v => HOpaque ty v
        end in go v.

Definition value_rect_mut'
        (P : value -> Type)
        (Pl : list value -> Type)
    (HConstr :  forall tag args, Pl args -> P (Constr tag args))
    (HClose :   forall fname free, Pl free -> P (Close fname free))
    (HOpaque :  forall ty v, P (Opaque ty v))
    (Hnil :     Pl [])
    (Hcons :    forall v vs, P v -> Pl vs -> Pl (v :: vs)) :
    (forall v, P v) * (forall vs, Pl vs) :=
    let fix go v :=
        let fix go_list vs :=
            match vs as vs_ return Pl vs_ with
            | [] => Hnil
            | v :: vs => Hcons v vs (go v) (go_list vs)
            end in
        match v as v_ return P v_ with
        | Constr tag args => HConstr tag args (go_list args)
        | Close fname free => HClose fname free (go_list free)
        | Opaque ty v => HOpaque ty v
        end in
    let fix go_list vs :=
        match vs as vs_ return Pl vs_ with
        | [] => Hnil
        | v :: vs => Hcons v vs (go v) (go_list vs)
        end in
    (go, go_list).

(* Useful wrapper for `expr_rect_mut with (Pl := Forall P)` *)
Definition value_ind' (P : value -> Prop)
           (HConstr : forall tag args, Forall P args -> P (Constr tag args))
           (HClose : forall fname args, Forall P args -> P (Close fname args))
           (HOpaque :  forall ty v, P (Opaque ty v))
    (v : value) : P v :=
    ltac:(refine (@value_rect_mut P (Forall P)
        HConstr HClose HOpaque _ _ v); eauto).

(* given an address, addresses of the nested values *)
Fixpoint arg_addrs (b : block) (ofs : int) (l : list value) : list (value * val) :=
  match l with
  | nil => nil
  | v :: vs =>
    let ofs' := Int.add ofs (Int.repr 4) in
    (v, Vptr b ofs) :: arg_addrs b ofs' vs
  end.

Fixpoint load_all (l : list (value * val)) (m : mem) : option (list (value * val)) :=
  match l with
  | nil => Some nil
  | (hval,vaddr) :: rest =>
    match Mem.loadv Mint32 m vaddr with
    | None => None
    | Some v' =>
      match load_all rest m with
      | None => None
      | Some res => Some ((hval,v') :: res)
      end
    end
  end.

(* mapping of high level values to low level values *)
(* everything is one pointer *)
Inductive value_inject {A B} (ge : Genv.t A B) (m : mem) : value -> val -> Prop :=
| inj_constr :
    (* a constructor is a pointer to the correct tag *)
    (* and every value following that in memory is a value for that constructor *)
    (* *(b,ofs) = tag *)
    (* *(b,ofs+4) = pointer to first field *)
    forall b ofs n values l',
      Mem.loadv Mint32 m (Vptr b ofs) = Some (Vint n) -> (* correct tag *)
      load_all (arg_addrs b (Int.add ofs (Int.repr 4)) values) m = Some l' -> (* one more deref for args *)
      (forall a b, In (a,b) l' -> value_inject ge m a b) -> (* all args inject *)
      value_inject ge m (Constr n values) (Vptr b ofs)
| inj_closure :
    forall b ofs bcode f fname values l',
      Mem.loadv Mint32 m (Vptr b ofs) = Some (Vptr bcode Int.zero) ->
      Genv.find_funct_ptr ge bcode = Some f -> (* legit pointer to some code *)
      Genv.find_symbol ge fname = Some bcode -> (* name we have points to same code *)
      load_all (arg_addrs b (Int.add ofs (Int.repr 4)) values) m = Some l' -> (* one more deref for args *)
      (forall a b, In (a,b) l' -> value_inject ge m a b) -> (* all args inject *)
      value_inject ge m (Close fname values) (Vptr b ofs)
| inj_opaque : forall oty ov cv,
        opaque_type_value_inject oty ov cv m ->
        value_inject ge m (Opaque oty ov) cv
.

Lemma load_all_inject :
    forall l b ofs k args b' mi m m',
      load_all (arg_addrs b (Int.add ofs k) args) m = Some l ->
      Mem.inject mi m m' ->
      mi b = Some (b',0) ->
      exists l',
        load_all (arg_addrs b' (Int.add ofs k) args) m' = Some l' /\ list_forall2 (fun x y => fst x = fst y /\ Val.inject mi (snd x) (snd y)) l l'.
Proof.
  induction l; intros.
  destruct args; simpl in H; inv H. simpl.
  exists nil. split; eauto. econstructor; eauto.
  repeat (break_match_hyp; try congruence).
  destruct args. simpl in H. inv H.
  simpl in H. repeat (break_match_hyp; try congruence).
  invc H.
  simpl. app Mem.load_inject Mem.load. rewrite Z.add_0_r in *.
  collapse_match.
  eapply IHl in Heqo0; eauto.
  break_exists; break_and.
  collapse_match.
  eexists; split; eauto.
  econstructor; eauto.
Qed.

Lemma list_forall2_in_backwards :
  forall {A B : Type} (P : A -> B -> Prop) l l',
    list_forall2 P l l' ->
    forall elem',
      In elem' l' ->
      exists elem,
        In elem l /\ P elem elem'.
Proof.
  induction 1; intros.
  simpl in H. inv H.
  simpl in H1. destruct H1. subst b1. eexists; split; eauto. simpl. left. reflexivity.
  simpl. apply IHlist_forall2 in H1. break_exists. break_and.
  eexists; split; eauto; right; eauto.
Qed.

Lemma load_all_hval_in :
  forall args l b ofs m,
    load_all (arg_addrs b ofs args) m = Some l ->
    forall a x,
      In (a,x) l ->
      In a args.
Proof.
  induction args; intros.
  simpl in H. inv H. simpl in H0. inv H0.
  simpl in H. repeat break_match_hyp; try congruence.
  inv H. simpl in H0. destruct H0. inv H0.
  simpl; left; reflexivity.
  simpl; right; eauto.
Qed.

Lemma value_val_inject :
  forall {F} (ge : Genv.t F unit) m v v',
    value_inject ge m v v' ->
    forall mi m' v0,
      Val.inject mi v' v0 ->
      Mem.inject mi m m' ->
      same_offsets mi ->
      globals_inj_same ge mi ->
      value_inject ge m' v v0.
Proof.
  induction v using value_ind'; intros; cycle 2.

  { on >@value_inject, invc. fix_existT.  subst. econstructor.
    on >Mem.inject, invc.  eapply opaque_type_value_val_inject; eauto. }

  all: try solve [inv H]; (* handle opaque *)
    inv H0; inv H1;
      app Mem.loadv_inject Mem.loadv;
      inv H7; app H3 (mi b); subst delta;
        app load_all_inject load_all; repeat break_and;
          econstructor; eauto; repeat rewrite Int.add_zero in *; try eassumption.

  Focus 2.
  rewrite Int.add_commut in *.
  repeat rewrite Int.add_zero in *.
  unfold same_offsets in *.
  app H3 (mi bcode). subst delta0.
  erewrite H4 in H16; eauto. inv H16. assumption.

  intros.
  eapply list_forall2_in_backwards in H12; eauto.
  break_exists. repeat break_and. destruct x0. simpl in H14. subst.
  eapply H10 in H12.
  rewrite Forall_forall in H. simpl in H15. eapply H; eauto.
  eapply load_all_hval_in; eauto.

  intros.
  eapply list_forall2_in_backwards in H14; eauto.
  break_exists. repeat break_and. destruct x0. simpl in H17. subst.
  eapply H12 in H14.
  rewrite Forall_forall in H. simpl in H18. eapply H; eauto.
  eapply load_all_hval_in; eauto.

  Grab Existential Variables.
  repeat (econstructor; eauto).
Qed.

Lemma value_inject_swap_ge :
  forall {F F' V} (ge1 : Genv.t F V) (ge2 : Genv.t F' V),
    forall m v v',
      value_inject ge1 m v v' ->
    (forall b f,
        Genv.find_funct_ptr ge1 b = Some f ->
        exists f',
          Genv.find_funct_ptr ge2 b = Some f') ->
    (forall fname b,
        Genv.find_symbol ge1 fname = Some b ->
        Genv.find_symbol ge2 fname = Some b) ->
      value_inject ge2 m v v'.
Proof.
  induction 1; intros.
  econstructor; eauto.
  eapply H5 in H0.
  break_exists.
  econstructor; eauto.
  econstructor; eauto.
Qed.

Definition global_blocks_valid {A B : Type} (ge : Genv.t A B) (b : block) :=
  Plt (Genv.genv_next ge) b.

Lemma global_block_find_symbol :
  forall {A B} (ge : Genv.t A B) id b m,
    Genv.find_symbol ge id = Some b ->
    global_blocks_valid ge (Mem.nextblock m) ->
    Plt b (Mem.nextblock m).
Proof.
  intros.
  unfold global_blocks_valid in *.
  unfold Genv.find_symbol in H.
  eapply Genv.genv_symb_range in H.
  eapply Plt_trans; eauto.
Qed.

Lemma genv_next_ind :
  forall {A B V} l l',
    length l = length l' ->
    forall  (ge : Genv.t A V) (tge : Genv.t B V),
      Genv.genv_next ge = Genv.genv_next tge ->
      Genv.genv_next (Genv.add_globals ge l) = Genv.genv_next (Genv.add_globals tge l').
Proof.
  induction l; intros;
    destruct l' eqn:?; simpl in *; try omega;
      eauto.
  subst.
  eapply IHl; eauto.
  unfold Genv.add_global. simpl. congruence.
Qed.

Lemma genv_next_transf :
  forall {A B V} (p : AST.program A V) (tp : AST.program B V) (tf : A -> B),
    transform_program tf p = tp ->
    Genv.genv_next (Genv.globalenv p) = Genv.genv_next (Genv.globalenv tp).
Proof.
  intros. unfold Genv.globalenv.
  erewrite genv_next_ind; try reflexivity.
  unfold transform_program in *.
  subst tp. simpl.
  rewrite list_length_map; reflexivity.
Qed.

Lemma transf_globdefs_length :
  forall {A B V W} l l' (tf : A -> Errors.res B) (tv : V -> Errors.res W),
    transf_globdefs tf tv l = Errors.OK l' ->
    length l = length l'.
Proof.
  induction l; intros.
  simpl in H. inv H. reflexivity.
  simpl in *. repeat (break_match_hyp; try congruence; inv H).
  eapply Errors.bind_inversion in H3. break_exists. break_and.
  inv H3. simpl.
  erewrite IHl; eauto.
  eapply Errors.bind_inversion in H3. break_exists. break_and.
  inv H3. simpl.
  erewrite IHl; eauto.
Qed.

Lemma genv_next_transf_partial :
  forall {A B V} (p : AST.program A V) (tp : AST.program B V) (tf : A -> Errors.res B),
    transform_partial_program tf p = Errors.OK tp ->
    Genv.genv_next (Genv.globalenv p) = Genv.genv_next (Genv.globalenv tp).
Proof.
  intros. unfold Genv.globalenv.
  erewrite genv_next_ind; try reflexivity.
  unfold transform_partial_program in *.
  unfold transform_partial_program2 in *.
  eapply Errors.bind_inversion in H.
  break_exists. break_and.
  inv H0. simpl.
  eapply transf_globdefs_length; eauto.
Qed.

(*Definition global_blocks_valid {A B} (ge : Genv.t A B) (m : mem) : Prop :=
  forall b f v,
    Genv.find_funct_ptr ge b = Some f \/ Genv.find_var_info ge b = Some v -> Plt b (Mem.nextblock m).*)

Definition no_future_pointers (m : mem) : Prop :=
  forall b ofs b' ofs' q n,
    Plt b (Mem.nextblock m) ->
    ZMap.get ofs (Mem.mem_contents m) !! b = Fragment (Vptr b' ofs') q n ->
    Plt b' (Mem.nextblock m).

Lemma load_all_extends :
  forall {F V} (ge : Genv.t F V) l m l',
    load_all l m = Some l' ->
    (forall a b, In (a,b) l' -> value_inject ge m a b) ->
    forall m',
      Mem.extends m m' ->
      (forall a b, In (a,b) l' -> value_inject ge m' a b) ->
      exists l0,
        load_all l m' = Some l0 /\ (forall a b, In (a,b) l0 -> value_inject ge m' a b).
Proof.
    induction l; intros.
  - simpl in H. inv H. exists nil.
    simpl. split; auto.
  - simpl in H.
    repeat (break_match_hyp; try congruence).
    subst.
    invc H.
    eapply IHl in Heqo0; eauto.

    + app Mem.loadv_extends Mem.loadv.
      break_exists; break_and. eexists; split.
        { simpl. repeat collapse_match. reflexivity. }

      intros. simpl in H7. destruct H7; cycle 1.
        { eapply H6. assumption. }
      invc H7.
      assert (value_inject ge m' a v1). {
        eapply H2. simpl. left. auto.
      }
      assert (v1 = b). {
        inv H7; inv H5; try congruence.
        - (* opaque case *)
          on >@value_inject, invc.
          fwd eapply opaque_type_inject_defined; eauto.  congruence.
      } subst.
      assumption.

    + intros. eapply H0. simpl. right. assumption.

    + intros. eapply H2. simpl. right. auto.
Qed.

Lemma load_all_result_decomp :
  forall args b ofs m l,
    load_all (arg_addrs b ofs args) m = Some l ->
    exists r',
      split l = (args,r') /\ length args = length r'.
Proof.
  induction args; intros.
  simpl in *. inv H. simpl. eauto.
  simpl in *. repeat (break_match_hyp; try congruence).
  inv H. simpl.
  eapply IHargs in Heqo0.
  break_exists. break_and. rewrite H0.
  eexists; split; eauto. simpl. eauto.
Qed.

Lemma list_forall2_combine :
  forall {A B : Type}  l r,
    length l = length r ->
  forall (P : A -> B -> Prop),
    (list_forall2 P l r <->
    (forall (x : A) (y : B),
      In (x,y) (combine l r) ->
      P x y)).
Proof.
  intros; split.
  induction 1; intros.
  simpl in H0. inversion H0. simpl.
  simpl in H2. destruct H2; try inv H2;
                 eauto.
  generalize dependent r.
  induction l; intros;
  destruct r; simpl in H; try congruence;
  econstructor; eauto.
  eapply H0. simpl. left. auto.
  eapply IHl. inv H. eauto.
  intros. eapply H0. simpl. right. auto.
Qed.

Lemma value_inject_mem_extends :
  forall {F V} (ge : Genv.t F V) m m' v v',
    value_inject ge m v v' ->
    Mem.extends m m' ->
    value_inject ge m' v v'.
Proof.
  intros until v.
  induction v using value_rect_mut with (Pl := fun vs => forall vs',
                                                   list_forall2 (value_inject ge m) vs vs' ->
                                                   Mem.extends m m' ->
                                                   list_forall2 (value_inject ge m') vs vs'
                                        ); intros;
    inv H;
    try solve [econstructor; eauto].

  Focus 3. {
    on >Mem.extends, invc. on >@value_inject, invc. fix_existT. subst.
    assert (same_offsets inject_id).
      { unfold same_offsets, inject_id. simpl. intros. congruence. }
    econstructor.
    eapply opaque_type_value_val_inject; eauto.
    - destruct v'; econstructor; eauto.
      + reflexivity.
      + rewrite Int.add_zero. reflexivity.
  } Unfocus.

  all: app Mem.loadv_extends Mem.loadv;
    app (@load_all_extends F V) load_all;
  try solve [econstructor; eauto;
             inv H3; eauto].

  intros.
  eapply load_all_result_decomp in H5.
  break_exists. break_and.
  specialize (IHv x0).
  copy (split_combine l').
  rewrite H5 in H9. subst l'.
  eapply list_forall2_combine; eauto.
  eapply IHv; eauto.
  erewrite list_forall2_combine; eauto.

  intros.
  eapply load_all_result_decomp in H6.
  break_exists. break_and.
  specialize (IHv x0).
  copy (split_combine l').
  rewrite H6 in H11. subst l'.
  eapply list_forall2_combine; eauto.
  eapply IHv; eauto.
  erewrite list_forall2_combine; eauto.
Qed.

Definition env_inject {A B} (hlenv : PTree.t value) (llenv : PTree.t val) (ge : Genv.t A B)(m : mem) : Prop :=
  forall id v,
    PTree.get id hlenv = Some v ->
    exists v',
      PTree.get id llenv = Some v' /\ value_inject ge m v v'.

Lemma load_all_val :
  forall l b ofs m l' n v,
    nth_error l n = Some v ->
    load_all (arg_addrs b ofs l) m = Some l' ->
    exists v',
      Mem.loadv Mint32 m (Vptr b (Int.add ofs (Int.repr (4 * Z.of_nat n)))) = Some v' /\ In (v,v') l'.
Proof.
  induction l; intros;
    destruct n; simpl in H; inv H; subst.
  * simpl in H0.
    repeat break_match_hyp; try congruence.
    simpl. replace (Int.add ofs (Int.repr 0)) with ofs by ring.
    eexists; split; eauto. invc H0. simpl.
    left. auto.
  * simpl in H0. repeat break_match_hyp; try congruence.
    inv H0.
    eapply IHl in H; eauto.
    repeat break_exists; repeat break_and.
    replace (Int.add (Int.add ofs (Int.repr 4)) (Int.repr (4 * Z.of_nat n)))
    with  (Int.add ofs (Int.repr (4 * Z.of_nat (S n)))) in H.

    eexists. split. eauto.
    simpl. right. auto.

    (* rest is annoying math over Z/nat/int *)
    replace (4 * Z.of_nat (S n)) with (4 + 4 * Z.of_nat n)%Z.
    rewrite Int.add_assoc.
    f_equal.
    rewrite Int.add_unsigned.
    rewrite (Int.unsigned_repr 4).
    rewrite Int.unsigned_repr_eq.
    eapply Int.eqm_samerepr.
    unfold Int.eqm.
    assert (Int.modulus > 0).
    unfold Int.modulus, two_power_nat, Int.wordsize, Wordsize_32.wordsize.
    simpl. omega.
    remember (Int.eqmod_mod Int.modulus H3) as ie.
    eapply Int.eqmod_add. econstructor; eauto. instantiate (1 := 0).
    omega.
    eapply Int.eqmod_mod.
    omega. unfold Int.max_unsigned.
    simpl. omega.
    rewrite Nat2Z.inj_succ.
    omega.
Qed.

(* (* number of bytes to store a value *) *)
Definition size_bytes (v : value) : Z :=
  match v with
  | Close _ l => (4 * Z.of_nat (length l)) + 4
  | Constr _ l => (4 * Z.of_nat (length l)) + 4
  | Opaque _ _ => 0
  end.

Definition rest (v : value ) : list value :=
  match v with
  | Close _ l => l
  | Constr _ l => l
  | Opaque _ _ => []
  end.

Fixpoint store_list (b : block) (ofs : Z) (l : list val) (m : mem) : option mem :=
  match l with
  | nil => Some m
  | v :: vs =>
    match Mem.storev Mint32 m (Vptr b (Int.repr ofs)) v with
    | Some m' => store_list b (ofs + 4) vs m'
    | None => None
    end
  end.

Definition first_byte {A B} (ge : Genv.t A B) (v : value) : option val :=
  match v with
  | Close fname _ =>
    match Genv.find_symbol ge fname with
    | Some b =>
      match Genv.find_funct_ptr ge b with
      | Some _ => Some (Vptr b Int.zero)
      | None => None
      end
    | None => None
    end
  | Constr tag _ => Some (Vint tag)
  | Opaque _ _ => None
  end.

Definition store_value {A B} (ge : Genv.t A B) (v : value) (m : mem) (l : list val) : option (val * mem) :=
  let sz := size_bytes v in (* find total size for value *)
  let (m',b) := Mem.alloc m 0 sz in (* allocate that much space *)
  match first_byte ge v with
  | Some v' =>
    match Mem.storev Mint32 m' (Vptr b Int.zero) v' with
    | Some m'' =>
      match store_list b 4 l m'' with
      | Some m''' =>
        Some (Vptr b Int.zero, m''')
      | None => None
      end
    | None => None
    end
  | None => None
  end.

Ltac clean :=
  match goal with
  | [ H : Some _ = Some _ |- _ ] => invc H
  | [ H : False |- _ ] => inv H
  end; try congruence.

Definition meta_map := list (ident * metadata).

Inductive public_value {F V} (P : AST.program F V) (M : meta_map) : value -> Prop :=
| PvConstr : forall tag args,
        Forall (public_value P M) args ->
        public_value P M (Constr tag args)
| PvClose : forall fname free m,
        In fname (prog_public P) ->
        Forall (public_value P M) free ->
        In (fname, m) M ->
        length free = m_nfree m ->
        public_value P M (Close fname free)
| PvOpaque : forall ty v, public_value P M (Opaque ty v).

Lemma prog_public_public_value : forall F V F' V'
        (p : AST.program F V) (p' : AST.program F' V') M,
    prog_public p = prog_public p' ->
    forall v,
    public_value p M v ->
    public_value p' M v.
intros until v.
induction v using value_rect_mut with
    (Pl := fun vs =>
        Forall (public_value p M) vs ->
        Forall (public_value p' M) vs);
intros Apub; invc Apub; econstructor; eauto.
- find_rewrite. auto.
Qed.

Lemma prog_public_public_value' : forall F V F' V'
        (p : AST.program F V) (p' : AST.program F' V') M,
    prog_public p = prog_public p' ->
    forall v,
    public_value p' M v ->
    public_value p M v.
intros until v.
induction v using value_rect_mut with
    (Pl := fun vs =>
        Forall (public_value p' M) vs ->
        Forall (public_value p M) vs);
intros Bpub; invc Bpub; econstructor; eauto.
- find_rewrite. auto.
Qed.

Lemma transf_public_value : forall A B V (f : A -> B) (p : AST.program A V) M v,
    public_value p M v ->
    public_value (AST.transform_program f p) M v.
intros.
eapply prog_public_public_value; try eassumption; eauto.
Qed.

Lemma transf_public_value' : forall A B V (f : A -> B) (p : AST.program A V) M v,
    public_value (AST.transform_program f p) M v ->
    public_value p M v.
intros.
eapply prog_public_public_value'; try eassumption; eauto.
Qed.

Lemma transf_partial_public_value : forall A B V (f : A -> res B)
        (p : AST.program A V) p' M,
    AST.transform_partial_program f p = OK p' ->
    forall v,
    public_value p M v ->
    public_value p' M v.
intros.
eapply prog_public_public_value; try eassumption.
symmetry. eauto using transform_partial_program_public.
Qed.

Lemma transf_partial_public_value' : forall A B V (f : A -> res B)
        (p : AST.program A V) p' M,
    AST.transform_partial_program f p = OK p' ->
    forall v,
    public_value p' M v ->
    public_value p M v.
intros.
eapply prog_public_public_value'; try eassumption.
symmetry. eauto using transform_partial_program_public.
Qed.

Definition change_only_fnames (P : function_name -> function_name -> Prop) :
        value -> value -> Prop :=
    let fix go v1 v2 :=
        let fix go_list vs1 vs2 :=
            match vs1, vs2 with
            | [], [] => True
            | v1 :: vs1, v2 :: vs2 => go v1 v2 /\ go_list vs1 vs2
            | _, _ => False
            end in
        match v1, v2 with
        | Constr tag1 args1, Constr tag2 args2 =>
                tag1 = tag2 /\ go_list args1 args2
        | Close f1 free1, Close f2 free2 =>
                P f1 f2 /\ go_list free1 free2
        | Opaque oty1 ov1, Opaque oty2 ov2 =>
                existT _ oty1 ov1 = existT _ oty2 ov2
        | _, _ => False
        end in go.

Definition change_only_fnames_list (P : function_name -> function_name -> Prop) :=
    let go := change_only_fnames P in
    let fix go_list vs1 vs2 :=
        match vs1, vs2 with
        | [], [] => True
        | v1 :: vs1, v2 :: vs2 => go v1 v2 /\ go_list vs1 vs2
        | _, _ => False
        end in go_list.

Ltac refold_change_only_fnames P := fold (change_only_fnames P) in *.

Lemma change_only_fnames_list_Forall : forall P vs1 vs2,
    change_only_fnames_list P vs1 vs2 <->
    Forall2 (change_only_fnames P) vs1 vs2.
induction vs1; destruct vs2; split; intro HH; invc HH.
- constructor.
- constructor.
- constructor; eauto. firstorder.
- constructor; eauto. firstorder.
Qed.

Lemma ptr_block_valid : forall A B (ge : Genv.t A B) m hv b ofs,
    value_inject ge m hv (Vptr b ofs) ->
    Mem.valid_block m b.
inversion 1.

- eapply Mem.valid_access_valid_block.
  eapply Mem.valid_access_implies.
  + eapply Mem.load_valid_access. eauto.
  + constructor.

- eapply Mem.valid_access_valid_block.
  eapply Mem.valid_access_implies.
  + eapply Mem.load_valid_access. eauto.
  + constructor.

- eapply opaque_type_ptr_block_valid; eauto.
Qed.