diff options
Diffstat (limited to 'src/bva')
| -rw-r--r-- | src/bva/BVList.v | 2704 | ||||
| -rw-r--r-- | src/bva/Bva_checker.v | 8576 |
2 files changed, 11280 insertions, 0 deletions
diff --git a/src/bva/BVList.v b/src/bva/BVList.v new file mode 100644 index 0000000..48befd6 --- /dev/null +++ b/src/bva/BVList.v @@ -0,0 +1,2704 @@ +(**************************************************************************) +(* *) +(* SMTCoq *) +(* Copyright (C) 2011 - 2019 *) +(* *) +(* See file "AUTHORS" for the list of authors *) +(* *) +(* This file is distributed under the terms of the CeCILL-C licence *) +(* *) +(**************************************************************************) + + +Require Import List Bool NArith Psatz Int63 Nnat. +Require Import Misc. +Import ListNotations. +Local Open Scope list_scope. +Local Open Scope N_scope. +Local Open Scope bool_scope. + + +Set Implicit Arguments. +Unset Strict Implicit. + +(* We temporarily assume proof irrelevance to handle dependently typed + bit vectors *) +Axiom proof_irrelevance : forall (P : Prop) (p1 p2 : P), p1 = p2. + +Lemma inj a a' : N.to_nat a = N.to_nat a' -> a = a'. +Proof. intros. lia. Qed. + + Fixpoint leb (n m: nat) : bool := + match n with + | O => + match m with + | O => true + | S m' => true + end + | S n' => + match m with + | O => false + | S m' => leb n' m' + end + end. + +Module Type BITVECTOR. + + Parameter bitvector : N -> Type. + Parameter bits : forall n, bitvector n -> list bool. + Parameter of_bits : forall (l:list bool), bitvector (N.of_nat (List.length l)). + Parameter bitOf : forall n, nat -> bitvector n -> bool. + + (* Constants *) + Parameter zeros : forall n, bitvector n. + + (*equality*) + Parameter bv_eq : forall n, bitvector n -> bitvector n -> bool. + + (*binary operations*) + Parameter bv_concat : forall n m, bitvector n -> bitvector m -> bitvector (n + m). + Parameter bv_and : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_or : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_xor : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_add : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_subt : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_mult : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_ult : forall n, bitvector n -> bitvector n -> bool. + Parameter bv_slt : forall n, bitvector n -> bitvector n -> bool. + + Parameter bv_ultP : forall n, bitvector n -> bitvector n -> Prop. + Parameter bv_sltP : forall n, bitvector n -> bitvector n -> Prop. + + Parameter bv_shl : forall n, bitvector n -> bitvector n -> bitvector n. + Parameter bv_shr : forall n, bitvector n -> bitvector n -> bitvector n. + + (*unary operations*) + Parameter bv_not : forall n, bitvector n -> bitvector n. + Parameter bv_neg : forall n, bitvector n -> bitvector n. + Parameter bv_extr : forall (i n0 n1 : N), bitvector n1 -> bitvector n0. + + (* Parameter bv_extr : forall (n i j : N) {H0: n >= j} {H1: j >= i}, bitvector n -> bitvector (j - i). *) + + Parameter bv_zextn : forall (n i: N), bitvector n -> bitvector (i + n). + Parameter bv_sextn : forall (n i: N), bitvector n -> bitvector (i + n). + (* Parameter bv_extr : forall n i j : N, bitvector n -> n >= j -> j >= i -> bitvector (j - i). *) + + (* Specification *) + Axiom bits_size : forall n (bv:bitvector n), List.length (bits bv) = N.to_nat n. + Axiom bv_eq_reflect : forall n (a b:bitvector n), bv_eq a b = true <-> a = b. + Axiom bv_eq_refl : forall n (a:bitvector n), bv_eq a a = true. + + Axiom bv_ult_B2P : forall n (a b:bitvector n), bv_ult a b = true <-> bv_ultP a b. + Axiom bv_slt_B2P : forall n (a b:bitvector n), bv_slt a b = true <-> bv_sltP a b. + Axiom bv_ult_not_eq : forall n (a b:bitvector n), bv_ult a b = true -> a <> b. + Axiom bv_slt_not_eq : forall n (a b:bitvector n), bv_slt a b = true -> a <> b. + Axiom bv_ult_not_eqP: forall n (a b:bitvector n), bv_ultP a b -> a <> b. + Axiom bv_slt_not_eqP: forall n (a b:bitvector n), bv_sltP a b -> a <> b. + + Axiom bv_and_comm : forall n (a b:bitvector n), bv_eq (bv_and a b) (bv_and b a) = true. + Axiom bv_or_comm : forall n (a b:bitvector n), bv_eq (bv_or a b) (bv_or b a) = true. + Axiom bv_add_comm : forall n (a b:bitvector n), bv_eq (bv_add a b) (bv_add b a) = true. + + Axiom bv_and_assoc : forall n (a b c: bitvector n), bv_eq (bv_and a (bv_and b c)) (bv_and (bv_and a b) c) = true. + Axiom bv_or_assoc : forall n (a b c: bitvector n), bv_eq (bv_or a (bv_or b c)) (bv_or (bv_or a b) c) = true. + Axiom bv_xor_assoc : forall n (a b c: bitvector n), bv_eq (bv_xor a (bv_xor b c)) (bv_xor (bv_xor a b) c) = true. + Axiom bv_add_assoc : forall n (a b c: bitvector n), bv_eq (bv_add a (bv_add b c)) (bv_add (bv_add a b) c) = true. + Axiom bv_not_involutive: forall n (a: bitvector n), bv_eq (bv_not (bv_not a)) a = true. + + Parameter _of_bits : forall (l: list bool) (s : N), bitvector s. + +End BITVECTOR. + +Module Type RAWBITVECTOR. + +Parameter bitvector : Type. +Parameter size : bitvector -> N. +Parameter bits : bitvector -> list bool. +Parameter of_bits : list bool -> bitvector. +Parameter _of_bits : list bool -> N -> bitvector. +Parameter bitOf : nat -> bitvector -> bool. + +(* Constants *) +Parameter zeros : N -> bitvector. + +(*equality*) +Parameter bv_eq : bitvector -> bitvector -> bool. + +(*binary operations*) +Parameter bv_concat : bitvector -> bitvector -> bitvector. +Parameter bv_and : bitvector -> bitvector -> bitvector. +Parameter bv_or : bitvector -> bitvector -> bitvector. +Parameter bv_xor : bitvector -> bitvector -> bitvector. +Parameter bv_add : bitvector -> bitvector -> bitvector. +Parameter bv_mult : bitvector -> bitvector -> bitvector. +Parameter bv_subt : bitvector -> bitvector -> bitvector. +Parameter bv_ult : bitvector -> bitvector -> bool. +Parameter bv_slt : bitvector -> bitvector -> bool. + +Parameter bv_ultP : bitvector -> bitvector -> Prop. +Parameter bv_sltP : bitvector -> bitvector -> Prop. + +Parameter bv_shl : bitvector -> bitvector -> bitvector. +Parameter bv_shr : bitvector -> bitvector -> bitvector. + +(*unary operations*) +Parameter bv_not : bitvector -> bitvector. +Parameter bv_neg : bitvector -> bitvector. +Parameter bv_extr : forall (i n0 n1: N), bitvector -> bitvector. + +(*Parameter bv_extr : forall (n i j: N) {H0: n >= j} {H1: j >= i}, bitvector -> bitvector.*) + +Parameter bv_zextn : forall (n i: N), bitvector -> bitvector. +Parameter bv_sextn : forall (n i: N), bitvector -> bitvector. + +(* All the operations are size-preserving *) + +Axiom bits_size : forall bv, List.length (bits bv) = N.to_nat (size bv). +Axiom of_bits_size : forall l, N.to_nat (size (of_bits l)) = List.length l. +Axiom _of_bits_size : forall l s,(size (_of_bits l s)) = s. +Axiom zeros_size : forall n, size (zeros n) = n. +Axiom bv_concat_size : forall n m a b, size a = n -> size b = m -> size (bv_concat a b) = n + m. +Axiom bv_and_size : forall n a b, size a = n -> size b = n -> size (bv_and a b) = n. +Axiom bv_or_size : forall n a b, size a = n -> size b = n -> size (bv_or a b) = n. +Axiom bv_xor_size : forall n a b, size a = n -> size b = n -> size (bv_xor a b) = n. +Axiom bv_add_size : forall n a b, size a = n -> size b = n -> size (bv_add a b) = n. +Axiom bv_subt_size : forall n a b, size a = n -> size b = n -> size (bv_subt a b) = n. +Axiom bv_mult_size : forall n a b, size a = n -> size b = n -> size (bv_mult a b) = n. +Axiom bv_not_size : forall n a, size a = n -> size (bv_not a) = n. +Axiom bv_neg_size : forall n a, size a = n -> size (bv_neg a) = n. +Axiom bv_shl_size : forall n a b, size a = n -> size b = n -> size (bv_shl a b) = n. +Axiom bv_shr_size : forall n a b, size a = n -> size b = n -> size (bv_shr a b) = n. + +Axiom bv_extr_size : forall i n0 n1 a, size a = n1 -> size (@bv_extr i n0 n1 a) = n0. + +(* +Axiom bv_extr_size : forall n (i j: N) a (H0: n >= j) (H1: j >= i), + size a = n -> size (@bv_extr n i j H0 H1 a) = (j - i). +*) + +Axiom bv_zextn_size : forall (n i: N) a, + size a = n -> size (@bv_zextn n i a) = (i + n). +Axiom bv_sextn_size : forall (n i: N) a, + size a = n -> size (@bv_sextn n i a) = (i + n). + +(* Specification *) +Axiom bv_eq_reflect : forall a b, bv_eq a b = true <-> a = b. +Axiom bv_eq_refl : forall a, bv_eq a a = true. + + +Axiom bv_ult_not_eq : forall a b, bv_ult a b = true -> a <> b. +Axiom bv_slt_not_eq : forall a b, bv_slt a b = true -> a <> b. +Axiom bv_ult_not_eqP : forall a b, bv_ultP a b -> a <> b. +Axiom bv_slt_not_eqP : forall a b, bv_sltP a b -> a <> b. +Axiom bv_ult_B2P : forall a b, bv_ult a b = true <-> bv_ultP a b. +Axiom bv_slt_B2P : forall a b, bv_slt a b = true <-> bv_sltP a b. + + +Axiom bv_and_comm : forall n a b, size a = n -> size b = n -> bv_and a b = bv_and b a. +Axiom bv_or_comm : forall n a b, size a = n -> size b = n -> bv_or a b = bv_or b a. +Axiom bv_add_comm : forall n a b, size a = n -> size b = n -> bv_add a b = bv_add b a. + +Axiom bv_and_assoc : forall n a b c, size a = n -> size b = n -> size c = n -> + (bv_and a (bv_and b c)) = (bv_and (bv_and a b) c). +Axiom bv_or_assoc : forall n a b c, size a = n -> size b = n -> size c = n -> + (bv_or a (bv_or b c)) = (bv_or (bv_or a b) c). +Axiom bv_xor_assoc : forall n a b c, size a = n -> size b = n -> size c = n -> + (bv_xor a (bv_xor b c)) = (bv_xor (bv_xor a b) c). +Axiom bv_add_assoc : forall n a b c, size a = n -> size b = n -> size c = n -> + (bv_add a (bv_add b c)) = (bv_add (bv_add a b) c). +Axiom bv_not_involutive: forall a, bv_not (bv_not a) = a. + +End RAWBITVECTOR. + +Module RAW2BITVECTOR (M:RAWBITVECTOR) <: BITVECTOR. + + Record bitvector_ (n:N) : Type := + MkBitvector + { bv :> M.bitvector; + wf : M.size bv = n + }. + Definition bitvector := bitvector_. + + Definition bits n (bv:bitvector n) := M.bits bv. + + Lemma of_bits_size l : M.size (M.of_bits l) = N.of_nat (List.length l). + Proof. now rewrite <- M.of_bits_size, N2Nat.id. Qed. + + Lemma _of_bits_size l s: M.size (M._of_bits l s) = s. + Proof. apply (M._of_bits_size l s). Qed. + + Definition of_bits (l:list bool) : bitvector (N.of_nat (List.length l)) := + @MkBitvector _ (M.of_bits l) (of_bits_size l). + + Definition _of_bits (l: list bool) (s : N): bitvector s := + @MkBitvector _ (M._of_bits l s) (_of_bits_size l s). + + Definition bitOf n p (bv:bitvector n) : bool := M.bitOf p bv. + + Definition zeros (n:N) : bitvector n := + @MkBitvector _ (M.zeros n) (M.zeros_size n). + + Definition bv_eq n (bv1 bv2:bitvector n) := M.bv_eq bv1 bv2. + + Definition bv_ultP n (bv1 bv2:bitvector n) := M.bv_ultP bv1 bv2. + + Definition bv_sltP n (bv1 bv2:bitvector n) := M.bv_sltP bv1 bv2. + + Definition bv_and n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_and bv1 bv2) (M.bv_and_size (wf bv1) (wf bv2)). + + Definition bv_or n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_or bv1 bv2) (M.bv_or_size (wf bv1) (wf bv2)). + + Definition bv_add n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_add bv1 bv2) (M.bv_add_size (wf bv1) (wf bv2)). + + Definition bv_subt n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_subt bv1 bv2) (M.bv_subt_size (wf bv1) (wf bv2)). + + Definition bv_mult n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_mult bv1 bv2) (M.bv_mult_size (wf bv1) (wf bv2)). + + Definition bv_xor n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_xor bv1 bv2) (M.bv_xor_size (wf bv1) (wf bv2)). + + Definition bv_ult n (bv1 bv2:bitvector n) : bool := M.bv_ult bv1 bv2. + + Definition bv_slt n (bv1 bv2:bitvector n) : bool := M.bv_slt bv1 bv2. + + Definition bv_not n (bv1: bitvector n) : bitvector n := + @MkBitvector n (M.bv_not bv1) (M.bv_not_size (wf bv1)). + + Definition bv_neg n (bv1: bitvector n) : bitvector n := + @MkBitvector n (M.bv_neg bv1) (M.bv_neg_size (wf bv1)). + + Definition bv_concat n m (bv1:bitvector n) (bv2: bitvector m) : bitvector (n + m) := + @MkBitvector (n + m) (M.bv_concat bv1 bv2) (M.bv_concat_size (wf bv1) (wf bv2)). + + Definition bv_extr (i n0 n1: N) (bv1: bitvector n1) : bitvector n0 := + @MkBitvector n0 (@M.bv_extr i n0 n1 bv1) (@M.bv_extr_size i n0 n1 bv1 (wf bv1)). + +(* + Definition bv_extr n (i j: N) (H0: n >= j) (H1: j >= i) (bv1: bitvector n) : bitvector (j - i) := + @MkBitvector (j - i) (@M.bv_extr n i j H0 H1 bv1) (@M.bv_extr_size n i j bv1 H0 H1 (wf bv1)). +*) + + Definition bv_zextn n (i: N) (bv1: bitvector n) : bitvector (i + n) := + @MkBitvector (i + n) (@M.bv_zextn n i bv1) (@M.bv_zextn_size n i bv1 (wf bv1)). + + Definition bv_sextn n (i: N) (bv1: bitvector n) : bitvector (i + n) := + @MkBitvector (i + n) (@M.bv_sextn n i bv1) (@M.bv_sextn_size n i bv1 (wf bv1)). + + Definition bv_shl n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_shl bv1 bv2) (M.bv_shl_size (wf bv1) (wf bv2)). + + Definition bv_shr n (bv1 bv2:bitvector n) : bitvector n := + @MkBitvector n (M.bv_shr bv1 bv2) (M.bv_shr_size (wf bv1) (wf bv2)). + + Lemma bits_size n (bv:bitvector n) : List.length (bits bv) = N.to_nat n. + Proof. unfold bits. now rewrite M.bits_size, wf. Qed. + + (* The next lemma is provable only if we assume proof irrelevance *) + Lemma bv_eq_reflect n (a b: bitvector n) : bv_eq a b = true <-> a = b. + Proof. + unfold bv_eq. rewrite M.bv_eq_reflect. split. + - revert a b. intros [a Ha] [b Hb]. simpl. intros ->. + rewrite (proof_irrelevance Ha Hb). reflexivity. + - intros. case a in *. case b in *. simpl in *. + now inversion H. (* now intros ->. *) + Qed. + + Lemma bv_eq_refl n (a : bitvector n) : bv_eq a a = true. + Proof. + unfold bv_eq. now rewrite M.bv_eq_reflect. + Qed. + + Lemma bv_ult_not_eqP: forall n (a b: bitvector n), bv_ultP a b -> a <> b. + Proof. + unfold bv_ultP, bv_ult. intros n a b H. + apply M.bv_ult_not_eqP in H. unfold not in *; intros. apply H. + apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl. + Qed. + + Lemma bv_slt_not_eqP: forall n (a b: bitvector n), bv_sltP a b -> a <> b. + Proof. + unfold bv_sltP, bv_slt. intros n a b H. + apply M.bv_slt_not_eqP in H. unfold not in *; intros. apply H. + apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl. + Qed. + + Lemma bv_ult_not_eq: forall n (a b: bitvector n), bv_ult a b = true -> a <> b. + Proof. + unfold bv_ult. intros n a b H. + apply M.bv_ult_not_eq in H. unfold not in *; intros. apply H. + apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl. + Qed. + + Lemma bv_slt_not_eq: forall n (a b: bitvector n), bv_slt a b = true -> a <> b. + Proof. + unfold bv_slt. intros n a b H. + apply M.bv_slt_not_eq in H. unfold not in *; intros. apply H. + apply M.bv_eq_reflect. rewrite H0. apply M.bv_eq_refl. + Qed. + + Lemma bv_ult_B2P: forall n (a b: bitvector n), bv_ult a b = true <-> bv_ultP a b. + Proof. + unfold bv_ultP, bv_ult; intros; split; intros; + now apply M.bv_ult_B2P. + Qed. + + Lemma bv_slt_B2P: forall n (a b: bitvector n), bv_slt a b = true <-> bv_sltP a b. + Proof. + unfold bv_ultP, bv_slt; intros; split; intros; + now apply M.bv_slt_B2P. + Qed. + + Lemma bv_and_comm n (a b:bitvector n) : bv_eq (bv_and a b) (bv_and b a) = true. + Proof. + unfold bv_eq. rewrite M.bv_eq_reflect. apply (@M.bv_and_comm n); now rewrite wf. + Qed. + + Lemma bv_or_comm n (a b:bitvector n) : bv_eq (bv_or a b) (bv_or b a) = true. + Proof. + unfold bv_eq. rewrite M.bv_eq_reflect. apply (@M.bv_or_comm n); now rewrite wf. + Qed. + + Lemma bv_add_comm n (a b:bitvector n) : bv_eq (bv_add a b) (bv_add b a) = true. + Proof. + unfold bv_eq. rewrite M.bv_eq_reflect. apply (@M.bv_add_comm n); now rewrite wf. + Qed. + + Lemma bv_and_assoc : forall n (a b c :bitvector n), bv_eq (bv_and a (bv_and b c)) (bv_and (bv_and a b) c) = true. + Proof. + intros n a b c. + unfold bv_eq. rewrite M.bv_eq_reflect. simpl. + apply (@M.bv_and_assoc n a b c); now rewrite wf. + Qed. + + Lemma bv_or_assoc : forall n (a b c :bitvector n), bv_eq (bv_or a (bv_or b c)) (bv_or (bv_or a b) c) = true. + Proof. + intros n a b c. + unfold bv_eq. rewrite M.bv_eq_reflect. simpl. + apply (@M.bv_or_assoc n a b c); now rewrite wf. + Qed. + + Lemma bv_xor_assoc : forall n (a b c :bitvector n), bv_eq (bv_xor a (bv_xor b c)) (bv_xor (bv_xor a b) c) = true. + Proof. + intros n a b c. + unfold bv_eq. rewrite M.bv_eq_reflect. simpl. + apply (@M.bv_xor_assoc n a b c); now rewrite wf. + Qed. + + Lemma bv_add_assoc : forall n (a b c :bitvector n), bv_eq (bv_add a (bv_add b c)) (bv_add (bv_add a b) c) = true. + Proof. + intros n a b c. + unfold bv_eq. rewrite M.bv_eq_reflect. simpl. + apply (@M.bv_add_assoc n a b c); now rewrite wf. + Qed. + + Lemma bv_not_involutive: forall n (a: bitvector n), bv_eq (bv_not (bv_not a)) a = true. + Proof. + intros n a. + unfold bv_eq. rewrite M.bv_eq_reflect. simpl. + apply (@M.bv_not_involutive a); now rewrite wf. + Qed. + + +End RAW2BITVECTOR. + +Module RAWBITVECTOR_LIST <: RAWBITVECTOR. + +Definition bitvector := list bool. +Definition bits (a:bitvector) : list bool := a. +Definition size (a:bitvector) := N.of_nat (List.length a). +Definition of_bits (a:list bool) : bitvector := a. + +Lemma bits_size bv : List.length (bits bv) = N.to_nat (size bv). +Proof. unfold bits, size. now rewrite Nat2N.id. Qed. + +Lemma of_bits_size l : N.to_nat (size (of_bits l)) = List.length l. +Proof. unfold of_bits, size. now rewrite Nat2N.id. Qed. + +Fixpoint beq_list (l m : list bool) {struct l} := + match l, m with + | nil, nil => true + | x :: l', y :: m' => (Bool.eqb x y) && (beq_list l' m') + | _, _ => false + end. + +Definition bv_eq (a b: bitvector): bool:= + if ((size a) =? (size b)) then beq_list (bits a) (bits b) else false. + +Fixpoint beq_listP (l m : list bool) {struct l} := + match l, m with + | nil, nil => True + | x :: l', y :: m' => (x = y) /\ (beq_listP l' m') + | _, _ => False + end. + +Lemma bv_mk_eq l1 l2 : bv_eq l1 l2 = beq_list l1 l2. +Proof. + unfold bv_eq, size, bits. + case_eq (Nat_eqb (length l1) (length l2)); intro Heq. + - now rewrite (EqNat.beq_nat_true _ _ Heq), N.eqb_refl. + - replace (N.of_nat (length l1) =? N.of_nat (length l2)) with false. + * revert l2 Heq. induction l1 as [ |b1 l1 IHl1]; intros [ |b2 l2]; simpl in *; auto. + intro Heq. now rewrite <- (IHl1 _ Heq), andb_false_r. + * symmetry. rewrite N.eqb_neq. intro H. apply Nat2N.inj in H. rewrite H in Heq. + rewrite <- EqNat.beq_nat_refl in Heq. discriminate. +Qed. + +Definition bv_concat (a b: bitvector) : bitvector := b ++ a. + +Section Map2. + + Variables A B C: Type. + Variable f : A -> B -> C. + + Fixpoint map2 (l1 : list A) (l2 : list B) {struct l1} : list C := + match l1, l2 with + | b1::tl1, b2::tl2 => (f b1 b2)::(map2 tl1 tl2) + | _, _ => nil + end. + +End Map2. + +Section Fold_left2. + + Variables A B: Type. + Variable f : A -> B -> B -> A. + + Fixpoint fold_left2 (xs ys: list B) (acc:A) {struct xs} : A := + match xs, ys with + | nil, _ | _, nil => acc + | x::xs, y::ys => fold_left2 xs ys (f acc x y) + end. + + Lemma foo : forall (I: A -> Prop) acc, I acc -> + (forall a b1 b2, I a -> I (f a b1 b2)) -> + forall xs ys, I (fold_left2 xs ys acc). + Proof. intros I acc H0 H1 xs. revert acc H0. + induction xs as [ | a xs IHxs]; intros acc H. + simpl. auto. + intros [ | b ys]. + + simpl. exact H. + + simpl. apply IHxs, H1. exact H. + Qed. + +Fixpoint mk_list_true_acc (t: nat) (acc: list bool) : list bool := + match t with + | O => acc + | S t' => mk_list_true_acc t' (true::acc) + end. + +Fixpoint mk_list_true (t: nat) : list bool := + match t with + | O => [] + | S t' => true::(mk_list_true t') + end. + +Fixpoint mk_list_false_acc (t: nat) (acc: list bool) : list bool := + match t with + | O => acc + | S t' => mk_list_false_acc t' (false::acc) + end. + +Fixpoint mk_list_false (t: nat) : list bool := + match t with + | O => [] + | S t' => false::(mk_list_false t') + end. + +Definition zeros (n : N) : bitvector := mk_list_false (N.to_nat n). + +End Fold_left2. + +Definition bitOf (n: nat) (a: bitvector): bool := nth n a false. + +Definition bv_and (a b : bitvector) : bitvector := + match (@size a) =? (@size b) with + | true => map2 andb (@bits a) (@bits b) + | _ => nil + end. + +Definition bv_or (a b : bitvector) : bitvector := + match (@size a) =? (@size b) with + | true => map2 orb (@bits a) (@bits b) + | _ => nil + end. + +Definition bv_xor (a b : bitvector) : bitvector := + match (@size a) =? (@size b) with + | true => map2 xorb (@bits a) (@bits b) + | _ => nil + end. + +Definition bv_not (a: bitvector) : bitvector := map negb (@bits a). + + +(*arithmetic operations*) + + (*addition*) + +Definition add_carry b1 b2 c := + match b1, b2, c with + | true, true, true => (true, true) + | true, true, false + | true, false, true + | false, true, true => (false, true) + | false, false, true + | false, true, false + | true, false, false => (true, false) + | false, false, false => (false, false) + end. + +(* Truncating addition in little-endian, direct style *) + +Fixpoint add_list_ingr bs1 bs2 c {struct bs1} := + match bs1, bs2 with + | nil, _ => nil + | _ , nil => nil + | b1 :: bs1, b2 :: bs2 => + let (r, c) := add_carry b1 b2 c in r :: (add_list_ingr bs1 bs2 c) + end. + +Definition add_list (a b: list bool) := add_list_ingr a b false. + +Definition bv_add (a b : bitvector) : bitvector := + match (@size a) =? (@size b) with + | true => add_list a b + | _ => nil + end. + + (*substraction*) + +Definition twos_complement b := + add_list_ingr (map negb b) (mk_list_false (length b)) true. + +Definition bv_neg (a: bitvector) : bitvector := (twos_complement a). + +Definition subst_list' a b := add_list a (twos_complement b). + +Definition bv_subt' (a b : bitvector) : bitvector := + match (@size a) =? (@size b) with + | true => (subst_list' (@bits a) (@bits b)) + | _ => nil + end. + +Definition subst_borrow b1 b2 b := + match b1, b2, b with + | true, true, true => (true, true) + | true, true, false => (false, false) + | true, false, true => (false, false) + | false, true, true => (false, true) + | false, false, true => (true, true) + | false, true, false => (true, true) + | true, false, false => (true, false) + | false, false, false => (false, false) + end. + +Fixpoint subst_list_borrow bs1 bs2 b {struct bs1} := + match bs1, bs2 with + | nil, _ => nil + | _ , nil => nil + | b1 :: bs1, b2 :: bs2 => + let (r, b) := subst_borrow b1 b2 b in r :: (subst_list_borrow bs1 bs2 b) + end. + +Definition subst_list (a b: list bool) := subst_list_borrow a b false. + +Definition bv_subt (a b : bitvector) : bitvector := + match (@size a) =? (@size b) with + | true => subst_list (@bits a) (@bits b) + | _ => nil + end. + +(*less than*) + +Fixpoint ult_list_big_endian (x y: list bool) := + match x, y with + | nil, _ => false + | _ , nil => false + | xi :: nil, yi :: nil => andb (negb xi) yi + | xi :: x', yi :: y' => + orb (andb (Bool.eqb xi yi) (ult_list_big_endian x' y')) + (andb (negb xi) yi) + end. + +Definition ult_list (x y: list bool) := + (ult_list_big_endian (List.rev x) (List.rev y)). + + +Fixpoint slt_list_big_endian (x y: list bool) := + match x, y with + | nil, _ => false + | _ , nil => false + | xi :: nil, yi :: nil => andb xi (negb yi) + | xi :: x', yi :: y' => + orb (andb (Bool.eqb xi yi) (ult_list_big_endian x' y')) + (andb xi (negb yi)) + end. + +Definition slt_list (x y: list bool) := + slt_list_big_endian (List.rev x) (List.rev y). + + +Definition bv_ult (a b : bitvector) : bool := + if @size a =? @size b then ult_list a b else false. + + +Definition bv_slt (a b : bitvector) : bool := + if @size a =? @size b then slt_list a b else false. + +Definition ult_listP (x y: list bool) := + if ult_list x y then True else False. + +Definition slt_listP (x y: list bool) := + if slt_list x y then True else False. + +Definition bv_ultP (a b : bitvector) : Prop := + if @size a =? @size b then ult_listP a b else False. + +Definition bv_sltP (a b : bitvector) : Prop := + if @size a =? @size b then slt_listP a b else False. + + + (*multiplication*) + +Fixpoint mult_list_carry (a b :list bool) n {struct a}: list bool := + match a with + | nil => mk_list_false n + | a' :: xs => + if a' then + add_list b (mult_list_carry xs (false :: b) n) + else + mult_list_carry xs (false :: b) n + end. + +Fixpoint mult_list_carry2 (a b :list bool) n {struct a}: list bool := + match a with + | nil => mk_list_false n + | a' :: xs => + if a' then + add_list b (mult_list_carry2 xs (false :: (removelast b)) n) + else + mult_list_carry2 xs (false :: (removelast b)) n + end. + +Fixpoint and_with_bool (a: list bool) (bt: bool) : list bool := + match a with + | nil => nil + | ai :: a' => (bt && ai) :: and_with_bool a' bt + end. + + +Fixpoint mult_bool_step_k_h (a b: list bool) (c: bool) (k: Z) : list bool := + match a, b with + | nil , _ => nil + | ai :: a', bi :: b' => + if (k - 1 <? 0)%Z then + let carry_out := (ai && bi) || ((xorb ai bi) && c) in + let curr := xorb (xorb ai bi) c in + curr :: mult_bool_step_k_h a' b' carry_out (k - 1) + else + ai :: mult_bool_step_k_h a' b c (k - 1) + | ai :: a' , nil => ai :: mult_bool_step_k_h a' b c k + end. + +Local Open Scope int63_scope. + +Fixpoint top_k_bools (a: list bool) (k: int) : list bool := + if (k == 0) then nil + else match a with + | nil => nil + | ai :: a' => ai :: top_k_bools a' (k - 1) + end. + + +Fixpoint mult_bool_step (a b: list bool) (res: list bool) (k k': nat) : list bool := + let ak := List.firstn (S k') a in + let b' := and_with_bool ak (nth k b false) in + let res' := mult_bool_step_k_h res b' false (Z.of_nat k) in + match k' with + | O => res' + (* | S O => res' *) + | S pk' => mult_bool_step a b res' (S k) pk' + end. + +Definition bvmult_bool (a b: list bool) (n: nat) : list bool := + let res := and_with_bool a (nth 0 b false) in + match n with + | O => res + | S O => res + | S (S k) => mult_bool_step a b res 1 k + end. + +Definition mult_list a b := bvmult_bool a b (length a). + +Definition bv_mult (a b : bitvector) : bitvector := + if ((@size a) =? (@size b)) + then mult_list a b + else zeros (@size a). + +(* Theorems *) + +Lemma length_mk_list_false: forall n, length (mk_list_false n) = n. +Proof. intro n. + induction n as [ | n' IHn]. + - simpl. auto. + - simpl. apply f_equal. exact IHn. +Qed. + +Definition _of_bits (a:list bool) (s: N) := +if (N.of_nat (length a) =? s) then a else zeros s. + +Lemma _of_bits_size l s: (size (_of_bits l s)) = s. +Proof. unfold of_bits, size. unfold _of_bits. + case_eq ( N.of_nat (length l) =? s). + intros. now rewrite N.eqb_eq in H. + intros. unfold zeros. rewrite length_mk_list_false. + now rewrite N2Nat.id. +Qed. + +Lemma length_mk_list_true: forall n, length (mk_list_true n) = n. +Proof. intro n. + induction n as [ | n' IHn]. + - simpl. auto. + - simpl. apply f_equal. exact IHn. +Qed. + +Lemma zeros_size (n : N) : size (zeros n) = n. +Proof. unfold size, zeros. now rewrite length_mk_list_false, N2Nat.id. Qed. + +Lemma List_eq : forall (l m: list bool), beq_list l m = true <-> l = m. +Proof. + induction l; destruct m; simpl; split; intro; try (reflexivity || discriminate). + - rewrite andb_true_iff in H. destruct H. rewrite eqb_true_iff in H. rewrite H. + apply f_equal. apply IHl. exact H0. + - inversion H. subst b. subst m. rewrite andb_true_iff. split. + + apply eqb_reflx. + + apply IHl; reflexivity. +Qed. + +Lemma List_eqP : forall (l m: list bool), beq_listP l m <-> l = m. +Proof. + induction l; destruct m; simpl; split; intro; try (reflexivity || discriminate); try now contradict H. + - destruct H. rewrite H. + apply f_equal. apply IHl. exact H0. + - inversion H. subst b. subst m. split. + + reflexivity. + + apply IHl; reflexivity. +Qed. + +Lemma List_eq_refl : forall (l: list bool), beq_list l l = true. +Proof. + induction l; simpl; try (reflexivity || discriminate). + - rewrite andb_true_iff. split. apply eqb_reflx. apply IHl. +Qed. + +Lemma List_eqP_refl : forall (l: list bool), beq_listP l l <-> l = l. +Proof. intro l. + induction l as [ | xl xsl IHl ]; intros. + - easy. + - simpl. repeat split. now apply IHl. +Qed. + +Lemma List_neq : forall (l m: list bool), beq_list l m = false -> l <> m. +Proof. + intro l. + induction l. + - intros. case m in *; simpl. now contradict H. easy. + - intros. simpl in H. + case_eq m; intros; rewrite H0 in H. + easy. simpl. + case_eq (Bool.eqb a b); intros. + rewrite H1 in H. rewrite andb_true_l in H. + apply Bool.eqb_prop in H1. + specialize (IHl l0 H). + rewrite H1. + unfold not in *. + intros. apply IHl. + now inversion H2. + apply Bool.eqb_false_iff in H1. + unfold not in *. + intros. apply H1. + now inversion H2. +Qed. + +Lemma List_neqP : forall (l m: list bool), ~beq_listP l m -> l <> m. +Proof. + intro l. + induction l. + - intros. case m in *; simpl. now contradict H. easy. + - intros. unfold not in H. simpl in H. + case_eq m; intros. easy. + rewrite H0 in H. + unfold not. intros. apply H. inversion H1. + split; try easy. + now apply List_eqP_refl. +Qed. + +Lemma bv_eq_reflect a b : bv_eq a b = true <-> a = b. +Proof. + unfold bv_eq. case_eq (size a =? size b); intro Heq; simpl. + - apply List_eq. + - split; try discriminate. + intro H. rewrite H, N.eqb_refl in Heq. discriminate. +Qed. + +Lemma bv_eq_refl a: bv_eq a a = true. +Proof. + unfold bv_eq. rewrite N.eqb_refl. now apply List_eq. +Qed. + +Lemma bv_concat_size n m a b : size a = n -> size b = m -> size (bv_concat a b) = (n + m)%N. +Proof. + unfold bv_concat, size. intros H0 H1. + rewrite app_length, Nat2N.inj_add, H0, H1; now rewrite N.add_comm. +Qed. + +(*list bitwise AND properties*) + +Lemma map2_and_comm: forall (a b: list bool), (map2 andb a b) = (map2 andb b a). +Proof. intros a. induction a as [ | a' xs IHxs]. + intros [ | b' ys]. + - simpl. auto. + - simpl. auto. + - intros [ | b' ys]. + + simpl. auto. + + intros. simpl. + cut (a' && b' = b' && a'). intro H. rewrite <- H. apply f_equal. + apply IHxs. apply andb_comm. +Qed. + +Lemma map2_and_assoc: forall (a b c: list bool), (map2 andb a (map2 andb b c)) = (map2 andb (map2 andb a b) c). +Proof. intro a. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b' ys]. + - simpl. auto. + - intros [ | c' zs]. + + simpl. auto. + + simpl. cut (a' && (b' && c') = a' && b' && c'). intro H. rewrite <- H. apply f_equal. + apply IHxs. apply andb_assoc. +Qed. + +Lemma map2_and_idem1: forall (a b: list bool), (map2 andb (map2 andb a b) a) = (map2 andb a b). +Proof. intros a. induction a as [ | a' xs IHxs]. + intros [ | b' ys]. + - simpl. auto. + - simpl. auto. + - intros [ | b' ys]. + + simpl. auto. + + intros. simpl. + cut (a' && b' && a' = a' && b'). intro H. rewrite H. apply f_equal. + apply IHxs. rewrite andb_comm, andb_assoc, andb_diag. reflexivity. +Qed. + +Lemma map2_and_idem_comm: forall (a b: list bool), (map2 andb (map2 andb a b) a) = (map2 andb b a). +Proof. intros a b. symmetry. rewrite <- map2_and_comm. symmetry; apply map2_and_idem1. Qed. + +Lemma map2_and_idem2: forall (a b: list bool), (map2 andb (map2 andb a b) b) = (map2 andb a b). +Proof. intros a. induction a as [ | a' xs IHxs]. + intros [ | b' ys]. + - simpl. auto. + - simpl. auto. + - intros [ | b' ys]. + + simpl. auto. + + intros. simpl. + cut (a' && b' && b' = a' && b'). intro H. rewrite H. apply f_equal. + apply IHxs. rewrite <- andb_assoc. rewrite andb_diag. reflexivity. +Qed. + +Lemma map2_and_idem_comm2: forall (a b: list bool), (map2 andb (map2 andb a b) b) = (map2 andb b a). +Proof. intros a b. symmetry. rewrite <- map2_and_comm. symmetry; apply map2_and_idem2. Qed. + +Lemma map2_and_empty_empty1: forall (a: list bool), (map2 andb a []) = []. +Proof. intros a. induction a as [ | a' xs IHxs]; simpl; auto. Qed. + +Lemma map2_and_empty_empty2: forall (a: list bool), (map2 andb [] a) = []. +Proof. intros a. rewrite map2_and_comm. apply map2_and_empty_empty1. Qed. + +Lemma map2_nth_empty_false: forall (i: nat), nth i [] false = false. +Proof. intros i. induction i as [ | IHi]; simpl; reflexivity. Qed. + +Lemma mk_list_true_equiv: forall t acc, mk_list_true_acc t acc = (List.rev (mk_list_true t)) ++ acc. +Proof. induction t as [ |t IHt]; auto; intro acc; simpl; rewrite IHt. + rewrite app_assoc_reverse. + apply f_equal. simpl. reflexivity. +Qed. + +Lemma mk_list_false_equiv: forall t acc, mk_list_false_acc t acc = (List.rev (mk_list_false t)) ++ acc. +Proof. induction t as [ |t IHt]; auto; intro acc; simpl; rewrite IHt. + rewrite app_assoc_reverse. + apply f_equal. simpl. reflexivity. +Qed. + +Lemma len_mk_list_true_empty: length (mk_list_true_acc 0 []) = 0%nat. +Proof. simpl. reflexivity. Qed. + +Lemma add_mk_list_true: forall n acc, length (mk_list_true_acc n acc) = (n + length acc)%nat. +Proof. intros n. + induction n as [ | n' IHn]. + + auto. + + intro acc. simpl. rewrite IHn. simpl. lia. +Qed. + +Lemma map2_and_nth_bitOf: forall (a b: list bool) (i: nat), + (length a) = (length b) -> + (i <= (length a))%nat -> + nth i (map2 andb a b) false = (nth i a false) && (nth i b false). +Proof. intro a. + induction a as [ | a xs IHxs]. + - intros [ | b ys]. + + intros i H0 H1. do 2 rewrite map2_nth_empty_false. reflexivity. + + intros i H0 H1. rewrite map2_and_empty_empty2. + rewrite map2_nth_empty_false. reflexivity. + - intros [ | b ys]. + + intros i H0 H1. rewrite map2_and_empty_empty1. + rewrite map2_nth_empty_false. rewrite andb_false_r. reflexivity. + + intros i H0 H1. simpl. + revert i H1. intros [ | i]; [ |intros IHi]. + * simpl. auto. + * apply IHxs. + inversion H0; reflexivity. + inversion IHi; lia. +Qed. + +Lemma length_mk_list_true_full: forall n, length (mk_list_true_acc n []) = n. +Proof. intro n. rewrite (@add_mk_list_true n []). auto. Qed. + +Lemma mk_list_app: forall n acc, mk_list_true_acc n acc = mk_list_true_acc n [] ++ acc. +Proof. intro n. + induction n as [ | n IHn]. + + auto. + + intro acc. simpl in *. rewrite IHn. + cut (mk_list_true_acc n [] ++ [true] = mk_list_true_acc n [true]). intro H. + rewrite <- H. rewrite <- app_assoc. unfold app. reflexivity. + rewrite <- IHn. reflexivity. +Qed. + +Lemma mk_list_ltrue: forall n, mk_list_true_acc n [true] = mk_list_true_acc (S n) []. +Proof. intro n. induction n as [ | n IHn]; auto. Qed. + +Lemma map2_and_1_neutral: forall (a: list bool), (map2 andb a (mk_list_true (length a))) = a. +Proof. intro a. + induction a as [ | a xs IHxs]. + + auto. + + simpl. rewrite IHxs. + rewrite andb_true_r. reflexivity. +Qed. + +Lemma map2_and_0_absorb: forall (a: list bool), (map2 andb a (mk_list_false (length a))) = (mk_list_false (length a)). +Proof. intro a. induction a as [ | a' xs IHxs]. + - simpl. reflexivity. + - simpl. rewrite IHxs. + rewrite andb_false_r; reflexivity. +Qed. + +Lemma map2_and_length: forall (a b: list bool), length a = length b -> length a = length (map2 andb a b). +Proof. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b ys]. + - simpl. intros. exact H. + - intros. simpl in *. apply f_equal. apply IHxs. + inversion H; auto. +Qed. + +(*bitvector AND properties*) + +Lemma bv_and_size n a b : size a = n -> size b = n -> size (bv_and a b) = n. +Proof. + unfold bv_and. intros H1 H2. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size in *. rewrite <- map2_and_length. + - exact H1. + - unfold bits. now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_and_comm n a b : size a = n -> size b = n -> bv_and a b = bv_and b a. +Proof. + intros H1 H2. unfold bv_and. rewrite H1, H2. + rewrite N.eqb_compare, N.compare_refl. + rewrite map2_and_comm. reflexivity. +Qed. + +Lemma bv_and_assoc: forall n a b c, size a = n -> size b = n -> size c = n -> + (bv_and a (bv_and b c)) = (bv_and (bv_and a b) c). +Proof. intros n a b c H0 H1 H2. + unfold bv_and, size, bits in *. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite H0. rewrite N.compare_refl. + rewrite <- (@map2_and_length a b). rewrite <- map2_and_length. rewrite H0, H1. + rewrite N.compare_refl. + rewrite map2_and_assoc; reflexivity. + now rewrite <- Nat2N.inj_iff, H1. + now rewrite <- Nat2N.inj_iff, H0. +Qed. + +Lemma bv_and_idem1: forall a b n, size a = n -> size b = n -> (bv_and (bv_and a b) a) = (bv_and a b). +Proof. intros a b n H0 H1. + unfold bv_and. rewrite H0. do 2 rewrite N.eqb_compare. + unfold size in *. + rewrite H1. rewrite N.compare_refl. + rewrite <- H0. unfold bits. + rewrite <- map2_and_length. rewrite N.compare_refl. + rewrite map2_and_idem1; reflexivity. + now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_and_idem2: forall a b n, size a = n -> size b = n -> (bv_and (bv_and a b) b) = (bv_and a b). +Proof. intros a b n H0 H1. + unfold bv_and. rewrite H0. do 2 rewrite N.eqb_compare. + unfold size in *. + rewrite H1. rewrite N.compare_refl. + rewrite <- H0. unfold bits. + rewrite <- map2_and_length. rewrite N.compare_refl. + rewrite map2_and_idem2; reflexivity. + now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Definition bv_empty: bitvector := nil. + +Lemma bv_and_empty_empty1: forall a, (bv_and a bv_empty) = bv_empty. +Proof. intros a. unfold bv_empty, bv_and, size, bits. simpl. + rewrite map2_and_empty_empty1. + case_eq (N.compare (N.of_nat (length a)) 0); intro H; simpl. + - apply (N.compare_eq (N.of_nat (length a))) in H. + rewrite H. simpl. reflexivity. + - rewrite N.eqb_compare. rewrite H; reflexivity. + - rewrite N.eqb_compare. rewrite H; reflexivity. +Qed. + +Lemma bv_and_nth_bitOf: forall a b n (i: nat), + (size a) = n -> (size b) = n -> + (i <= (nat_of_N (size a)))%nat -> + nth i (bits (bv_and a b)) false = (nth i (bits a) false) && (nth i (bits b) false). +Proof. intros a b n i H0 H1 H2. + unfold bv_and. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + apply map2_and_nth_bitOf; unfold size in *; unfold bits. + now rewrite <- Nat2N.inj_iff, H1. rewrite Nat2N.id in H2; exact H2. +Qed. + +Lemma bv_and_empty_empty2: forall a, (bv_and bv_empty a) = bv_empty. +Proof. intro a. unfold bv_and, bv_empty, size. + case (length a); simpl; auto. +Qed. + +Lemma bv_and_1_neutral: forall a, (bv_and a (mk_list_true (length (bits a)))) = a. +Proof. intro a. unfold bv_and. + rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_true. + rewrite N.compare_refl. + rewrite map2_and_1_neutral. reflexivity. +Qed. + +Lemma bv_and_0_absorb: forall a, (bv_and a (mk_list_false (length (bits a)))) = (mk_list_false (length (bits a))). +Proof. intro a. unfold bv_and. + rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_false. + rewrite N.compare_refl. + rewrite map2_and_0_absorb. reflexivity. +Qed. + +(* lists bitwise OR properties *) + +Lemma map2_or_comm: forall (a b: list bool), (map2 orb a b) = (map2 orb b a). +Proof. intros a. induction a as [ | a' xs IHxs]. + intros [ | b' ys]. + - simpl. auto. + - simpl. auto. + - intros [ | b' ys]. + + simpl. auto. + + intros. simpl. + cut (a' || b' = b' || a'). intro H. rewrite <- H. apply f_equal. + apply IHxs. apply orb_comm. +Qed. + +Lemma map2_or_assoc: forall (a b c: list bool), (map2 orb a (map2 orb b c)) = (map2 orb (map2 orb a b) c). +Proof. intro a. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b' ys]. + - simpl. auto. + - intros [ | c' zs]. + + simpl. auto. + + simpl. cut (a' || (b' || c') = a' || b' || c'). intro H. rewrite <- H. apply f_equal. + apply IHxs. apply orb_assoc. +Qed. + +Lemma map2_or_length: forall (a b: list bool), length a = length b -> length a = length (map2 orb a b). +Proof. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b ys]. + - simpl. intros. exact H. + - intros. simpl in *. apply f_equal. apply IHxs. + inversion H; auto. +Qed. + +Lemma map2_or_empty_empty1: forall (a: list bool), (map2 orb a []) = []. +Proof. intros a. induction a as [ | a' xs IHxs]; simpl; auto. Qed. + +Lemma map2_or_empty_empty2: forall (a: list bool), (map2 orb [] a) = []. +Proof. intros a. rewrite map2_or_comm. apply map2_or_empty_empty1. Qed. + +Lemma map2_or_nth_bitOf: forall (a b: list bool) (i: nat), + (length a) = (length b) -> + (i <= (length a))%nat -> + nth i (map2 orb a b) false = (nth i a false) || (nth i b false). +Proof. intro a. + induction a as [ | a xs IHxs]. + - intros [ | b ys]. + + intros i H0 H1. do 2 rewrite map2_nth_empty_false. reflexivity. + + intros i H0 H1. rewrite map2_or_empty_empty2. + rewrite map2_nth_empty_false. contradict H1. simpl. unfold not. intros. easy. + - intros [ | b ys]. + + intros i H0 H1. rewrite map2_or_empty_empty1. + rewrite map2_nth_empty_false. rewrite orb_false_r. rewrite H0 in H1. + contradict H1. simpl. unfold not. intros. easy. + + intros i H0 H1. simpl. + revert i H1. intros [ | i]; [ |intros IHi]. + * simpl. auto. + * apply IHxs. + inversion H0; reflexivity. + inversion IHi; lia. +Qed. + +Lemma map2_or_0_neutral: forall (a: list bool), (map2 orb a (mk_list_false (length a))) = a. +Proof. intro a. + induction a as [ | a xs IHxs]. + + auto. + + simpl. rewrite IHxs. + rewrite orb_false_r. reflexivity. +Qed. + +Lemma map2_or_1_true: forall (a: list bool), (map2 orb a (mk_list_true (length a))) = (mk_list_true (length a)). +Proof. intro a. induction a as [ | a' xs IHxs]. + - simpl. reflexivity. + - simpl. rewrite IHxs. + rewrite orb_true_r; reflexivity. +Qed. + +(*bitvector OR properties*) + +Lemma bv_or_size n a b : size a = n -> size b = n -> size (bv_or a b) = n. +Proof. + unfold bv_or. intros H1 H2. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size in *. rewrite <- map2_or_length. + - exact H1. + - unfold bits. now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_or_comm: forall n a b, (size a) = n -> (size b) = n -> bv_or a b = bv_or b a. +Proof. intros a b n H0 H1. unfold bv_or. + rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite map2_or_comm. reflexivity. +Qed. + +Lemma bv_or_assoc: forall n a b c, (size a) = n -> (size b) = n -> (size c) = n -> + (bv_or a (bv_or b c)) = (bv_or (bv_or a b) c). +Proof. intros n a b c H0 H1 H2. + unfold bv_or. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size, bits in *. rewrite <- (@map2_or_length b c). + rewrite H0, H1. + rewrite N.compare_refl. + rewrite N.eqb_compare. rewrite N.eqb_compare. + rewrite N.compare_refl. rewrite <- (@map2_or_length a b). + rewrite H0. rewrite N.compare_refl. + rewrite map2_or_assoc; reflexivity. + now rewrite <- Nat2N.inj_iff, H0. + now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_or_empty_empty1: forall a, (bv_or a bv_empty) = bv_empty. +Proof. intros a. unfold bv_empty. + unfold bv_or, bits, size. simpl. + case_eq (N.compare (N.of_nat (length a)) 0); intro H; simpl. + - apply (N.compare_eq (N.of_nat (length a)) 0) in H. + rewrite H. simpl. rewrite map2_or_empty_empty1; reflexivity. + - rewrite N.eqb_compare. rewrite H; reflexivity. + - rewrite N.eqb_compare. rewrite H; reflexivity. +Qed. + +Lemma bv_or_nth_bitOf: forall a b n (i: nat), + (size a) = n -> (size b) = n -> + (i <= (nat_of_N (size a)))%nat -> + nth i (bits (bv_or a b)) false = (nth i (bits a) false) || (nth i (bits b) false). +Proof. intros a b n i H0 H1 H2. + unfold bv_or. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + apply map2_or_nth_bitOf; unfold size in *; unfold bits. + now rewrite <- Nat2N.inj_iff, H1. rewrite Nat2N.id in H2; exact H2. +Qed. + +Lemma bv_or_0_neutral: forall a, (bv_or a (mk_list_false (length (bits a)))) = a. +Proof. intro a. unfold bv_or. + rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_false. + rewrite N.compare_refl. + rewrite map2_or_0_neutral. reflexivity. +Qed. + +Lemma bv_or_1_true: forall a, (bv_or a (mk_list_true (length (bits a)))) = (mk_list_true (length (bits a))). +Proof. intro a. unfold bv_or. + rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_true. + rewrite N.compare_refl. + rewrite map2_or_1_true. reflexivity. +Qed. + +(* lists bitwise XOR properties *) + +Lemma map2_xor_comm: forall (a b: list bool), (map2 xorb a b) = (map2 xorb b a). +Proof. intros a. induction a as [ | a' xs IHxs]. + intros [ | b' ys]. + - simpl. auto. + - simpl. auto. + - intros [ | b' ys]. + + simpl. auto. + + intros. simpl. + cut (xorb a' b' = xorb b' a'). intro H. rewrite <- H. apply f_equal. + apply IHxs. apply xorb_comm. +Qed. + +Lemma map2_xor_assoc: forall (a b c: list bool), (map2 xorb a (map2 xorb b c)) = (map2 xorb (map2 xorb a b) c). +Proof. intro a. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b' ys]. + - simpl. auto. + - intros [ | c' zs]. + + simpl. auto. + + simpl. cut (xorb a' (xorb b' c') = (xorb (xorb a' b') c')). intro H. rewrite <- H. apply f_equal. + apply IHxs. rewrite xorb_assoc_reverse. reflexivity. +Qed. + +Lemma map2_xor_length: forall (a b: list bool), length a = length b -> length a = length (map2 xorb a b). +Proof. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b ys]. + - simpl. intros. exact H. + - intros. simpl in *. apply f_equal. apply IHxs. + inversion H; auto. +Qed. + +Lemma map2_xor_empty_empty1: forall (a: list bool), (map2 xorb a []) = []. +Proof. intros a. induction a as [ | a' xs IHxs]; simpl; auto. Qed. + +Lemma map2_xor_empty_empty2: forall (a: list bool), (map2 xorb [] a) = []. +Proof. intros a. rewrite map2_xor_comm. apply map2_xor_empty_empty1. Qed. + +Lemma map2_xor_nth_bitOf: forall (a b: list bool) (i: nat), + (length a) = (length b) -> + (i <= (length a))%nat -> + nth i (map2 xorb a b) false = xorb (nth i a false) (nth i b false). +Proof. intro a. + induction a as [ | a xs IHxs]. + - intros [ | b ys]. + + intros i H0 H1. do 2 rewrite map2_nth_empty_false. reflexivity. + + intros i H0 H1. rewrite map2_xor_empty_empty2. + rewrite map2_nth_empty_false. contradict H1. simpl. unfold not. intros. easy. + - intros [ | b ys]. + + intros i H0 H1. rewrite map2_xor_empty_empty1. + rewrite map2_nth_empty_false. rewrite xorb_false_r. rewrite H0 in H1. + contradict H1. simpl. unfold not. intros. easy. + + intros i H0 H1. simpl. + revert i H1. intros [ | i]; [ |intros IHi]. + * simpl. auto. + * apply IHxs. + inversion H0; reflexivity. + inversion IHi; lia. +Qed. + +Lemma map2_xor_0_neutral: forall (a: list bool), (map2 xorb a (mk_list_false (length a))) = a. +Proof. intro a. + induction a as [ | a xs IHxs]. + + auto. + + simpl. rewrite IHxs. + rewrite xorb_false_r. reflexivity. +Qed. + +Lemma map2_xor_1_true: forall (a: list bool), (map2 xorb a (mk_list_true (length a))) = map negb a. +Proof. intro a. induction a as [ | a' xs IHxs]. + - simpl. reflexivity. + - simpl. rewrite IHxs. rewrite <- IHxs. + rewrite xorb_true_r; reflexivity. +Qed. + +(*bitvector OR properties*) + +Lemma bv_xor_size n a b : size a = n -> size b = n -> size (bv_xor a b) = n. +Proof. + unfold bv_xor. intros H1 H2. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size in *. rewrite <- map2_xor_length. + - exact H1. + - unfold bits. now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_xor_comm: forall n a b, (size a) = n -> (size b) = n -> bv_xor a b = bv_xor b a. +Proof. intros n a b H0 H1. unfold bv_xor. + rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite map2_xor_comm. reflexivity. +Qed. + +Lemma bv_xor_assoc: forall n a b c, (size a) = n -> (size b) = n -> (size c) = n -> + (bv_xor a (bv_xor b c)) = (bv_xor (bv_xor a b) c). +Proof. intros n a b c H0 H1 H2. + unfold bv_xor. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size, bits in *. rewrite <- (@map2_xor_length b c). + rewrite H0, H1. + rewrite N.compare_refl. + rewrite N.eqb_compare. rewrite N.eqb_compare. + rewrite N.compare_refl. rewrite <- (@map2_xor_length a b). + rewrite H0. rewrite N.compare_refl. + rewrite map2_xor_assoc; reflexivity. + now rewrite <- Nat2N.inj_iff, H0. + now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_xor_empty_empty1: forall a, (bv_xor a bv_empty) = bv_empty. +Proof. intros a. unfold bv_empty. + unfold bv_xor, bits, size. simpl. + case_eq (N.compare (N.of_nat (length a)) 0); intro H; simpl. + - apply (N.compare_eq (N.of_nat (length a)) 0) in H. + rewrite H. simpl. rewrite map2_xor_empty_empty1; reflexivity. + - rewrite N.eqb_compare. rewrite H; reflexivity. + - rewrite N.eqb_compare. rewrite H; reflexivity. +Qed. + +Lemma bv_xor_nth_bitOf: forall a b n (i: nat), + (size a) = n -> (size b) = n -> + (i <= (nat_of_N (size a)))%nat -> + nth i (bits (bv_xor a b)) false = xorb (nth i (bits a) false) (nth i (bits b) false). +Proof. intros a b n i H0 H1 H2. + unfold bv_xor. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + apply map2_xor_nth_bitOf; unfold size in *; unfold bits. + now rewrite <- Nat2N.inj_iff, H1. rewrite Nat2N.id in H2; exact H2. +Qed. + +Lemma bv_xor_0_neutral: forall a, (bv_xor a (mk_list_false (length (bits a)))) = a. +Proof. intro a. unfold bv_xor. + rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_false. + rewrite N.compare_refl. + rewrite map2_xor_0_neutral. reflexivity. +Qed. + +Lemma bv_xor_1_true: forall a, (bv_xor a (mk_list_true (length (bits a)))) = map negb a. +Proof. intro a. unfold bv_xor. + rewrite N.eqb_compare. unfold size, bits. rewrite length_mk_list_true. + rewrite N.compare_refl. + rewrite map2_xor_1_true. reflexivity. +Qed. + +(*bitwise NOT properties*) + +Lemma not_list_length: forall a, length a = length (map negb a). +Proof. intro a. + induction a as [ | a xs IHxs]. + - auto. + - simpl. apply f_equal. exact IHxs. +Qed. + +Lemma not_list_involutative: forall a, map negb (map negb a) = a. +Proof. intro a. + induction a as [ | a xs IHxs]; auto. + simpl. rewrite negb_involutive. apply f_equal. exact IHxs. +Qed. + +Lemma not_list_false_true: forall n, map negb (mk_list_false n) = mk_list_true n. +Proof. intro n. + induction n as [ | n IHn]. + - auto. + - simpl. apply f_equal. exact IHn. +Qed. + +Lemma not_list_true_false: forall n, map negb (mk_list_true n) = mk_list_false n. +Proof. intro n. + induction n as [ | n IHn]. + - auto. + - simpl. apply f_equal. exact IHn. +Qed. + +Lemma not_list_and_or: forall a b, map negb (map2 andb a b) = map2 orb (map negb a) (map negb b). +Proof. intro a. + induction a as [ | a xs IHxs]. + - auto. + - intros [ | b ys]. + + auto. + + simpl. rewrite negb_andb. apply f_equal. apply IHxs. +Qed. + +Lemma not_list_or_and: forall a b, map negb (map2 orb a b) = map2 andb (map negb a) (map negb b). +Proof. intro a. + induction a as [ | a xs IHxs]. + - auto. + - intros [ | b ys]. + + auto. + + simpl. rewrite negb_orb. apply f_equal. apply IHxs. +Qed. + +(*bitvector NOT properties*) + +Lemma bv_not_size: forall n a, (size a) = n -> size (bv_not a) = n. +Proof. intros n a H. unfold bv_not. + unfold size, bits in *. rewrite <- not_list_length. exact H. +Qed. + +Lemma bv_not_involutive: forall a, bv_not (bv_not a) = a. +Proof. intro a. unfold bv_not. + unfold size, bits. rewrite not_list_involutative. reflexivity. +Qed. + +Lemma bv_not_false_true: forall n, bv_not (mk_list_false n) = (mk_list_true n). +Proof. intros n. unfold bv_not. + unfold size, bits. rewrite not_list_false_true. reflexivity. +Qed. + +Lemma bv_not_true_false: forall n, bv_not (mk_list_true n) = (mk_list_false n). +Proof. intros n. unfold bv_not. + unfold size, bits. rewrite not_list_true_false. reflexivity. +Qed. + +Lemma bv_not_and_or: forall n a b, (size a) = n -> (size b) = n -> bv_not (bv_and a b) = bv_or (bv_not a) (bv_not b). +Proof. intros n a b H0 H1. unfold bv_and in *. + rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + unfold bv_or, size, bits in *. + do 2 rewrite <- not_list_length. rewrite H0, H1. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold bv_not, size, bits in *. + rewrite not_list_and_or. reflexivity. +Qed. + +Lemma bv_not_or_and: forall n a b, (size a) = n -> (size b) = n -> bv_not (bv_or a b) = bv_and (bv_not a) (bv_not b). +Proof. intros n a b H0 H1. unfold bv_and, size, bits in *. + do 2 rewrite <- not_list_length. + rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + unfold bv_or, size, bits in *. + rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + unfold bv_not, size, bits in *. + rewrite not_list_or_and. reflexivity. +Qed. + +(* list bitwise ADD properties*) + +Lemma add_carry_ff: forall a, add_carry a false false = (a, false). +Proof. intros a. + case a; simpl; auto. +Qed. + +Lemma add_carry_neg_f: forall a, add_carry a (negb a) false = (true, false). +Proof. intros a. + case a; simpl; auto. +Qed. + +Lemma add_carry_neg_f_r: forall a, add_carry (negb a) a false = (true, false). +Proof. intros a. + case a; simpl; auto. +Qed. + +Lemma add_carry_neg_t: forall a, add_carry a (negb a) true = (false, true). +Proof. intros a. + case a; simpl; auto. +Qed. + +Lemma add_carry_tt: forall a, add_carry a true true = (a, true). +Proof. intro a. case a; auto. Qed. + +Lemma add_list_empty_l: forall (a: list bool), (add_list [] a) = []. +Proof. intro a. induction a as [ | a xs IHxs]. + - unfold add_list. simpl. reflexivity. + - apply IHxs. +Qed. + +Lemma add_list_empty_r: forall (a: list bool), (add_list a []) = []. +Proof. intro a. induction a as [ | a xs IHxs]; unfold add_list; simpl; reflexivity. Qed. + +Lemma add_list_ingr_l: forall (a: list bool) (c: bool), (add_list_ingr [] a c) = []. +Proof. intro a. induction a as [ | a xs IHxs]; unfold add_list; simpl; reflexivity. Qed. + +Lemma add_list_ingr_r: forall (a: list bool) (c: bool), (add_list_ingr a [] c) = []. +Proof. intro a. induction a as [ | a xs IHxs]; unfold add_list; simpl; reflexivity. Qed. + +Lemma add_list_carry_comm: forall (a b: list bool) (c: bool), add_list_ingr a b c = add_list_ingr b a c. +Proof. intros a. induction a as [ | a' xs IHxs]; intros b c. + - simpl. rewrite add_list_ingr_r. reflexivity. + - case b as [ | b' ys]. + + simpl. auto. + + simpl in *. cut (add_carry a' b' c = add_carry b' a' c). + * intro H. rewrite H. destruct (add_carry b' a' c) as (r, c0). + rewrite IHxs. reflexivity. + * case a', b', c; auto. +Qed. + +Lemma add_list_comm: forall (a b: list bool), (add_list a b) = (add_list b a). +Proof. intros a b. unfold add_list. apply (add_list_carry_comm a b false). Qed. + +Lemma add_list_carry_assoc: forall (a b c: list bool) (d1 d2 d3 d4: bool), + add_carry d1 d2 false = add_carry d3 d4 false -> + (add_list_ingr (add_list_ingr a b d1) c d2) = (add_list_ingr a (add_list_ingr b c d3) d4). +Proof. intros a. induction a as [ | a' xs IHxs]; intros b c d1 d2 d3 d4. + - simpl. reflexivity. + - case b as [ | b' ys]. + + simpl. auto. + + case c as [ | c' zs]. + * simpl. rewrite add_list_ingr_r. auto. + * simpl. + case_eq (add_carry a' b' d1); intros r0 c0 Heq0. simpl. + case_eq (add_carry r0 c' d2); intros r1 c1 Heq1. + case_eq (add_carry b' c' d3); intros r3 c3 Heq3. + case_eq (add_carry a' r3 d4); intros r2 c2 Heq2. + intro H. rewrite (IHxs _ _ c0 c1 c3 c2); + revert Heq0 Heq1 Heq3 Heq2; + case a', b', c', d1, d2, d3, d4; simpl; do 4 (intros H'; inversion_clear H'); + try reflexivity; simpl in H; discriminate. +Qed. + +Lemma add_list_carry_length_eq: forall (a b: list bool) c, length a = length b -> length a = length (add_list_ingr a b c). +Proof. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b ys]. + - simpl. intros. exact H. + - intros. simpl in *. + case_eq (add_carry a' b c); intros r c0 Heq. simpl. apply f_equal. + specialize (@IHxs ys). apply IHxs. inversion H; reflexivity. +Qed. + +Lemma add_list_carry_length_ge: forall (a b: list bool) c, (length a >= length b)%nat -> length b = length (add_list_ingr a b c). +Proof. induction a as [ | a' xs IHxs]. + simpl. intros b H0 H1. lia. + intros [ | b ys]. + - simpl. intros. auto. + - intros. simpl in *. + case_eq (add_carry a' b c); intros r c0 Heq. simpl. apply f_equal. + specialize (@IHxs ys). apply IHxs. lia. +Qed. + +Lemma add_list_carry_length_le: forall (a b: list bool) c, (length b >= length a)%nat -> length a = length (add_list_ingr a b c). +Proof. induction a as [ | a' xs IHxs]. + simpl. intros b H0 H1. reflexivity. + intros [ | b ys]. + - simpl. intros. contradict H. lia. + - intros. simpl in *. + case_eq (add_carry a' b c); intros r c0 Heq. simpl. apply f_equal. + specialize (@IHxs ys). apply IHxs. lia. +Qed. + +Lemma bv_neg_size: forall n a, (size a) = n -> size (bv_neg a) = n. +Proof. intros n a H. unfold bv_neg. + unfold size, bits in *. unfold twos_complement. + specialize (@add_list_carry_length_eq (map negb a) (mk_list_false (length a)) true). + intros. rewrite <- H0. now rewrite map_length. + rewrite map_length. + now rewrite length_mk_list_false. +Qed. + +Lemma length_add_list_eq: forall (a b: list bool), length a = length b -> length a = length (add_list a b). +Proof. intros a b H. unfold add_list. apply (@add_list_carry_length_eq a b false). exact H. Qed. + +Lemma length_add_list_ge: forall (a b: list bool), (length a >= length b)%nat -> length b = length (add_list a b). +Proof. intros a b H. unfold add_list. apply (@add_list_carry_length_ge a b false). exact H. Qed. + +Lemma length_add_list_le: forall (a b: list bool), (length b >= length a)%nat -> length a = length (add_list a b). +Proof. intros a b H. unfold add_list. apply (@add_list_carry_length_le a b false). exact H. Qed. + +Lemma add_list_assoc: forall (a b c: list bool), (add_list (add_list a b) c) = (add_list a (add_list b c)). +Proof. intros a b c. unfold add_list. + apply (@add_list_carry_assoc a b c false false false false). + simpl; reflexivity. +Qed. + +Lemma add_list_carry_empty_neutral_n_l: forall (a: list bool) n, (n >= (length a))%nat -> (add_list_ingr (mk_list_false n) a false) = a. +Proof. intro a. induction a as [ | a' xs IHxs]. + - intro n. rewrite add_list_ingr_r. reflexivity. + - intros [ | n]. + + simpl. intro H. contradict H. easy. + + simpl. intro H. + case a'; apply f_equal; apply IHxs; lia. +Qed. + +Lemma add_list_carry_empty_neutral_n_r: forall (a: list bool) n, (n >= (length a))%nat -> (add_list_ingr a (mk_list_false n) false) = a. +Proof. intro a. induction a as [ | a' xs IHxs]. + - intro n. rewrite add_list_ingr_l. reflexivity. + - intros [ | n]. + + simpl. intro H. contradict H. easy. + + simpl. intro H. + case a'; apply f_equal; apply IHxs; lia. +Qed. + +Lemma add_list_carry_empty_neutral_l: forall (a: list bool), (add_list_ingr (mk_list_false (length a)) a false) = a. +Proof. intro a. + rewrite add_list_carry_empty_neutral_n_l; auto. +Qed. + +Lemma add_list_carry_empty_neutral_r: forall (a: list bool), (add_list_ingr a (mk_list_false (length a)) false) = a. +Proof. intro a. + rewrite add_list_carry_empty_neutral_n_r; auto. +Qed. + +Lemma add_list_empty_neutral_n_l: forall (a: list bool) n, (n >= (length a))%nat -> (add_list (mk_list_false n) a) = a. +Proof. intros a. unfold add_list. + apply (@add_list_carry_empty_neutral_n_l a). +Qed. + +Lemma add_list_empty_neutral_n_r: forall (a: list bool) n, (n >= (length a))%nat -> (add_list a (mk_list_false n)) = a. +Proof. intros a. unfold add_list. + apply (@add_list_carry_empty_neutral_n_r a). +Qed. + +Lemma add_list_empty_neutral_r: forall (a: list bool), (add_list a (mk_list_false (length a))) = a. +Proof. intros a. unfold add_list. + apply (@add_list_carry_empty_neutral_r a). +Qed. + +Lemma add_list_empty_neutral_l: forall (a: list bool), (add_list (mk_list_false (length a)) a) = a. +Proof. intros a. unfold add_list. + apply (@add_list_carry_empty_neutral_l a). +Qed. + +Lemma add_list_carry_unit_t : forall a, add_list_ingr a (mk_list_true (length a)) true = a. +Proof. intro a. + induction a as [ | a xs IHxs]. + - simpl. reflexivity. + - simpl. case_eq (add_carry a true true). intros r0 c0 Heq0. + rewrite add_carry_tt in Heq0. inversion Heq0. + apply f_equal. exact IHxs. +Qed. + +Lemma add_list_carry_twice: forall a c, add_list_ingr a a c = removelast (c :: a). +Proof. intro a. + induction a as [ | a xs IHxs]. + - intros c. simpl. reflexivity. + - intros [ | ]. + + simpl. case a. + * simpl. rewrite IHxs. + case_eq xs. intro Heq0. simpl. reflexivity. + reflexivity. + * simpl. rewrite IHxs. + case_eq xs. intro Heq0. simpl. reflexivity. + reflexivity. + + simpl. case a. + * simpl. rewrite IHxs. + case_eq xs. intro Heq0. simpl. reflexivity. + reflexivity. + * simpl. rewrite IHxs. + case_eq xs. intro Heq0. simpl. reflexivity. + reflexivity. +Qed. + +Lemma add_list_twice: forall a, add_list a a = removelast (false :: a). +Proof. intro a. + unfold add_list. rewrite add_list_carry_twice. reflexivity. +Qed. + +(*bitvector ADD properties*) + +Lemma bv_add_size: forall n a b, (size a) = n -> (@size b) = n -> size (bv_add a b) = n. +Proof. intros n a b H0 H1. + unfold bv_add. rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size, bits in *. rewrite <- (@length_add_list_eq a b). auto. + now rewrite <- Nat2N.inj_iff, H0. +Qed. + +Lemma bv_add_comm: forall n a b, (size a) = n -> (size b) = n -> bv_add a b = bv_add b a. +Proof. intros n a b H0 H1. + unfold bv_add, size, bits in *. rewrite H0, H1. + rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite add_list_comm. reflexivity. +Qed. + +Lemma bv_add_assoc: forall n a b c, (size a) = n -> (size b) = n -> (size c) = n -> + (bv_add a (bv_add b c)) = (bv_add (bv_add a b) c). +Proof. intros n a b c H0 H1 H2. + unfold bv_add, size, bits in *. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite <- (@length_add_list_eq b c). rewrite H0, H1. + rewrite N.compare_refl. rewrite N.eqb_compare. + rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite <- (@length_add_list_eq a b). rewrite H0. + rewrite N.compare_refl. + rewrite add_list_assoc. reflexivity. + now rewrite <- Nat2N.inj_iff, H0. + now rewrite <- Nat2N.inj_iff, H1. +Qed. + +Lemma bv_add_empty_neutral_l: forall a, (bv_add (mk_list_false (length (bits a))) a) = a. +Proof. intro a. unfold bv_add, size, bits. + rewrite N.eqb_compare. rewrite length_mk_list_false. rewrite N.compare_refl. + rewrite add_list_empty_neutral_l. reflexivity. +Qed. + +Lemma bv_add_empty_neutral_r: forall a, (bv_add a (mk_list_false (length (bits a)))) = a. +Proof. intro a. unfold bv_add, size, bits. + rewrite N.eqb_compare. rewrite length_mk_list_false. rewrite N.compare_refl. + rewrite add_list_empty_neutral_r. reflexivity. +Qed. + +Lemma bv_add_twice: forall a, bv_add a a = removelast (false :: a). +Proof. intro a. unfold bv_add, size, bits. + rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite add_list_twice. reflexivity. +Qed. + +(* bitwise SUBST properties *) + +Lemma subst_list_empty_empty_l: forall a, (subst_list [] a) = []. +Proof. intro a. unfold subst_list; auto. Qed. + +Lemma subst_list_empty_empty_r: forall a, (subst_list a []) = []. +Proof. intro a. + induction a as [ | a xs IHxs]. + - auto. + - unfold subst_list; auto. +Qed. + +Lemma subst_list'_empty_empty_r: forall a, (subst_list' a []) = []. +Proof. intro a. + induction a as [ | a xs IHxs]. + - auto. + - unfold subst_list' in *. unfold twos_complement. simpl. reflexivity. +Qed. + +Lemma subst_list_borrow_length: forall (a b: list bool) c, length a = length b -> length a = length (subst_list_borrow a b c). +Proof. induction a as [ | a' xs IHxs]. + simpl. auto. + intros [ | b ys]. + - simpl. intros. exact H. + - intros. simpl in *. + case_eq (subst_borrow a' b c); intros r c0 Heq. simpl. apply f_equal. + specialize (@IHxs ys). apply IHxs. inversion H; reflexivity. +Qed. + +Lemma length_twos_complement: forall (a: list bool), length a = length (twos_complement a). +Proof. intro a. + induction a as [ | a' xs IHxs]. + - auto. + - unfold twos_complement. specialize (@add_list_carry_length_eq (map negb (a' :: xs)) (mk_list_false (length (a' :: xs))) true). + intro H. rewrite <- H. simpl. apply f_equal. rewrite <- not_list_length. reflexivity. + rewrite length_mk_list_false. rewrite <- not_list_length. reflexivity. +Qed. + +Lemma subst_list_length: forall (a b: list bool), length a = length b -> length a = length (subst_list a b). +Proof. intros a b H. unfold subst_list. apply (@subst_list_borrow_length a b false). exact H. Qed. + +Lemma subst_list'_length: forall (a b: list bool), length a = length b -> length a = length (subst_list' a b). +Proof. intros a b H. unfold subst_list'. + rewrite <- (@length_add_list_eq a (twos_complement b)). + - reflexivity. + - rewrite <- (@length_twos_complement b). exact H. +Qed. + +Lemma subst_list_borrow_empty_neutral: forall (a: list bool), (subst_list_borrow a (mk_list_false (length a)) false) = a. +Proof. intro a. induction a as [ | a' xs IHxs]. + - simpl. reflexivity. + - simpl. + cut(subst_borrow a' false false = (a', false)). + + intro H. rewrite H. rewrite IHxs. reflexivity. + + unfold subst_borrow. case a'; auto. +Qed. + +Lemma subst_list_empty_neutral: forall (a: list bool), (subst_list a (mk_list_false (length a))) = a. +Proof. intros a. unfold subst_list. + apply (@subst_list_borrow_empty_neutral a). +Qed. + +Lemma twos_complement_cons_false: forall a, false :: twos_complement a = twos_complement (false :: a). +Proof. intro a. + induction a as [ | a xs IHxs]; unfold twos_complement; simpl; reflexivity. +Qed. + +Lemma twos_complement_false_false: forall n, twos_complement (mk_list_false n) = mk_list_false n. +Proof. intro n. + induction n as [ | n IHn]. + - auto. + - simpl. rewrite <- twos_complement_cons_false. + apply f_equal. exact IHn. +Qed. + +Lemma subst_list'_empty_neutral: forall (a: list bool), (subst_list' a (mk_list_false (length a))) = a. +Proof. intros a. unfold subst_list'. + rewrite (@twos_complement_false_false (length a)). + rewrite add_list_empty_neutral_r. reflexivity. +Qed. + +(* some list ult and slt properties *) + +Lemma ult_list_big_endian_trans : forall x y z, + ult_list_big_endian x y = true -> + ult_list_big_endian y z = true -> + ult_list_big_endian x z = true. +Proof. + intros x. induction x. + simpl. easy. + intros y z. + case y. + simpl. case x; easy. + intros b l. + intros. + simpl in *. case x in *. + case z in *. simpl in H0. case l in *; easy. + case l in *. + rewrite andb_true_iff in H. + destruct H. + apply negb_true_iff in H. subst. + simpl. case z in *. easy. + rewrite !orb_true_iff, !andb_true_iff in H0. + destruct H0. + destruct H. + apply Bool.eqb_prop in H. + subst. + rewrite orb_true_iff. now right. + destruct H. easy. + rewrite !orb_true_iff, !andb_true_iff in H, H0. + destruct H. + simpl in H. easy. + destruct H. + apply negb_true_iff in H. subst. + simpl. + destruct H0. + destruct H. + apply Bool.eqb_prop in H. + subst. + case z; easy. + destruct H. easy. + case l in *. + rewrite !orb_true_iff, !andb_true_iff in H. + simpl in H. destruct H. destruct H. case x in H1; easy. + destruct H. + apply negb_true_iff in H. subst. + simpl in H0. + case z in *; try easy. + case z in *; simpl in H0; try easy. + case b in H0; simpl in H0; try easy. + case z in *; try easy. + rewrite !orb_true_iff, !andb_true_iff in *. + destruct H. + destruct H. + destruct H0. + destruct H0. + apply Bool.eqb_prop in H. + apply Bool.eqb_prop in H0. + subst. + left. + split. + apply Bool.eqb_reflx. + now apply (IHx (b1 :: l) z H1 H2). + right. apply Bool.eqb_prop in H. now subst. + right. destruct H0, H0. + apply Bool.eqb_prop in H0. now subst. + split; easy. +Qed. + + +Lemma ult_list_trans : forall x y z, + ult_list x y = true -> ult_list y z = true -> ult_list x z = true. +Proof. unfold ult_list. intros x y z. apply ult_list_big_endian_trans. +Qed. + +Lemma ult_list_big_endian_not_eq : forall x y, + ult_list_big_endian x y = true -> x <> y. +Proof. + intros x. induction x. + simpl. easy. + intros y. + case y. + simpl. case x; easy. + intros b l. + simpl. + specialize (IHx l). + case x in *. + simpl. + case l in *. case a; case b; simpl; easy. + easy. + rewrite !orb_true_iff, !andb_true_iff. + intro. + destruct H. + destruct H. + apply IHx in H0. + apply Bool.eqb_prop in H. + rewrite H in *. + unfold not in *; intro. + inversion H1; subst. now apply H0. + destruct H. + apply negb_true_iff in H. subst. easy. +Qed. + +Lemma ult_list_not_eq : forall x y, ult_list x y = true -> x <> y. +Proof. unfold ult_list. + unfold not. intros. + apply ult_list_big_endian_not_eq in H. + subst. auto. +Qed. + +Lemma slt_list_big_endian_not_eq : forall x y, + slt_list_big_endian x y = true -> x <> y. +Proof. + intros x. induction x. + simpl. easy. + intros y. + case y. + simpl. case x; easy. + intros b l. + simpl. + specialize (IHx l). + case x in *. + simpl. + case l in *. case a; case b; simpl; easy. + easy. + rewrite !orb_true_iff, !andb_true_iff. + intro. + destruct H. + destruct H. + apply ult_list_big_endian_not_eq in H0. + apply Bool.eqb_prop in H. rewrite H in *. + unfold not in *. intros. apply H0. now inversion H1. + destruct H. + apply negb_true_iff in H0. subst. easy. +Qed. + +Lemma slt_list_not_eq : forall x y, slt_list x y = true -> x <> y. +Proof. unfold slt_list. + unfold not. intros. + apply slt_list_big_endian_not_eq in H. + subst. auto. +Qed. + + +Lemma ult_list_not_eqP : forall x y, ult_listP x y -> x <> y. +Proof. unfold ult_listP. + unfold not. intros. unfold ult_list in H. + case_eq (ult_list_big_endian (List.rev x) (List.rev y)); intros. + apply ult_list_big_endian_not_eq in H1. subst. now contradict H1. + now rewrite H1 in H. +Qed. + +Lemma slt_list_not_eqP : forall x y, slt_listP x y -> x <> y. +Proof. unfold slt_listP. + unfold not. intros. unfold slt_list in H. + case_eq (slt_list_big_endian (List.rev x) (List.rev y)); intros. + apply slt_list_big_endian_not_eq in H1. subst. now contradict H1. + now rewrite H1 in H. +Qed. + +Lemma bv_ult_B2P: forall x y, bv_ult x y = true <-> bv_ultP x y. +Proof. intros. split; intros; unfold bv_ult, bv_ultP in *. + case_eq (size x =? size y); intros; + rewrite H0 in H; unfold ult_listP. now rewrite H. + now contradict H. + unfold ult_listP in *. + case_eq (size x =? size y); intros. + rewrite H0 in H. + case_eq (ult_list x y); intros. easy. + rewrite H1 in H. now contradict H. + rewrite H0 in H. now contradict H. +Qed. + +Lemma bv_slt_B2P: forall x y, bv_slt x y = true <-> bv_sltP x y. +Proof. intros. split; intros; unfold bv_slt, bv_sltP in *. + case_eq (size x =? size y); intros; + rewrite H0 in H; unfold slt_listP. now rewrite H. + now contradict H. + unfold slt_listP in *. + case_eq (size x =? size y); intros. + rewrite H0 in H. + case_eq (slt_list x y); intros. easy. + rewrite H1 in H. now contradict H. + rewrite H0 in H. now contradict H. +Qed. + +Lemma nlt_be_neq_gt: forall x y, + length x = length y -> ult_list_big_endian x y = false -> + beq_list x y = false -> ult_list_big_endian y x = true. +Proof. intro x. + induction x as [ | x xs IHxs ]. + - intros. simpl in *. case y in *; now contradict H. + - intros. + simpl in H1. + + case_eq y; intros. + rewrite H2 in H. now contradict H. + simpl. + case_eq l. intros. case_eq xs. intros. + rewrite H2 in H1. + rewrite H4 in H0, H. simpl in H0, H. + rewrite H2, H3 in H0, H. + rewrite H4, H3 in H1. simpl in H1. rewrite andb_true_r in H1. + case b in *; case x in *; easy. + intros. + rewrite H4, H2, H3 in H. now contradict H. + intros. + rewrite H2, H3 in H0, H1. + + simpl in H0. + case_eq xs. intros. rewrite H4, H2, H3 in H. now contradict H. + intros. rewrite H4 in H0. + rewrite <- H3, <- H4. + rewrite <- H3, <- H4 in H0. + rewrite <- H3 in H1. + rewrite orb_false_iff in H0. + destruct H0. + + case_eq (Bool.eqb x b); intros. + rewrite H6 in H0, H1. + rewrite andb_true_l in H0, H1. + assert (Bool.eqb b x = true). + { case b in *; case x in *; easy. } + rewrite H7. rewrite andb_true_l. + rewrite orb_true_iff. + left. + apply IHxs. rewrite H2 in H. + now inversion H. + easy. easy. + assert (Bool.eqb b x = false). + { case b in *; case x in *; easy. } + rewrite H7. rewrite orb_false_l. + case x in *. case b in *. + now contradict H6. + now easy. + case b in *. + now contradict H5. + now contradict H6. +Qed. + +(** bitvector ult/slt *) + +Lemma bv_ult_not_eqP : forall x y, bv_ultP x y -> x <> y. +Proof. intros x y. unfold bv_ultP. + case_eq (size x =? size y); intros. + - now apply ult_list_not_eqP in H0. + - now contradict H0. +Qed. + +Lemma bv_slt_not_eqP : forall x y, bv_sltP x y -> x <> y. +Proof. intros x y. unfold bv_sltP. + case_eq (size x =? size y); intros. + - now apply slt_list_not_eqP in H0. + - now contradict H0. +Qed. + +Lemma bv_ult_not_eq : forall x y, bv_ult x y = true -> x <> y. +Proof. intros x y. unfold bv_ult. + case_eq (size x =? size y); intros. + - now apply ult_list_not_eq in H0. + - now contradict H0. +Qed. + +Lemma bv_slt_not_eq : forall x y, bv_slt x y = true -> x <> y. +Proof. intros x y. unfold bv_slt. + case_eq (size x =? size y); intros. + - now apply slt_list_not_eq in H0. + - now contradict H0. +Qed. + +Lemma rev_eq: forall x y, beq_list x y = true -> + beq_list (List.rev x) (List.rev y) = true. +Proof. intros. + apply List_eq in H. + rewrite H. + now apply List_eq_refl. +Qed. + +Lemma rev_neq: forall x y, beq_list x y = false -> + beq_list (List.rev x) (List.rev y) = false. +Proof. intros. + specialize (@List_neq x y H). + intros. + apply not_true_is_false. + unfold not in *. + intros. apply H0. + apply List_eq in H1. + + specialize (f_equal (@List.rev bool) H1 ). + intros. + now rewrite !rev_involutive in H2. +Qed. + +Lemma nlt_neq_gt: forall x y, + length x = length y -> ult_list x y = false -> + beq_list x y = false -> ult_list y x = true. +Proof. intros. + unfold ult_list in *. + apply nlt_be_neq_gt. + now rewrite !rev_length. + easy. + now apply rev_neq in H1. +Qed. + +(* bitvector SUBT properties *) + +Lemma bv_subt_size: forall n a b, size a = n -> size b = n -> size (bv_subt a b) = n. +Proof. intros n a b H0 H1. + unfold bv_subt, size, bits in *. rewrite H0, H1. rewrite N.eqb_compare. + rewrite N.compare_refl. rewrite <- subst_list_length. exact H0. + now rewrite <- Nat2N.inj_iff, H0. +Qed. + +Lemma bv_subt_empty_neutral_r: forall a, (bv_subt a (mk_list_false (length (bits a)))) = a. +Proof. intro a. unfold bv_subt, size, bits. + rewrite N.eqb_compare. rewrite length_mk_list_false. + rewrite N.compare_refl. + rewrite subst_list_empty_neutral. reflexivity. +Qed. + +Lemma bv_subt'_size: forall n a b, (size a) = n -> (size b) = n -> size (bv_subt' a b) = n. +Proof. intros n a b H0 H1. unfold bv_subt', size, bits in *. + rewrite H0, H1. rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite <- subst_list'_length. exact H0. + now rewrite <- Nat2N.inj_iff, H0. +Qed. + +Lemma bv_subt'_empty_neutral_r: forall a, (bv_subt' a (mk_list_false (length (bits a)))) = a. +Proof. intro a. unfold bv_subt', size, bits. + rewrite N.eqb_compare. rewrite length_mk_list_false. + rewrite N.compare_refl. + rewrite subst_list'_empty_neutral. reflexivity. +Qed. + +(* bitwise ADD-NEG properties *) + +Lemma add_neg_list_carry_false: forall a b c, add_list_ingr a (add_list_ingr b c true) false = add_list_ingr a (add_list_ingr b c false) true. +Proof. intro a. + induction a as [ | a xs IHxs]. + - simpl. auto. + - case b as [ | b ys]. + + simpl. auto. + + case c as [ | c zs]. + * simpl. auto. + * simpl. + case_eq (add_carry b c false); intros r0 c0 Heq0. + case_eq (add_carry b c true); intros r1 c1 Heq1. + case_eq (add_carry a r1 false); intros r2 c2 Heq2. + case_eq (add_carry a r0 true); intros r3 c3 Heq3. + case a, b, c; inversion Heq0; inversion Heq1; + inversion Heq2; inversion Heq3; rewrite <- H2 in H4; + rewrite <- H0 in H5; inversion H4; inversion H5; apply f_equal; + try reflexivity; rewrite IHxs; reflexivity. +Qed. + + +Lemma add_neg_list_carry_neg_f: forall a, (add_list_ingr a (map negb a) false) = mk_list_true (length a). +Proof. intro a. + induction a as [ | a xs IHxs]. + - simpl. reflexivity. + - simpl. + case_eq (add_carry a (negb a) false); intros r0 c0 Heq0. + rewrite add_carry_neg_f in Heq0. + inversion Heq0. rewrite IHxs. reflexivity. +Qed. + +Lemma add_neg_list_carry_neg_f_r: forall a, (add_list_ingr (map negb a) a false) = mk_list_true (length a). +Proof. intro a. + induction a as [ | a xs IHxs]. + - simpl. reflexivity. + - simpl. + case_eq (add_carry (negb a) a false); intros r0 c0 Heq0. + rewrite add_carry_neg_f_r in Heq0. + inversion Heq0. rewrite IHxs. reflexivity. +Qed. + +Lemma add_neg_list_carry_neg_t: forall a, (add_list_ingr a (map negb a) true) = mk_list_false (length a). +Proof. intro a. + induction a as [ | a xs IHxs]. + - simpl. reflexivity. + - simpl. + case_eq (add_carry a (negb a) true); intros r0 c0 Heq0. + rewrite add_carry_neg_t in Heq0. + inversion Heq0. rewrite IHxs. reflexivity. +Qed. + +Lemma add_neg_list_carry: forall a, add_list_ingr a (twos_complement a) false = mk_list_false (length a). +Proof. intro a. + induction a as [ | a xs IHxs]. + - simpl. reflexivity. + - unfold twos_complement. rewrite add_neg_list_carry_false. rewrite not_list_length at 1. + rewrite add_list_carry_empty_neutral_r. + rewrite add_neg_list_carry_neg_t. reflexivity. +Qed. + +Lemma add_neg_list_absorb: forall a, add_list a (twos_complement a) = mk_list_false (length a). +Proof. intro a. unfold add_list. rewrite add_neg_list_carry. reflexivity. Qed. + +(* bitvector ADD-NEG properties *) + +Lemma bv_add_neg_unit: forall a, bv_add a (bv_not a) = mk_list_true (nat_of_N (size a)). +Proof. intro a. unfold bv_add, bv_not, size, bits. rewrite not_list_length. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold add_list. rewrite add_neg_list_carry_neg_f. + rewrite Nat2N.id, not_list_length. reflexivity. +Qed. + + +(* bitwise ADD-SUBST properties *) + +Lemma add_subst_list_carry_opp: forall n a b, (length a) = n -> (length b) = n -> (add_list_ingr (subst_list' a b) b false) = a. +Proof. intros n a b H0 H1. + unfold subst_list', twos_complement, add_list. + rewrite add_neg_list_carry_false. rewrite not_list_length at 1. + rewrite add_list_carry_empty_neutral_r. + specialize (@add_list_carry_assoc a (map negb b) b true false false true). + intro H2. rewrite H2; try auto. rewrite add_neg_list_carry_neg_f_r. + rewrite H1. rewrite <- H0. rewrite add_list_carry_unit_t; reflexivity. +Qed. + +Lemma add_subst_opp: forall n a b, (length a) = n -> (length b) = n -> (add_list (subst_list' a b) b) = a. +Proof. intros n a b H0 H1. unfold add_list, size, bits. + apply (@add_subst_list_carry_opp n a b); easy. +Qed. + +(* bitvector ADD-SUBT properties *) + +Lemma bv_add_subst_opp: forall n a b, (size a) = n -> (size b) = n -> (bv_add (bv_subt' a b) b) = a. +Proof. intros n a b H0 H1. unfold bv_add, bv_subt', add_list, size, bits in *. + rewrite H0, H1. + rewrite N.eqb_compare. rewrite N.eqb_compare. rewrite N.compare_refl. + rewrite <- (@subst_list'_length a b). rewrite H0. + rewrite N.compare_refl. rewrite (@add_subst_list_carry_opp (nat_of_N n) a b); auto; + inversion H0; rewrite Nat2N.id; auto. + symmetry. now rewrite <- Nat2N.inj_iff, H0. + now rewrite <- Nat2N.inj_iff, H0. +Qed. + + (* bitvector MULT properties *) + +Lemma prop_mult_bool_step_k_h_len: forall a b c k, +length (mult_bool_step_k_h a b c k) = length a. +Proof. intro a. + induction a as [ | xa xsa IHa ]. + - intros. simpl. easy. + - intros. + case b in *. simpl. rewrite IHa. simpl. omega. + simpl. case (k - 1 <? 0)%Z; simpl; now rewrite IHa. +Qed. + + +Lemma empty_list_length: forall {A: Type} (a: list A), (length a = 0)%nat <-> a = []. +Proof. intros A a. + induction a; split; intros; auto; contradict H; easy. +Qed. + +Lemma prop_mult_bool_step: forall k' a b res k, + length (mult_bool_step a b res k k') = (length res)%nat. +Proof. intro k'. + induction k'. + - intros. simpl. rewrite prop_mult_bool_step_k_h_len. simpl. omega. + - intros. simpl. rewrite IHk'. rewrite prop_mult_bool_step_k_h_len. simpl; omega. +Qed. + +Lemma and_with_bool_len: forall a b, length (and_with_bool a (nth 0 b false)) = length a. +Proof. intro a. + - induction a. + intros. now simpl. + intros. simpl. now rewrite IHa. +Qed. + +Lemma bv_mult_size: forall n a b, (size a) = n -> (@size b) = n -> size (bv_mult a b) = n. +Proof. intros n a b H0 H1. + unfold bv_mult, size, bits in *. + rewrite H0, H1. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold mult_list, bvmult_bool. + case_eq (length a). + intros. + + rewrite empty_list_length in H. rewrite H in *. now simpl in *. + + intros. + case n0 in *. now rewrite and_with_bool_len. + rewrite prop_mult_bool_step. now rewrite and_with_bool_len. +Qed. + + (** list extraction *) + Fixpoint extract (x: list bool) (i j: nat) : list bool := + match x with + | [] => [] + | bx :: x' => + match i with + | O => + match j with + | O => [] + | S j' => bx :: extract x' i j' + end + | S i' => + match j with + | O => [] + | S j' => extract x' i' j' + end + end + end. + + Lemma zero_false: forall p, ~ 0 >= Npos p. + Proof. intro p. induction p; lia. Qed. + + Lemma min_distr: forall i j: N, N.to_nat (j - i) = ((N.to_nat j) - (N.to_nat i))%nat. + Proof. intros i j; case i; case j in *; try intros; lia. Qed. + + Lemma posSn: forall n, (Pos.to_nat (Pos.of_succ_nat n)) = S n. + Proof. intros; case n; [easy | intros; lia ]. Qed. + + Lemma _length_extract: forall a (i j: N) (H0: (N.of_nat (length a)) >= j) (H1: j >= i), + length (extract a 0 (N.to_nat j)) = (N.to_nat j). + Proof. intro a. + induction a as [ | xa xsa IHa ]. + - simpl. case i in *. case j in *. + easy. lia. + case j in *; lia. + - intros. simpl. + case_eq j. intros. + now simpl. + intros. rewrite <- H. + case_eq (N.to_nat j). + easy. intros. simpl. + apply f_equal. + specialize (@IHa 0%N (N.of_nat n)). + rewrite Nat2N.id in IHa. + apply IHa. + apply (f_equal (N.of_nat)) in H2. + rewrite N2Nat.id in H2. + rewrite H2 in H0. simpl in *. lia. + lia. + Qed. + + Lemma length_extract: forall a (i j: N) (H0: (N.of_nat (length a)) >= j) (H1: j >= i), + length (extract a (N.to_nat i) (N.to_nat j)) = (N.to_nat (j - i)). + Proof. intro a. + induction a as [ | xa xsa IHa]. + - intros. simpl. + case i in *. case j in *. + easy. simpl in *. + contradict H0. apply zero_false. + case j in *. now simpl. + apply zero_false in H0; now contradict H0. + - intros. simpl. + case_eq (N.to_nat i). intros. + case_eq (N.to_nat j). intros. + rewrite min_distr. now rewrite H, H2. + intros. simpl. + rewrite min_distr. rewrite H, H2. + simpl. apply f_equal. + + specialize (@IHa 0%N (N.of_nat n)). + rewrite Nat2N.id in IHa. + simpl in *. + rewrite IHa. lia. + lia. lia. + intros. + case_eq (N.to_nat j). + simpl. intros. + rewrite min_distr. rewrite H, H2. now simpl. + intros. + rewrite min_distr. rewrite H, H2. + simpl. + specialize (@IHa (N.of_nat n) (N.of_nat n0)). + rewrite !Nat2N.id in IHa. + rewrite IHa. lia. + apply (f_equal (N.of_nat)) in H2. + rewrite N2Nat.id in H2. + rewrite H2 in H0. simpl in H0. lia. + lia. +Qed. + + (** bit-vector extraction *) + Definition bv_extr (i n0 n1: N) a : bitvector := + if (N.ltb n1 (n0 + i)) then mk_list_false (nat_of_N n0) + else extract a (nat_of_N i) (nat_of_N (n0 + i)). + + Lemma not_ltb: forall (n0 n1 i: N), (n1 <? n0 + i)%N = false -> n1 >= n0 + i. + Proof. intro n0. + induction n0. + intros. simpl in *. + apply N.ltb_nlt in H. + apply N.nlt_ge in H. lia. + intros. simpl. + case_eq i. + intros. subst. simpl in H. + apply N.ltb_nlt in H. + apply N.nlt_ge in H. intros. simpl in H. lia. + intros. subst. + apply N.ltb_nlt in H. + apply N.nlt_ge in H. lia. + Qed. + + + Lemma bv_extr_size: forall (i n0 n1 : N) a, + size a = n1 -> size (@bv_extr i n0 n1 a) = n0%N. + Proof. + intros. unfold bv_extr, size in *. + case_eq (n1 <? n0 + i). + intros. now rewrite length_mk_list_false, N2Nat.id. + intros. + specialize (@length_extract a i (n0 + i)). intros. + assert ((n0 + i - i) = n0)%N. + { lia. } rewrite H2 in H1. + rewrite H1. + now rewrite N2Nat.id. + rewrite H. + now apply not_ltb. + lia. + Qed. + + (* + Definition bv_extr (n i j: N) {H0: n >= j} {H1: j >= i} {a: bitvector} : bitvector := + extract a (nat_of_N i) (nat_of_N j). + + + Lemma bv_extr_size: forall n (i j: N) a (H0: n >= j) (H1: j >= i), + size a = n -> size (@bv_extr n i j H0 H1 a) = (j - i)%N. + Proof. + intros. unfold bv_extr, size in *. + rewrite <- N2Nat.id. apply f_equal. + rewrite <- H in H0. + specialize (@length_extract a i j H0 H1); intros; apply H2. + Qed. + *) + + (** list extension *) + Fixpoint extend (x: list bool) (i: nat) (b: bool) {struct i}: list bool := + match i with + | O => x + | S i' => b :: extend x i' b + end. + + Definition zextend (x: list bool) (i: nat): list bool := + extend x i false. + + Definition sextend (x: list bool) (i: nat): list bool := + match x with + | [] => mk_list_false i + | xb :: x' => extend x i xb + end. + + Lemma extend_size_zero: forall i b, (length (extend [] i b)) = i. + Proof. + intros. + induction i as [ | xi IHi]. + - now simpl. + - simpl. now rewrite IHi. + Qed. + + Lemma extend_size_one: forall i a b, length (extend [a] i b) = S i. + Proof. intros. + induction i. + - now simpl. + - simpl. now rewrite IHi. + Qed. + + Lemma length_extend: forall a i b, length (extend a i b) = ((length a) + i)%nat. + Proof. intro a. + induction a. + - intros. simpl. now rewrite extend_size_zero. + - intros. + induction i. + + intros. simpl. lia. + + intros. simpl. apply f_equal. + rewrite IHi. simpl. lia. + Qed. + + Lemma zextend_size_zero: forall i, (length (zextend [] i)) = i. + Proof. + intros. unfold zextend. apply extend_size_zero. + Qed. + + Lemma zextend_size_one: forall i a, length (zextend [a] i) = S i. + Proof. + intros. unfold zextend. apply extend_size_one. + Qed. + + Lemma length_zextend: forall a i, length (zextend a i) = ((length a) + i)%nat. + Proof. + intros. unfold zextend. apply length_extend. + Qed. + + Lemma sextend_size_zero: forall i, (length (sextend [] i)) = i. + Proof. + intros. unfold sextend. now rewrite length_mk_list_false. + Qed. + + Lemma sextend_size_one: forall i a, length (sextend [a] i) = S i. + Proof. + intros. unfold sextend. apply extend_size_one. + Qed. + + Lemma length_sextend: forall a i, length (sextend a i) = ((length a) + i)%nat. + Proof. + intros. unfold sextend. + case_eq a. intros. rewrite length_mk_list_false. easy. + intros. apply length_extend. + Qed. + + (** bit-vector extension *) + Definition bv_zextn (n i: N) (a: bitvector): bitvector := + zextend a (nat_of_N i). + + Definition bv_sextn (n i: N) (a: bitvector): bitvector := + sextend a (nat_of_N i). + + Lemma plus_distr: forall i j: N, N.to_nat (j + i) = ((N.to_nat j) + (N.to_nat i))%nat. + Proof. intros i j; case i; case j in *; try intros; lia. Qed. + + Lemma bv_zextn_size: forall n (i: N) a, + size a = n -> size (@bv_zextn n i a) = (i + n)%N. + Proof. + intros. unfold bv_zextn, zextend, size in *. + rewrite <- N2Nat.id. apply f_equal. + specialize (@length_extend a (nat_of_N i) false). intros. + rewrite H0. rewrite plus_distr. rewrite plus_comm. + apply f_equal. + apply (f_equal (N.to_nat)) in H. + now rewrite Nat2N.id in H. + Qed. + + Lemma bv_sextn_size: forall n (i: N) a, + size a = n -> size (@bv_sextn n i a) = (i + n)%N. + Proof. + intros. unfold bv_sextn, sextend, size in *. + rewrite <- N2Nat.id. apply f_equal. + case_eq a. + intros. rewrite length_mk_list_false. + rewrite H0 in H. simpl in H. rewrite <- H. + lia. + intros. + specialize (@length_extend a (nat_of_N i) b). intros. + subst. rewrite plus_distr. rewrite plus_comm. + rewrite Nat2N.id. + now rewrite <- H1. + Qed. + + (** shift left *) + +Fixpoint pow2 (n: nat): nat := + match n with + | O => 1%nat + | S n' => (2 * pow2 n')%nat + end. + +Fixpoint _list2nat_be (a: list bool) (n i: nat) : nat := + match a with + | [] => n + | xa :: xsa => + if xa then _list2nat_be xsa (n + (pow2 i)) (i + 1) + else _list2nat_be xsa n (i + 1) + end. + +Definition list2nat_be (a: list bool) := _list2nat_be a 0 0. + +Definition _shl_be (a: list bool) : list bool := + match a with + | [] => [] + | _ => false :: removelast a + end. + +Fixpoint nshl_be (a: list bool) (n: nat): list bool := + match n with + | O => a + | S n' => nshl_be (_shl_be a) n' + end. + +Definition shl_be (a b: list bool): list bool := +nshl_be a (list2nat_be b). + +Lemma length__shl_be: forall a, length (_shl_be a) = length a. +Proof. intro a. + induction a; intros. + - now simpl. + - simpl. rewrite <- IHa. + case_eq a0; easy. +Qed. + +Lemma length_nshl_be: forall n a, length (nshl_be a n) = length a. +Proof. intro n. + induction n; intros; simpl. + - reflexivity. + - now rewrite (IHn (_shl_be a)), length__shl_be. +Qed. + +Lemma length_shl_be: forall a b n, n = (length a) -> n = (length b)%nat -> + n = (length (shl_be a b)). +Proof. + intros. + unfold shl_be. now rewrite length_nshl_be. +Qed. + + (** bit-vector extension *) +Definition bv_shl (a b : bitvector) : bitvector := + if ((@size a) =? (@size b)) + then shl_be a b + else zeros (@size a). + +Lemma bv_shl_size n a b : size a = n -> size b = n -> size (bv_shl a b) = n. +Proof. + unfold bv_shl. intros H1 H2. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size in *. rewrite <- (@length_shl_be a b (nat_of_N n)). + now rewrite N2Nat.id. + now apply (f_equal (N.to_nat)) in H1; rewrite Nat2N.id in H1. + now apply (f_equal (N.to_nat)) in H2; rewrite Nat2N.id in H2. +Qed. + + (** shift right *) + +Definition _shr_be (a: list bool) : list bool := + match a with + | [] => [] + | xa :: xsa => xsa ++ [false] + end. + +Fixpoint nshr_be (a: list bool) (n: nat): list bool := + match n with + | O => a + | S n' => nshr_be (_shr_be a) n' + end. + +Definition shr_be (a b: list bool): list bool := +nshr_be a (list2nat_be b). + +Lemma length__shr_be: forall a, length (_shr_be a) = length a. +Proof. intro a. + induction a; intros. + - now simpl. + - simpl. rewrite <- IHa. + case_eq a0; easy. +Qed. + +Lemma length_nshr_be: forall n a, length (nshr_be a n) = length a. +Proof. intro n. + induction n; intros; simpl. + - reflexivity. + - now rewrite (IHn (_shr_be a)), length__shr_be. +Qed. + +Lemma length_shr_be: forall a b n, n = (length a) -> n = (length b)%nat -> + n = (length (shr_be a b)). +Proof. + intros. + unfold shr_be. now rewrite length_nshr_be. +Qed. + + (** bit-vector extension *) +Definition bv_shr (a b : bitvector) : bitvector := + if ((@size a) =? (@size b)) + then shr_be a b + else zeros (@size a). + +Lemma bv_shr_size n a b : size a = n -> size b = n -> size (bv_shr a b) = n. +Proof. + unfold bv_shr. intros H1 H2. rewrite H1, H2. + rewrite N.eqb_compare. rewrite N.compare_refl. + unfold size in *. rewrite <- (@length_shr_be a b (nat_of_N n)). + now rewrite N2Nat.id. + now apply (f_equal (N.to_nat)) in H1; rewrite Nat2N.id in H1. + now apply (f_equal (N.to_nat)) in H2; rewrite Nat2N.id in H2. +Qed. + +End RAWBITVECTOR_LIST. + +Module BITVECTOR_LIST <: BITVECTOR. + + Include RAW2BITVECTOR(RAWBITVECTOR_LIST). + + Notation "x |0" := (cons false x) (left associativity, at level 73, format "x |0"): bv_scope. + Notation "x |1" := (cons true x) (left associativity, at level 73, format "x |1"): bv_scope. + Notation "'b|0'" := [false] (at level 70): bv_scope. + Notation "'b|1'" := [true] (at level 70): bv_scope. + Notation "# x |" := (@of_bits x) (no associativity, at level 1, format "# x |"): bv_scope. + Notation "v @ p" := (bitOf p v) (at level 1, format "v @ p ") : bv_scope. + +End BITVECTOR_LIST. + +(* + Local Variables: + coq-load-path: ((rec ".." "SMTCoq")) + End: +*) diff --git a/src/bva/Bva_checker.v b/src/bva/Bva_checker.v new file mode 100644 index 0000000..81e0a30 --- /dev/null +++ b/src/bva/Bva_checker.v @@ -0,0 +1,8576 @@ +(**************************************************************************) +(* *) +(* SMTCoq *) +(* Copyright (C) 2011 - 2019 *) +(* *) +(* See file "AUTHORS" for the list of authors *) +(* *) +(* This file is distributed under the terms of the CeCILL-C licence *) +(* *) +(**************************************************************************) + + +(** A small checker for bit-vectors bit-blasting *) + +(*Add Rec LoadPath "." as SMTCoq.*) + +Require Structures. + +Require Import Int63 Int63Properties PArray SMT_classes. + +Require Import Misc State SMT_terms BVList Psatz. +Require Import Bool List BoolEq NZParity Nnat. +Require Import BinPos BinNat Pnat Init.Peano. + +Require FArray. + +Import ListNotations. +Import Form. + +Local Open Scope array_scope. +Local Open Scope int63_scope. +Local Open Scope list_scope. + +Set Implicit Arguments. +Unset Strict Implicit. + + +Section Checker. + + Import Atom. + + Variable t_atom : PArray.array atom. + Variable t_form : PArray.array form. + + Local Notation get_form := (PArray.get t_form) (only parsing). + Local Notation get_atom := (PArray.get t_atom) (only parsing). + + (** * Bit-blasting a constant bitvector: + + --------------------------- bbConst + bbT(#b0010, [0; 1; 0; 0]) + *) + + Fixpoint check_bbc (a_bv: list bool) (bs: list _lit) := + match a_bv, bs with + | nil, nil => true + | v :: a_bv, b::bs => + if Lit.is_pos b then + match get_form (Lit.blit b), v with + | Ftrue, true | Ffalse, false => check_bbc a_bv bs + | _, _ => false + end + else false + | _, _ => false + end. + + (** Checker for bitblasting of bitvector constants *) + Definition check_bbConst lres := + if Lit.is_pos lres then + match get_form (Lit.blit lres) with + | FbbT a bs => + match get_atom a with + | Acop (CO_BV bv N) => + if check_bbc bv bs && (N.of_nat (length bv) =? N)%N + then lres::nil + else C._true + | _ => C._true + end + | _ => C._true + end + else C._true. + + + (** * Bit-blasting a variable: + + x ∈ BV n + ----------------------- bbVar + bbT(x, [x₀; ...; xₙ₋₁]) + *) + + Fixpoint check_bb (a: int) (bs: list _lit) (i n: nat) := + match bs with + | nil => Nat_eqb i n (* We go up to n *) + | b::bs => + if Lit.is_pos b then + match get_form (Lit.blit b) with + | Fatom a' => + match get_atom a' with + | Auop (UO_BVbitOf N p) a' => + (* TODO: + Do not need to check [Nat_eqb l (N.to_nat N)] at every iteration *) + if (a == a') (* We bit blast the right bv *) + && (Nat_eqb i p) (* We consider bits after bits *) + && (Nat_eqb n (N.to_nat N)) (* The bv has indeed type BV n *) + then check_bb a bs (S i) n + else false + | _ => false + end + | _ => false + end + else false + end. + + (** Checker for bitblasting of bitvector variables *) + Definition check_bbVar lres := + if Lit.is_pos lres then + match get_form (Lit.blit lres) with + | FbbT a bs => + if check_bb a bs O (List.length bs)%N + then lres::nil + else C._true + | _ => C._true + end + else C._true. + + Variable s : S.t. + + (** * Bit-blasting bitvector not ... + + bbT(a, [a0; ...; an]) + ------------------------------ bbNot + bbT(not a, [~a0; ...; ~an]) + *) + + (* Helper function for bv_not *) + Fixpoint check_not (bs br : list _lit) := + match bs, br with + | nil, nil => true + | b::bs, r::br => (r == Lit.neg b) && check_not bs br + | _, _ => false + end. + + (** Checker for bitblasting of bitvector not *) + Definition check_bbNot pos lres := + match S.get s pos with + | l::nil => + if (Lit.is_pos l) && (Lit.is_pos lres) then + match get_form (Lit.blit l), get_form (Lit.blit lres) with + | FbbT a bs, FbbT r br => + match get_atom r with + | Auop (UO_BVnot N) a' => + if (a == a') && check_not bs br && + (N.of_nat (length bs) =? N)%N + then lres::nil + else C._true + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _ => C._true + end. + + (** * Bit-blasting bitwise operations: bbAnd, bbOr, ... + + bbT(a, [a0; ...; an]) bbT(b, [b0; ...; bn]) + -------------------------------------------------- bbAnd + bbT(a&b, [a0 /\ b0; ...; an /\ bn]) + *) + +Fixpoint check_symopp (bs1 bs2 bsres : list _lit) (bvop: binop) := + match bs1, bs2, bsres with + | nil, nil, nil => true + | b1::bs1, b2::bs2, bres::bsres => + if Lit.is_pos bres then + let (ires, bvop) := + match get_form (Lit.blit bres), bvop with + + | Fand args, BO_BVand n => + ((if PArray.length args == 2 then + let a1 := args.[0] in + let a2 := args.[1] in + ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)) + else false), BO_BVand (n-1)) + + | For args, BO_BVor n => + ((if PArray.length args == 2 then + let a1 := args.[0] in + let a2 := args.[1] in + ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)) + else false), BO_BVor (n-1)) + + | Fxor a1 a2, BO_BVxor n => + (((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)), + BO_BVxor (n-1)) + + | Fiff a1 a2, (BO_eq (Typ.TBV n)) => + (((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)), + BO_eq (Typ.TBV n)) + + | _, _ => (false, bvop) + end in + if ires then check_symopp bs1 bs2 bsres bvop + else false + else false + | _, _, _ => false + end. + + Lemma empty_list_length: forall {A: Type} (a: list A), (length a = 0)%nat <-> a = []. + Proof. intros A a. + induction a; split; intros; auto; contradict H; easy. + Qed. + + (** Checker for bitblasting of bitwise operators on bitvectors *) + Definition check_bbOp pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres => + match get_atom a with + + | Abop (BO_BVand n) a1' a2' => + if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1'))) + && (@check_symopp bs1 bs2 bsres (BO_BVand n)) + && (N.of_nat (length bs1) =? n)%N + then lres::nil + else C._true + + | Abop (BO_BVor n) a1' a2' => + if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1'))) + && (check_symopp bs1 bs2 bsres (BO_BVor n)) + && (N.of_nat (length bs1) =? n)%N + then lres::nil + else C._true + + | Abop (BO_BVxor n) a1' a2' => + if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1'))) + && (check_symopp bs1 bs2 bsres (BO_BVxor n)) + && (N.of_nat (length bs1) =? n)%N + then lres::nil + else C._true + + | _ => C._true + end + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + (** * Bit-blasting bitvector equality + + bbT(a, [a0; ...; an]) bbT(b, [b0; ...; bn]) + -------------------------------------------------- bbEq + (a = b) <-> ((a0 <-> b0) /\ ... /\ (an <-> bn)) + *) + + Fixpoint check_eq (bs1 bs2 bsres: list _lit) := + match bs1, bs2, bsres with + | nil, nil, nil => true + | b1::bs1, b2::bs2, bres :: bsres => + match bs1, bs2, bsres with + | _::_, _::_, [] => + if Lit.is_pos bres then + match get_form (Lit.blit bres) with + | Fand args => + match PArray.to_list args with + | bres :: bsres => + if Lit.is_pos bres then + let ires := + match get_form (Lit.blit bres) with + | Fiff a1 a2 => + ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)) + | _ => false + end in + if ires then check_eq bs1 bs2 bsres + else false + else false + | _ => false + end + | _ => false + end + else false + | _, _, _ => + if Lit.is_pos bres then + let ires := + match get_form (Lit.blit bres) with + | Fiff a1 a2 => + ((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1)) + | _ => false + end in + if ires then check_eq bs1 bs2 bsres + else false + else false + end + | _, _, _ => false + end. + + (** Checker for bitblasting of equality between bitvector terms *) + Definition check_bbEq pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, Fiff leq lbb => + if (Bool.eqb (Lit.is_pos leq) (Lit.is_pos lbb)) then + match get_form (Lit.blit leq), get_form (Lit.blit lbb) with + | Fatom a, _ (* | _, Fatom a *) => + match get_atom a with + | Abop (BO_eq (Typ.TBV n)) a1' a2' => + if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1'))) + && (check_eq bs1 bs2 [lbb]) + && (N.of_nat (length bs1) =? n)%N + then lres::nil + else C._true + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + (** * Bitvector Arithmetic *) + + (** Representaion for symbolic carry computations *) + Inductive carry : Type := + | Clit (_:_lit) + | Cand (_:carry) (_:carry) + | Cxor (_:carry) (_:carry) + | Cor (_:carry) (_:carry) + | Ciff (_:carry) (_:carry) + . + + + (** Check if a symbolic carry computation is equal to a literal + representation. This function does not account for potential symmetries *) + (* c should always be a positive literal in carry computations *) + Fixpoint eq_carry_lit (carry : carry) (c : _lit) := + if Lit.is_pos c then + match carry with + | Clit l => l == c + + | Cand c1 c2 => + match get_form (Lit.blit c) with + | Fand args => + if PArray.length args == 2 then + (eq_carry_lit c1 (args.[0]) && eq_carry_lit c2 (args.[1])) + (* || (eq_carry_lit c1 (args.[1]) && eq_carry_lit c2 (args.[0])) *) + else false + | _ => false + end + + | Cxor c1 c2 => + match get_form (Lit.blit c) with + | Fxor a1 a2 => + (eq_carry_lit c1 a1 && eq_carry_lit c2 a2) + (* || (eq_carry_lit c1 a2 && eq_carry_lit c2 a1) *) + | _ => false + end + + | Cor c1 c2 => + match get_form (Lit.blit c) with + | For args => + if PArray.length args == 2 then + (eq_carry_lit c1 (args.[0]) && eq_carry_lit c2 (args.[1])) + (* || (eq_carry_lit c1 (args.[1]) && eq_carry_lit c2 (args.[0])) *) + else false + | _ => false + end + + | Ciff c1 c2 => + match get_form (Lit.blit c) with + | Fiff a1 a2 => + (eq_carry_lit c1 a1 && eq_carry_lit c2 a2) + (* || (eq_carry_lit c1 a2 && eq_carry_lit c2 a1) *) + | _ => false + end + end + else + (* c can be negative only when it is literal false *) + match carry with + | Clit l => l == c + | _ => false + end. + + (** Checks if [bsres] is the result of bvand of bs1 and bs2. The inital + value for the carry is [false]. *) + Fixpoint check_add (bs1 bs2 bsres : list _lit) (carry : carry) := + match bs1, bs2, bsres with + | nil, nil, nil => true + | b1::bs1, b2::bs2, bres::bsres => + if Lit.is_pos bres then + match get_form (Lit.blit bres) with + | Fxor xab c => + if Lit.is_pos xab then + match get_form (Lit.blit xab) with + | Fxor a1 a2 => + (* This is the way LFSC computes carries *) + let carry' := Cor (Cand (Clit b1) (Clit b2)) + (Cand (Cxor (Clit b1) (Clit b2)) carry) in + (((a1 == b1) && (a2 == b2)) || ((a1 == b2) && (a2 == b1))) + && eq_carry_lit carry c + && check_add bs1 bs2 bsres carry' + | _ => false + end + else false + | _ => false + end + else false + | _, _, _ => false + end. + + (** * Checker for bitblasting of bitvector addition *) + Definition check_bbAdd pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres => + match get_atom a with + + | Abop (BO_BVadd n) a1' a2' => + if (((a1 == a1') && (a2 == a2')) || ((a1 == a2') && (a2 == a1'))) + && (check_add bs1 bs2 bsres (Clit Lit._false)) + && (N.of_nat (length bs1) =? n)%N + then lres::nil + else C._true + + | _ => C._true + end + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + (** * Bit-blasting bitvector negation ... + + bbT(a, [a0; ...; an]) + ------------------------------ bbNeg + bbT(-a, [...]) + *) + + (* Helper function for bv_neg *) + Definition check_neg (bs br : list _lit) := + let z := map (fun _ => Lit._false) bs in + let nbs := map (fun l => Lit.neg l) bs in + check_add nbs z br (Clit Lit._true). + + (** Checker for bitblasting of bitvector negation *) + Definition check_bbNeg pos lres := + match S.get s pos with + | l::nil => + if (Lit.is_pos l) && (Lit.is_pos lres) then + match get_form (Lit.blit l), get_form (Lit.blit lres) with + | FbbT a bs, FbbT r br => + match get_atom r with + | Auop (UO_BVneg n) a' => + if (a == a') && check_neg bs br && + (N.of_nat (length bs) =? n)%N + then lres::nil + else C._true + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _ => C._true + end. + + Fixpoint and_with_bit (a: list _lit) (bt: _lit) : list carry := + match a with + | nil => nil + | ai :: a' => (Cand (Clit bt) (Clit ai)) :: and_with_bit a' bt + end. + + Fixpoint mult_step_k_h (a b: list carry) (c: carry) (k: Z) : list carry := + match a, b with + | nil, _ => [] + | ai :: a', bi :: b' => + if (k - 1 <? 0)%Z then + let carry_out := Cor (Cand ai bi) (Cand (Cxor ai bi) c) in + let curr := Cxor (Cxor ai bi) c in + curr :: mult_step_k_h a' b' carry_out (k - 1) + else + ai :: mult_step_k_h a' b c (k - 1) + | ai :: a', nil => ai :: mult_step_k_h a' b c k + end. + + Fixpoint mult_step (a b: list _lit) (res: list carry) (k k': nat) : list carry := + let ak := List.firstn (S k') a in + let b' := and_with_bit ak (nth k b Lit._false) in + let res' := mult_step_k_h res b' (Clit Lit._false) (Z.of_nat k) in + match k' with + | O => res' + (* | S O => res' *) + | S pk' => mult_step a b res' (S k) pk' + end. + + Definition bblast_bvmult (a b: list _lit) (n: nat) : list carry := + let res := and_with_bit a (nth 0 b Lit._false) in + match n with + | O => res + | S O => res + | S (S k) => mult_step a b res 1 k + end. + + Fixpoint mkzeros (k: nat) : list carry := + match k with + | O => nil + | S k => (Clit Lit._false) :: mkzeros k + end . + + Fixpoint bblast_bvadd (a b: list carry) (c: carry) : list carry := + match a, b with + | nil, _ | _, nil => nil + | ai :: a', bi :: b' => + let c' := (Cor (Cand ai bi) (Cand (Cxor ai bi) c)) in + (Cxor (Cxor ai bi) c') :: (bblast_bvadd a' b' c') + end. + + Fixpoint mult_shift (a b: list _lit) (n: nat) : list carry := + match a with + | nil => mkzeros n + | ai :: a' => + (bblast_bvadd (and_with_bit b ai) + (mult_shift a' (Lit._false :: b) n) (Clit Lit._false)) + end. + + Definition check_mult (bs1 bs2 bsres: list _lit) : bool := + if Nat_eqb (length bs1) (length bs2)%nat then + let bvm12 := bblast_bvmult bs1 bs2 (length bs1) in + forallb2 eq_carry_lit bvm12 bsres + else false. + + (** * Checker for bitblasting of bitvector multiplication *) + Definition check_bbMult pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres => + match get_atom a with + + | Abop (BO_BVmult n) a1' a2' => + if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) ) + && (check_mult bs1 bs2 bsres) + && (N.of_nat (length bs1) =? n)%N + then lres::nil + else C._true + + | _ => C._true + end + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + (** * Checker for bitblasting of bitvector comparison: lt *) + + Fixpoint ult_big_endian_lit_list (bs1 bs2: list _lit) := + match bs1, bs2 with + | nil, _ => Clit (Lit._false) + | _, nil => Clit (Lit._false) + | xi :: nil, yi :: nil => (Cand (Clit (Lit.neg xi)) (Clit yi)) + | xi :: x', yi :: y' => + (Cor (Cand (Ciff (Clit xi) (Clit yi)) (ult_big_endian_lit_list x' y')) + (Cand (Clit (Lit.neg xi)) (Clit yi))) + end. + + Definition ult_lit_list (x y: list _lit) := + ult_big_endian_lit_list (List.rev x) (List.rev y). + + Definition check_ult (bs1 bs2: list _lit) (bsres: _lit) : bool := + if Lit.is_pos bsres then + eq_carry_lit (ult_lit_list bs1 bs2) bsres + else false. + + Definition check_bbUlt pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, Fiff llt lbb => + if (Bool.eqb (Lit.is_pos llt) (Lit.is_pos lbb)) then + match get_form (Lit.blit llt), get_form (Lit.blit lbb) with + | Fatom a, _ (* | _, Fatom a *) => + match get_atom a with + | Abop (BO_BVult n) a1' a2' => + if ((a1 == a1') && (a2 == a2')) + && (check_ult bs1 bs2 lbb) + && (N.of_nat (length bs1) =? n)%N + && (N.of_nat (length bs2) =? n)%N + then lres::nil + else C._true + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + Definition slt_big_endian_lit_list (x y: list _lit) := + match x, y with + | nil, _ => Clit (Lit._false) + | _, nil => Clit (Lit._false) + | xi :: nil, yi :: nil => (Cand (Clit xi) (Clit (Lit.neg yi))) + | xi :: x', yi :: y' => + (Cor (Cand (Ciff (Clit xi) (Clit yi)) (ult_big_endian_lit_list x' y')) + (Cand (Clit xi) (Clit (Lit.neg yi)))) + end. + + Definition slt_lit_list (x y: list _lit) := + slt_big_endian_lit_list (List.rev x) (List.rev y). + + Definition check_slt (bs1 bs2: list _lit) (bsres: _lit) : bool := + if Lit.is_pos bsres then + eq_carry_lit (slt_lit_list bs1 bs2) bsres + else false. + + Definition check_bbSlt pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, Fiff llt lbb => + if (Bool.eqb (Lit.is_pos llt) (Lit.is_pos lbb)) then + match get_form (Lit.blit llt), get_form (Lit.blit lbb) with + | Fatom a, _ (* | _, Fatom a *) => + match get_atom a with + | Abop (BO_BVslt n) a1' a2' => + if ((a1 == a1') && (a2 == a2')) + && (check_slt bs1 bs2 lbb) + && (N.of_nat (length bs1) =? n)%N + && (N.of_nat (length bs2) =? n)%N + then lres::nil + else C._true + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + (** * Checker for bitblasting of bitvector concatenation *) + +(* + Fixpoint lit_to_carry (bs: list _lit) : list carry := + match bs with + | nil => [] + | xbs :: xsbs => Clit xbs :: lit_to_carry xsbs + end. + + Fixpoint h_check_bbConcat (bs1 bs2: list _lit) {struct bs1}: list carry := + match bs1 with + | nil => + match bs2 with + | nil => [] + | xbs2 :: xsbs2 => lit_to_carry bs2 + end + | xbs1 :: xsbs1 => Clit xbs1 :: (h_check_bbConcat xsbs1 bs2) + end. + *) + + Fixpoint lit_to_carry (bs: list _lit) : list carry := + match bs with + | nil => [] + | xbs :: xsbs => Clit xbs :: lit_to_carry xsbs + end. + + Definition check_concat (bs1 bs2 bsres: list _lit) : bool := + if (forallb2 eq_carry_lit (lit_to_carry (bs2 ++ bs1)) bsres) then true else false. + + Definition check_bbConcat pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, FbbT a2 bs2, FbbT a bsres => + match get_atom a with + + | Abop (BO_BVconcat n m) a1' a2' => + if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) ) + && (check_concat bs1 bs2 bsres) + && (N.of_nat (length bs1) =? n)%N + && (N.of_nat (length bs2) =? m)%N + then lres::nil + else C._true + + | _ => C._true + end + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + +(* bitwise disequality *) + + Fixpoint List_diseqb (a b: list bool) : bool := + match a, b with + | nil, nil => false + | xa :: xsa, xb :: xsb => + if (Bool.eqb xa false) then + (if (Bool.eqb xb false) then List_diseqb xsa xsb else true) + else (if (Bool.eqb xb true) then List_diseqb xsa xsb else true) + | _, _ => true + end. + + + (** Checker for bitvector disequality *) + Definition check_bbDiseq lres := + if negb (Lit.is_pos lres) then + match get_form (Lit.blit lres) with + | Fatom f => + match (get_atom f) with + | Abop (BO_eq (Typ.TBV n)) a b => + match (get_atom a), (get_atom b) with + | (Acop (CO_BV bv1 n1)), (Acop (CO_BV bv2 n2)) => + if List_diseqb bv1 bv2 + && (N.of_nat (length bv1) =? n)%N + && (N.of_nat (length bv2) =? n)%N + && (n1 =? n)%N && (n2 =? n)%N + then lres::nil + else C._true + | _, _ => C._true + end + | _ => C._true + end + | _ => C._true + end + else C._true. + + + (** Checker for bitvector extraction *) + Fixpoint extract_lit (x: list _lit) (i j: nat) : list _lit := + match x with + | [] => [] + | bx :: x' => + match i with + | O => + match j with + | O => [] + | S j' => bx :: extract_lit x' i j' + end + | S i' => + match j with + | O => [] + | S j' => extract_lit x' i' j' + end + end + end. + + Definition check_extract (bs bsres: list _lit) (i j: N) : bool := + if (N.ltb (N.of_nat (length bs)) j) + then false + else + if (forallb2 eq_carry_lit (lit_to_carry (extract_lit bs (nat_of_N i) (nat_of_N j))) bsres) + then true + else false. + + Definition check_extract3 (bs bsres: list _lit) (i j: N) : bool := + forallb2 (fun l1 l2 => l1 == l2) (extract_lit bs (nat_of_N i) (nat_of_N j)) bsres. + + + (** Checker for bitvector extraction *) + Fixpoint check_extract2 (x bsres: list _lit) (i j: nat) : bool := + match x with + | [] => match bsres with [] => true | _ => false end + | bx :: x' => + match i with + | O => + match j, bsres with + | O, nil => true + | S j', b :: bsres' => (bx == b) && check_extract2 x' bsres' i j' + | _, _ => false + end + | S i' => + match j, bsres with + | O, nil => true + | S j', _ => check_extract2 x' bsres i' j' + | _, _ => false + end + end + end. + + Definition check_bbExtract pos lres := + match S.get s pos with + | l1::nil => + if (Lit.is_pos l1) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit lres) with + | FbbT a1 bs, FbbT a bsres => + match get_atom a with + + | Auop (UO_BVextr i n0 n1) a1' => + if ((a1 == a1') (* || ((a1 == a2') && (a2 == a1')) *) ) + && (check_extract bs bsres i (n0 + i)) + && (N.of_nat (length bs) =? n1)%N + && (N.leb (n0 + i) n1) + then lres::nil + else C._true + + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _ => C._true + end. + + + (** Checker for unsigned bitvector extension *) + Fixpoint extend_lit (x: list _lit) (i: nat) (b: _lit) {struct i}: list _lit := + match i with + | O => x + | S i' => b :: extend_lit x i' b + end. + + Definition zextend_lit (x: list _lit) (i: nat): list _lit := + extend_lit x i Lit._false. + + Definition lit_of_bool (b: bool) :_lit := + if (Bool.eqb b true) then Lit._true + else Lit._false. + + Definition check_zextend (bs bsres: list _lit) (i: N) : bool := + if (forallb2 eq_carry_lit (lit_to_carry (zextend_lit bs (nat_of_N i))) bsres) + then true else false. + + Definition check_bbZextend pos lres := + match S.get s pos with + | l1::nil => + if (Lit.is_pos l1) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit lres) with + | FbbT a1 bs, FbbT a bsres => + match get_atom a with + + | Auop (UO_BVzextn n i) a1' => + if ((a1 == a1') (* || ((a1 == a2') && (a2 == a1')) *) ) + && (check_zextend bs bsres i) + && (N.of_nat (length bs) =? n)%N + then lres::nil + else C._true + + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _ => C._true + end. + + (** Checker for signed bitvector extension *) + + + Fixpoint mk_list_lit_false (t: nat) : list _lit := + match t with + | O => [] + | S t' => Lit._false :: (mk_list_lit_false t') + end. + + Definition sextend_lit (x: list _lit) (i: nat): list _lit := + match x with + | [] => mk_list_lit_false i + | xb :: x' => extend_lit x i xb + end. + + Definition check_sextend (bs bsres: list _lit) (i: N) : bool := + if (forallb2 eq_carry_lit (lit_to_carry (sextend_lit bs (nat_of_N i))) bsres) + then true else false. + + Definition check_bbSextend pos lres := + match S.get s pos with + | l1::nil => + if (Lit.is_pos l1) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit lres) with + | FbbT a1 bs, FbbT a bsres => + match get_atom a with + + | Auop (UO_BVsextn n i) a1' => + if ((a1 == a1') (* || ((a1 == a2') && (a2 == a1')) *) ) + && (check_sextend bs bsres i) + && (N.of_nat (length bs) =? n)%N + then lres::nil + else C._true + + | _ => C._true + end + | _, _ => C._true + end + else C._true + | _ => C._true + end. + + +(** Checker for the bit-blasted left shift (in big endian) *) + +Definition _shl_lit_be (a: list _lit) : list _lit := + match a with + | [] => [] + | _ => Lit._false :: removelast a + end. + +Fixpoint nshl_lit_be (a: list _lit) (n: nat): list _lit := + match n with + | O => a + | S n' => nshl_lit_be (_shl_lit_be a) n' + end. + +Definition shl_lit_be (a: list _lit) (b: list bool): list _lit := + nshl_lit_be a (RAWBITVECTOR_LIST.list2nat_be b). + + + Definition check_shl (bs1: list _lit) (bs2: list bool) (bsres: list _lit) : bool := + if (Structures.nat_eqb (length bs1) (length bs2)) then + if (forallb2 eq_carry_lit (lit_to_carry (shl_lit_be bs1 bs2)) bsres) + then true else false + else false. + + Definition check_bbShl pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, Fatom a2, FbbT a bsres => + match get_atom a with + | Abop (BO_BVshl n) a1' a2' => + match (get_atom a2) with + | (Acop (CO_BV bv2 n2)) => + if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) ) + && check_shl bs1 bv2 bsres + && (N.of_nat (length bs1) =? n)%N + && (N.of_nat (length bv2) =? n)%N + && (n2 =? n)%N + then lres::nil + else C._true + | _ => C._true + end + | _ => C._true + end + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + +(** Checker for the bit-blasted right shift (in big endian) *) + +Definition _shr_lit_be (a: list _lit) : list _lit := + match a with + | [] => [] + | xa :: xsa => xsa ++ [Lit._false] + end. + +Fixpoint nshr_lit_be (a: list _lit) (n: nat): list _lit := + match n with + | O => a + | S n' => nshr_lit_be (_shr_lit_be a) n' + end. + +Definition shr_lit_be (a: list _lit) (b: list bool): list _lit := + nshr_lit_be a (RAWBITVECTOR_LIST.list2nat_be b). + + + Definition check_shr (bs1: list _lit) (bs2: list bool) (bsres: list _lit) : bool := + if (Structures.nat_eqb (length bs1) (length bs2)) then + if (forallb2 eq_carry_lit (lit_to_carry (shr_lit_be bs1 bs2)) bsres) + then true else false + else false. + + Definition check_bbShr pos1 pos2 lres := + match S.get s pos1, S.get s pos2 with + | l1::nil, l2::nil => + if (Lit.is_pos l1) && (Lit.is_pos l2) && (Lit.is_pos lres) then + match get_form (Lit.blit l1), get_form (Lit.blit l2), get_form (Lit.blit lres) with + | FbbT a1 bs1, Fatom a2, FbbT a bsres => + match get_atom a with + | Abop (BO_BVshr n) a1' a2' => + match (get_atom a2) with + | (Acop (CO_BV bv2 n2)) => + if (((a1 == a1') && (a2 == a2')) (* || ((a1 == a2') && (a2 == a1')) *) ) + && check_shr bs1 bv2 bsres + && (N.of_nat (length bs1) =? n)%N + && (N.of_nat (length bv2) =? n)%N + && (n2 =? n)%N + then lres::nil + else C._true + | _ => C._true + end + | _ => C._true + end + | _, _, _ => C._true + end + else C._true + | _, _ => C._true + end. + + Section Proof. + + Variables (t_i : array typ_compdec) + (t_func : array (Atom.tval t_i)) + (ch_atom : Atom.check_atom t_atom) + (ch_form : Form.check_form t_form) + (wt_t_atom : Atom.wt t_i t_func t_atom). + + Local Notation check_atom := + (check_aux t_i t_func (get_type t_i t_func t_atom)). + + Local Notation interp_form_hatom := + (Atom.interp_form_hatom t_i t_func t_atom). + + Local Notation interp_form_hatom_bv := + (Atom.interp_form_hatom_bv t_i t_func t_atom). + + Local Notation rho := + (Form.interp_state_var interp_form_hatom interp_form_hatom_bv t_form). + + Fixpoint interp_carry (c: carry) : bool := + match c with + | Clit l => (Lit.interp rho l) + | Cand c1 c2 => (interp_carry c1) && (interp_carry c2) + | Cor c1 c2 => (interp_carry c1) || (interp_carry c2) + | Cxor c1 c2 => xorb (interp_carry c1) (interp_carry c2) + | Ciff c1 c2 => Bool.eqb (interp_carry c1) (interp_carry c2) + end. + + Hypothesis Hs : S.valid rho s. + + Local Notation t_interp := (t_interp t_i t_func t_atom). + + Local Notation interp_atom := + (interp_aux t_i t_func (get t_interp)). + + Let wf_t_atom : Atom.wf t_atom. + Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed. + + Let def_t_atom : default t_atom = Atom.Acop Atom.CO_xH. + Proof. destruct (Atom.check_atom_correct _ ch_atom); auto. Qed. + + Let def_t_form : default t_form = Form.Ftrue. + Proof. + destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto. + Qed. + + Let wf_t_form : Form.wf t_form. + Proof. + destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form) as [H _]; destruct H; auto. + Qed. + + Let wf_rho : Valuation.wf rho. + Proof. + destruct (Form.check_form_correct interp_form_hatom interp_form_hatom_bv _ ch_form); auto. + Qed. + + Lemma lit_interp_true : Lit.interp rho Lit._true = true. + Proof. + apply Lit.interp_true. + apply wf_rho. + Qed. + + Lemma lit_interp_false : Lit.interp rho Lit._false = false. + Proof. + specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. + Qed. + + Let rho_interp : forall x : int, rho x = Form.interp interp_form_hatom interp_form_hatom_bv t_form (t_form.[ x]). + Proof. intros x;apply wf_interp_form;trivial. Qed. + + Definition wf := PArray.forallbi lt_form t_form. + + Hypothesis wf_t_i : wf. + Variable interp_bvatom : atom -> forall s, BITVECTOR_LIST.bitvector s. + Notation atom := int (only parsing). + +Lemma id'' a : N.of_nat (N.to_nat a) = a. +Proof. + destruct a as [ | p]; simpl; trivial. + destruct (Pos2Nat.is_succ p) as (n,H). rewrite H. simpl. f_equal. + apply Pos2Nat.inj. rewrite H. apply SuccNat2Pos.id_succ. +Qed. + +Lemma inj a a' : N.to_nat a = N.to_nat a' -> a = a'. +Proof. + intro H. rewrite <- (id'' a), <- (id'' a'). now f_equal. +Qed. + +Lemma inj_iff a a' : N.to_nat a = N.to_nat a' <-> a = a'. +Proof. + split. apply inj. intros; now subst. +Qed. + +Lemma id' n : N.to_nat (N.of_nat n) = n. +Proof. + induction n; simpl; trivial. apply SuccNat2Pos.id_succ. +Qed. + +Lemma nth_eq1: forall i a xs, +nth (S i) (a :: xs) 1 = nth i xs 1. +Proof. intros. + now simpl. +Qed. + +Theorem nat_case: forall (n:nat) (P:nat -> Prop), P 0%nat -> (forall m:nat, P (S m)) -> P n. +Proof. induction n; auto. Qed. + +Theorem le_lt_or_eq : forall (n m: nat), (n <= m)%nat -> (n < m)%nat \/ n = m. +Proof. +induction 1; auto with arith. +Qed. + +Lemma le_le_S_eq : forall (n m: nat), (n <= m)%nat -> (S n <= m)%nat \/ n = m. +Proof le_lt_or_eq. + +Lemma Nat_eqb_eq: forall n m, Nat_eqb n m = true -> n = m. +Proof. induction n. + intros n Hm. simpl in Hm. case_eq n. reflexivity. + intros. rewrite H in Hm. now contradict H. + intros m Hm. + case_eq m. intros. rewrite H in Hm. simpl in Hm. + now contradict Hm. + intros. rewrite H in Hm. simpl in Hm. + specialize (@IHn n0 Hm). now rewrite IHn. +Qed. + +Lemma diseq_neg_eq: forall (la lb: list bool), + List_diseqb la lb = true -> negb (RAWBITVECTOR_LIST.beq_list la lb) = true. +Proof. intro la. + induction la. + - intros. simpl in H. case lb in *. + now contradict H. + now simpl. + - intros. + simpl in *. + case lb in *. + easy. + case_eq (Bool.eqb a false). + intros. rewrite H0 in H. + case_eq (Bool.eqb b false). + intros. rewrite H1 in H. + case a in *. now contradict H0. + case b in *. now contradict H1. + simpl. + apply IHla. easy. + case a in *. now contradict H0. + case b in *. intros. + now simpl. + intros. simpl. + apply IHla. + simpl in H. easy. + intros. rewrite H0 in H. + case_eq (Bool.eqb b true ). intros. + case a in *. + case b in *. simpl. + apply IHla. simpl in H. easy. + now simpl. + now contradict H0. + intros. + case a in *. + case b in *. simpl in *. now contradict H1. + now simpl in *. + case b in *. now simpl in *. + simpl in *. now contradict H. +Qed. + +Lemma valid_check_bbDiseq lres : C.valid rho (check_bbDiseq lres). +Proof. + unfold check_bbDiseq. + case_eq (Lit.is_pos lres); intro Heq; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros f Heq2. + case_eq (t_atom .[ f]); try (intros; now apply C.interp_true). + + intros [ | | | | | | |[ A B | A| | | |n]|N|N|N|N|N|N|N|N|N| | | | ]; + try (intros; now apply C.interp_true). intros a b Heq3. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros c Heq4. + case_eq c; try (intros; now apply C.interp_true). + intros la n1 Heq5. + case_eq (t_atom .[ b]); try (intros; now apply C.interp_true). + intros c0 Heq6. + case_eq c0; try (intros; now apply C.interp_true). + intros lb n2 Heq7. + case_eq (List_diseqb la lb && (N.of_nat (Datatypes.length la) =? n)%N + && (N.of_nat (Datatypes.length lb) =? n)%N + && (n1 =? n)%N && (n2 =? n)%N); + try (intros; now apply C.interp_true). intros Heq8. + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq2. simpl. + unfold Atom.interp_form_hatom, interp_hatom. + rewrite Atom.t_interp_wf; trivial. + rewrite Heq3. simpl. + rewrite !Atom.t_interp_wf; trivial. + rewrite Heq4, Heq6. simpl. + rewrite Heq5, Heq7. simpl. + + rewrite !andb_true_iff in Heq8. + destruct Heq8 as (((Heq8, Ha), Hb), Hc). + destruct Heq8 as (Heq8, Hd). + rewrite N.eqb_eq in Hb, Hc. + rewrite Hb, Hc. + rewrite Typ.N_cast_refl. simpl. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + (* a *) + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq4, Heq5. easy. } + specialize (@H0 H1). rewrite Heq4 in H0. simpl in H0. + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + rewrite Atom.t_interp_wf in Htia; trivial. + rewrite Heq4, Heq5 in Htia. simpl in Htia. + rewrite Hb in Htia. + unfold Bval in Htia. + rewrite Heq5 in H0. simpl in H0. + inversion Htia. + + generalize dependent v_vala. + rewrite <- H3. intros. + + (* b *) + pose proof (H b). + assert (b < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6, Heq7. easy. } + specialize (@H2 H4). rewrite Heq6 in H2. simpl in H2. + unfold get_type' in H2. unfold v_type in H2. + case_eq (t_interp .[ b]). + intros v_typeb v_valb Htib. rewrite Htib in H2. + rewrite Atom.t_interp_wf in Htib; trivial. + rewrite Heq6, Heq7 in Htib. simpl in Htib. + rewrite Hc in Htib. + unfold Bval in Htib. + rewrite Heq7 in H2. simpl in H2. + inversion Htib. + + generalize dependent v_valb. + rewrite <- H6. intros. + + (* f *) + pose proof (H f). + assert (f < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq3. easy. } + specialize (@H5 H7). rewrite Heq3 in H5. simpl in H5. + unfold get_type' in H5. unfold v_type in H5. + case_eq (t_interp .[ f]). + intros v_typef v_valf Htif. rewrite Htif in H5. + rewrite Atom.t_interp_wf in Htif; trivial. + rewrite Heq3 in Htif. simpl in Htif. + rewrite !Atom.t_interp_wf in Htif; trivial. + rewrite Heq4, Heq6 in Htif. + rewrite Heq5, Heq7 in Htif. + simpl in Htif. + rewrite Hb, Hc in Htif. + rewrite Typ.N_cast_refl in Htif. + unfold Bval in Htif. + rewrite !andb_true_iff in H5. + destruct H5. destruct H5. + + inversion Htif. + + generalize dependent v_valf. + rewrite <- H11. intros. + + unfold BITVECTOR_LIST._of_bits, RAWBITVECTOR_LIST._of_bits. + rewrite N.eqb_eq in Ha, Hd. + + generalize (BITVECTOR_LIST._of_bits_size la n). + + unfold BITVECTOR_LIST._of_bits, RAWBITVECTOR_LIST._of_bits. + + rewrite Hd. + + generalize (BITVECTOR_LIST._of_bits_size lb n). + unfold BITVECTOR_LIST._of_bits, RAWBITVECTOR_LIST._of_bits. + rewrite Ha. + intros. + + unfold Typ.i_eqb. simpl. + unfold BITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bv_eq. + simpl. + rewrite e, e0. + rewrite N.eqb_refl. + unfold RAWBITVECTOR_LIST.bits. + + apply diseq_neg_eq. easy. +Qed. + +Lemma prop_checkbb: forall (a: int) (bs: list _lit) (i n: nat), + (length bs = (n - i))%nat -> + (check_bb a bs i n = true) -> + (forall i0, (i <= i0 < n )%nat -> + Lit.interp rho (nth (i0 - i) bs 1) = + (@BITVECTOR_LIST.bitOf (N.of_nat n) i0 (interp_form_hatom_bv a (N.of_nat n)))). +Proof. intros a bs. + revert a. + induction bs as [ | b ys IHys]. + - intros. simpl in H. + cut (i = n). intro Hn. rewrite Hn in H1. + contradict H1. omega. omega. + - intros. simpl in H0. + case_eq (Lit.is_pos b). intros Heq0. rewrite Heq0 in H0. + case_eq (t_form .[ Lit.blit b] ). intros i1 Heq1. rewrite Heq1 in H0. + case_eq (t_atom .[ i1]). intros c Heq2. + rewrite Heq2 in H0; now contradict H0. + intros u i2 Heq2. + rewrite Heq2 in H0. + case_eq u; try (intro Heq'; rewrite Heq' in H0; now contradict H0). + + intros. rewrite H2 in H0. + case_eq ((a == i2) && Nat_eqb i n1 && Nat_eqb n (N.to_nat n0)). intros Hif. + rewrite Hif in H0. + do 2 rewrite andb_true_iff in Hif. destruct Hif as ((Hif0 & Hif1) & Hif2). + specialize (@IHys a (S i) n). + inversion H. + cut (Datatypes.length ys = (n - S i)%nat). intro HSi. + specialize (@IHys HSi H0). + + cut (((S i) <= i0 < n)%nat \/ i = i0). + intro Hd. destruct Hd as [Hd | Hd]. + inversion Hd. + induction i0 as [ | k IHk]. + now contradict H3. + specialize (@IHys (S k)). + cut ((S k - i)%nat = S (k - i)%nat). intro ISk. + rewrite ISk. + rewrite (@nth_eq1 (k - i) b ys). + cut ((S k - S i)%nat = (k - i)%nat). intro ISki. + specialize (@IHys Hd). + now rewrite ISki in IHys. + now simpl. omega. + rewrite Hd. + cut ((i0 - i0 = 0)%nat). intro Hi0. rewrite Hi0. + simpl. + + unfold Lit.interp. + rewrite Heq0. + unfold Var.interp. + rewrite rho_interp. + rewrite Heq1. + + rewrite Lit.eqb_spec in Hif0. + rewrite Hif0. rewrite <- Hd. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + assert (i1 < PArray.length t_atom). + { + apply PArray.get_not_default_lt. + rewrite Heq2. now rewrite def_t_atom. + } + + specialize (@H3 i1 H5). + rewrite Heq2 in H3. simpl in H3. + rewrite H2 in H3. simpl in H3. + rewrite !andb_true_iff in H3. + decompose [and] H3. clear H3. + simpl in H7. + + unfold get_type' in H6, H7. + unfold v_type in H6, H7. + case_eq (t_interp .[ i1]). + intros. rewrite H3 in H6. simpl in H6. + case_eq (v_type0); intros; try (rewrite H8 in H6; now contradict H6). + simpl. + + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_form_hatom. + unfold Atom.interp_hatom. + rewrite Atom.t_interp_wf; trivial. + rewrite Heq2. + simpl. + + rewrite H2. simpl. + cut (i = n1). intro Hin1. rewrite Hin1. + cut (n = (N.to_nat n0)). intro Hnn0. + rewrite Hnn0. + rewrite id''. + case_eq (t_interp .[ i2]). + + intros. rewrite H9 in H7. rewrite <- H9. + case_eq v_type1; intros; rewrite H10 in H7; try (now contradict H7). + cut (n2 = n0)%N. intros Hn2n0. rewrite Hn2n0 in H10. + + rewrite H9. simpl. + unfold interp_bool. + case_eq (Typ.cast v_type1 (Typ.TBV n0)). + (* split *) + split. rewrite H10. + simpl. + rewrite Typ.N_cast_refl. intros. + contradict H11. easy. + + apply Typ.eqb_spec in H7. inversion H7. easy. + + now apply Nat_eqb_eq in Hif2. + now apply Nat_eqb_eq in Hif1. + + omega. + destruct H1. + specialize (@le_le_S_eq i i0). intros H11. + specialize (@H11 H1). + destruct H11. left. split. exact H5. exact H3. + right. exact H5. + omega. + intro H3. rewrite H3 in H0. now contradict H0. + intros n0 Hn. rewrite Hn in H0. now contradict H0. + intros n0 Hn. rewrite Hn in H0. now contradict H0. + intros i3 n0 n1 Heq. rewrite Heq in H0. now contradict H0. + intros n0 i3 Heq. rewrite Heq in H0. now contradict H0. + intros n0 i3 Heq. rewrite Heq in H0. now contradict H0. + intros b0 i2 i3 Heq. rewrite Heq in H0. now contradict H0. + intros t i2 i3 i4 Heq. rewrite Heq in H0. now contradict H0. + intros n0 l Heq. rewrite Heq in H0. now contradict H0. + intros i2 l Heq. rewrite Heq in H0. now contradict H0. + intros Heq. rewrite Heq in H0. now contradict H0. + intros Heq. rewrite Heq in H0. now contradict H0. + intros i1 i2 Heq. rewrite Heq in H0. now contradict H0. + intros a0 Heq. rewrite Heq in H0. now contradict H0. + intros a0 Heq. rewrite Heq in H0. now contradict H0. + intros a0 Heq. rewrite Heq in H0. now contradict H0. + intros i1 i2 Heq. rewrite Heq in H0. now contradict H0. + intros i1 i2 Heq. rewrite Heq in H0. now contradict H0. + intros i1 i2 i3 Heq. rewrite Heq in H0. now contradict H0. + intros i1 l Heq. rewrite Heq in H0. now contradict H0. + intros Heq. rewrite Heq in H0. now contradict H0. +Qed. + +Lemma prop_checkbb': forall (a: int) (bs: list _lit), + (check_bb a bs 0 (length bs) = true) -> + (forall i0, (i0 < (length bs) )%nat -> + (Lit.interp rho (nth i0 bs 1)) = + (@BITVECTOR_LIST.bitOf (N.of_nat(length bs)) i0 + (interp_form_hatom_bv a (N.of_nat (length bs))))). +Proof. intros. + specialize (@prop_checkbb a bs 0 (length bs)). + intros Hp. + cut ((i0 - 0)%nat = i0%nat). + intro Hc. + cut (Datatypes.length bs = (Datatypes.length bs - 0)%nat). + intro Hc2. + specialize (@Hp Hc2 H i0). + cut ( (0 <= i0 < Datatypes.length bs)%nat). intro Hc3. + specialize (@Hp Hc3). + now rewrite Hc in Hp. + omega. omega. omega. +Qed. + + +Lemma eq_rec: forall (n: N) (a b: BITVECTOR_LIST.bitvector n), BITVECTOR_LIST.bv a = BITVECTOR_LIST.bv b + -> + a = b. +Proof. intros. destruct a, b. + unfold BITVECTOR_LIST.bv in H. + revert wf0. + rewrite H. intros. + now rewrite (proof_irrelevance wf0 wf1). +Qed. + +Lemma nth_eq0: forall i a b xs ys, +nth (S i) (a :: xs) false = nth (S i) (b :: ys) false -> nth i xs false = nth i ys false. +Proof. intros. + now simpl in H. +Qed. + +Lemma nth_eq: forall (a b: list bool), (length a) = (length b) -> + (forall (i: nat), + (i < length a)%nat -> + nth i a false = nth i b false) -> a = b. +Proof. intros a. + induction a as [ | a xs IHxs]. + - intros. simpl in *. symmetry in H. + now rewrite empty_list_length in H. + - intros [ | b ys] H0. + + simpl in *. now contradict H0. + + specialize (@IHxs ys). + inversion H0. specialize (@IHxs H1). + intros. + pose proof (@H 0%nat). simpl in H2. + cut ((0 < S (Datatypes.length xs))%nat). intro HS. + specialize (@H2 HS). rewrite H2; apply f_equal. + apply IHxs. intros. apply (@nth_eq0 i a b xs ys). + apply H. simpl. omega. omega. +Qed. + +Lemma is_even_0: is_even 0 = true. +Proof. apply refl_equal. Qed. + +Lemma rho_1: Lit.interp rho 1 = false. +Proof. unfold Lit.interp. + unfold Lit.is_pos. + simpl. + cut (is_even 1 = false). intro Hev. rewrite Hev. + unfold Var.interp. + destruct wf_rho. unfold Lit.blit. + cut (1 >> 1 = 0). intros Heq0. rewrite Heq0. + unfold negb. now rewrite H. + easy. easy. +Qed. + +Lemma rho_false: Lit.interp rho false = true. +Proof. unfold Lit.interp. + unfold Lit.is_pos. + simpl. + cut (is_even 0 = true). intro Hev. rewrite Hev. + unfold Var.interp. + destruct wf_rho. simpl. unfold Lit.blit. + cut (0 >> 1 = 0). intros Heq0. rewrite Heq0. exact H. + now rewrite lsr_0_l. + apply is_even_0. +Qed. + +Lemma bitOf_of_bits: forall l (a: BITVECTOR_LIST.bitvector (N.of_nat (length l))), + (forall i, + (i < (length l))%nat -> + nth i l false = + (@BITVECTOR_LIST.bitOf (N.of_nat (length l)) i a)) + -> + (BITVECTOR_LIST.bv_eq a (BITVECTOR_LIST.of_bits l)). +Proof. intros l a H. + unfold BITVECTOR_LIST.of_bits in *. + unfold BITVECTOR_LIST.bitOf in *. + unfold BITVECTOR_LIST.bv_eq, BITVECTOR_LIST.bv in *. + unfold RAWBITVECTOR_LIST.bitOf in *. + destruct a. + unfold RAWBITVECTOR_LIST.of_bits. + unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits in *. + rewrite wf0. + rewrite N.eqb_compare. + rewrite N.compare_refl. + cut (Datatypes.length l = Datatypes.length bv). intro wf1. + + apply (@nth_eq l bv wf1) in H. + + rewrite H. + unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits in *. + rewrite RAWBITVECTOR_LIST.List_eq_refl; auto. + apply inj_iff in wf0. now do 2 rewrite id' in wf0. + +Qed. + +Lemma valid_check_bbVar lres : C.valid rho (check_bbVar lres). +Proof. + unfold check_bbVar. + case_eq (Lit.is_pos lres); intro Heq1; [ |now apply C.interp_true]. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bs Heq0. + case_eq (check_bb a bs 0 (Datatypes.length bs)); intro Heq2; [ |now apply C.interp_true]. + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq1. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq0. simpl. + apply bitOf_of_bits. intros. + cut (Lit.interp rho 1 = false). intro Hr. rewrite <- Hr. + rewrite map_nth. + remember (@prop_checkbb' a bs Heq2 i). + rewrite map_length in H. + rewrite map_length. + clear Heqe. + now apply e in H. + now apply rho_1. +Qed. + +Lemma check_bbc_length : forall bv bs, check_bbc bv bs = true -> length bv = length bs. +Proof. + intro bv. induction bv. + intro bs. case bs. + simpl; trivial. + simpl; easy. + intro bs. case bs in *. + simpl; easy. + simpl. + case (Lit.is_pos i); try easy. + case (t_form .[ Lit.blit i]); try easy; + case a; try easy; intro Hc; apply IHbv in Hc; now rewrite Hc. +Qed. + +Lemma nth_nil : forall A i (d:A), nth i [] d = d. +Proof. + intros. unfold nth. case i; trivial. +Qed. + +Lemma prop_check_bbc: forall bv bs, + (check_bbc bv bs = true) -> + (forall i, (i < (length bs) )%nat -> + (Lit.interp rho (nth i bs 1)) = nth i bv false). +Proof. + intro bv. induction bv. + intros bs. case bs. + intros. + do 2 rewrite nth_nil. easy. + simpl. easy. + intros bs. + case bs. simpl. easy. + intros b l Hc i Hlen. + case i in *. + simpl. + simpl in Hc. + case_eq (Lit.is_pos b). + intro Hposb. + rewrite Hposb in Hc. + case_eq (t_form .[ Lit.blit b]); try (intros; rewrite H in Hc; now contradict Hc). + intros Hb. + rewrite Hb in Hc. + generalize (rho_interp (Lit.blit b)). rewrite Hb. simpl. + intro Hbb. + unfold Lit.interp, Var.interp. + rewrite Hbb, Hposb. + case a in *. + trivial. now contradict Hc. + intro Hb. + rewrite Hb in Hc. + generalize (rho_interp (Lit.blit b)). rewrite Hb. simpl. + intro Hbb. + unfold Lit.interp, Var.interp. + rewrite Hbb, Hposb. + case a in *. + now contradict Hc. trivial. + intro Hposb. rewrite Hposb in Hc. now contradict Hc. + simpl. + apply IHbv. + simpl in Hc. + case (Lit.is_pos b) in Hc; try now contradict Hc. + case (t_form .[ Lit.blit b]) in Hc; try now contradict Hc. + case a in Hc; try now contradict Hc. exact Hc. + case a in Hc; try now contradict Hc. exact Hc. + simpl in Hlen. omega. +Qed. + +Lemma prop_check_bbc2: forall l bs, check_bbc l bs = true -> +RAWBITVECTOR_LIST.beq_list l (map (Lit.interp rho) bs) = true. +Proof. intro l. + induction l as [ | xl xsl IHl ]. + - intros. simpl in *. + case bs in *. now simpl. now contradict H. + - intros. simpl in H. + case bs in *. now contradict H. + simpl. + case_eq (Lit.is_pos i); intros. + rewrite H0 in H. + case_eq (t_form .[ Lit.blit i]); intros; try (rewrite H1 in H; now contradict H). + rewrite H1 in H. + case xl in *. + rewrite andb_true_iff. split. + unfold Lit.interp. rewrite H0. + unfold Var.interp. + specialize (rho_interp (Lit.blit i)). + rewrite H1 in rho_interp. simpl in rho_interp. + rewrite rho_interp. easy. + apply IHl; easy. + now contradict H. + rewrite H1 in H. + case xl in *. now contradict H. + rewrite andb_true_iff. + split. + specialize (rho_interp (Lit.blit i)). + rewrite H1 in rho_interp. simpl in rho_interp. + unfold Lit.interp. rewrite H0. + unfold Var.interp. + rewrite rho_interp. easy. + apply IHl; easy. + rewrite H0 in H. now contradict H. +Qed. + +Lemma valid_check_bbConst lres : C.valid rho (check_bbConst lres). +Proof. + unfold check_bbConst. + case_eq (Lit.is_pos lres); intro Heq1; [ |now apply C.interp_true]. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bs Heq0. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros c Ha. + case_eq c; try (intros; now apply C.interp_true). + intros l N Hc. + case_eq (check_bbc l bs && + (N.of_nat (Datatypes.length l) =? N)%N); + try (intros; now apply C.interp_true). + intro Hcheck. + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq1. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq0. simpl. + + assert (Hinterpa: + (interp_form_hatom_bv a = interp_bv t_i (interp_atom (t_atom .[a])))). + { + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + } + rewrite Hinterpa. + rewrite Ha, Hc. simpl. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert ((N.of_nat (Datatypes.length (map (Lit.interp rho) bs))) = N). + { + rewrite andb_true_iff in Hcheck. + destruct Hcheck as (Hcheck1 & Hcheck2). + apply check_bbc_length in Hcheck1. + rewrite N.eqb_eq in Hcheck2. + rewrite Hcheck1 in Hcheck2. + now rewrite map_length. + } + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs) + ). + + rewrite H. + intros. + + rewrite Typ.N_cast_refl. + + unfold BITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bv_eq. + simpl. + unfold RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST._of_bits. + + rewrite andb_true_iff in Hcheck. + destruct Hcheck as (Hcheck1 & Hcheck2). + pose proof Hcheck1. + apply check_bbc_length in Hcheck1. + rewrite N.eqb_eq in Hcheck2. + rewrite Hcheck2. + rewrite N.eqb_refl. + rewrite Hcheck1, map_length, N.eqb_refl. + unfold RAWBITVECTOR_LIST.bits. + + now apply prop_check_bbc2. +Qed. + +Lemma prop_check_not: + forall bs br, length bs = length br -> + check_not bs br = true -> + map (Lit.interp rho) br = map (fun l => negb (Lit.interp rho l)) bs. +Proof. + intro bs; induction bs; intros br Hlen Hcheck. + - simpl in Hlen. symmetry in Hlen. apply empty_list_length in Hlen. rewrite Hlen; now simpl. + - case br in *. + + simpl in Hcheck; now contradict Hcheck. + + simpl in Hlen. inversion Hlen as [Hlen']. + simpl in Hcheck. rewrite andb_true_iff in Hcheck; destruct Hcheck as (Hcheck1, Hcheck2). + apply Int63Properties.eqb_spec in Hcheck1; rewrite Hcheck1. + simpl. rewrite Lit.interp_neg. apply f_equal. + apply IHbs; auto. +Qed. + +Lemma check_not_length: + forall bs br, check_not bs br = true -> length bs = length br. +Proof. + intro bs; induction bs; intros br Hcheck. + - case br in *. + + auto. + + simpl in Hcheck; now contradict Hcheck. + - case br in *. + + simpl in Hcheck; now contradict Hcheck. + + simpl in *. + rewrite andb_true_iff in Hcheck. + destruct Hcheck as (_, Hcheck'). + apply IHbs in Hcheck'; auto. +Qed. + +Lemma valid_check_bbNot pos lres : C.valid rho (check_bbNot pos lres). +Proof. + unfold check_bbNot. + case_eq (S.get s pos); [ (intros; now apply C.interp_true) | ]. + intros l ls Hpos. + case_eq ls; [ | (intros; now apply C.interp_true) ]. + intro Hnil. + case_eq (Lit.is_pos l && Lit.is_pos lres); [ | (intros; now apply C.interp_true) ]. + intro Hpos'. + case_eq (t_form .[ Lit.blit l]); try (intros; now apply C.interp_true). + intros a bs HBl. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros r br HBr. + case_eq (t_atom .[ r]); try (intros; now apply C.interp_true). + intros u a'. + case_eq u; try (intros; now apply C.interp_true). + intros n Huot Hr. + case_eq ((a == a') + && check_not bs br + && (N.of_nat (Datatypes.length bs) =? n)%N); + try (intros; now apply C.interp_true). + intro Hc. + rewrite !andb_true_iff in Hc. + destruct Hc as ((Ha, Hcheck), Hlen). + rewrite N.eqb_eq in Hlen. + apply Int63Properties.eqb_spec in Ha. + generalize (Hs pos). + rewrite Hpos, Hnil. + unfold C.valid, C.interp; simpl; rewrite !orb_false_r. + unfold Lit.interp, Var.interp. + rewrite andb_true_iff in Hpos'. + destruct Hpos' as (Hposl, Hposlres). + rewrite Hposl, Hposlres. + rewrite !rho_interp. rewrite HBl, HBr. simpl. + + intro Heqa. + apply BITVECTOR_LIST.bv_eq_reflect in Heqa. + apply BITVECTOR_LIST.bv_eq_reflect. + + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H r). + assert (r < PArray.length t_atom). + { + apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Hr. easy. + } + + specialize (@H0 H1). rewrite Hr in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ r]). + intros v_typer v_valr Htir. rewrite Htir in H0. + case_eq (v_typer); intros; rewrite H3 in H0; try (now contradict H1). + rename H3 into Hv. + + (* interp_form_hatom_bv r = + interp_bv t_i (interp_atom (t_atom .[r])) *) + assert (interp_form_hatom_bv r = + interp_bv t_i (interp_atom (t_atom .[r]))). + { + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + } + + rewrite H3, Hr. simpl. + unfold interp_bv. + apply Typ.eqb_spec in H2. + unfold get_type' in H2. + unfold v_type in H2. + case_eq (t_interp .[ a']). + intros. rewrite H4 in H2. simpl. + + revert v_val0 H4. + rewrite H2. intros. + rewrite Typ.cast_refl. + simpl. + + assert ( (N.of_nat (Datatypes.length (map (Lit.interp rho) br))) = n). + { + apply check_not_length in Hcheck. rewrite Hcheck in Hlen. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) br) + ). + + rewrite H5. + intros. + rewrite Typ.N_cast_refl. + unfold BITVECTOR_LIST.bv_not, RAWBITVECTOR_LIST.bv_not. + + apply eq_rec. + simpl. + + rewrite <- Ha in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + } + + rewrite H6 in Heqa. + unfold interp_bv in Heqa. + rewrite <- !Atom.t_interp_wf in Heqa; trivial. + rewrite H4 in Heqa. + revert Heqa . + + assert ( (N.of_nat (Datatypes.length (map (Lit.interp rho) bs))) = n). + { + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs) + ). + + rewrite H7. + rewrite Typ.cast_refl. intros. + rewrite Heqa. simpl. + + specialize (@prop_check_not bs br). intros. + symmetry. + unfold RAWBITVECTOR_LIST.bits. + rewrite map_map; apply H8; auto. + + now apply check_not_length in Hcheck. + +Qed. + +Lemma eq_head: forall {A: Type} a b (l: list A), (a :: l) = (b :: l) <-> a = b. +Proof. intros A a b l; split; [intros H; inversion H|intros ->]; auto. Qed. + +Axiom afold_left_and : forall a, + afold_left bool int true andb (Lit.interp rho) a = List.forallb (Lit.interp rho) (to_list a). + + Axiom afold_left_or : forall a, + afold_left bool int false orb (Lit.interp rho) a = + C.interp rho (to_list a). + + Axiom afold_left_xor : forall a, + afold_left bool int false xorb (Lit.interp rho) a = + C.interp rho (to_list a). + +Lemma eqb_spec : forall x y, (x == y) = true <-> x = y. +Proof. + split;auto using eqb_correct, eqb_complete. +Qed. + +Lemma to_list_two: forall {A:Type} (a: PArray.array A), + PArray.length a = 2 -> (to_list a) = a .[0] :: a .[1] :: nil. +Proof. intros A a H. + rewrite to_list_to_list_ntr. unfold to_list_ntr. + rewrite H. + cut (0 == 2 = false). intro H1. + rewrite H1. + unfold foldi_ntr. rewrite foldi_cont_lt; auto. + auto. +Qed. + +Lemma check_symopp_and: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres N, + check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_BVand N) = true -> + check_symopp xbs1 ybs2 zbsres (BO_BVand (N-1)) = true. +Proof. intros. + induction N. simpl. + simpl in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case (PArray.length a == 2) in H. + case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2) + || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H. + exact H. + now contradict H. + now contradict H. + now contradict H. + unfold check_symopp in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case (PArray.length a == 2) in H. + case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2) + || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H. + apply H. + now contradict H. + now contradict H. + now contradict H. +Qed. + +Lemma check_symopp_or: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres N, + check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_BVor N) = true -> + check_symopp xbs1 ybs2 zbsres (BO_BVor (N-1)) = true. +Proof. intros. + induction N. simpl. + simpl in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case (PArray.length a == 2) in H. + case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2) + || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H. + exact H. + now contradict H. + now contradict H. + now contradict H. + unfold check_symopp in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case (PArray.length a == 2) in H. + case ((a .[ 0] == ibs1) && (a .[ 1] == ibs2) + || (a .[ 0] == ibs2) && (a .[ 1] == ibs1)) in H. + apply H. + now contradict H. + now contradict H. + now contradict H. +Qed. + +Lemma check_symopp_xor: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres N, + check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_BVxor N) = true -> + check_symopp xbs1 ybs2 zbsres (BO_BVxor (N-1)) = true. +Proof. intros. + induction N. simpl. + simpl in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)) in H. + exact H. + now contradict H. + now contradict H. + unfold check_symopp in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)) in H. + apply H. + now contradict H. + now contradict H. +Qed. + +Lemma check_symopp_bvand: forall bs1 bs2 bsres N, + let n := length bsres in + (length bs1 = n)%nat -> + (length bs2 = n)%nat -> + check_symopp bs1 bs2 bsres (BO_BVand N) = true -> + (List.map (Lit.interp rho) bsres) = + (RAWBITVECTOR_LIST.map2 andb (List.map (Lit.interp rho) bs1) (List.map (Lit.interp rho) bs2)). +Proof. intro bs1. + induction bs1 as [ | ibs1 xbs1 IHbs1]. + - intros. simpl in *. rewrite <- H0 in H. + rewrite <- H in H0. unfold n in H0. + symmetry in H0. + rewrite empty_list_length in H0. + unfold map. now rewrite H0. + - intros [ | ibs2 ybs2]. + + intros. + simpl in *. now contradict H1. + + intros [ | ibsres zbsres ]. + * intros. simpl in *. now contradict H. + * intros. simpl. + specialize (IHbs1 ybs2 zbsres (N-1)%N). + rewrite IHbs1. rewrite eq_head. + unfold Lit.interp, Var.interp. + case_eq (Lit.is_pos ibsres); intro Heq0. + case_eq (Lit.is_pos ibs1); intro Heq1. + case_eq (Lit.is_pos ibs2); intro Heq2. + rewrite wf_interp_form; trivial. + simpl in H1. + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H2 in H1. simpl. + rewrite afold_left_and. + + case_eq (PArray.length a == 2). intros. rewrite H3 in H1. + rewrite eqb_spec in H3. + apply to_list_two in H3. + (* apply length_to_list in H4. *) + unfold forallb. + rewrite H3. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite andb_true_r. + intros. rewrite H4 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). + intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. + rewrite H5, H6. rewrite andb_true_r. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite andb_comm. + intros. rewrite H5 in H1. now contradict H1. + intros. rewrite H3 in H1. now contradict H1. + + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H2 in H1. simpl. + rewrite afold_left_and. + + case_eq (PArray.length a == 2). intros. rewrite H3 in H1. + rewrite eqb_spec in H3. + apply to_list_two in H3. + unfold forallb. + rewrite H3. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite andb_true_r. + intros H4. rewrite H4 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. rewrite andb_true_r. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite andb_comm. + intros. rewrite H5 in H1. now contradict H1. + intros. rewrite H3 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + case_eq (Lit.is_pos ibs2). + intro Heq2. + + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H2 in H1. simpl. + rewrite afold_left_and. + + case_eq (PArray.length a == 2). intros. rewrite H3 in H1. + rewrite eqb_spec in H3. + apply to_list_two in H3. + unfold forallb. + rewrite H3. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite andb_true_r. + intros. rewrite H4 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. rewrite andb_true_r. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite andb_comm. + intros. rewrite H5 in H1. now contradict H1. + intros. rewrite H3 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + intros. + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H3 in H1. simpl. + rewrite afold_left_and. + + case_eq (PArray.length a == 2). intros H5. + rewrite H5 in H1. + rewrite eqb_spec in H5. + apply to_list_two in H5. + unfold forallb. + rewrite H5. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H6. + rewrite andb_true_iff in H6. destruct H6 as (H6 & H7). + rewrite eqb_spec in H6, H7. rewrite H6, H7. + unfold Lit.interp. + rewrite Heq1, H2. + unfold Var.interp. now rewrite andb_true_r. + intros H6. rewrite H6 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H7. + rewrite andb_true_iff in H7. destruct H7 as (H7 & H8). + rewrite eqb_spec in H7, H8. + rewrite H7, H8. rewrite andb_true_r. + unfold Lit.interp. + rewrite Heq1, H2. + unfold Var.interp. now rewrite andb_comm. + intros. rewrite H4 in H1. now contradict H1. + intros. rewrite H4 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + rewrite wf_interp_form; trivial. simpl in H1. + rewrite Heq0 in H1. now contradict H1. + now inversion H. + now inversion H0. + apply (@check_symopp_and ibs1 ibs2 xbs1 ybs2 ibsres zbsres N). + exact H1. +Qed. + + +Lemma check_symopp_bvor: forall bs1 bs2 bsres N, + let n := length bsres in + (length bs1 = n)%nat -> + (length bs2 = n)%nat -> + check_symopp bs1 bs2 bsres (BO_BVor N) = true -> + (List.map (Lit.interp rho) bsres) = + (RAWBITVECTOR_LIST.map2 orb (List.map (Lit.interp rho) bs1) (List.map (Lit.interp rho) bs2)). +Proof. intro bs1. + induction bs1 as [ | ibs1 xbs1 IHbs1]. + - intros. simpl in *. rewrite <- H0 in H. + rewrite <- H in H0. unfold n in H0. + symmetry in H0. + rewrite empty_list_length in H0. + unfold map. now rewrite H0. + - intros [ | ibs2 ybs2]. + + intros. + simpl in *. now contradict H1. + + intros [ | ibsres zbsres ]. + * intros. simpl in *. now contradict H. + * intros. simpl. + specialize (IHbs1 ybs2 zbsres (N-1)%N). + rewrite IHbs1. rewrite eq_head. + unfold Lit.interp, Var.interp. + case_eq (Lit.is_pos ibsres); intro Heq0. + case_eq (Lit.is_pos ibs1); intro Heq1. + case_eq (Lit.is_pos ibs2); intro Heq2. + rewrite wf_interp_form; trivial. + simpl in H1. + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + + intros. rewrite H2 in H1. simpl. + rewrite afold_left_or. + + case_eq (PArray.length a == 2). intros. rewrite H3 in H1. + rewrite eqb_spec in H3. + apply to_list_two in H3. + unfold forallb. + rewrite H3. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold C.interp. unfold existsb. rewrite orb_false_r. + + unfold Lit.interp. + rewrite Heq1, Heq2. + now unfold Var.interp. + + intros. rewrite H4 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). + intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. + rewrite H5, H6. rewrite orb_false_r. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite orb_comm. + intros. rewrite H5 in H1. now contradict H1. + intros. rewrite H3 in H1. now contradict H1. + + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H2 in H1. simpl. + rewrite afold_left_or. + + case_eq (PArray.length a == 2). intros. rewrite H3 in H1. + rewrite eqb_spec in H3. + apply to_list_two in H3. + unfold C.interp. + unfold existsb. + + rewrite H3. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite orb_false_r. + intros H4. rewrite H4 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. rewrite orb_false_r. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite orb_comm. + intros. rewrite H5, Heq0 in H1. now contradict H1. + intros. rewrite H3, Heq0 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + case_eq (Lit.is_pos ibs2). + intro Heq2. + + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H2 in H1. simpl. + rewrite afold_left_or. + + case_eq (PArray.length a == 2). intros. rewrite H3 in H1. + rewrite eqb_spec in H3. + apply to_list_two in H3. + unfold forallb. + rewrite H3. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold C.interp, existsb. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite orb_false_r. + intros. rewrite H4 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. rewrite orb_false_r. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite orb_comm. + intros. rewrite Heq0, H5 in H1. now contradict H1. + intros. rewrite Heq0, H3 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + intros. + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H3 in H1. simpl. + rewrite afold_left_or. + + case_eq (PArray.length a == 2). intros H5. + rewrite H5 in H1. + rewrite eqb_spec in H5. + apply to_list_two in H5. + unfold forallb. + rewrite H5. + case_eq ((a .[ 0] == ibs1) && (a .[ 1] == ibs2)). intros H6. + rewrite andb_true_iff in H6. destruct H6 as (H6 & H7). + rewrite eqb_spec in H6, H7. rewrite H6, H7. + unfold C.interp, Lit.interp, existsb. + rewrite Heq1, H2. + unfold Var.interp. now rewrite orb_false_r. + intros H6. rewrite H6 in H1. simpl in *. + case_eq ((a .[ 0] == ibs2) && (a .[ 1] == ibs1)). intros H7. + rewrite andb_true_iff in H7. destruct H7 as (H7 & H8). + rewrite eqb_spec in H7, H8. + rewrite H7, H8. rewrite orb_false_r. + unfold Lit.interp. + rewrite Heq1, H2. + unfold Var.interp. now rewrite orb_comm. + intros. rewrite Heq0, H4 in H1. now contradict H1. + intros. rewrite Heq0, H4 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + rewrite wf_interp_form; trivial. simpl in H1. + rewrite Heq0 in H1. now contradict H1. + now inversion H. + now inversion H0. + apply (@check_symopp_or ibs1 ibs2 xbs1 ybs2 ibsres zbsres N). + exact H1. +Qed. + + +Lemma check_symopp_bvxor: forall bs1 bs2 bsres N, + let n := length bsres in + (length bs1 = n)%nat -> + (length bs2 = n)%nat -> + check_symopp bs1 bs2 bsres (BO_BVxor N) = true -> + (List.map (Lit.interp rho) bsres) = + (RAWBITVECTOR_LIST.map2 xorb (List.map (Lit.interp rho) bs1) (List.map (Lit.interp rho) bs2)). +Proof. intro bs1. + induction bs1 as [ | ibs1 xbs1 IHbs1]. + - intros. simpl in *. rewrite <- H0 in H. + rewrite <- H in H0. unfold n in H0. + symmetry in H0. + rewrite empty_list_length in H0. + unfold map. now rewrite H0. + - intros [ | ibs2 ybs2]. + + intros. + simpl in *. now contradict H1. + + intros [ | ibsres zbsres ]. + * intros. simpl in *. now contradict H. + * intros. simpl. + specialize (IHbs1 ybs2 zbsres (N-1)%N). + rewrite IHbs1. rewrite eq_head. + unfold Lit.interp, Var.interp. + case_eq (Lit.is_pos ibsres); intro Heq0. + case_eq (Lit.is_pos ibs1); intro Heq1. + case_eq (Lit.is_pos ibs2); intro Heq2. + rewrite wf_interp_form; trivial. + simpl in H1. + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + intros. rewrite H2 in H1. simpl. + case_eq ((i == ibs1) && (i0 == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + + unfold Lit.interp. + rewrite Heq1, Heq2. + now unfold Var.interp. + + intros H4. rewrite H4 in H1. simpl in *. + case_eq ((i == ibs2) && (i0 == ibs1)). + intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. + rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite xorb_comm. + intros. rewrite H3 in H1. now contradict H1. + + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + + intros. rewrite H2 in H1. simpl. + case_eq ((i == ibs1) && (i0 == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + now unfold Var.interp. + intros H4. rewrite Heq0, H4 in H1. simpl in *. + case_eq ((i == ibs2) && (i0 == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite xorb_comm. + intros. rewrite H3 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + case_eq (Lit.is_pos ibs2). + intro Heq2. + + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + + intros. rewrite H2 in H1. simpl. + + case_eq ((i == ibs1) && (i0 == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + now unfold Var.interp. + intros H4. rewrite Heq0, H4 in H1. simpl in *. + case_eq ((i == ibs2) && (i0 == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite xorb_comm. + intros. rewrite H3 in H1. now contradict H1. + + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + intro Heq2. + rewrite wf_interp_form; trivial. simpl in H1. + case_eq (t_form .[ Lit.blit ibsres]). + rewrite Heq0 in H1. + case_eq (t_form .[ Lit.blit ibsres]). + try (intros i Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros Heq; rewrite Heq in H1; now contradict H1). + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + try (intros a Heq; rewrite Heq in H1; now contradict H1). + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + intros. contradict H3. discriminate. + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros a Heq; rewrite Heq in H1; now contradict H1). + + intros. rewrite H2 in H1. simpl. + case_eq ((i == ibs1) && (i0 == ibs2)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H5 & H6). + rewrite eqb_spec in H5, H6. rewrite H5, H6. + unfold Lit.interp. + rewrite Heq1, Heq2. + now unfold Var.interp. + intros H4. rewrite Heq0, H4 in H1. simpl in *. + case_eq ((i == ibs2) && (i0 == ibs1)). intros H5. + rewrite andb_true_iff in H5. destruct H5 as (H6 & H7). + rewrite eqb_spec in H6, H7. + rewrite H6, H7. + unfold Lit.interp. + rewrite Heq1, Heq2. + unfold Var.interp. now rewrite xorb_comm. + intros. rewrite H3 in H1. now contradict H1. + rewrite Heq0 in H1. + try (intros i i0 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i i0 i1 Heq; rewrite Heq in H1; now contradict H1). + rewrite Heq0 in H1. + try (intros i l Heq; rewrite Heq in H1; now contradict H1). + + rewrite wf_interp_form; trivial. simpl in H1. + rewrite Heq0 in H1. now contradict H1. + now inversion H. + now inversion H0. + apply (@check_symopp_xor ibs1 ibs2 xbs1 ybs2 ibsres zbsres N). + exact H1. +Qed. + +Lemma check_symopp_bvand_length: forall bs1 bs2 bsres N, + let n := length bsres in + check_symopp bs1 bs2 bsres (BO_BVand N) = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 N H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case (PArray.length a == 2) in H; try easy. + case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy. + specialize (IHrbsres bs1 bs2 (N - 1)%N H). + simpl. + simpl in n. + fold n' in n. + unfold n. + split; apply f_equal. easy. easy. + easy. +Qed. + + +Lemma check_symopp_bvand_length2: forall bs1 bs2 bsres N, + let n := length bsres in + check_symopp bs1 bs2 bsres (BO_BVand N) = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 N H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case (PArray.length a == 2) in H; try easy. + case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy. + specialize (IHrbsres bs1 bs2 (N - 1)%N H). + simpl. + simpl in n. + fold n' in n. + unfold n. + split; apply f_equal. easy. easy. + easy. +Qed. + +Lemma check_symopp_bvand_length3: forall bs1 bs2 bsres n, + check_symopp bs1 bs2 bsres (BO_BVand (N.of_nat n)) = true -> + (length bs1 = n)%nat -> + (length bsres = n)%nat. +Proof. intros bs1 bs2 bsres. + revert bs1 bs2. + induction bsres as [ | xbsres xsbsres IHbsres ]. + - intros. + case bs1 in *. + simpl in H. + case bs2 in *. + easy. now contradict H. + case bs2 in *. + simpl in H. now contradict H. + simpl in H. now contradict H. + - intros. + case bs1 in *. + simpl in H. + case bs2 in *. + now contradict H. + now contradict H. + simpl in H. + case bs2 in *. + now contradict H. + case (Lit.is_pos xbsres) in *. + case (t_form .[ Lit.blit xbsres] ) in *; try now contradict H. + case (PArray.length a == 2) in *. + case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in *. + specialize (IHbsres bs1 bs2 (n-1)%nat). + simpl in H0. + assert (length bs1 = (n-1)%nat). + { omega. } + + cut ( (BO_BVand (N.of_nat n - 1)) = (BO_BVand (N.of_nat (n - 1)))). + + intros. + revert H. + rewrite H2. + intros. + specialize (IHbsres H H1). + simpl. rewrite IHbsres. omega. + + simpl. + cut ((N.of_nat n - 1)%N = (N.of_nat (n - 1))). + intros. now rewrite H2. + + case n. now simpl. + intros. lia. + now contradict H. + now contradict H. + now contradict H. +Qed. + +Lemma check_symopp_bvor_length: forall bs1 bs2 bsres N, + let n := length bsres in + check_symopp bs1 bs2 bsres (BO_BVor N) = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 N H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case (PArray.length a == 2) in H; try easy. + case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy. + specialize (IHrbsres bs1 bs2 (N - 1)%N H). + simpl. + simpl in n. + fold n' in n. + unfold n. + split; apply f_equal. easy. easy. + easy. +Qed. + +Lemma check_symopp_bvor_length2: forall bs1 bs2 bsres N, + let n := length bsres in + check_symopp bs1 bs2 bsres (BO_BVor N) = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 N H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case (PArray.length a == 2) in H; try easy. + case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in H; try easy. + specialize (IHrbsres bs1 bs2 (N - 1)%N H). + simpl. + simpl in n. + fold n' in n. + unfold n. + split; apply f_equal. easy. easy. + easy. +Qed. + +Lemma check_symopp_bvor_length3: forall bs1 bs2 bsres n, + check_symopp bs1 bs2 bsres (BO_BVor (N.of_nat n)) = true -> + (length bs1 = n)%nat -> + (length bsres = n)%nat. +Proof. intros bs1 bs2 bsres. + revert bs1 bs2. + induction bsres as [ | xbsres xsbsres IHbsres ]. + - intros. + case bs1 in *. + simpl in H. + case bs2 in *. + easy. now contradict H. + case bs2 in *. + simpl in H. now contradict H. + simpl in H. now contradict H. + - intros. + case bs1 in *. + simpl in H. + case bs2 in *. + now contradict H. + now contradict H. + simpl in H. + case bs2 in *. + now contradict H. + case (Lit.is_pos xbsres) in *. + case (t_form .[ Lit.blit xbsres] ) in *; try now contradict H. + case (PArray.length a == 2) in *. + case ((a .[ 0] == i) && (a .[ 1] == i0) || (a .[ 0] == i0) && (a .[ 1] == i)) in *. + specialize (IHbsres bs1 bs2 (n-1)%nat). + simpl in H0. + assert (length bs1 = (n-1)%nat). + { omega. } + + cut ( (BO_BVor (N.of_nat n - 1)) = (BO_BVor (N.of_nat (n - 1)))). + + intros. + revert H. + rewrite H2. + intros. + specialize (IHbsres H H1). + simpl. rewrite IHbsres. omega. + + simpl. + cut ((N.of_nat n - 1)%N = (N.of_nat (n - 1))). + intros. now rewrite H2. + + case n. now simpl. + intros. lia. + now contradict H. + now contradict H. + now contradict H. +Qed. + +Lemma check_symopp_bvxor_length: forall bs1 bs2 bsres N, + let n := length bsres in + check_symopp bs1 bs2 bsres (BO_BVxor N) = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 N H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case ((i1 == i) && (i2 == i0) || (i1 == i0) && (i2 == i)) in H; try easy. + specialize (IHrbsres bs1 bs2 (N - 1)%N H). + simpl. + simpl in n. + fold n' in n. + unfold n. + split; apply f_equal. easy. easy. + easy. +Qed. + + +Lemma check_symopp_bvxor_length2: forall bs1 bs2 bsres N, + let n := length bsres in + check_symopp bs1 bs2 bsres (BO_BVxor N) = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 N H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case ((i1 == i) && (i2 == i0) || (i1 == i0) && (i2 == i)) in H; try easy. + specialize (IHrbsres bs1 bs2 (N - 1)%N H). + simpl. + simpl in n. + fold n' in n. + unfold n. + split; apply f_equal. easy. easy. + easy. +Qed. + +Lemma check_symopp_bvxor_length3: forall bs1 bs2 bsres n, + check_symopp bs1 bs2 bsres (BO_BVxor (N.of_nat n)) = true -> + (length bs1 = n)%nat -> + (length bsres = n)%nat. +Proof. intros bs1 bs2 bsres. + revert bs1 bs2. + induction bsres as [ | xbsres xsbsres IHbsres ]. + - intros. + case bs1 in *. + simpl in H. + case bs2 in *. + easy. now contradict H. + case bs2 in *. + simpl in H. now contradict H. + simpl in H. now contradict H. + - intros. + case bs1 in *. + simpl in H. + case bs2 in *. + now contradict H. + now contradict H. + simpl in H. + case bs2 in *. + now contradict H. + case (Lit.is_pos xbsres) in *. + case (t_form .[ Lit.blit xbsres] ) in *; try now contradict H. + case ((i1 == i) && (i2 == i0) || (i1 == i0) && (i2 == i)) in *. + specialize (IHbsres bs1 bs2 (n-1)%nat). + simpl in H0. + assert (length bs1 = (n-1)%nat). + { omega. } + + cut ( (BO_BVxor (N.of_nat n - 1)) = (BO_BVxor (N.of_nat (n - 1)))). + + intros. + revert H. + rewrite H2. + intros. + specialize (IHbsres H H1). + simpl. rewrite IHbsres. omega. + + simpl. + cut ((N.of_nat n - 1)%N = (N.of_nat (n - 1))). + intros. now rewrite H2. + + case n. now simpl. + intros. lia. + now contradict H. + now contradict H. +Qed. + +Lemma check_symopp_bvand_nl: forall bs1 bs2 bsres N, + check_symopp bs1 bs2 bsres (BO_BVand N) = true -> + (List.map (Lit.interp rho) bsres) = + (RAWBITVECTOR_LIST.map2 andb (List.map (Lit.interp rho) bs1) + (List.map (Lit.interp rho) bs2)). +Proof. + intros. + pose proof H. + apply check_symopp_bvand_length in H. + destruct H. + apply check_symopp_bvand in H0. easy. easy. easy. +Qed. + +Lemma check_symopp_bvor_nl: forall bs1 bs2 bsres N, + check_symopp bs1 bs2 bsres (BO_BVor N) = true -> + (List.map (Lit.interp rho) bsres) = + (RAWBITVECTOR_LIST.map2 orb (List.map (Lit.interp rho) bs1) + (List.map (Lit.interp rho) bs2)). +Proof. + intros. + pose proof H. + apply check_symopp_bvor_length in H. + destruct H. + apply check_symopp_bvor in H0. easy. easy. easy. +Qed. + +Lemma check_symopp_bvxor_nl: forall bs1 bs2 bsres N, + check_symopp bs1 bs2 bsres (BO_BVxor N) = true -> + (List.map (Lit.interp rho) bsres) = + (RAWBITVECTOR_LIST.map2 xorb (List.map (Lit.interp rho) bs1) + (List.map (Lit.interp rho) bs2)). +Proof. + intros. + pose proof H. + apply check_symopp_bvxor_length in H. + destruct H. + apply check_symopp_bvxor in H0. easy. easy. easy. +Qed. + +Lemma valid_check_bbOp pos1 pos2 lres: C.valid rho (check_bbOp pos1 pos2 lres). +Proof. + unfold check_bbOp. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | | [ A B | A | | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; + try (intros; now apply C.interp_true). + (* BVand *) + - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); + simpl; intros Heq10; try (now apply C.interp_true). + + case_eq ( + check_symopp bs1 bs2 bsres (BO_BVand N) && + (N.of_nat (Datatypes.length bs1) =? N)%N); + simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + unfold Atom.interp_form_hatom_bv at 2, Atom.interp_hatom. + rewrite Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite Atom.t_interp_wf; trivial. + rewrite Atom.t_interp_wf; trivial. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. rewrite Htia1, Htia2. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea). + intros i j Hv. rewrite Hv in H0. now contradict H0. + intros i Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros n Hv. rewrite Hv in H0. + + (** n = N **) + apply N.eqb_eq in H0. + rewrite <- H0 in *. + revert v_vala Htia. rewrite Hv. + intros v_vala Htia. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + revert v_vala1 Htia1 v_vala2 Htia2. + rewrite H2, H3. + unfold bvtrue. + rewrite Typ.cast_refl. + + intros v_vala1 Htia1 v_vala2 Htia2. + + (** case a1 = a1' and a2 = a2' **) + rewrite orb_true_iff in Heq10. + do 2 rewrite andb_true_iff in Heq10. + destruct Heq10 as [Heq10 | Heq10]; + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2. + rewrite Heq10a1, Heq10a2 in *. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp1. + rewrite Htia1 in HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' + = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp2. + simpl in HSp2. + rewrite Htia2 in HSp2. + + apply BITVECTOR_LIST.bv_eq_reflect. + unfold Bval, interp_bv. + + rewrite (@check_symopp_bvand_nl bs1 bs2 bsres N). + + assert ( + H100: (N.of_nat + (Datatypes.length + (RAWBITVECTOR_LIST.map2 andb (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + specialize (@RAWBITVECTOR_LIST.map2_and_length + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)). + intros. rewrite <- H6. + now rewrite map_length. + apply check_symopp_bvand_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite !map_length, Heq11a, Heq11b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + generalize ( + BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 andb + (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)) + ). + + rewrite H100. + rewrite Typ.cast_refl. intros. + + unfold BITVECTOR_LIST.bv_and, RAWBITVECTOR_LIST.bv_and. + unfold RAWBITVECTOR_LIST.size. + unfold RAWBITVECTOR_LIST.bits. + + unfold interp_bv in HSp1, HSp2. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_symopp_bvand_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + revert HSp2. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2) + ). + + rewrite H101. intros. + + assert ( + H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp1. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1) + ). + + rewrite H102. intros. + + rewrite Typ.cast_refl in *. + rewrite HSp1, HSp2. simpl. + apply eq_rec. simpl. + + rewrite H101, H102. + rewrite N.eqb_compare, N.compare_refl. easy. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + exact Heq11. + + (** symmetric case*) + rewrite Heq10a1, Heq10a2 in *. + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp2. + rewrite Htia1 in HSp2. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' + = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp1. + simpl in HSp1. + rewrite Htia2 in HSp1. + + apply BITVECTOR_LIST.bv_eq_reflect. + unfold Bval, interp_bv. + + rewrite (@check_symopp_bvand_nl bs1 bs2 bsres N). + + assert ( + H100: (N.of_nat + (Datatypes.length + (RAWBITVECTOR_LIST.map2 andb (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + specialize (@RAWBITVECTOR_LIST.map2_and_length + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)). + intros. rewrite <- H6. + apply check_symopp_bvand_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite map_length. + apply check_symopp_bvand_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite !map_length, Heq11a, Heq11b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + generalize ( + BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 andb + (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)) + ). + + rewrite H100. + rewrite Typ.cast_refl. intros. + + unfold BITVECTOR_LIST.bv_and, RAWBITVECTOR_LIST.bv_and. + unfold RAWBITVECTOR_LIST.size. + unfold RAWBITVECTOR_LIST.bits. + + unfold interp_bv in HSp1, HSp2. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_symopp_bvand_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp2. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2) + ). + + rewrite H101. intros. + + assert ( + H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp1. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1) + ). + + rewrite H102. intros. + rewrite Typ.cast_refl in *. + rewrite HSp1, HSp2. simpl. + apply eq_rec. simpl. + rewrite H101, H102. + rewrite N.eqb_compare, N.compare_refl. + now rewrite RAWBITVECTOR_LIST.map2_and_comm. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + exact Heq11. + + (* BVor *) + - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); + simpl; intros Heq10; try (now apply C.interp_true). + + case_eq ( + check_symopp bs1 bs2 bsres (BO_BVor N) && + (N.of_nat (Datatypes.length bs1) =? N)%N); + simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + unfold Atom.interp_form_hatom_bv at 2, Atom.interp_hatom. + rewrite Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite Atom.t_interp_wf; trivial. + rewrite Atom.t_interp_wf; trivial. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. rewrite Htia1, Htia2. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea). + intros i j Hv. rewrite Hv in H0. now contradict H0. + intros i Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros n Hv. rewrite Hv in H0. + + (** n = N **) + apply N.eqb_eq in H0. + rewrite <- H0 in *. + revert v_vala Htia. rewrite Hv. + intros v_vala Htia. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + revert v_vala1 Htia1 v_vala2 Htia2. + rewrite H2, H3. + unfold bvtrue. + rewrite Typ.cast_refl. + + intros v_vala1 Htia1 v_vala2 Htia2. + + (** case a1 = a1' and a2 = a2' **) + rewrite orb_true_iff in Heq10. + do 2 rewrite andb_true_iff in Heq10. + destruct Heq10 as [Heq10 | Heq10]; + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2. + rewrite Heq10a1, Heq10a2 in *. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp1. + rewrite Htia1 in HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' + = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp2. + simpl in HSp2. + rewrite Htia2 in HSp2. + + apply BITVECTOR_LIST.bv_eq_reflect. + unfold Bval, interp_bv. + + rewrite (@check_symopp_bvor_nl bs1 bs2 bsres N). + + assert ( + H100: (N.of_nat + (Datatypes.length + (RAWBITVECTOR_LIST.map2 orb (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)))) = N). + rewrite andb_true_iff in Heq11. + { + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + specialize (@RAWBITVECTOR_LIST.map2_or_length + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)). + intros. rewrite <- H6. + now rewrite map_length. + apply check_symopp_bvor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite !map_length, Heq11a, Heq11b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + generalize ( + BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 orb + (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)) + ). + + rewrite H100. + rewrite Typ.cast_refl. intros. + + unfold BITVECTOR_LIST.bv_or, RAWBITVECTOR_LIST.bv_or. + unfold RAWBITVECTOR_LIST.size. + unfold RAWBITVECTOR_LIST.bits. + + unfold interp_bv in HSp1, HSp2. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_symopp_bvor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp2. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2) + ). + + rewrite H101. intros. + + assert ( + H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp1. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1) + ). + + rewrite H102. intros. + + rewrite Typ.cast_refl in *. + rewrite HSp1, HSp2. simpl. + apply eq_rec. simpl. + rewrite H101, H102. + rewrite N.eqb_compare, N.compare_refl. easy. + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + exact Heq11. + + (** symmetric case*) + rewrite Heq10a1, Heq10a2 in *. + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp2. + rewrite Htia1 in HSp2. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' + = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp1. + simpl in HSp1. + rewrite Htia2 in HSp1. + + apply BITVECTOR_LIST.bv_eq_reflect. + unfold Bval, interp_bv. + + rewrite (@check_symopp_bvor_nl bs1 bs2 bsres N). + + assert ( + H100: (N.of_nat + (Datatypes.length + (RAWBITVECTOR_LIST.map2 orb (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)))) = N). + rewrite andb_true_iff in Heq11. + { + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + specialize (@RAWBITVECTOR_LIST.map2_or_length + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)). + intros. rewrite <- H6. + apply check_symopp_bvor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite map_length. + apply check_symopp_bvor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite !map_length, Heq11a, Heq11b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + generalize ( + BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 orb + (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)) + ). + + rewrite H100. + rewrite Typ.cast_refl. intros. + + unfold BITVECTOR_LIST.bv_or, RAWBITVECTOR_LIST.bv_or. + unfold RAWBITVECTOR_LIST.size. + unfold RAWBITVECTOR_LIST.bits. + + unfold interp_bv in HSp1, HSp2. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_symopp_bvor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + revert HSp2. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2) + ). + + rewrite H101. intros. + + assert ( + H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp1. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1) + ). + + rewrite H102. intros. + + rewrite Typ.cast_refl in *. + rewrite HSp1, HSp2. simpl. + apply eq_rec. simpl. + rewrite H101, H102. + rewrite N.eqb_compare, N.compare_refl. + now rewrite RAWBITVECTOR_LIST.map2_or_comm. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + exact Heq11. + + (** BVxor **) + - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); + simpl; intros Heq10; try (now apply C.interp_true). + + case_eq ( + check_symopp bs1 bs2 bsres (BO_BVxor N) && + (N.of_nat (Datatypes.length bs1) =? N)%N); + simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + unfold Atom.interp_form_hatom_bv at 2, Atom.interp_hatom. + rewrite Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite Atom.t_interp_wf; trivial. + rewrite Atom.t_interp_wf; trivial. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. rewrite Htia1, Htia2. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea). + intros i j Hv. rewrite Hv in H0. now contradict H0. + intros i Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros Hv. rewrite Hv in H0. now contradict H0. + intros n Hv. rewrite Hv in H0. + + (** n = N **) + apply N.eqb_eq in H0. + rewrite <- H0 in *. + revert v_vala Htia. rewrite Hv. + intros v_vala Htia. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + revert v_vala1 Htia1 v_vala2 Htia2. + rewrite H2, H3. + unfold bvtrue. + rewrite Typ.cast_refl. + + intros v_vala1 Htia1 v_vala2 Htia2. + + (** case a1 = a1' and a2 = a2' **) + rewrite orb_true_iff in Heq10. + do 2 rewrite andb_true_iff in Heq10. + destruct Heq10 as [Heq10 | Heq10]; + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2. + rewrite Heq10a1, Heq10a2 in *. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + rewrite H4 in HSp1. + rewrite Htia1 in HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' + = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp2. + simpl in HSp2. + rewrite Htia2 in HSp2. + + apply BITVECTOR_LIST.bv_eq_reflect. + unfold Bval, interp_bv. + + rewrite (@check_symopp_bvxor_nl bs1 bs2 bsres N). + + assert ( + H100: (N.of_nat + (Datatypes.length + (RAWBITVECTOR_LIST.map2 xorb (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)))) = N). + rewrite andb_true_iff in Heq11. + { + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + specialize (@RAWBITVECTOR_LIST.map2_xor_length + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)). + intros. rewrite <- H6. + now rewrite map_length. + apply check_symopp_bvxor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite !map_length, Heq11a, Heq11b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + generalize ( + BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 xorb + (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)) + ). + + rewrite H100. + rewrite Typ.cast_refl. intros. + + unfold BITVECTOR_LIST.bv_xor, RAWBITVECTOR_LIST.bv_xor. + unfold RAWBITVECTOR_LIST.size. + unfold RAWBITVECTOR_LIST.bits. + + unfold interp_bv in HSp1, HSp2. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_symopp_bvxor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp2. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2) + ). + + rewrite H101. intros. + + assert ( + H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp1. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1) + ). + + rewrite H102. intros. + + rewrite Typ.cast_refl in *. + rewrite HSp1, HSp2. simpl. + apply eq_rec. simpl. + + rewrite H101, H102. + rewrite N.eqb_compare, N.compare_refl. easy. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + exact Heq11. + + (** symmetric case*) + rewrite Heq10a1, Heq10a2 in *. + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp2. + rewrite Htia1 in HSp2. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' + = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp1. + simpl in HSp1. + rewrite Htia2 in HSp1. + + apply BITVECTOR_LIST.bv_eq_reflect. + unfold Bval, interp_bv. + + rewrite (@check_symopp_bvxor_nl bs1 bs2 bsres N). + + assert ( + H100: (N.of_nat + (Datatypes.length + (RAWBITVECTOR_LIST.map2 xorb (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)))) = N). + rewrite andb_true_iff in Heq11. + { + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + specialize (@RAWBITVECTOR_LIST.map2_xor_length + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2)). + intros. rewrite <- H6. + apply check_symopp_bvxor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite map_length. + apply check_symopp_bvxor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + now rewrite !map_length, Heq11a, Heq11b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + generalize ( + BITVECTOR_LIST.of_bits_size (RAWBITVECTOR_LIST.map2 xorb + (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2)) + ). + + rewrite H100. + rewrite Typ.cast_refl. intros. + + unfold BITVECTOR_LIST.bv_xor, RAWBITVECTOR_LIST.bv_xor. + unfold RAWBITVECTOR_LIST.size. + unfold RAWBITVECTOR_LIST.bits. + + unfold interp_bv in HSp1, HSp2. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits in HSp1, HSp2. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_symopp_bvxor_length2 in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp2. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2) + ). + + rewrite H101. intros. + + assert ( + H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + revert HSp1. + + generalize ( + BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1) + ). + + rewrite H102. intros. + + rewrite Typ.cast_refl in *. + rewrite HSp1, HSp2. simpl. + apply eq_rec. simpl. + rewrite H101, H102. + rewrite N.eqb_compare, N.compare_refl. + now rewrite RAWBITVECTOR_LIST.map2_xor_comm. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + exact Heq11. +Qed. + +Lemma check_symopp_eq: forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres n, + check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_eq (Typ.TBV n)) = true -> + check_symopp xbs1 ybs2 zbsres (BO_eq (Typ.TBV n)) = true. +Proof. intros. + simpl in H. + case (Lit.is_pos ibsres) in H. + case (t_form .[ Lit.blit ibsres]) in H; try (contradict H; easy). + case ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)) in H. + exact H. + now contradict H. + now contradict H. +Qed. + +Lemma bool_eqb_comm: forall ibs1 ibs2, Bool.eqb ibs1 ibs2 = Bool.eqb ibs2 ibs1. +Proof. intros. case_eq ibs1. intros. case_eq ibs2. intros. easy. intros. easy. intros. easy. Qed. + +Lemma check_symopp_eq': forall ibs1 ibs2 xbs1 ybs2 ibsres zbsres n, + check_symopp (ibs1 :: xbs1) (ibs2 :: ybs2) (ibsres :: zbsres) (BO_eq (Typ.TBV n)) = true -> + Bool.eqb (Lit.interp rho ibs1) (Lit.interp rho ibs2) = Lit.interp rho ibsres. +Proof. intros. + simpl in H. + case_eq (Lit.is_pos ibsres). intros. rewrite H0 in H. + case_eq (t_form .[ Lit.blit ibsres]); intros; rewrite H1 in H; try (now contradict H). + specialize (@rho_interp ( Lit.blit ibsres)). + rewrite H1 in rho_interp. simpl in rho_interp. + case_eq ((i == ibs1) && (i0 == ibs2) || (i == ibs2) && (i0 == ibs1)). + intros. rewrite orb_true_iff in H2. destruct H2. + rewrite andb_true_iff in H2. destruct H2. rewrite eqb_spec in H2, H3. + rewrite H2, H3 in rho_interp. + rewrite <- rho_interp. unfold Lit.interp. rewrite H0. now unfold Var.interp. + intros. rewrite andb_true_iff in H2. destruct H2. rewrite eqb_spec in H2, H3. + rewrite H2, H3 in rho_interp. rewrite bool_eqb_comm in rho_interp. + rewrite <- rho_interp. unfold Lit.interp. rewrite H0. now unfold Var.interp. + intros. rewrite H2 in H. now contradict H. + intros. rewrite H0 in H. now contradict H. +Qed. + +Lemma check_symopp_bveq: forall bs1 bs2 a4 n, check_symopp bs1 bs2 (to_list a4) (BO_eq (Typ.TBV n)) = true -> + RAWBITVECTOR_LIST.beq_list (map (Lit.interp rho) bs1) + (map (Lit.interp rho) bs2) = forallb (Lit.interp rho) (to_list a4). +Proof. intros. revert bs1 bs2 H. + induction (to_list a4) as [ | xa4 xsa4 IHa4]. + - intros. + case_eq bs1. intros. rewrite H0 in H. + case_eq bs2. intros. rewrite H1 in H. + simpl. easy. + intros. rewrite H1 in H. simpl in H. now contradict H. + intros. rewrite H0 in H. simpl in H. + case_eq bs2. intros. rewrite H1 in H. now contradict H. + intros. rewrite H1 in H. now contradict H. + - intros. unfold check_symopp in H. + case_eq bs1. intros. rewrite H0 in H. + case_eq bs2. intros. rewrite H1 in H. now contradict H. + intros. rewrite H1 in H. now contradict H. + intros. fold check_symopp in H. + case_eq bs2. intros. rewrite H1 in H. simpl in H. + rewrite H0 in H. simpl in H. now contradict H. + intros. rewrite H0, H1 in H. + pose proof H. apply check_symopp_eq' in H2. + apply check_symopp_eq in H. + specialize (IHa4 l l0 H). simpl. rewrite IHa4. + case (forallb (Lit.interp rho) xsa4); [ do 2 rewrite andb_true_r | now do 2 rewrite andb_false_r]. + exact H2. +Qed. + +Lemma beq_list_comm: forall bs1 bs2, RAWBITVECTOR_LIST.beq_list bs2 bs1 = + RAWBITVECTOR_LIST.beq_list bs1 bs2. +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. case bs2. easy. + intros. easy. + - intros. case bs2. easy. + intros. simpl. + specialize (@IHbs1 l). rewrite IHbs1. + case (RAWBITVECTOR_LIST.beq_list xsbs1 l). do 2 rewrite andb_true_r. + unfold Bool.eqb. + case b. easy. easy. + now do 2 rewrite andb_false_r. +Qed. + +Lemma prop_check_eq: forall bs1 bs2 bsres, + (length bs1) = (length bs2) -> + check_eq bs1 bs2 bsres = true -> + forallb2 Bool.eqb (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) = + forallb (Lit.interp rho) bsres. +Proof. intro bs1. + induction bs1 as [ | x1 bs1 IHbs1 ]. + - intros bs2 bsres Hlen Hcheck. + case bs2 in *. + + case bsres in *. + * now simpl. + * contradict Hcheck; now simpl. + + contradict Hcheck; now simpl. + - intros bs2 bsres Hlen Hcheck. + symmetry. + case bs2 in *. + + case bsres in *; contradict Hcheck; now simpl. + + case bsres in *. + * contradict Hcheck; now simpl. + * simpl. + rename i into x2. rename i0 into r1. + simpl in Hlen. inversion Hlen. + rename H0 into Hlen'. + + case bsres in *. + (*--*) simpl in Hcheck. + case_eq (Lit.is_pos r1); intros; rewrite H in Hcheck; + try (case bs1 in *; try (now contradict Hcheck); case bs2 in *; + try (now contradict Hcheck)); + rename H into Hposr1; + case_eq (t_form .[ Lit.blit r1]);intros; rewrite H in Hcheck; try (now contradict Hcheck); + rename H into Hform_r1; + generalize (rho_interp (Lit.blit r1)); rewrite Hform_r1; simpl; + intro Hi. + (*++*) rename i into arg1; rename i0 into arg2. + unfold Lit.interp at 1, Var.interp at 1. + rewrite Hposr1, Hi. repeat (rewrite andb_true_r). + case_eq ((arg1 == x1) && (arg2 == x2) || (arg1 == x2) && (arg2 == x1)). + (* ** *) intros Hif. + rewrite orb_true_iff in Hif. + repeat (rewrite andb_true_iff in Hif). + repeat (rewrite eqb_spec in Hif). + destruct Hif as [ Hif1 | Hif2 ]. + (* --- *) destruct Hif1 as (Hx1, Hx2). now rewrite Hx1, Hx2. + (* --- *) destruct Hif2 as (Hx2, Hx1). rewrite Hx1, Hx2. + now rewrite bool_eqb_comm. + (* ** *)intros Hif. rewrite Hif in Hcheck. now contradict Hcheck. + + (* ++ *) + case_eq (to_list a); + intros; rewrite H in Hcheck; try (now contradict Hcheck). + rename H into Ha, i1 into a1, l into rargs. + case_eq (Lit.is_pos a1); + intros; rewrite H in Hcheck; try (now contradict Hcheck). + rename H into Hposa1. + case_eq (t_form .[ Lit.blit a1]); + intros; rewrite H in Hcheck; try (now contradict Hcheck). + rename H into Hform_a1. + rename i into x1', i0 into x2', i1 into arg1, i2 into arg2. + generalize (rho_interp (Lit.blit a1)). rewrite Hform_a1. simpl. + intro Heqx1x2. + rewrite afold_left_and in Hi. + rewrite Ha in Hi. simpl in Hi. + unfold Lit.interp at 1, Var.interp at 1. + rewrite Hposr1, Hi. repeat (rewrite andb_true_r). + unfold Lit.interp at 1, Var.interp at 1. + rewrite Hposa1. rewrite Heqx1x2. + + case_eq ((arg1 == x1) && (arg2 == x2) || (arg1 == x2) && (arg2 == x1)). + (* ** *) intros Hif. + rewrite Hif in Hcheck. + apply (@IHbs1 _ _ Hlen') in Hcheck. + simpl in Hcheck. rewrite Hcheck. + repeat (rewrite orb_true_iff in Hif). + repeat (rewrite andb_true_iff in Hif). + repeat (rewrite eqb_spec in Hif). + destruct Hif as [ Hif1 | Hif2 ]. + (* --- *) destruct Hif1 as (Hx1, Hx2). now rewrite Hx1, Hx2. + (* --- *) destruct Hif2 as (Hx2, Hx1). rewrite Hx1, Hx2. + now rewrite bool_eqb_comm. + (* ** *) intros Hif. rewrite Hif in Hcheck. now contradict Hcheck. + + (* -- *) simpl in Hcheck. + case_eq (Lit.is_pos r1); intros; rewrite H in Hcheck; + try (case bs1 in *; try (now contradict Hcheck); case bs2 in *; + try (now contradict Hcheck)); + rename H into Hposr1; + case_eq (t_form .[ Lit.blit r1]);intros; rewrite H in Hcheck; try (now contradict Hcheck); + rename H into Hform_r1; + generalize (rho_interp (Lit.blit r1)); rewrite Hform_r1; simpl; + intro Hi. + (* ++ *) contradict Hcheck. simpl. + case ((i0 == x1) && (i1 == x2) || (i0 == x2) && (i1 == x1)); easy. + (* ++ *) rename i0 into x1', i1 into x2', i2 into arg1, i3 into arg2. + unfold Lit.interp at 1, Var.interp at 1. + rewrite Hposr1, Hi. + case_eq ((arg1 == x1) && (arg2 == x2) || (arg1 == x2) && (arg2 == x1)). + (* ** *) intros Hif. rewrite Hif in Hcheck. + apply (@IHbs1 _ _ Hlen') in Hcheck. + simpl in Hcheck. rewrite Hcheck. + repeat (rewrite orb_true_iff in Hif). + repeat (rewrite andb_true_iff in Hif). + repeat (rewrite eqb_spec in Hif). + destruct Hif as [ Hif1 | Hif2 ]. + (* --- *) destruct Hif1 as (Hx1, Hx2). now rewrite Hx1, Hx2. + (* --- *) destruct Hif2 as (Hx2, Hx1). rewrite Hx1, Hx2. + now rewrite bool_eqb_comm. + (* ** *) intros Hif. rewrite Hif in Hcheck. now contradict Hcheck. +Qed. + +Lemma length_check_eq: forall bs1 bs2 bsres, + check_eq bs1 bs2 bsres = true -> length bs1 = length bs2. +Proof. + intro bs1. + induction bs1. + + intros. case bs2 in *. trivial. + simpl in H. now contradict H. + + intros. + case bs2 in *. + - simpl in H. now contradict H. + - simpl. apply f_equal. + simpl in H. + revert H. + case bsres. easy. + intros r rl. + case rl. + case (Lit.is_pos r). + case (t_form .[ Lit.blit r]); try easy. + intro a0. + case bs1 in *; try easy; case bs2; try easy. + case bs1 in *; try easy; case bs2; try easy. + case bs1 in *; try easy; case bs2; try easy. + case bs1 in *; try easy; case bs2; try easy. + case bs1 in *; try easy; case bs2; try easy. + case bs1 in *; try easy; case bs2; try easy. + intros i1 l a0. + case (to_list a0); try easy. + intros i2 l0. + case (Lit.is_pos i2); try easy. + case (t_form .[ Lit.blit i2]); try easy. + intros i3 i4. + case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)). + apply IHbs1. + easy. + intros _ _ i2 l0 a0. + case (to_list a0); try easy. + intros i1 l. + case (Lit.is_pos i1); try easy. + case (t_form .[ Lit.blit i1]); try easy. + intros i3 i4. + case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)). + apply IHbs1. + easy. + intros i2 l0 a0. + case (to_list a0); try easy. + intros i9 l. + case (Lit.is_pos i9); try easy. + case (t_form .[ Lit.blit i9]); try easy. + intros i3 i4. + case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)). + apply IHbs1. + easy. + intros _ _ i2 l0 a0. + case (to_list a0); try easy. + intros i9 l. + case (Lit.is_pos i9); try easy. + case (t_form .[ Lit.blit i9]); try easy. + intros i3 i4. + case ((i3 == a) && (i4 == i) || (i3 == i) && (i4 == a)). + apply IHbs1. + easy. + case bs1; try easy; case bs2; easy. + case bs1; try easy; case bs2; easy. + case bs1; try easy; case bs2; easy. + case bs1; try easy; case bs2. + + simpl. easy. + + intros i0 l i1 i2. + case ((i1 == a) && (i2 == i) || (i1 == i) && (i2 == a)); easy. + simpl. + intros _ l i1 i2. + case ((i1 == a) && (i2 == i) || (i1 == i) && (i2 == a)); easy. + easy. + case bs1 in *; try easy; case bs2; easy. + case bs1 in *; try easy; case bs2; easy. + case bs1 in *; try easy; case bs2; easy. + case bs1 in *; try easy; case bs2; try easy. + case (Lit.is_pos r); try easy. + case (t_form .[ Lit.blit r]); try easy. + simpl. intros x y. case ((x == a) && (y == i) || (x == i) && (y == a)); easy. + case (Lit.is_pos r); try easy. + case (t_form .[ Lit.blit r]); try easy. + simpl. intros x y. case ((x == a) && (y == i) || (x == i) && (y == a)); easy. + case (Lit.is_pos r); try easy. + case (t_form .[ Lit.blit r]); try easy. + intros x y. case ((x == a) && (y == i) || (x == i) && (y == a)). + intros x2 rbs2 xr rbrs. + apply IHbs1. easy. +Qed. + +Lemma valid_check_bbEq pos1 pos2 lres : C.valid rho (check_bbEq pos1 pos2 lres). + Proof. + unfold check_bbEq. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). intros a bsres Heq8. + case_eq (Bool.eqb (Lit.is_pos a) (Lit.is_pos bsres)); try (intros; now apply C.interp_true). intros Heq12. + case_eq (t_form .[ Lit.blit a]); try (intros; now apply C.interp_true). intros a3 Heq10. + case_eq (t_atom .[ a3]); try (intros; now apply C.interp_true). + + intros [ | | | | | | | [ A B | A | | | |n]|N|N|N|N|N|N|N|N|N| | | | ]; + try (intros; now apply C.interp_true). + + intros a1' a2' Heq9. + case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); + simpl; intros Heq15; try (now apply C.interp_true). + + case_eq (check_eq bs1 bs2 [bsres] && + (N.of_nat (Datatypes.length bs1) =? n)%N); + simpl; intros Heq16; try (now apply C.interp_true). + + unfold C.valid. simpl. + rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a3). + assert (a3 < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a3]). + intros v_typea3 v_vala3 Htia3. rewrite Htia3 in H0. + + case_eq (v_typea3); intros; rewrite H4 in H0; try (now contradict H0). + rename H4 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + simpl in v_vala2, v_vala2. + + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + (** case a1 = a1' and a2 = a2' **) + rewrite orb_true_iff in Heq15. + do 2 rewrite andb_true_iff in Heq15. + destruct Heq15 as [Heq15 | Heq15]; + destruct Heq15 as (Heq15a1 & Heq15a2); rewrite eqb_spec in Heq15a1, Heq15a2 + ;rewrite Heq15a1, Heq15a2 in *. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp1. + unfold interp_bv in HSp1. + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp2. + unfold interp_bv in HSp2. + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2 in HSp2. + unfold interp_bv in HSp2. + + generalize dependent v_vala1. generalize dependent v_vala2. + + rewrite H2, H3. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert ( + H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = n + ). + { + rewrite !andb_true_iff in Heq16. + destruct Heq16 as (Heq16, Heq16r). + rewrite N.eqb_eq in Heq16r. + apply length_check_eq in Heq16. + rewrite Heq16 in Heq16r. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H100. + rewrite Typ.cast_refl. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n + ). + { + rewrite !andb_true_iff in Heq16. + destruct Heq16 as (Heq16, Heq16r). + rewrite N.eqb_eq in Heq16r. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite !Typ.cast_refl. intros. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)). + + unfold Lit.interp, Var.interp. + rewrite rho_interp. + rewrite Heq10. simpl. + + unfold Atom.interp_form_hatom. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1, Htia2. simpl. + rewrite Typ.N_cast_refl. simpl. + + rewrite Form.wf_interp_form; trivial. + simpl. + apply Bool.eqb_prop in Heq12. + rewrite Heq12. + rewrite HSp1, HSp2. + simpl. + + rewrite Typ.i_eqb_t. simpl. + + unfold BITVECTOR_LIST.bv_eq. + unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bits. + unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + unfold RAWBITVECTOR_LIST.size. + + case_eq (Lit.is_pos bsres). + intros Hpos. + + rewrite andb_true_iff in Heq16. + destruct Heq16 as (Heq16 & Heq16r). + rewrite N.eqb_eq in Heq16r. simpl. + pose proof Heq16 as Heq16p. + + apply length_check_eq in Heq16. + rewrite !map_length, Heq16. + rewrite N.eqb_compare, N.compare_refl. + pose proof (Heq16) as Hleq. + + rewrite (@prop_check_eq _ _ [bsres]). simpl. + rewrite andb_true_r. unfold Lit.interp, Var.interp. + generalize (rho_interp (Lit.blit bsres)). simpl. + intro Hbres. rewrite Hbres. simpl. + rewrite Hpos. + simpl. now unfold Atom.interp_form_hatom, interp_hatom. + exact Hleq. + + exact Heq16p. + + intros Hpos. + rewrite andb_true_iff in Heq16. + destruct Heq16 as (Heq16 & Heq16r). + + contradict Heq16. + case bs1 in *; try now simpl; case bs2 in *; now simpl. + case bs2 in *. simpl. easy. + simpl. rewrite Hpos. case bs1; intros; auto; case bs2; auto. + + pose proof Heq16 as Heq16'. + + rewrite andb_true_iff in Heq16. + destruct Heq16 as (Heq16 & Heq16r). + apply length_check_eq in Heq16; auto. + + (** case symmetry **) + + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp2. + unfold interp_bv in HSp2. + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1 in HSp2. + unfold interp_bv in HSp2. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp1. + unfold interp_bv in HSp1. + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2 in HSp1. + unfold interp_bv in HSp1. + + generalize dependent v_vala1. generalize dependent v_vala2. + + rewrite H2, H3. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert ( + H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n + ). + { + rewrite N.eqb_eq in Heq16r. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H100. + rewrite !Typ.cast_refl. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = n + ). + { + rewrite N.eqb_eq in Heq16r. + rewrite Heq16 in Heq16r. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H101. + rewrite Typ.cast_refl. + + intros. + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)). + + unfold Lit.interp, Var.interp. + rewrite rho_interp. + rewrite Heq10. simpl. + + unfold Atom.interp_form_hatom. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1, Htia2. simpl. + rewrite Typ.N_cast_refl. simpl. + + rewrite Form.wf_interp_form; trivial. + simpl. + apply Bool.eqb_prop in Heq12. + rewrite Heq12. + rewrite HSp1, HSp2. + simpl. + + rewrite Typ.i_eqb_t. simpl. + + unfold BITVECTOR_LIST.bv_eq. + unfold RAWBITVECTOR_LIST.bv_eq, RAWBITVECTOR_LIST.bits. + unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + unfold RAWBITVECTOR_LIST.size. + + case_eq (Lit.is_pos bsres). + intros Hpos. + + rewrite beq_list_comm. + rewrite !map_length, Heq16, N.eqb_compare, N.compare_refl. + + rewrite (@prop_check_eq _ _ [bsres]). simpl. + rewrite andb_true_r. unfold Lit.interp, Var.interp. + generalize (rho_interp (Lit.blit bsres)). simpl. + intro Hbres. rewrite Hbres. + + rewrite andb_true_iff in Heq16'. + destruct Heq16' as (Heq16' & Heq16'r). + rewrite Hpos. + now unfold Atom.interp_form_hatom, interp_hatom. + intros. exact Heq16. + + rewrite andb_true_iff in Heq16'. + destruct Heq16' as (Heq16' & Heq16'r). + exact Heq16'. + + intros Hpos. + contradict Heq16'. + case bs1 in *; try now simpl; case bs2 in *; now simpl. + case bs2 in *; try now simpl; case bs2 in *; now simpl. + simpl. easy. + simpl. + case bs1 in *; try now simpl; case bs2 in *; now simpl. + rewrite Hpos. + case bs2 in *; try now simpl; case bs2 in *; now simpl. + now rewrite andb_false_l. + + case bs2 in *; rewrite Hpos; simpl; easy. +Qed. + +Lemma check_add_bvadd_length: forall bs1 bs2 bsres c, + let n := length bsres in + check_add bs1 bs2 bsres c = true -> + (length bs1 = n)%nat /\ (length bs2 = n)%nat . +Proof. + intros. + revert bs1 bs2 c H. + induction bsres as [ | r rbsres ]. + intros. + simpl in H. + case bs1 in *. simpl in H. + case bs2 in *. simpl in *. easy. easy. + case bs2 in *. simpl in *. easy. + simpl in *. easy. + intros. + case bs1 in *. + case bs2 in *. + simpl in *. easy. + simpl in *. easy. + case bs2 in *. simpl in *. easy. + set (n' := length rbsres). + fold n' in n, IHrbsres, H. + simpl in IHrbsres. + simpl in H. + case (Lit.is_pos r) in H. + case (t_form .[ Lit.blit r]) in H; try easy. + case (Lit.is_pos i1) in H. + case (t_form .[ Lit.blit i1]) in H; try now contradict H. + rewrite andb_true_iff in H. destruct H. + specialize (IHrbsres bs1 bs2 ((Cor (Cand (Clit i) (Clit i0)) (Cand (Cxor (Clit i) (Clit i0)) c))) H0). + simpl. + simpl in n. + split; apply f_equal. easy. easy. + easy. easy. +Qed. + +Lemma prop_eq_carry_lit: forall c i, eq_carry_lit c i = true -> interp_carry c = (Lit.interp rho i). +Proof. intro c. + induction c. + - intros. simpl in *. + case (Lit.is_pos i0 ) in H; rewrite eqb_spec in H; now rewrite H. + - intros. simpl. + pose proof IHc1. pose proof IHc2. + simpl in H. + case_eq ( Lit.is_pos i). intros Hip0. + rewrite Hip0 in H. + case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H. + case_eq (PArray.length a == 2). intros Hl. rewrite Hl in H. + (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H. + + specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp. + simpl in rho_interp. + rewrite afold_left_and in rho_interp. + rewrite eqb_spec in Hl. + apply to_list_two in Hl. + rewrite Hl in rho_interp. + simpl in rho_interp. + rewrite andb_true_r in rho_interp. + + (* destruct H. *) + + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. + unfold Lit.interp at 3. unfold Var.interp. + rewrite Hip0. now rewrite rho_interp. + (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *) + (* unfold Lit.interp at 3. unfold Var.interp. *) + (* rewrite Hip0. rewrite rho_interp. now rewrite andb_comm. *) + + intros. rewrite H3 in H. now contradict H. + + intros. rewrite H2 in H. now contradict H. + + - intros. simpl. + pose proof IHc1. pose proof IHc2. + simpl in H. + case_eq ( Lit.is_pos i). intros Hip0. + rewrite Hip0 in H. + case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H. + (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H. + + specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp. + simpl in rho_interp. + + (* destruct H. *) + + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. + unfold Lit.interp at 3. unfold Var.interp. + rewrite Hip0. now rewrite rho_interp. + (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *) + (* unfold Lit.interp at 3. unfold Var.interp. *) + (* rewrite Hip0. rewrite rho_interp. now rewrite xorb_comm. *) + + intros. rewrite H2 in H. now contradict H. + + - intros. simpl. + pose proof IHc1. pose proof IHc2. + simpl in H. + case_eq ( Lit.is_pos i). intros Hip0. + rewrite Hip0 in H. + case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H. + case_eq (PArray.length a == 2). intros Hl. rewrite Hl in H. + (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H. + + specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp. + simpl in rho_interp. + rewrite afold_left_or in rho_interp. + rewrite eqb_spec in Hl. + apply to_list_two in Hl. + rewrite Hl in rho_interp. + simpl in rho_interp. + rewrite orb_false_r in rho_interp. + + (* destruct H. *) + + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. + unfold Lit.interp at 3. unfold Var.interp. + rewrite Hip0. now rewrite rho_interp. + (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *) + (* unfold Lit.interp at 3. unfold Var.interp. *) + (* rewrite Hip0. rewrite rho_interp. now rewrite orb_comm. *) + + intros. rewrite H3 in H. now contradict H. + + intros. rewrite H2 in H. now contradict H. + + - intros. simpl. + pose proof IHc1. pose proof IHc2. + simpl in H. + case_eq ( Lit.is_pos i). intros Hip0. + rewrite Hip0 in H. + case_eq (t_form .[ Lit.blit i]); intros; rewrite H2 in H; try now contradict H. + (* rewrite orb_true_iff in H; do 2 *) rewrite andb_true_iff in H. + + specialize (@rho_interp ( Lit.blit i)). rewrite H2 in rho_interp. + simpl in rho_interp. + + (* destruct H. *) + + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. + unfold Lit.interp at 3. unfold Var.interp. + rewrite Hip0. now rewrite rho_interp. + (* + destruct H. apply H0 in H. apply H1 in H3. rewrite H, H3. *) + (* unfold Lit.interp at 3. unfold Var.interp. *) + (* rewrite Hip0. rewrite rho_interp. *) + (* case_eq (Bool.eqb (Lit.interp rho i0) (Lit.interp rho i1)). *) + (* intros. apply Bool.eqb_prop in H4. rewrite H4. apply Bool.eqb_reflx. *) + (* intros. apply Bool.eqb_false_iff in H4. apply Bool.eqb_false_iff. unfold not in *. intro. symmetry in H5. *) + (* apply H4; trivial. *) + + intros. rewrite H2 in H. now contradict H. +Qed. + + + +Lemma map_cons T U (f: T -> U) (h: T) (l: list T): map f (h :: l) = f h :: map f l. +Proof. auto. Qed. + +Lemma prop_check_ult: forall bs1 bs2, + length bs1 = length bs2 -> + RAWBITVECTOR_LIST.ult_list_big_endian + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) + = interp_carry (ult_big_endian_lit_list bs1 bs2). +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1 ]. + - intros. simpl in *. + symmetry in H; rewrite empty_list_length in H. + specialize (Lit.interp_false rho wf_rho). + intros. unfold is_true in H0; now rewrite not_true_iff_false in H0. + - intros. + case_eq bs2. intros. rewrite H0 in *. now contradict H. + intros. rewrite H0 in *. + inversion H. + rewrite !map_cons. + simpl. + case xsbs1 in *. simpl. + case l in *. simpl. now rewrite Lit.interp_neg. + now contradict H2. + case l in *. simpl. + now contradict H2. + rewrite !map_cons. + unfold interp_carry. + fold interp_carry. + specialize (@IHbs1 (i1 :: l)). + rewrite !map_cons in IHbs1. + rewrite Lit.interp_neg. + now rewrite IHbs1. +Qed. + +Lemma prop_check_slt: forall bs1 bs2, + length bs1 = length bs2 -> + RAWBITVECTOR_LIST.slt_list_big_endian + (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) + = interp_carry (slt_big_endian_lit_list bs1 bs2). +Proof. intros. + case bs1 in *. simpl. + specialize (Lit.interp_false rho wf_rho). + intros. unfold is_true in H0; now rewrite not_true_iff_false in H0. + case bs2 in *. + now contradict H. + rewrite !map_cons. + case bs1 in *. simpl. + case bs2 in *. simpl. now rewrite Lit.interp_neg. + now contradict H. + case bs2 in *. + now contradict H. + unfold slt_big_endian_lit_list. + unfold RAWBITVECTOR_LIST.slt_list_big_endian. + rewrite !map_cons. + unfold interp_carry. + fold interp_carry. + rewrite <- !map_cons. + rewrite Lit.interp_neg. + rewrite prop_check_ult. + now apply f_equal. + simpl. + now inversion H. +Qed. + +Lemma prop_check_ult2: forall bs1 bs2 bsres, +length bs1 = length bs2 -> +check_ult bs1 bs2 bsres = true -> +interp_carry (ult_big_endian_lit_list (rev bs1) (rev bs2)) = Lit.interp rho bsres. +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. + case bs2 in *. + unfold check_ult in H0. + simpl in *. + case_eq (Lit.is_pos bsres). intros Hbsres. + rewrite Hbsres in H0. + case (Lit.is_pos bsres) in H0; rewrite eqb_spec in H0; now rewrite H0. + intros. rewrite H1 in H0. now contradict H0. + + now contradict H. + + - intros. + case bs2 in *. + now contradict H. + simpl. + unfold check_ult,ult_lit_list in H0. + simpl in H0. + case_eq (Lit.is_pos bsres). intros Hbsres. + rewrite Hbsres in H0. + + now apply prop_eq_carry_lit. + + intros. rewrite H1 in H0. now contradict H0. +Qed. + +Lemma prop_check_slt2: forall bs1 bs2 bsres, +length bs1 = length bs2 -> +check_slt bs1 bs2 bsres = true -> +interp_carry (slt_big_endian_lit_list (rev bs1) (rev bs2)) = Lit.interp rho bsres. +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. + case bs2 in *. + unfold check_slt in H0. + simpl in *. + case_eq (Lit.is_pos bsres). intros Hbsres. + rewrite Hbsres in H0. + case (Lit.is_pos bsres) in H0; rewrite eqb_spec in H0; now rewrite H0. + intros. rewrite H1 in H0. now contradict H0. + + now contradict H. + + - intros. + case bs2 in *. + now contradict H. + simpl. + unfold check_slt, slt_lit_list in H0. + simpl in H0. + case_eq (Lit.is_pos bsres). intros Hbsres. + rewrite Hbsres in H0. + now apply prop_eq_carry_lit. + + intros. rewrite H1 in H0. now contradict H0. +Qed. + +Lemma prop_lit: forall bsres, +Lit.is_pos bsres = true -> +Lit.interp + (interp_state_var (fun a0 : int => interp_bool t_i (t_interp .[ a0])) + interp_form_hatom_bv t_form) bsres = +Form.interp (fun a0 : int => interp_bool t_i (t_interp .[ a0])) + interp_form_hatom_bv t_form (t_form .[ Lit.blit bsres]). +Proof. intros. + rewrite <- rho_interp. + simpl. + unfold Lit.interp, Var.interp. + rewrite H. + simpl. easy. +Qed. + +Lemma prop_lit2: forall bsres, +Lit.is_pos bsres = false -> +Lit.interp + (interp_state_var (fun a0 : int => interp_bool t_i (t_interp .[ a0])) + interp_form_hatom_bv t_form) bsres = +negb (Form.interp (fun a0 : int => interp_bool t_i (t_interp .[ a0])) + interp_form_hatom_bv t_form (t_form .[ Lit.blit bsres])). +Proof. intros. + rewrite <- rho_interp. + simpl. + unfold Lit.interp, Var.interp. + rewrite H. + simpl. easy. +Qed. + +Lemma valid_check_bbUlt pos1 pos2 lres : C.valid rho (check_bbUlt pos1 pos2 lres). +Proof. + unfold check_bbUlt. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). intros a bsres Heq8. + case_eq (Bool.eqb (Lit.is_pos a) (Lit.is_pos bsres)); try (intros; now apply C.interp_true). intros Heq12. + case_eq (t_form .[ Lit.blit a]); try (intros; now apply C.interp_true). intros a3 Heq10. + case_eq (t_atom .[ a3]); try (intros; now apply C.interp_true). + + intros [ | | | | | | | [ A B | A | | | | ]|N|N|N|N|N|N|N|N|N| | | | ]; + try (intros; now apply C.interp_true). + + intros a1' a2' Heq9. + case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq15; try (now apply C.interp_true). + + case_eq (check_ult bs1 bs2 bsres && + (N.of_nat (Datatypes.length bs1) =? N)%N && + (N.of_nat (Datatypes.length bs2) =? N)%N); + simpl; intros Heq16; try (now apply C.interp_true). + + unfold C.valid. simpl. + + rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a3). + assert (a3 < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a3]). + intros v_typea3 v_vala3 Htia3. rewrite Htia3 in H0. + case_eq (v_typea3); intros; rewrite H4 in H0; try (now contradict H0). + rename H4 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + simpl in v_vala2, v_vala2. + + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + (** case a1 = a1' and a2 = a2' **) + rewrite andb_true_iff in Heq15. + destruct Heq15 as (Heq15a1 & Heq15a2); rewrite eqb_spec in Heq15a1, Heq15a2 + ;rewrite Heq15a1, Heq15a2 in *. + + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp1. + unfold interp_bv in HSp1. + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp2. + unfold interp_bv in HSp2. + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2 in HSp2. + unfold interp_bv in HSp2. + + generalize dependent v_vala1. generalize dependent v_vala2. + + rewrite H2, H3. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert ( + H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16a, Heq16b), Heq16c). + rewrite N.eqb_eq in Heq16c. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H100. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16a, Heq16b), Heq16c). + rewrite N.eqb_eq in Heq16b. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + + rewrite Typ.cast_refl in *. + + intros. + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)). + + unfold Lit.interp, Var.interp. + rewrite rho_interp. + rewrite Heq10. simpl. + + unfold Atom.interp_form_hatom. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1, Htia2. simpl. + + rewrite Form.wf_interp_form; trivial. + simpl. + apply Bool.eqb_prop in Heq12. + rewrite Heq12. + rewrite HSp1, HSp2. + + case_eq (Lit.is_pos bsres). + intros Hpos. + + unfold BITVECTOR_LIST.bv_ult. + unfold RAWBITVECTOR_LIST.bv_ult, RAWBITVECTOR_LIST.bits. + unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + simpl. + unfold RAWBITVECTOR_LIST.size. + simpl. + + rewrite !Typ.N_cast_refl. + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16 & Heq16l) & Heq16r). + rewrite N.eqb_eq in Heq16r, Heq16l. + rewrite map_length, Heq16l. + rewrite H100. + rewrite N.eqb_compare. rewrite N.compare_refl. + + unfold RAWBITVECTOR_LIST.ult_list. + specialize (@prop_check_ult (List.rev bs1) (List.rev bs2)). + intros. + + cut ( Datatypes.length (List.rev bs1) = Datatypes.length (List.rev bs2)). + intros. specialize (H6 H7). + do 2 rewrite <- List.map_rev. + rewrite H6. + + pose proof (rho_interp). + specialize (H8 (Lit.blit a)). + rewrite Heq10 in H8. + simpl in H8. + + rewrite !rev_length in H7. + specialize (@prop_check_ult2 bs1 bs2 bsres H7 Heq16). + intros. + rewrite H9. + simpl. + unfold Atom.interp_form_hatom, interp_hatom. + simpl. + now rewrite prop_lit. + + rewrite !rev_length. + apply (f_equal nat_of_N) in Heq16l. + apply (f_equal nat_of_N) in Heq16r. + rewrite Nat2N.id in Heq16l, Heq16r. + now rewrite Heq16l, Heq16r. + + intros. + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16 & Heq16l) & Heq16r). + rewrite N.eqb_eq in Heq16r, Heq16l. + + contradict Heq16. + unfold check_ult. + rewrite H6. easy. +Qed. + +Lemma valid_check_bbSlt pos1 pos2 lres : C.valid rho (check_bbSlt pos1 pos2 lres). +Proof. + unfold check_bbSlt. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). intros a bsres Heq8. + case_eq (Bool.eqb (Lit.is_pos a) (Lit.is_pos bsres)); try (intros; now apply C.interp_true). intros Heq12. + case_eq (t_form .[ Lit.blit a]); try (intros; now apply C.interp_true). intros a3 Heq10. + case_eq (t_atom .[ a3]); try (intros; now apply C.interp_true). + + intros [ | | | | | | | [ A B | A | | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; + try (intros; now apply C.interp_true). + + case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq15; try (now apply C.interp_true). + + case_eq (check_slt bs1 bs2 bsres && + (N.of_nat (Datatypes.length bs1) =? N)%N && + (N.of_nat (Datatypes.length bs2) =? N)%N); + simpl; intros Heq16; try (now apply C.interp_true). + + unfold C.valid. simpl. + + rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a3). + assert (a3 < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a3]). + intros v_typea3 v_vala3 Htia3. rewrite Htia3 in H0. + case_eq (v_typea3); intros; rewrite H4 in H0; try (now contradict H0). + rename H4 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + simpl in v_vala2, v_vala2. + + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + (** case a1 = a1' and a2 = a2' **) + rewrite andb_true_iff in Heq15. + destruct Heq15 as (Heq15a1 & Heq15a2); rewrite eqb_spec in Heq15a1, Heq15a2 + ;rewrite Heq15a1, Heq15a2 in *. + + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp1. + unfold interp_bv in HSp1. + rewrite !Atom.t_interp_wf in Htia1; trivial. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H5 in HSp2. + unfold interp_bv in HSp2. + rewrite !Atom.t_interp_wf in Htia2; trivial. + rewrite Htia2 in HSp2. + unfold interp_bv in HSp2. + + generalize dependent v_vala1. generalize dependent v_vala2. + rewrite H2, H3. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert ( + H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N + ). + { + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16a, Heq16b), Heq16c). + rewrite N.eqb_eq in Heq16c. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H100. + + assert ( + H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N + ). + { + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16a, Heq16b), Heq16c). + rewrite N.eqb_eq in Heq16b. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + + rewrite Typ.cast_refl in *. + + intros. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + apply (@Bool.eqb_true_iff (Lit.interp rho a) (Lit.interp rho bsres)). + + unfold Lit.interp, Var.interp. + rewrite rho_interp. + rewrite Heq10. simpl. + + unfold Atom.interp_form_hatom. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Heq9. simpl. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1, Htia2. simpl. + + rewrite Form.wf_interp_form; trivial. + simpl. + apply Bool.eqb_prop in Heq12. + rewrite Heq12. + rewrite HSp1, HSp2. + + case_eq (Lit.is_pos bsres). + intros Hpos. + + unfold BITVECTOR_LIST.bv_slt. + unfold RAWBITVECTOR_LIST.bv_slt, RAWBITVECTOR_LIST.bits. + unfold BITVECTOR_LIST.bv, BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + simpl. + unfold RAWBITVECTOR_LIST.size. + simpl. + + rewrite !Typ.N_cast_refl. + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16 & Heq16l) & Heq16r). + rewrite N.eqb_eq in Heq16r, Heq16l. + rewrite map_length, Heq16l. + rewrite H100. + rewrite N.eqb_compare. rewrite N.compare_refl. + + unfold RAWBITVECTOR_LIST.slt_list. + specialize (@prop_check_slt (List.rev bs1) (List.rev bs2)). + intros. + + cut ( Datatypes.length (List.rev bs1) = Datatypes.length (List.rev bs2)). + intros. specialize (H6 H7). + do 2 rewrite <- List.map_rev. + rewrite H6. + + pose proof (rho_interp). + specialize (H8 (Lit.blit a)). + rewrite Heq10 in H8. + simpl in H8. + + rewrite !rev_length in H7. + specialize (@prop_check_slt2 bs1 bs2 bsres H7 Heq16). + intros. + rewrite H9. + simpl. + unfold Atom.interp_form_hatom, interp_hatom. + simpl. + now rewrite prop_lit. + + rewrite !rev_length. + apply (f_equal nat_of_N) in Heq16l. + apply (f_equal nat_of_N) in Heq16r. + rewrite Nat2N.id in Heq16l, Heq16r. + now rewrite Heq16l, Heq16r. + + intros. + rewrite !andb_true_iff in Heq16. + destruct Heq16 as ((Heq16 & Heq16l) & Heq16r). + rewrite N.eqb_eq in Heq16r, Heq16l. + + contradict Heq16. + unfold check_slt. + rewrite H6. easy. +Qed. + +Lemma check_add_list:forall bs1 bs2 bsres c, + let n := length bsres in + (length bs1 = n)%nat -> + (length bs2 = n)%nat -> + check_add bs1 bs2 bsres c -> + (RAWBITVECTOR_LIST.add_list_ingr (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) + (interp_carry c)) + = + (map (Lit.interp rho) bsres). +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. simpl in H1. + case_eq bs2. intros. rewrite H2 in H1. simpl. + case_eq bsres. intros. rewrite H3 in H1. now simpl. + intros. rewrite H3 in H1. now contradict H1. + intros. rewrite H2 in H1. now contradict H1. + - intros. + case_eq bs2. intros. rewrite H2 in H1. simpl in H1. now contradict H1. + intros. rewrite H2 in H1. + case_eq bsres. intros. rewrite H3 in H1. simpl in H1. now contradict H1. + intros. rewrite H3 in H1. simpl in H1. + case_eq ( Lit.is_pos i0). intros. rewrite H4 in H1. + case_eq ( t_form .[ Lit.blit i0]); intros; rewrite H5 in H1; try now contradict H. + case_eq ( Lit.is_pos i1). intros. rewrite H6 in H1. + case_eq ( t_form .[ Lit.blit i1]); intros; rewrite H7 in H1; try now contradict H. + unfold is_true in H1. + rewrite andb_true_iff in H1. destruct H1. + unfold n in *. + rewrite H3 in H. + rewrite H2, H3 in H0. + inversion H. inversion H0. + + specialize + (@IHbs1 l l0 + ((Cor (Cand (Clit xbs1) (Clit i)) (Cand (Cxor (Clit xbs1) (Clit i)) c))) + H10 H11 H8). + + simpl in *. unfold RAWBITVECTOR_LIST.of_bits in IHbs1. + case_eq (RAWBITVECTOR_LIST.add_carry (Lit.interp rho xbs1) (Lit.interp rho i) + (interp_carry c)). intros r c0 Heqrc. + + (** rho_interp Lit.blit i0 **) + pose proof (rho_interp (Lit.blit i0)). + rewrite H5 in H9. simpl in H9. + + (** rho_interp Lit.blit i1 **) + pose proof (rho_interp (Lit.blit i1)). + rewrite H7 in H12. simpl in H12. + + unfold Lit.interp at 3. + rewrite H4. unfold Var.interp. rewrite H9. + rewrite <- IHbs1. + simpl. + cut (r = xorb (Lit.interp rho i1) (Lit.interp rho i2)). + cut (c0 = (Lit.interp rho xbs1 && Lit.interp rho i + || xorb (Lit.interp rho xbs1) (Lit.interp rho i) && interp_carry c)). + intros. now rewrite H13, H14. + + (* c *) + case ((Lit.interp rho xbs1)) in *. + case ((Lit.interp rho i)) in *. + case ((interp_carry c)) in *. + inversion Heqrc. easy. + inversion Heqrc. easy. + case ((interp_carry c)) in *. + inversion Heqrc. easy. + inversion Heqrc. easy. + case ((Lit.interp rho i)) in *. + case ((interp_carry c)) in *. + inversion Heqrc. easy. + inversion Heqrc. easy. + case ((interp_carry c)) in *. + inversion Heqrc. easy. + inversion Heqrc. easy. + + (* r *) + rewrite andb_true_iff in H1. + destruct H1. + rewrite orb_true_iff in H1. + destruct H1; rewrite andb_true_iff in H1; destruct H1. + rewrite eqb_spec in H1, H14. rewrite H1, H14 in *. + + apply prop_eq_carry_lit in H13. rewrite <- H13. + + case ((Lit.interp rho xbs1)) in *. + case ((Lit.interp rho i)) in *. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + case ((Lit.interp rho i)) in *. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + + rewrite eqb_spec in H1, H14. rewrite H1, H14 in *. + + apply prop_eq_carry_lit in H13. rewrite <- H13. + + case ((Lit.interp rho xbs1)) in *. + case ((Lit.interp rho i)) in *. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + case ((Lit.interp rho i)) in *. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + case ((interp_carry c)) in *. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + inversion Heqrc. + unfold Lit.interp, Var.interp. + rewrite H6, H12. easy. + + (** contradictions **) + intros. rewrite H6 in H1. now contradict H1. + intros. rewrite H4 in H1. now contradict H1. +Qed. + +Lemma check_add_bvadd: forall bs1 bs2 bsres n, + (N.of_nat(length bs1) = n)%N -> + (N.of_nat(length bs2) = n)%N -> + (N.of_nat(length bsres) = n)%N -> + check_add bs1 bs2 bsres (Clit Lit._false) = true -> + (RAWBITVECTOR_LIST.bv_add (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) = + (map (Lit.interp rho) bsres)). +Proof. intros. + pose proof H as H'. pose proof H0 as H0'. pose proof H1 as H1'. + rewrite <- H1 in H. apply Nat2N.inj in H. + rewrite <- H1 in H0. apply Nat2N.inj in H0. + specialize (@check_add_list bs1 bs2 bsres ( (Clit Lit._false)) H H0 H2). intros. + unfold RAWBITVECTOR_LIST.bv_add. + unfold RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits. + unfold BITVECTOR_LIST.of_bits. + rewrite !map_length, H, H0. + rewrite N.eqb_refl. + + assert ( (interp_carry (Clit Lit._false)) = false). + { + specialize (Lit.interp_false rho wf_rho). intros. + unfold is_true in H4. + rewrite not_true_iff_false in H4. + now unfold interp_carry. + } + + rewrite H4 in H3. + unfold RAWBITVECTOR_LIST.add_list. + apply H3. +Qed. + +Lemma valid_check_bbAdd pos1 pos2 lres : C.valid rho (check_bbAdd pos1 pos2 lres). +Proof. + unfold check_bbAdd. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; + try (intros; now apply C.interp_true). + + (* BVadd *) + - case_eq ((a1 == a1') && (a2 == a2') || (a1 == a2') && (a2 == a1')); + simpl; intros Heq10; try (now apply C.interp_true). + case_eq ( + check_add bs1 bs2 bsres (Clit Lit._false) && + (N.of_nat (Datatypes.length bs1) =? N)%N + ); simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H4 in H0; try (now contradict H0). + rename H4 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + (** case a1 = a1' and a2 = a2' **) + rewrite orb_true_iff in Heq10. + do 2 rewrite andb_true_iff in Heq10. + destruct Heq10 as [Heq10 | Heq10]; + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2 + ;rewrite Heq10a1, Heq10a2 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H4. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2. + intros v_vala2 Htia2 v_vala1 Htia1. + rewrite Htia1, Htia2. + rewrite Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_add_bvadd_length in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite N.eqb_eq in Heq11r. + rewrite Heq11a in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + rewrite H5 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + rewrite H6 in HSp2. + unfold interp_bv in HSp2. + rewrite Htia2 in HSp2. + unfold interp_bv in HSp2. + + revert HSp2. + + assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_add_bvadd_length in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite Heq11a, <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H102. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp2. + + pose proof Heq11. + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11 & Heq11r). + rewrite N.eqb_eq in Heq11r. + + apply check_add_bvadd_length in Heq11. + + unfold BITVECTOR_LIST.bv_add. simpl. + apply eq_rec. + simpl. + + specialize (@check_add_bvadd bs1 bs2 bsres N). + + intros. apply H8. + exact Heq11r. + destruct Heq11 as (Heq11a & Heq11b). + rewrite <- Heq11b in Heq11a. + rewrite Heq11a in Heq11r. easy. + destruct Heq11 as (Heq11a & Heq11b). + rewrite Heq11a in Heq11r. easy. + rewrite andb_true_iff in H7. + destruct H7 as (H7 & H7r). + exact H7. + + (** symmetic case **) + + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H4. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2. + intros v_vala2 Htia2 v_vala1 Htia1. + rewrite Htia1, Htia2. + rewrite Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_add_bvadd_length in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite N.eqb_eq in Heq11r. + rewrite Heq11a in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H5 in HSp2. + unfold interp_bv in HSp2. + rewrite Htia1 in HSp2. + unfold interp_bv in HSp2. + + revert HSp2. + + assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + apply check_add_bvadd_length in Heq11. + destruct Heq11 as (Heq11a, Heq11b). + rewrite Heq11a, <- Heq11b in Heq11r. + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H102. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp2. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H6 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia2 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp1. + + pose proof Heq11. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11 & Heq11r). + rewrite N.eqb_eq in Heq11r. + + apply check_add_bvadd_length in Heq11. + + unfold BITVECTOR_LIST.bv_add. simpl. + apply eq_rec. + simpl. + + specialize (@RAWBITVECTOR_LIST.bv_add_comm N). + intros. rewrite H8. + + specialize (@check_add_bvadd bs1 bs2 bsres N). + + intros. apply H9. + exact Heq11r. + destruct Heq11 as (Heq11a & Heq11b). + rewrite <- Heq11b in Heq11a. + rewrite Heq11a in Heq11r. easy. + destruct Heq11 as (Heq11a & Heq11b). + rewrite Heq11a in Heq11r. easy. + + rewrite andb_true_iff in H7. + destruct H7 as (H7 & H7r). + exact H7. + + unfold RAWBITVECTOR_LIST.size. + destruct Heq11 as (Heq11a, Heq11b). + rewrite <- Heq11a in Heq11b. + rewrite <- Heq11b in Heq11r. + now rewrite map_length. + + unfold RAWBITVECTOR_LIST.size. + now rewrite map_length. +Qed. + +Lemma mk_list_false_eq: forall bs, (map (fun _ : int => Lit.interp rho Lit._false) bs) = + (RAWBITVECTOR_LIST.mk_list_false (Datatypes.length bs)). +Proof. intro bs. + induction bs as [ | xbs xsbs IHbs ]. + - now simpl. + - simpl. rewrite IHbs. specialize (@Lit.interp_false rho wf_rho). + intros. unfold is_true in H. apply not_true_is_false in H. + now rewrite H. +Qed. + +Lemma map_interp_neg: forall bs, (map (fun x : int => negb (Lit.interp rho x)) bs) = + (map (fun x : int => Lit.interp rho (Lit.neg x)) bs). +Proof. intro bs. + induction bs as [ | xbs xsbs IHbs ]. + - now simpl. + - simpl. rewrite IHbs. + now rewrite Lit.interp_neg. +Qed. + +Lemma prop_check_neg: forall bs bsres n, + (N.of_nat(length bs) = n)%N -> + (N.of_nat(length bsres) = n)%N -> + check_neg bs bsres = true -> + RAWBITVECTOR_LIST.bv_neg (map (Lit.interp rho) bs) = map (Lit.interp rho) bsres. +Proof. intros. + + unfold check_neg in H1. + specialize (@check_add_list (map (fun l : int => Lit.neg l) bs) + (map (fun _ : int => Lit._false) bs) bsres (Clit Lit._true)). + + intros. simpl in H2. + cut ( Datatypes.length (map (fun l : int => Lit.neg l) bs) = + Datatypes.length bsres ). intros. + cut (Datatypes.length (map (fun _ : int => Lit._false) bs) = + Datatypes.length bsres). intros. + specialize (H2 H3 H4 H1). + unfold BITVECTOR_LIST.bv_neg, RAWBITVECTOR_LIST.bv_neg. + unfold RAWBITVECTOR_LIST.twos_complement. + + rewrite !map_map in H2. + rewrite !map_map. + rewrite mk_list_false_eq in H2. + rewrite <- map_interp_neg in H2. + rewrite Lit.interp_true in H2. + rewrite <- H2. + now rewrite map_length. + + easy. + + rewrite map_length. + apply (f_equal (N.to_nat)) in H. + apply (f_equal (N.to_nat)) in H0. + rewrite Nat2N.id in H, H0. + now rewrite H, H0. + + rewrite map_length. + apply (f_equal (N.to_nat)) in H. + apply (f_equal (N.to_nat)) in H0. + rewrite Nat2N.id in H, H0. + now rewrite H, H0. +Qed. + +Lemma check_neg_length: forall bs bsres, + check_neg bs bsres = true -> (length bs = length bsres)%nat. +Proof. intros. + unfold check_neg in H. + specialize (@check_add_bvadd_length (map (fun l : int => Lit.neg l) bs) + (map (fun _ : int => Lit._false) bs) bsres (Clit Lit._true)). + intros. simpl in H0. + specialize (H0 H). + destruct H0. now rewrite map_length in H0. +Qed. + +Lemma valid_check_bbNeg pos lres : C.valid rho (check_bbNeg pos lres). +Proof. + unfold check_bbNeg. + case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | | | | | ] a1' Heq9; try now apply C.interp_true. + + case_eq ((a1 == a1') && check_neg bs1 bsres && + (N.of_nat (Datatypes.length bs1) =? n)%N); + simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H3 in H0; try (now contradict H0). + rename H3 into Hv. + + generalize (Hs pos). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + unfold get_type' in H2. unfold v_type in H2. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. + + (** case a1 = a1' **) + do 2 rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq10, Heq11). + destruct Heq10 as (Heq10a1 & Heq10a2). + rewrite Int63Properties.eqb_spec in Heq10a1; rewrite Heq10a1 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H3. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + revert v_vala1 Htia1. rewrite H2. intros. + rewrite Htia1. + unfold apply_unop. + rewrite Typ.cast_refl. + unfold Bval. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n). + { + apply check_neg_length in Heq10a2. + rewrite N.eqb_eq in Heq11. + rewrite Heq10a2 in Heq11. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + + rewrite Typ.cast_refl. + intros. + unfold BITVECTOR_LIST.bv_neg. + apply eq_rec. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n). + { + rewrite N.eqb_eq in Heq11. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + + rewrite Typ.cast_refl. + intros. + rewrite HSp1. simpl. + + specialize(@prop_check_neg bs1 bsres). + intros. apply H5 with n. + now rewrite N.eqb_eq in Heq11. + + pose proof Heq10a2 as Heq10a3. + apply check_neg_length in Heq10a3. + rewrite <- Heq10a3. + now rewrite N.eqb_eq in Heq11. + + easy. +Qed. + +Lemma prop_forallb2: forall {A B} {f: A -> B -> bool} l1 l2, forallb2 f l1 l2 = true -> length l1 = length l2. +Proof. intros A B f l1. + induction l1 as [ | xl1 xsl1 IHl1]. + - intros. simpl in H. + case l2 in *. easy. + now contradict H. + - intros. simpl in H. + case l2 in *. + now contradict H. + simpl. + rewrite andb_true_iff in H. destruct H. + apply IHl1 in H0. now rewrite H0. +Qed. + +Lemma prop_and_with_bit: forall a b, map interp_carry (and_with_bit a b) = + RAWBITVECTOR_LIST.and_with_bool (map (Lit.interp rho) a) (Lit.interp rho b). +Proof. intro a. + induction a as [ | xa xsa IHa ]. + - intros. now simpl in *. + - intros. simpl in *. now rewrite IHa. +Qed. + +Lemma prop_mult_step_k_h: forall a b c k, + map interp_carry (mult_step_k_h a b c k) = + RAWBITVECTOR_LIST.mult_bool_step_k_h + (map interp_carry a) (map interp_carry b) + (interp_carry c) k. +Proof. intro a. + induction a as [ | xa xsa IHa ]. + - intros. case b. + now simpl. + intros. now simpl. + - intros. case b in *. simpl. + rewrite IHa. now simpl. + intros. simpl. + case (k - 1 <? 0)%Z. + simpl. apply f_equal. + apply IHa. + rewrite <- map_cons. simpl. apply f_equal. + apply IHa. +Qed. + +Lemma prop_interp_firstn: forall xk' a, map (Lit.interp rho) (List.firstn xk' a) = (List.firstn xk' (map (Lit.interp rho) a)). +Proof. intro xk'0. + induction xk'0. + + intros. now simpl. + + intros. simpl. + case a. now simpl. + intros. simpl. apply f_equal. apply IHxk'0. +Qed. + +Lemma map_firstn: forall A B n (l: list A) (f:A -> B), firstn n (map f l) = map f (firstn n l). +Proof. + intros A B n. + induction n; intro l; induction l; try now simpl. + intros. simpl. apply f_equal. apply IHn. +Qed. + +Lemma prop_mult_step: forall a b res k k', + (map interp_carry (mult_step a b res k k')) = + RAWBITVECTOR_LIST.mult_bool_step (map (Lit.interp rho) a) (map (Lit.interp rho) b) + (map interp_carry res) k k'. +Proof. intros. revert a b res k. + assert (false = (Lit.interp rho (Lit._false))) as Ha. + { + specialize (Lit.interp_false rho wf_rho). intros. + unfold is_true in H. rewrite not_true_iff_false in H. + now rewrite H. + } + + assert (false = interp_carry (Clit Lit._false)). + { + unfold interp_carry. + specialize (Lit.interp_false rho wf_rho). intros. + unfold is_true in H. rewrite not_true_iff_false in H. + now rewrite H. + } + + assert ([] = map (interp_carry) []). { now simpl. } + + induction k' as [ | xk' xsk' IHk' ]. + - intros. + case a. simpl. rewrite H; apply prop_mult_step_k_h. + intros. simpl. rewrite H. rewrite prop_mult_step_k_h. simpl. now rewrite map_nth. + - intros. simpl. + rewrite xsk', prop_mult_step_k_h, prop_and_with_bit. + rewrite <- map_nth, <- Ha, <- H. + case a. now simpl. simpl. intros. + case l. now simpl. simpl. intros. + case xk'. now simpl. intros. now rewrite map_firstn. +Qed. + +Lemma prop_bblast_bvmult: forall a b n, + (map interp_carry (bblast_bvmult a b n)) = + RAWBITVECTOR_LIST.bvmult_bool (map (Lit.interp rho) a) + (map (Lit.interp rho) b) + n. +Proof. intros. + revert a b. + induction n. + - intros. simpl. rewrite prop_and_with_bit. + rewrite <- map_nth. + specialize (Lit.interp_false rho wf_rho). intros. + unfold is_true in H. rewrite not_true_iff_false in H. + now rewrite H. + - intros. simpl. + specialize (Lit.interp_false rho wf_rho). intros. + unfold is_true in H. rewrite not_true_iff_false in H. + case n in *. + rewrite prop_and_with_bit; rewrite <- map_nth; now rewrite H. + rewrite prop_mult_step; rewrite prop_and_with_bit; rewrite <- map_nth; now rewrite H. +Qed. + +Lemma prop_mult_step_k_h_len: forall a b c k, +length (mult_step_k_h a b c k) = length a . +Proof. intro a. + induction a as [ | xa xsa IHa ]. + - intros. simpl. easy. + - intros. + case b in *. simpl. rewrite IHa. simpl. omega. + simpl. case (k - 1 <? 0)%Z; simpl; now rewrite IHa. +Qed. + +Lemma prop_mult_step3: forall k' a b res k, + length (mult_step a b res k k') = (length res)%nat. +Proof. intro k'. + induction k'. + - intros. simpl. rewrite prop_mult_step_k_h_len. simpl. omega. + - intros. simpl. + rewrite IHk'. rewrite prop_mult_step_k_h_len. simpl; omega. +Qed. + +Lemma prop_and_with_bit2: forall bs1 b, length (and_with_bit bs1 b) = length bs1. +Proof. intros bs1. + induction bs1. + - intros. now simpl. + - intros. simpl. now rewrite IHbs1. +Qed. + +Lemma check_bvmult_length: forall bs1 bs2, + let bsres0 := bblast_bvmult bs1 bs2 (length bs1) in + length bs1 = length bs2 -> length bs1 = length bsres0. +Proof. intros. unfold bblast_bvmult in bsres0. + case_eq (length bs1). intros. unfold bsres0. + rewrite H0. + specialize (@prop_and_with_bit2 bs1 (nth 0 bs2 Lit._false)). intros. + now rewrite H1. + intros. unfold bsres0. rewrite H0. + case n in *. + simpl. rewrite prop_and_with_bit2. auto. + rewrite prop_mult_step3. rewrite prop_and_with_bit2. auto. +Qed. + +Lemma check_bvmult_length2: forall bs1 bs2 bsres, + check_mult bs1 bs2 bsres = true -> length bs1 = length bs2 . +Proof. intros bs1. + induction bs1. + - intros. case bs2 in *. + + easy. + + unfold check_mult in H. + now contradict H. + - intros. unfold check_mult in H. + case_eq (Nat_eqb (Datatypes.length (a :: bs1)) ((Datatypes.length bs2))). + intros. now apply Nat_eqb_eq in H0. + intros. rewrite H0 in H. now contradict H. +Qed. + +Lemma prop_eq_carry_lit2: forall a b, forallb2 eq_carry_lit a b = true -> + (map interp_carry a) = (map (Lit.interp rho) b). +Proof. intro a. + induction a. + - intros. simpl in H. + case b in *. now simpl. + now contradict H. + - intros. + case b in *. + now simpl. + simpl in *. rewrite andb_true_iff in H; destruct H. + apply prop_eq_carry_lit in H. + rewrite H. apply f_equal. now apply IHa. +Qed. + +Lemma prop_main: forall bs1 bs2 bsres, + check_mult bs1 bs2 bsres = true -> + map interp_carry (bblast_bvmult bs1 bs2 (Datatypes.length (map (Lit.interp rho) bs1))) = + map (Lit.interp rho) bsres. +Proof. intros. unfold check_mult in H. + case_eq (Nat_eqb (Datatypes.length bs1) (Datatypes.length bs2)). intros. + rewrite H0 in H. apply prop_eq_carry_lit2 in H. + rewrite map_length. + now rewrite H. + intros. rewrite H0 in H. now contradict H. +Qed. + +Lemma valid_check_bbMult pos1 pos2 lres : C.valid rho (check_bbMult pos1 pos2 lres). +Proof. + unfold check_bbMult. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; try (intros; now apply C.interp_true). + (* BVmult *) + - case_eq ((a1 == a1') && (a2 == a2') (* || (a1 == a2') && (a2 == a1')*) ); + simpl; intros Heq10; try (now apply C.interp_true). + + case_eq ( + check_mult bs1 bs2 bsres && + (N.of_nat (Datatypes.length bs1) =? N)%N + ); simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H4 in H0; try (now contradict H0). + rename H4 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + + (** case a1 = a1' and a2 = a2' **) + rewrite andb_true_iff in Heq10. + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2; + rewrite Heq10a1, Heq10a2 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H4. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2. + intros v_vala2 Htia2 v_vala1 Htia1. + rewrite Htia1, Htia2. + rewrite Typ.cast_refl. + unfold Bval. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + pose proof Heq11 as Heq11'. + apply prop_main in Heq11. + rewrite <- Heq11. rewrite !map_length. + specialize (@check_bvmult_length bs1 bs2). + intros. simpl in H5. rewrite <- H5. + now rewrite N.eqb_eq in Heq11r. + now apply check_bvmult_length2 in Heq11'. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + + rewrite Typ.cast_refl. + intros. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H5 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + rewrite H101. + + rewrite Typ.cast_refl. + intros. + + rewrite HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H6 in HSp2. + unfold interp_bv in HSp2. + rewrite Htia2 in HSp2. + unfold interp_bv in HSp2. + + revert HSp2. + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = N). + { + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11, Heq11r). + rewrite N.eqb_eq in Heq11r. + apply check_bvmult_length2 in Heq11. + rewrite Heq11 in Heq11r. + now rewrite map_length. + } + + generalize (BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H102. + + rewrite Typ.cast_refl. + intros. rewrite HSp2. + + pose proof Heq11. + + unfold BITVECTOR_LIST.bv_mult. + unfold RAWBITVECTOR_LIST.bv_mult. + unfold RAWBITVECTOR_LIST.size, RAWBITVECTOR_LIST.bits. + unfold BITVECTOR_LIST.of_bits. + + unfold BITVECTOR_LIST.bv. + unfold RAWBITVECTOR_LIST.of_bits. + apply eq_rec. simpl. + + rewrite andb_true_iff in Heq11. + destruct Heq11 as (Heq11 & Heq11r). + rewrite N.eqb_eq in Heq11r. + rewrite map_length, Heq11r. + + apply check_bvmult_length2 in Heq11. + rewrite Heq11 in Heq11r. + rewrite map_length, Heq11r. + rewrite N.eqb_compare, N.compare_refl. + unfold RAWBITVECTOR_LIST.mult_list. + rewrite <- prop_bblast_bvmult. + + rewrite andb_true_iff in H7. + destruct H7 as (H7 & H7r). + + rewrite map_length. + apply prop_main in H7. + rewrite map_length in H7. + rewrite <- H7. + + easy. +Qed. + + +Lemma prop_interp_carry3: forall bs2, map interp_carry (lit_to_carry bs2) = map (Lit.interp rho) bs2. +Proof. intro bs2. + induction bs2 as [ | xbs2 xsbs2 IHbs2 ]. + - now simpl. + - simpl. now rewrite IHbs2. +Qed. + +Lemma check_concat_map: forall bs1 bs2, + map (Lit.interp rho) bs1 ++ map (Lit.interp rho) bs2 = map (Lit.interp rho) (bs1 ++ bs2). +Proof. intro bs1. + induction bs1. + - intros. now simpl. + - intros. simpl. now rewrite IHbs1. +Qed. + +Lemma concat_nil: forall {A} (a: list A), a ++ [] = a. +Proof. intros A a. + case a; [ easy | intros; apply app_nil_r ]. +Qed. + + +(* for native-coq compatibility *) +Lemma concat_map : forall (A B : Set) (f : A -> B) (l0 l1 : list A), + map f (l0 ++ l1) = (map f l0) ++ (map f l1). +Proof. + induction l0 as [ | xl0 xsl0 IHl0]; intros. + - now simpl. + - simpl. now rewrite IHl0. +Qed. + +Lemma check_concat_bvconcat: forall bs1 bs2 bsres , + check_concat bs1 bs2 bsres = true -> + (RAWBITVECTOR_LIST.bv_concat (map (Lit.interp rho) bs1) (map (Lit.interp rho) bs2) = + (map (Lit.interp rho) bsres)). +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1 ]. + - intros. simpl. + unfold check_concat in H. simpl in H. + case_eq (forallb2 eq_carry_lit (lit_to_carry bs2) bsres); intros. + rewrite concat_nil in H. + apply prop_eq_carry_lit2 in H0. + unfold RAWBITVECTOR_LIST.bv_concat. + rewrite concat_nil. + now rewrite prop_interp_carry3 in H0. + unfold RAWBITVECTOR_LIST.bv_concat. + rewrite concat_nil. + rewrite concat_nil in H. + rewrite H0 in H. now contradict H. + - intros. unfold check_concat in H. + case_eq (forallb2 eq_carry_lit (lit_to_carry (bs2 ++ xbs1 :: xsbs1)) bsres); intros. + apply prop_eq_carry_lit2 in H0. + rewrite prop_interp_carry3 in H0. + simpl in H0. simpl. + unfold RAWBITVECTOR_LIST.bv_concat. + specialize (concat_map (Lit.interp rho)). intros. + rewrite <- H0. simpl. + rewrite <- !check_concat_map. + apply f_equal. + now simpl. + rewrite H0 in H; now contradict H. +Qed. + +Lemma app_length : forall (l1 l2: list bool), (length (l1 ++ l2))%nat = ((length l1) + (length l2))%nat. +Proof. + induction l1; simpl; auto. +Qed. + +Lemma concat_len: forall (bs1 bs2 bsres: list bool), bs1 ++ bs2 = bsres -> + ((length bs1) + (length bs2))%nat = (length bsres)%nat. +Proof. intro bs1. + induction bs1. + - intros. simpl. simpl in H. now rewrite H. + - intros. simpl. simpl in H. rewrite <- H. simpl. + now rewrite app_length. +Qed. + +Lemma valid_check_bbConcat pos1 pos2 lres : C.valid rho (check_bbConcat pos1 pos2 lres). +Proof. + unfold check_bbConcat. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 bs2 Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; try (intros; now apply C.interp_true). + (* BVconcat *) + - case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq10; try (now apply C.interp_true). + case_eq ( + check_concat bs1 bs2 bsres && (N.of_nat (Datatypes.length bs1) =? N)%N && + (N.of_nat (Datatypes.length bs2) =? n)%N + ); simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H4 in H0; try (now contradict H0). + rename H4 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp2. + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + (** case a1 = a1' and a2 = a2' **) + rewrite andb_true_iff in Heq10. + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2; + rewrite Heq10a1, Heq10a2 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H4. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + + revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2. + intros v_vala2 Htia2 v_vala1 Htia1. + rewrite Htia1, Htia2. + rewrite !Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = (N + n)%N). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as ((Heq11, Heq11l) & Heq11r). + apply check_concat_bvconcat in Heq11. + unfold RAWBITVECTOR_LIST.bv_concat in Heq11. + apply concat_len in Heq11. + apply N.eqb_eq in Heq11l. + apply N.eqb_eq in Heq11r. + rewrite !map_length in Heq11. + rewrite <- Heq11l, <- Heq11r. + rewrite map_length. lia. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H5 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = N). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as ((Heq11, Heq11l) & Heq11r). + apply check_concat_bvconcat in Heq11. + apply N.eqb_eq in Heq11l. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp1. + + (* interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2'])) *) + assert (interp_form_hatom_bv a2' = + interp_bv t_i (interp_atom (t_atom .[a2']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia2. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia2. easy. + } + + rewrite H6 in HSp2. + unfold interp_bv in HSp2. + rewrite Htia2 in HSp2. + unfold interp_bv in HSp2. + + revert HSp2. + + assert (H102: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs2))) = n). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as ((Heq11, Heq11l) & Heq11r). + apply check_concat_bvconcat in Heq11. + apply N.eqb_eq in Heq11r. + now rewrite map_length. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs2)). + + rewrite H102. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp2. simpl. + unfold BITVECTOR_LIST.bv_concat. + apply eq_rec. simpl. + apply check_concat_bvconcat. + + rewrite !andb_true_iff in Heq11. + now destruct Heq11 as ((Heq11, Heq11l) & Heq11r). +Qed. + +Lemma extract_interp_zero: forall a n, RAWBITVECTOR_LIST.extract (map (Lit.interp rho) a) 0 n = +map (Lit.interp rho) (extract_lit a 0 n). +Proof. intro a. + induction a as [ | xa xsa IHa]. + - intros. now simpl. + - intros. simpl. + case_eq n. + now simpl. + intros. simpl. apply f_equal. + now rewrite IHa. +Qed. + +Lemma extract_interp_all: forall a m n, RAWBITVECTOR_LIST.extract (map (Lit.interp rho) a) m n = +map (Lit.interp rho) (extract_lit a m n). +Proof. intro a. + induction a as [ | xa xsa IHa]. + - intros. now simpl. + - intros. case_eq m. + intros. apply extract_interp_zero. + intros. simpl. + case_eq n. + now simpl. + intros. simpl. + now rewrite IHa. +Qed. + +Lemma extract_interp_main: forall bs1 bsres (i n0: N), + check_extract bs1 bsres i (n0 + i) = true -> + @RAWBITVECTOR_LIST.bv_extr i n0 (N.of_nat (length bs1)) + (map (Lit.interp rho) bs1) = map (Lit.interp rho) bsres. +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. simpl. + unfold check_extract in H. simpl in H. + unfold RAWBITVECTOR_LIST.bv_extr. + case_eq (nat_of_N i). + intros. simpl. + case_eq (nat_of_N n0). + intros. simpl. + case_eq ((0 <? n0 + i)%N); intros. + rewrite H2 in H. now contradict H. + rewrite H2 in H. + case_eq bsres. intros. now simpl. + intros. rewrite H3 in H. now contradict H. + intros. + case_eq bsres. intros. + apply (f_equal (N.of_nat)) in H1. + apply (f_equal (N.of_nat)) in H0. + rewrite N2Nat.id in H1, H0. rewrite H1, H0 in H. + simpl in H. now contradict H0. + intros. rewrite H2 in H. + case ((0 <? n0 + i)%N) in H; now contradict H. + intros. + case_eq (N.to_nat n0). + intros. + apply (f_equal (N.of_nat)) in H1. + apply (f_equal (N.of_nat)) in H0. + rewrite N2Nat.id in H1, H0. rewrite H1, H0 in H. + simpl in H. now contradict H0. + intros. + apply (f_equal (N.of_nat)) in H1. + apply (f_equal (N.of_nat)) in H0. + rewrite N2Nat.id in H1, H0. rewrite H1, H0 in H. + simpl in H. now contradict H0. + - intros. unfold check_extract in H. + case_eq ((N.of_nat (Datatypes.length (xbs1 :: xsbs1)) <? n0 + i)%N). + intros. rewrite H0 in H. now contradict H. + intros. rewrite H0 in H. + case_eq ( + forallb2 eq_carry_lit + (lit_to_carry + (extract_lit (xbs1 :: xsbs1) + (N.to_nat i) (N.to_nat (n0 + i)))) bsres); intros. + apply prop_eq_carry_lit2 in H1. + rewrite prop_interp_carry3 in H1. + simpl in H1. simpl. + + unfold RAWBITVECTOR_LIST.bv_extr in *. + simpl in *. + case_eq (N.to_nat i); intros; rewrite H2 in H1. + case_eq (N.to_nat (n0 + i)); intros; rewrite H3 in H1. + rewrite <- H1. rewrite H0. easy. + rewrite H0. + + simpl in H1. + rewrite <- H1. simpl. apply f_equal. + + now rewrite extract_interp_zero. + + case_eq (N.to_nat (n0 + i)); intros; rewrite H3 in H1. + rewrite H0. + rewrite <- H1. easy. + + rewrite H0. + now rewrite extract_interp_all. + + rewrite H1 in H. now contradict H. +Qed. + + Lemma Npos_dist: forall p p0: positive, (Npos (p + p0))%N = (Npos p + Npos p0)%N. + Proof. intros. case p in *; case p0 in *; easy. Qed. + + Lemma not_ltb2: forall (n0 n1 i: N), (n1 >= n0 + i)%N -> (n1 <? n0 + i)%N = false. + Proof. intro n0. + induction n0. + intros. simpl in *. + now apply N.ltb_nlt in H. + + intros. simpl. + case_eq i. + intros. subst. simpl in H. + now apply N.ltb_nlt in H. + intros. subst. + apply N.ltb_nlt in H. + now rewrite Npos_dist. + Qed. + +Lemma valid_check_bbExtract pos lres : C.valid rho (check_bbExtract pos lres). +Proof. + unfold check_bbExtract. + case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq2; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq3; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq4. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq5. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | | | | | ] a1' Heq6; try (intros; now apply C.interp_true). + (* BVextract *) + - case_eq ((a1 == a1')); simpl; intros Heq7; try (now apply C.interp_true). + case_eq ( + check_extract bs1 bsres i (n0 + i) && + (N.of_nat (Datatypes.length bs1) =? n1)%N && (n0 + i <=? n1)%N + ); simpl; intros Heq8; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq3. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq5. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. easy. } + specialize (@H0 H1). rewrite Heq6 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H3 in H0; try (now contradict H2). + rename H0 into Hv. + + generalize (Hs pos). intros HSp. unfold C.valid in HSp. rewrite Heq1 in HSp. + unfold C.interp in HSp. unfold existsb in HSp. rewrite orb_false_r in HSp. + unfold Lit.interp in HSp. rewrite Heq2 in HSp. unfold Var.interp in HSp. + rewrite rho_interp in HSp. rewrite Heq4 in HSp. simpl in HSp. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp. + + unfold get_type' in H2. unfold v_type in H2. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. + + (** case a1 = a1' **) + rewrite eqb_spec in Heq7; rewrite Heq7 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H0. rewrite Heq6. simpl. + unfold interp_bv. unfold apply_unop. + + rewrite !Atom.t_interp_wf; trivial. + + revert v_vala1 Htia1. rewrite H2. + intros v_vala1 Htia1. + rewrite Htia1. + rewrite !Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n0%N). + { + rewrite !andb_true_iff in Heq8. + destruct Heq8 as ((Heq8a, Heq8b), Heq8c). + rewrite map_length. + specialize (@extract_interp_main bs1 bsres i n0 Heq8a). + intros. + unfold RAWBITVECTOR_LIST.bv_extr in H4. + assert (length (RAWBITVECTOR_LIST.extract (map (Lit.interp rho) bs1) (N.to_nat i) + (N.to_nat (n0 + i))) = length (map (Lit.interp rho) bsres)). + rewrite N.eqb_eq in Heq8b. + rewrite Heq8b in H4. + case_eq ((n1 <? n0 + i)%N); intros. + apply N.leb_le in Heq8c. + assert ((n0 + i <= n1)%N -> (n1 >= n0 + i)%N). + { lia. } apply H6 in Heq8c. + apply not_ltb2 in Heq8c. + rewrite Heq8c in H5. now contradict H5. + rewrite H5 in H4. + now rewrite H4. + rewrite RAWBITVECTOR_LIST.length_extract, !map_length in H5. + assert ((n0 + i - i)%N = n0). + { lia. } rewrite H6 in H5. + now rewrite <- H5, N2Nat.id. + + rewrite map_length. + rewrite N.eqb_eq in Heq8b. + rewrite Heq8b. unfold is_true. + apply N.leb_le in Heq8c. + assert ((n0 + i <= n1)%N -> (n1 >= n0 + i)%N). + { lia. } now apply H6 in Heq8c. + lia. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp. + unfold interp_bv in HSp. + rewrite Htia1 in HSp. + unfold interp_bv in HSp. + + revert HSp. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n1). + { rewrite !andb_true_iff in Heq8. + destruct Heq8 as ((Heq8a, Heq8b), Heq8c). + rewrite map_length. + now rewrite N.eqb_eq in Heq8b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp. simpl. + unfold BITVECTOR_LIST.bv_extr. + apply eq_rec. simpl. + rewrite !andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + specialize (@extract_interp_main bs1 bsres i n0). + intros. + rewrite map_length in H101. + rewrite H101 in H5. now apply H5. +Qed. + +Lemma zextend_interp_zero: forall a, RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) a) O = +(map (Lit.interp rho) (zextend_lit a 0)). +Proof. now simpl. Qed. + +Lemma zextend_interp_empty: forall i, RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) []) i = +map (Lit.interp rho) (zextend_lit [] i). +Proof. simpl. intro i. + induction i. + - intros. now simpl. + - intros. simpl. + unfold RAWBITVECTOR_LIST.zextend in *. + simpl. rewrite IHi. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. } + now rewrite H. + Qed. + +Lemma zextend_interp_all: forall a i, RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) a) i = +map (Lit.interp rho) (zextend_lit a i). +Proof. intro a. + induction a as [ | xa xsa IHa]. + - intros. simpl. + induction i. + + intros. now simpl. + + intros. unfold RAWBITVECTOR_LIST.zextend in *. + simpl. rewrite IHi. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. } + now rewrite H. + - intros. + induction i. + + now simpl. + + unfold RAWBITVECTOR_LIST.zextend, zextend_lit in *. + simpl in *. rewrite <- IHi. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. } + now rewrite H. +Qed. + +Lemma zextend_interp_main: forall bs1 bsres (n i: N), + check_zextend bs1 bsres i = true -> + @RAWBITVECTOR_LIST.bv_zextn n i + (map (Lit.interp rho) bs1) = map (Lit.interp rho) bsres. +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. simpl. + unfold check_zextend in H. simpl in H. + case_eq (forallb2 eq_carry_lit + (lit_to_carry (zextend_lit [] (N.to_nat i))) bsres). + intros. + apply prop_eq_carry_lit2 in H0. + rewrite prop_interp_carry3 in H0. + simpl in H0. + unfold RAWBITVECTOR_LIST.bv_zextn. + now rewrite zextend_interp_empty. + intros. rewrite H0 in H. now contradict H0. + - intros. unfold RAWBITVECTOR_LIST.bv_zextn, check_zextend in H. + case_eq ( + forallb2 eq_carry_lit + (lit_to_carry + (zextend_lit (xbs1 :: xsbs1) (N.to_nat i))) + bsres); intros. + apply prop_eq_carry_lit2 in H0. + rewrite prop_interp_carry3 in H0. + simpl in H0. simpl. + + unfold RAWBITVECTOR_LIST.bv_zextn in *. + case_eq (N.to_nat i). intros. rewrite H1 in H0. + now simpl in *. + intros. rewrite H1 in H0. + rewrite <- H0. + rewrite <- zextend_interp_all. + simpl. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H2. } + reflexivity. + + rewrite H0 in H. now contradict H. +Qed. + +Lemma valid_check_bbZextend pos lres : C.valid rho (check_bbZextend pos lres). +Proof. + unfold check_bbZextend. + case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq2; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq3; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq4. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq5. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | | | | | ] a1' Heq6; try (intros; now apply C.interp_true). + (* BVzextend *) + - case_eq ((a1 == a1')); simpl; intros Heq7; try (now apply C.interp_true). + case_eq ( + check_zextend bs1 bsres i && (N.of_nat (Datatypes.length bs1) =? n)%N + ); simpl; intros Heq8; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq3. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq5. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. easy. } + specialize (@H0 H1). rewrite Heq6 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H3 in H0; try (now contradict H0). + rename H0 into Hv. + + generalize (Hs pos). intros HSp. unfold C.valid in HSp. rewrite Heq1 in HSp. + unfold C.interp in HSp. unfold existsb in HSp. rewrite orb_false_r in HSp. + unfold Lit.interp in HSp. rewrite Heq2 in HSp. unfold Var.interp in HSp. + rewrite rho_interp in HSp. rewrite Heq4 in HSp. simpl in HSp. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp. + + unfold get_type' in H2. unfold v_type in H2. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. + + (** case a1 = a1' **) + rewrite eqb_spec in Heq7; rewrite Heq7 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H0. rewrite Heq6. simpl. + unfold interp_bv. unfold apply_unop. + + rewrite !Atom.t_interp_wf; trivial. + + revert v_vala1 Htia1. rewrite H2. + intros v_vala1 Htia1. + rewrite Htia1. + rewrite !Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = (i + n)%N). + { + rewrite andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + rewrite map_length. + specialize (@zextend_interp_main bs1 bsres n i). + intros. + apply H4 in Heq8a. + unfold RAWBITVECTOR_LIST.bv_zextn in Heq8a. + assert (length (RAWBITVECTOR_LIST.zextend (map (Lit.interp rho) bs1) (N.to_nat i)) + = length (map (Lit.interp rho) bsres)). + { now rewrite Heq8a. } + rewrite RAWBITVECTOR_LIST.length_zextend, !map_length in H5. + apply (f_equal (N.of_nat)) in H5. + rewrite <- H5. + + rewrite N.eqb_eq in Heq8b. + apply (f_equal (N.to_nat)) in Heq8b. + rewrite Nat2N.id in Heq8b. + rewrite Heq8b. lia. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp. + unfold interp_bv in HSp. + rewrite Htia1 in HSp. + unfold interp_bv in HSp. + + revert HSp. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n). + { + rewrite andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + rewrite map_length. + now rewrite N.eqb_eq in Heq8b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp. simpl. + unfold BITVECTOR_LIST.bv_zextn. + apply eq_rec. simpl. + rewrite andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + now apply zextend_interp_main. +Qed. + +Lemma sextend_interp_zero: forall a, RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) a) O = +(map (Lit.interp rho) (sextend_lit a 0)). +Proof. intros. + unfold RAWBITVECTOR_LIST.sextend. + case_eq a; intros; now simpl. +Qed. + +Lemma sextend_interp_empty: forall i, RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) []) i = +map (Lit.interp rho) (sextend_lit [] i). +Proof. simpl. intro i. + induction i. + - intros. now simpl. + - intros. simpl. + unfold RAWBITVECTOR_LIST.sextend in *. + simpl. rewrite IHi. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. } + now rewrite H. + Qed. + +Lemma sextend_interp_all: forall a i, RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) a) i = +map (Lit.interp rho) (sextend_lit a i). +Proof. intro a. + induction a as [ | xa xsa IHa]. + - intros. simpl. + induction i. + + intros. now simpl. + + intros. unfold RAWBITVECTOR_LIST.sextend in *. + simpl. rewrite IHi. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. } + now rewrite H. + - intros. + induction i. + + now simpl. + + unfold RAWBITVECTOR_LIST.sextend, zextend_lit in *. + simpl in *. rewrite <- IHi. + assert (Lit.interp rho Lit._false = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H. } + reflexivity. +Qed. + +Lemma sextend_interp_main: forall bs1 bsres (n i: N), + check_sextend bs1 bsres i = true -> + @RAWBITVECTOR_LIST.bv_sextn n i + (map (Lit.interp rho) bs1) = map (Lit.interp rho) bsres. +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1]. + - intros. simpl. + unfold check_zextend in H. simpl in H. + case_eq (forallb2 eq_carry_lit + (lit_to_carry (sextend_lit [] (N.to_nat i))) bsres). + intros. + apply prop_eq_carry_lit2 in H0. + rewrite prop_interp_carry3 in H0. + simpl in H0. + unfold RAWBITVECTOR_LIST.bv_sextn. + now rewrite sextend_interp_empty. + intros. + unfold check_sextend in H. + rewrite H0 in H. now contradict H0. + - intros. unfold RAWBITVECTOR_LIST.bv_sextn, check_sextend in H. + case_eq ( + forallb2 eq_carry_lit + (lit_to_carry + (sextend_lit (xbs1 :: xsbs1) (N.to_nat i))) + bsres); intros. + apply prop_eq_carry_lit2 in H0. + rewrite prop_interp_carry3 in H0. + simpl in H0. + + unfold RAWBITVECTOR_LIST.bv_sextn in *. + case_eq (N.to_nat i). intros. rewrite H1 in H0. + now simpl in *. + intros. rewrite H1 in H0. + rewrite <- H0. + + rewrite sextend_interp_all. + now simpl. + + rewrite H0 in H. now contradict H. +Qed. + +Lemma valid_check_bbSextend pos lres : C.valid rho (check_bbSextend pos lres). +Proof. + unfold check_bbSextend. + case_eq (S.get s pos); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq2; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq3; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq4. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq5. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | | | | | ] a1' Heq6; try (intros; now apply C.interp_true). + (* BVsextend *) + - case_eq ((a1 == a1')); simpl; intros Heq7; try (now apply C.interp_true). + case_eq ( + check_sextend bs1 bsres i && (N.of_nat (Datatypes.length bs1) =? n)%N + ); simpl; intros Heq8; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq3. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq5. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq6. easy. } + specialize (@H0 H1). rewrite Heq6 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H3 in H0; try (now contradict H0). + rename H0 into Hv. + + generalize (Hs pos). intros HSp. unfold C.valid in HSp. rewrite Heq1 in HSp. + unfold C.interp in HSp. unfold existsb in HSp. rewrite orb_false_r in HSp. + unfold Lit.interp in HSp. rewrite Heq2 in HSp. unfold Var.interp in HSp. + rewrite rho_interp in HSp. rewrite Heq4 in HSp. simpl in HSp. + + apply BITVECTOR_LIST.bv_eq_reflect in HSp. + + unfold get_type' in H2. unfold v_type in H2. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. + + (** case a1 = a1' **) + rewrite eqb_spec in Heq7; rewrite Heq7 in *. + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H0. rewrite Heq6. simpl. + unfold interp_bv. unfold apply_unop. + + rewrite !Atom.t_interp_wf; trivial. + + revert v_vala1 Htia1. rewrite H2. + intros v_vala1 Htia1. + rewrite Htia1. + rewrite !Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = (i + n)%N). + { + rewrite andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + rewrite map_length. + specialize (@sextend_interp_main bs1 bsres n i). + intros. + apply H4 in Heq8a. + unfold RAWBITVECTOR_LIST.bv_sextn in Heq8a. + assert (length (RAWBITVECTOR_LIST.sextend (map (Lit.interp rho) bs1) (N.to_nat i)) + = length (map (Lit.interp rho) bsres)). + { now rewrite Heq8a. } + rewrite RAWBITVECTOR_LIST.length_sextend, !map_length in H5. + apply (f_equal (N.of_nat)) in H5. + rewrite <- H5. + + rewrite N.eqb_eq in Heq8b. + apply (f_equal (N.to_nat)) in Heq8b. + rewrite Nat2N.id in Heq8b. + rewrite Heq8b. lia. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H4 in HSp. + unfold interp_bv in HSp. + rewrite Htia1 in HSp. + unfold interp_bv in HSp. + + revert HSp. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n). + { + rewrite andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + rewrite map_length. + now rewrite N.eqb_eq in Heq8b. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp. simpl. + unfold BITVECTOR_LIST.bv_sextn. + apply eq_rec. simpl. + rewrite andb_true_iff in Heq8. + destruct Heq8 as (Heq8a, Heq8b). + now apply sextend_interp_main. +Qed. + + +Lemma nshl_lit_empty: forall b, nshl_lit_be [] b = []. +Proof. intro b. + induction b; intros; now simpl. +Qed. + +Lemma shl_lit_empty: forall b, shl_lit_be [] b = []. +Proof. intro b. unfold shl_lit_be. now rewrite nshl_lit_empty. Qed. + +Lemma rawbv_nshl_empty: forall b, RAWBITVECTOR_LIST.nshl_be [] b = []. +Proof. intro b. + induction b; intros; now simpl. +Qed. + +Lemma bv_shl_empty: forall b, RAWBITVECTOR_LIST.bv_shl [] b = []. +Proof. intro b. unfold RAWBITVECTOR_LIST.bv_shl. + case_eq b; simpl; intros. + unfold RAWBITVECTOR_LIST.shl_be. now rewrite rawbv_nshl_empty. + unfold RAWBITVECTOR_LIST.size. simpl. + unfold RAWBITVECTOR_LIST.zeros. now simpl. + Qed. + +Lemma helper: forall {A} (l0: list A) i0, S (S (length match l0 with + | [] => [] + | _ :: _ => i0 :: removelast l0 + end)) = S (S (length l0)). +Proof. intros A l0. + induction l0; intros. + - now simpl. + - simpl. now rewrite IHl0. +Qed. + +Lemma length_shl_lit_be: forall a, length (_shl_lit_be a) = length a. +Proof. intro a. + induction a; intros. + - now simpl. + - unfold _shl_lit_be. simpl. + case_eq a0; intros. + + easy. + + apply f_equal. + case_eq l; intros. + now simpl. + simpl. now rewrite helper. +Qed. + +Lemma length_nshl_lit_be: forall n a, length (nshl_lit_be a n) = length a. +Proof. intros n. + induction n; intros. + - now simpl. + - simpl. rewrite (IHn (_shl_lit_be a)). + simpl. unfold nshl_lit_be. now rewrite length_shl_lit_be. +Qed. + +Lemma length_shl_be: forall a b, length a = length (shl_lit_be a b). +Proof. intros. unfold shl_lit_be. now rewrite length_nshl_lit_be. Qed. + +Lemma length_check_shsl: forall bs1 bs2 bsres , + check_shl bs1 bs2 bsres = true -> length bs1 = length bs2 -> length bs1 = length bsres. +Proof. intro bs1. + induction bs1; intros. + - case_eq bs2; simpl; intros. + + subst. unfold check_shl in H. simpl in H. + case_eq bsres; simpl; intros; subst; easy. + + rewrite H1 in H. unfold check_shl in H. simpl in H. + now contradict H. + - simpl in *. + unfold check_shl in H. simpl in H. + case_eq bs2; simpl; intros; subst. simpl in H. now contradict H. + simpl in *. inversion H0. rewrite H2, Structures.nat_eqb_refl in H. + case_eq (forallb2 eq_carry_lit (lit_to_carry (shl_lit_be (a :: bs1) (b :: l))) bsres); intros. + + apply prop_eq_carry_lit2 in H1. + rewrite prop_interp_carry3 in H1. + simpl in H1. + assert (length (map (Lit.interp rho) (shl_lit_be (a :: bs1) (b :: l))) = + length (map (Lit.interp rho) bsres)). + { now rewrite H1. } + rewrite !map_length in H3. + rewrite <- (length_shl_be (a :: bs1) (b :: l)) in H3. + now simpl in *. + + rewrite H1 in H; now contradict H. +Qed. + +Lemma map_lst: forall l i, match map (Lit.interp rho) l with +| [] => [] +| _ :: _ => Lit.interp rho i :: removelast (map (Lit.interp rho) l) +end = map (Lit.interp rho) match l with + | [] => [] + | _ :: _ => i :: removelast l + end. +Proof. intro l. + induction l; intros. now simpl. + simpl. apply f_equal. now rewrite IHl. +Qed. + +Lemma prop_shl_be: forall a, RAWBITVECTOR_LIST._shl_be (map (Lit.interp rho) a) = + (map (Lit.interp rho) (_shl_lit_be a)). +Proof. intro a. + case_eq a; intros. + - now simpl. + - unfold RAWBITVECTOR_LIST._shl_be, _shl_lit_be. simpl. + assert (Lit.interp rho (Lit._false) = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H0. + } + rewrite H0. apply f_equal. + now rewrite map_lst. +Qed. + +Lemma nshl_interp: forall n bs1, +RAWBITVECTOR_LIST.nshl_be (map (Lit.interp rho) bs1) n = +map (Lit.interp rho) (nshl_lit_be bs1 n). +Proof. intro n. + induction n; intros. + - now simpl. + - simpl. specialize (@IHn (_shl_lit_be bs1)). + rewrite <- IHn. simpl. + now rewrite prop_shl_be. +Qed. + +Lemma shl_interp: forall bs1 bs2, +RAWBITVECTOR_LIST.shl_be (map (Lit.interp rho) bs1) bs2 = +map (Lit.interp rho) (shl_lit_be bs1 bs2). +Proof. intros. + unfold RAWBITVECTOR_LIST.shl_be, shl_lit_be. + now rewrite nshl_interp. +Qed. + + +Lemma check_shl_bvshl: forall bs1 bs2 bsres , + check_shl bs1 bs2 bsres = true -> + (RAWBITVECTOR_LIST.bv_shl (map (Lit.interp rho) bs1) bs2 = + (map (Lit.interp rho) bsres)). +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1 ]. + - intros. simpl. + unfold check_shl, shl_lit_be in H. + case_eq (Structures.nat_eqb (@length int []) (length bs2)); intros. + rewrite Structures.nat_eqb_eq in H0. + rewrite <- H0 in H. simpl in H. + rewrite nshl_lit_empty in H. + case_eq bsres; intros. simpl. + now rewrite bv_shl_empty. + subst; now contradict H. + rewrite H0 in H; now contradict H. + - intros. unfold check_shl in H. + case_eq (Structures.nat_eqb (Datatypes.length (xbs1 :: xsbs1)) (Datatypes.length bs2)); intros. + rewrite H0 in H. + case_eq ( + forallb2 eq_carry_lit (lit_to_carry (shl_lit_be (xbs1 :: xsbs1) bs2)) bsres); intros. + apply prop_eq_carry_lit2 in H1. + rewrite prop_interp_carry3 in H1. + + unfold RAWBITVECTOR_LIST.bv_shl. + rewrite Structures.nat_eqb_eq in H0. + unfold RAWBITVECTOR_LIST.size. + rewrite !map_length. rewrite H0, N.eqb_refl. + now rewrite <- H1, shl_interp. + + rewrite H1 in H; now contradict H. + rewrite H0 in H; now contradict H. +Qed. + +Lemma valid_check_bbShl pos1 pos2 lres : C.valid rho (check_bbShl pos1 pos2 lres). +Proof. + unfold check_bbShl. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 (*bs2*) Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; try (intros; now apply C.interp_true). + case_eq (t_atom .[ a2]); try (intros; now apply C.interp_true). intros c Heqa2. + case_eq c; try (intros; now apply C.interp_true). intros bv2 n0 Heqc. + (* BVshl *) + case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq10; try (now apply C.interp_true). + case_eq ( + check_shl bs1 bv2 bsres && (N.of_nat (Datatypes.length bs1) =? n)%N && + (N.of_nat (Datatypes.length bv2) =? n)%N && (n0 =? n)%N + ); simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + pose proof (H a2). + assert (a2 < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heqa2, Heqc. easy. } + specialize (@H4 H5). rewrite Heqa2 in H4. simpl in H4. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H6 in H0; try (now contradict H0). + rename H6 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + (*apply BITVECTOR_LIST.bv_eq_reflect in HSp2.*) + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (** case a1 = a1' and a2 = a2' **) + rewrite andb_true_iff in Heq10. + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2; + rewrite Heq10a1, Heq10a2 in *. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H6. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + + revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2. + intros v_vala2 Htia2 v_vala1 Htia1. + rewrite Htia1, Htia2. + rewrite !Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n%N). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d). + apply length_check_shsl in Heq11. + rewrite map_length, <- Heq11. + now apply N.eqb_eq in Heq11l. + apply N.eqb_eq in Heq11r. + apply N.eqb_eq in Heq11l. + apply (f_equal (N.to_nat)) in Heq11l. + apply (f_equal (N.to_nat)) in Heq11r. + rewrite Nat2N.id in Heq11l, Heq11r. + now rewrite Heq11l, Heq11r. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H7 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d). + rewrite map_length. + now apply N.eqb_eq in Heq11l. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp1. + + rewrite Heqa2 in Htia2. simpl in Htia2. + unfold interp_cop in Htia2. rewrite Heqc in Htia2. unfold Bval in Htia2. + rewrite !andb_true_iff in Heq11. + destruct Heq11 as (((Heq1a, Heq11b), Heq11c), Heq11d). + apply N.eqb_eq in Heq11d. + rewrite Heq11d in *. + specialize (Bval_inj2 _ (Typ.TBV n) (BITVECTOR_LIST._of_bits bv2 n) v_vala2); intros. + apply H8 in Htia2. rewrite <- Htia2. + + unfold BITVECTOR_LIST.bv_shl. + apply eq_rec. simpl. + apply check_shl_bvshl. + + now unfold RAWBITVECTOR_LIST._of_bits; rewrite Heq11c. +Qed. + + +Lemma nshr_lit_empty: forall b, nshr_lit_be [] b = []. +Proof. intro b. + induction b; intros; now simpl. +Qed. + +Lemma shr_lit_empty: forall b, shr_lit_be [] b = []. +Proof. intro b. unfold shr_lit_be. now rewrite nshr_lit_empty. Qed. + +Lemma rawbv_nshr_empty: forall b, RAWBITVECTOR_LIST.nshr_be [] b = []. +Proof. intro b. + induction b; intros; now simpl. +Qed. + +Lemma bv_shr_empty: forall b, RAWBITVECTOR_LIST.bv_shr [] b = []. +Proof. intro b. unfold RAWBITVECTOR_LIST.bv_shr. + case_eq b; simpl; intros. + unfold RAWBITVECTOR_LIST.shr_be. now rewrite rawbv_nshr_empty. + unfold RAWBITVECTOR_LIST.size. simpl. + unfold RAWBITVECTOR_LIST.zeros. now simpl. + Qed. + +Lemma helper2: forall {A} (l: list A) a, Datatypes.length (l ++ [a]) = S (Datatypes.length l). +Proof. intros A l. + induction l; intros. + - now simpl. + - simpl. now rewrite IHl. +Qed. + +Lemma length_shr_lit_be: forall a, length (_shr_lit_be a) = length a. +Proof. intro a. + induction a; intros. + - now simpl. + - unfold _shr_lit_be. simpl. + case_eq a0; intros. + + easy. + + simpl. apply f_equal. + case_eq l; intros. + now simpl. + simpl. now rewrite helper2. +Qed. + +Lemma length_nshr_lit_be: forall n a, length (nshr_lit_be a n) = length a. +Proof. intros n. + induction n; intros. + - now simpl. + - simpl. rewrite (IHn (_shr_lit_be a)). + simpl. unfold nshr_lit_be. now rewrite length_shr_lit_be. +Qed. + +Lemma length_shr_be: forall a b, length a = length (shr_lit_be a b). +Proof. intros. unfold shr_lit_be. now rewrite length_nshr_lit_be. Qed. + +Lemma length_check_shsr: forall bs1 bs2 bsres , + check_shr bs1 bs2 bsres = true -> length bs1 = length bs2 -> length bs1 = length bsres. +Proof. intro bs1. + induction bs1; intros. + - case_eq bs2; simpl; intros. + + subst. unfold check_shl in H. simpl in H. + case_eq bsres; simpl; intros; subst; easy. + + rewrite H1 in H. unfold check_shl in H. simpl in H. + now contradict H. + - simpl in *. + unfold check_shr in H. simpl in H. + case_eq bs2; simpl; intros; subst. simpl in H. now contradict H. + simpl in *. inversion H0. rewrite H2, Structures.nat_eqb_refl in H. + case_eq (forallb2 eq_carry_lit (lit_to_carry (shr_lit_be (a :: bs1) (b :: l))) bsres); intros. + + apply prop_eq_carry_lit2 in H1. + rewrite prop_interp_carry3 in H1. + simpl in H1. + assert (length (map (Lit.interp rho) (shr_lit_be (a :: bs1) (b :: l))) = + length (map (Lit.interp rho) bsres)). + { now rewrite H1. } + rewrite !map_length in H3. + rewrite <- (length_shr_be (a :: bs1) (b :: l)) in H3. + now simpl in *. + + rewrite H1 in H; now contradict H. +Qed. + +Lemma prop_shr_be: forall a, RAWBITVECTOR_LIST._shr_be (map (Lit.interp rho) a) = + (map (Lit.interp rho) (_shr_lit_be a)). +Proof. intro a. + case_eq a; intros. + - now simpl. + - unfold RAWBITVECTOR_LIST._shr_be, _shr_lit_be. simpl. + rewrite map_app. simpl. + assert (Lit.interp rho (Lit._false) = false). + { specialize (Lit.interp_false rho wf_rho). intros. + rewrite <- not_true_iff_false. + unfold not in *. + intros. now apply H0. + } + now rewrite H0. +Qed. + +Lemma nshr_interp: forall n bs1, +RAWBITVECTOR_LIST.nshr_be (map (Lit.interp rho) bs1) n = +map (Lit.interp rho) (nshr_lit_be bs1 n). +Proof. intro n. + induction n; intros. + - now simpl. + - simpl. specialize (@IHn (_shr_lit_be bs1)). + rewrite <- IHn. simpl. + now rewrite prop_shr_be. +Qed. + +Lemma shr_interp: forall bs1 bs2, +RAWBITVECTOR_LIST.shr_be (map (Lit.interp rho) bs1) bs2 = +map (Lit.interp rho) (shr_lit_be bs1 bs2). +Proof. intros. + unfold RAWBITVECTOR_LIST.shr_be, shr_lit_be. + now rewrite nshr_interp. +Qed. + + +Lemma check_shr_bvshr: forall bs1 bs2 bsres , + check_shr bs1 bs2 bsres = true -> + (RAWBITVECTOR_LIST.bv_shr (map (Lit.interp rho) bs1) bs2 = + (map (Lit.interp rho) bsres)). +Proof. intro bs1. + induction bs1 as [ | xbs1 xsbs1 IHbs1 ]. + - intros. simpl. + unfold check_shr, shr_lit_be in H. + case_eq (Structures.nat_eqb (@length int []) (length bs2)); intros. + rewrite Structures.nat_eqb_eq in H0. + rewrite <- H0 in H. simpl in H. + rewrite nshr_lit_empty in H. + case_eq bsres; intros. simpl. + now rewrite bv_shr_empty. + subst; now contradict H. + rewrite H0 in H; now contradict H. + - intros. unfold check_shr in H. + case_eq (Structures.nat_eqb (Datatypes.length (xbs1 :: xsbs1)) (Datatypes.length bs2)); intros. + rewrite H0 in H. + case_eq ( + forallb2 eq_carry_lit (lit_to_carry (shr_lit_be (xbs1 :: xsbs1) bs2)) bsres); intros. + apply prop_eq_carry_lit2 in H1. + rewrite prop_interp_carry3 in H1. + + unfold RAWBITVECTOR_LIST.bv_shr. + rewrite Structures.nat_eqb_eq in H0. + unfold RAWBITVECTOR_LIST.size. + rewrite !map_length. rewrite H0, N.eqb_refl. + now rewrite <- H1, shr_interp. + + rewrite H1 in H; now contradict H. + rewrite H0 in H; now contradict H. +Qed. + + +Lemma valid_check_bbShr pos1 pos2 lres : C.valid rho (check_bbShr pos1 pos2 lres). +Proof. + unfold check_bbShr. + case_eq (S.get s pos1); [intros _|intros l1 [ |l] Heq1]; try now apply C.interp_true. + case_eq (S.get s pos2); [intros _|intros l2 [ |l] Heq2]; try now apply C.interp_true. + case_eq (Lit.is_pos l1); intro Heq3; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos l2); intro Heq4; simpl; try now apply C.interp_true. + case_eq (Lit.is_pos lres); intro Heq5; simpl; try now apply C.interp_true. + case_eq (t_form .[ Lit.blit l1]); try (intros; now apply C.interp_true). intros a1 bs1 Heq6. + case_eq (t_form .[ Lit.blit l2]); try (intros; now apply C.interp_true). intros a2 (*bs2*) Heq7. + case_eq (t_form .[ Lit.blit lres]); try (intros; now apply C.interp_true). + intros a bsres Heq8. + case_eq (t_atom .[ a]); try (intros; now apply C.interp_true). + intros [ | | | | | | |[ A B | A| | | | ]|N|N|N|N|N|N|N|N|N| | | | ] a1' a2' Heq9; try (intros; now apply C.interp_true). + case_eq (t_atom .[ a2]); try (intros; now apply C.interp_true). intros c Heqa2. + case_eq c; try (intros; now apply C.interp_true). intros bv2 n0 Heqc. + (* BVshr *) + case_eq ((a1 == a1') && (a2 == a2')); simpl; intros Heq10; try (now apply C.interp_true). + case_eq ( + check_shr bs1 bv2 bsres && (N.of_nat (Datatypes.length bs1) =? n)%N && + (N.of_nat (Datatypes.length bv2) =? n)%N && (n0 =? n)%N + ); simpl; intros Heq11; try (now apply C.interp_true). + + unfold C.valid. simpl. rewrite orb_false_r. + unfold Lit.interp. rewrite Heq5. + unfold Var.interp. + rewrite wf_interp_form; trivial. rewrite Heq8. simpl. + + apply BITVECTOR_LIST.bv_eq_reflect. + + generalize wt_t_atom. unfold Atom.wt. unfold is_true. + rewrite PArray.forallbi_spec;intros. + + pose proof (H a). + assert (a < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heq9. easy. } + specialize (@H0 H1). rewrite Heq9 in H0. simpl in H0. + rewrite !andb_true_iff in H0. destruct H0. destruct H0. + + pose proof (H a2). + assert (a2 < PArray.length t_atom). + { apply PArray.get_not_default_lt. rewrite def_t_atom. rewrite Heqa2, Heqc. easy. } + specialize (@H4 H5). rewrite Heqa2 in H4. simpl in H4. + + unfold get_type' in H0. unfold v_type in H0. + case_eq (t_interp .[ a]). + intros v_typea v_vala Htia. rewrite Htia in H0. + case_eq (v_typea); intros; rewrite H6 in H0; try (now contradict H0). + rename H6 into Hv. + + generalize (Hs pos1). intros HSp1. unfold C.valid in HSp1. rewrite Heq1 in HSp1. + unfold C.interp in HSp1. unfold existsb in HSp1. rewrite orb_false_r in HSp1. + unfold Lit.interp in HSp1. rewrite Heq3 in HSp1. unfold Var.interp in HSp1. + rewrite rho_interp in HSp1. rewrite Heq6 in HSp1. simpl in HSp1. + + generalize (Hs pos2). intro HSp2. unfold C.valid in HSp2. rewrite Heq2 in HSp2. + unfold C.interp in HSp2. unfold existsb in HSp2. rewrite orb_false_r in HSp2. + unfold Lit.interp in HSp2. rewrite Heq4 in HSp2. unfold Var.interp in HSp2. + rewrite rho_interp in HSp2. rewrite Heq7 in HSp2. simpl in HSp2. + + (*apply BITVECTOR_LIST.bv_eq_reflect in HSp2.*) + apply BITVECTOR_LIST.bv_eq_reflect in HSp1. + + (** case a1 = a1' and a2 = a2' **) + rewrite andb_true_iff in Heq10. + destruct Heq10 as (Heq10a1 & Heq10a2); rewrite eqb_spec in Heq10a1, Heq10a2; + rewrite Heq10a1, Heq10a2 in *. + + unfold get_type' in H2, H3. unfold v_type in H2, H3. + case_eq (t_interp .[ a1']). + intros v_typea1 v_vala1 Htia1. rewrite Htia1 in H3. + case_eq (t_interp .[ a2']). + intros v_typea2 v_vala2 Htia2. rewrite Htia2 in H2. + rewrite Atom.t_interp_wf in Htia1; trivial. + rewrite Atom.t_interp_wf in Htia2; trivial. + unfold apply_binop. + apply Typ.eqb_spec in H2. apply Typ.eqb_spec in H3. + + + (* interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a])) *) + assert (interp_form_hatom_bv a = + interp_bv t_i (interp_atom (t_atom .[a]))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia. easy. + } + + rewrite H6. rewrite Heq9. simpl. + unfold interp_bv. unfold apply_binop. + + rewrite !Atom.t_interp_wf; trivial. + + revert v_vala1 Htia1. rewrite H3. revert v_vala2 Htia2. rewrite H2. + intros v_vala2 Htia2 v_vala1 Htia1. + rewrite Htia1, Htia2. + rewrite !Typ.cast_refl. + unfold Bval. + + assert (H100: (N.of_nat (Datatypes.length (map (Lit.interp rho) bsres))) = n%N). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d). + apply length_check_shsr in Heq11. + rewrite map_length, <- Heq11. + now apply N.eqb_eq in Heq11l. + apply N.eqb_eq in Heq11r. + apply N.eqb_eq in Heq11l. + apply (f_equal (N.to_nat)) in Heq11l. + apply (f_equal (N.to_nat)) in Heq11r. + rewrite Nat2N.id in Heq11l, Heq11r. + now rewrite Heq11l, Heq11r. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bsres)). + + rewrite H100. + rewrite Typ.cast_refl. intros. + simpl. + + (* interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1'])) *) + assert (interp_form_hatom_bv a1' = + interp_bv t_i (interp_atom (t_atom .[a1']))). + { + rewrite !Atom.t_interp_wf in Htia; trivial. + rewrite Htia1. + unfold Atom.interp_form_hatom_bv. + unfold Atom.interp_hatom. + rewrite !Atom.t_interp_wf; trivial. + rewrite Htia1. easy. + } + + rewrite H7 in HSp1. + unfold interp_bv in HSp1. + rewrite Htia1 in HSp1. + unfold interp_bv in HSp1. + + revert HSp1. + + assert (H101: (N.of_nat (Datatypes.length (map (Lit.interp rho) bs1))) = n). + { + rewrite !andb_true_iff in Heq11. + destruct Heq11 as (((Heq11, Heq11l) & Heq11r), Heq11d). + rewrite map_length. + now apply N.eqb_eq in Heq11l. + } + + unfold BITVECTOR_LIST.of_bits, RAWBITVECTOR_LIST.of_bits. + + generalize ( BITVECTOR_LIST.of_bits_size (map (Lit.interp rho) bs1)). + + rewrite H101. + rewrite Typ.cast_refl. intros. + simpl. + + rewrite HSp1. + + rewrite Heqa2 in Htia2. simpl in Htia2. + unfold interp_cop in Htia2. rewrite Heqc in Htia2. unfold Bval in Htia2. + rewrite !andb_true_iff in Heq11. + destruct Heq11 as (((Heq1a, Heq11b), Heq11c), Heq11d). + apply N.eqb_eq in Heq11d. + rewrite Heq11d in *. + specialize (Bval_inj2 _ (Typ.TBV n) (BITVECTOR_LIST._of_bits bv2 n) v_vala2); intros. + apply H8 in Htia2. rewrite <- Htia2. + + unfold BITVECTOR_LIST.bv_shr. + apply eq_rec. simpl. + apply check_shr_bvshr. + + now unfold RAWBITVECTOR_LIST._of_bits; rewrite Heq11c. +Qed. + + End Proof. + +End Checker. + + +(* + Local Variables: + coq-load-path: ((rec ".." "SMTCoq")) + End: +*) |