diff --git a/Kami/Ex/Divider32.v b/Kami/Ex/Divider32.v index ee621ae..4675111 100644 --- a/Kami/Ex/Divider32.v +++ b/Kami/Ex/Divider32.v @@ -1,6 +1,6 @@ From Coq Require Import Bool String List Lia. Require Import Lib.CommonTactics Lib.NatLib Lib.Indexer - Lib.Struct Lib.DepEq Lib.Word Lib.FMap Lib.Reflection. + Lib.Struct Lib.DepEq Lib.Word Lib.WordDerived Lib.FMap Lib.Reflection. Require Import Kami.Syntax Kami.Notations Kami.Semantics Kami.SemFacts Kami.Tactics. From Coq Require Import ZArith Eqdep Equality. @@ -23,7 +23,7 @@ Section Divider32. Definition DivLogNumPhases := 2. Definition DivNumBitsPerPhase := 8. - Local Definition DivNumPhases := wordToNat (wones DivLogNumPhases) + 1. + Local Definition DivNumPhases := pow2 DivLogNumPhases. Local Definition DivNumBits := DivNumPhases * DivNumBitsPerPhase. Local Definition DivBits := DivNumBits + (2 * DivNumBits). @@ -203,52 +203,32 @@ Section Divider32. Definition pn2binBool (b: bool): Z := if b then 1 else -1. - Fixpoint pn2binBitwise {n} (w: word n): Z := - match w with - | WO => 0 - | WS b w' => pn2binBool b + 2 * (pn2binBitwise w') - end. + Fixpoint pn2binBitwise {n} (w: word n) {struct n}: Z := + match n as m return word m -> Z with + | O => fun _ => 0%Z + | S n' => fun w => (pn2binBool (whd w) + 2 * (pn2binBitwise (wtl w)))%Z + end w. + + Lemma pn2binBitwise_eqn: + forall sz (w: word sz), + pn2binBitwise w = (2 * uwordToZ w - Zpow2 sz + 1)%Z. + Proof. + induction sz; intros w; cbn [pn2binBitwise]; cbv [pn2binBool]. + - word_lia_Z. + - rewrite IHsz; word_lia_Z. + Qed. + + Lemma pn2binE_wordToZ: + forall sz (w: word sz), + wordToZ (pn2binE w) = (2 * uwordToZ w - Zpow2 sz + 1)%Z. + Proof. + intros; cbv [pn2binE]; word_lia_Z. + Qed. Lemma pn2bin_bitwise_eq: forall sz (w: word sz), wordToZ (pn2binE w) = pn2binBitwise w. Proof. - dependent induction w; [reflexivity|]. - unfold pn2binE. - destruct b; cbn. - - rewrite wminus_WS_pos'. - rewrite <-IHw. - cbn; unfold pn2binE, zext; cbn. - destruct (wordToZ _); reflexivity. - - rewrite wminus_wordToZ. - + rewrite wminus_WS_pos'. - rewrite wminus_wordToZ'. - * rewrite <-IHw. - cbn; unfold pn2binE, zext; cbn. - destruct (wordToZ _); reflexivity. - * clear; intro Hx. - apply existT_wordToZ in Hx. - dependent destruction w. - { cbn in Hx; discriminate. } - { destruct b; unfold wminus in Hx; simpl in Hx. - { rewrite wneg_WS_0 in Hx. - rewrite <-wplus_WS_0 in Hx. - rewrite wordToZ_WS_0 in Hx. - rewrite wordToZ_WS_1' in Hx. - lia. - } - { rewrite wneg_WS_1 in Hx. - rewrite wplus_comm in Hx. - rewrite <-wplus_WS_0 in Hx. - rewrite wordToZ_WS_0 in Hx. - rewrite wordToZ_WS_1' in Hx. - lia. - } - } - + unfold wminus. - rewrite wneg_WS_0. - rewrite <-wplus_WS_0. - remember (combine (wnot w) WO~0 ^+ ^~ (combine w WO~0)) as ww. - clear; induction n; discriminate. + intros; rewrite pn2binE_wordToZ, pn2binBitwise_eqn; reflexivity. Qed. Corollary pn2binE_lsb_0: @@ -256,9 +236,7 @@ Section Divider32. wordToZ (pn2binE (combine (natToWord 1 0) w)) = (2 * wordToZ (pn2binE w) - 1)%Z. Proof. - intros. - do 2 rewrite pn2bin_bitwise_eq; simpl. - destruct (pn2binBitwise w); reflexivity. + intros; rewrite !pn2binE_wordToZ; word_lia_Z. Qed. Corollary pn2binE_lsb_1: @@ -266,9 +244,7 @@ Section Divider32. wordToZ (pn2binE (combine (natToWord 1 1) w)) = (2 * wordToZ (pn2binE w) + 1)%Z. Proof. - intros. - do 2 rewrite pn2bin_bitwise_eq; simpl. - destruct (pn2binBitwise w); reflexivity. + intros; rewrite !pn2binE_wordToZ; word_lia_Z. Qed. Variable n: nat. @@ -520,10 +496,10 @@ Section Divider32. destruct (weq _ _). + destruct (weq _ _); [rewrite e in e0; discriminate|clear e n]. destruct (weq _ _); subst. - * cbn; cbn in d, Hd; lia. + * change (#(split1 DivNumBits DivNumBits $0)) with 0; Lia.lia. * change (pred (2 * DivNumBits) + 1) with (DivNumBits + DivNumBits) in *. apply zext_size in H1; dest; subst. - { unfold zext; rewrite split1_combine. + { rewrite split1_zext. apply Nat.le_neq; split. { rewrite zext_wordToNat_equal_Z in H0 by discriminate. rewrite Zabs_of_nat in H0. @@ -542,8 +518,8 @@ Section Divider32. + change (pred (2 * DivNumBits) + 1) with (DivNumBits + DivNumBits) in *. destruct (weq _ _); [|remember (split2 _ _ _) as w; clear Heqw; - do 2 dependent destruction w; - destruct b; intuition idtac]. + pose proof (shatter_word_1 w) as Hw; + destruct (whd w); rewrite Hw in *; intuition idtac]. assert (Z.abs (wordToZ (prem ^+ zext d DivNumBits)) < wordToZ (zext d DivNumBits))%Z. { rewrite wordToZ_distr_diff_wmsb @@ -577,7 +553,7 @@ Section Divider32. dest; rewrite H4 in *. do 2 rewrite zext_wordToNat_equal_Z in H2 by discriminate. rewrite Zabs_of_nat in H2. - unfold zext; rewrite split1_combine. + rewrite split1_zext. apply Nat2Z.inj_lt; assumption. - subst. @@ -635,7 +611,7 @@ Section Divider32. apply zext_size_1 in H1; dest. rewrite H1 in *. rewrite zext_wordToNat_equal_Z by discriminate. - unfold zext; rewrite split1_combine. + rewrite split1_zext. reflexivity. } rewrite Zred_factor3 in H. @@ -644,7 +620,7 @@ Section Divider32. rewrite <-Nat2Z.inj_mul in H. apply Nat2Z.inj in H. rewrite <-H. - cbn; lia. + change (#(split1 DivNumBits DivNumBits $0)) with 0; lia. * assert (wmsb pq false = false). { apply wmsb_false_pos. destruct (Z_ge_lt_dec (wordToZ pq) 0%Z); auto. @@ -661,7 +637,7 @@ Section Divider32. lia. } pose proof (Nat2Z.is_nonneg (wordToNat x)). - assert (x = $0) by (apply wordToNat_inj; simpl; lia); subst. + assert (x = $0) by (apply wordToNat_inj; rewrite ?roundTrip_0; simpl; lia); subst. elim n; clear n. simpl in H. @@ -702,15 +678,15 @@ Section Divider32. apply wordToNat_bound. } dest; subst. - unfold zext; do 2 rewrite split1_combine. + rewrite !split1_zext. do 2 rewrite wordToNat_zext in H. auto using Nat2Z.inj. + change (pred (2 * DivNumBits) + 1) with (DivNumBits + DivNumBits) in *. destruct (weq _ _); [|remember (split2 _ _ _) as w; clear Heqw; - do 2 dependent destruction w; - destruct b; intuition idtac]. + pose proof (shatter_word_1 w) as Hw; + destruct (whd w); rewrite Hw in *; intuition idtac]. clear e n0. assert (Z.of_nat (wordToNat d) > 0)%Z by lia. @@ -752,8 +728,12 @@ Section Divider32. change (wordToZ (natToWord _ _)) with 1%Z. split; lia. } + change (DivNumBits + 1) with (S DivNumBits) in *. apply wordToZ_wplus_bound in H5. - assumption. + assert (E : wordToZ (wneg (natToWord (S DivNumBits) 1)) = (-1)%Z) + by reflexivity. + rewrite E in H5. + rewrite wminus_def; lia. } remember (wordToZ pq - 1)%Z as pqa; clear Heqpqa; subst. @@ -761,7 +741,7 @@ Section Divider32. apply zext_size_1 in H3; dest. rewrite H3 in *. rewrite zext_wordToNat_equal_Z by discriminate. - unfold zext; rewrite split1_combine. + rewrite split1_zext. reflexivity. } @@ -795,7 +775,7 @@ Section Divider32. } rewrite H5. - unfold zext; rewrite split1_combine. + rewrite split1_zext. rewrite <-H4, H5. rewrite zext_wordToNat_equal_Z by discriminate. reflexivity. @@ -819,26 +799,10 @@ Section Divider32. split1 DivNumBits 1 (evalExpr (finalRestoringQ prem pq d_pos)) = wdivN x d /\ evalExpr (finalRestoringR prem d_pos) = wremN x d. Proof. - unfold wdivN, wremN, wordBinN; intros. + intros. eapply nrDivInv_final_restoring' in H; eauto; dest. - split. - - apply wordToNat_inj. - rewrite wordToNat_natToWord_2. - + assumption. - + clear -Hd. - remember (wordToNat x) as xn; destruct xn; - [rewrite Nat.div_0_l by assumption; apply zero_lt_pow2|]. - remember (wordToNat d) as dn; destruct dn; [elim Hd; reflexivity|]. - destruct dn; [rewrite Nat.div_1_r, Heqxn; apply wordToNat_bound|]. - etransitivity. - * apply Nat.div_lt; lia. - * rewrite Heqxn; apply wordToNat_bound. - - apply wordToNat_inj. - rewrite wordToNat_natToWord_2. - + assumption. - + etransitivity. - * auto using Nat.mod_upper_bound. - * apply wordToNat_bound. + split; apply wordToNat_inj; + [rewrite wordToNat_wdivN | rewrite wordToNat_wremN]; assumption. Qed. Lemma nrDivInv_nrDivStep: @@ -870,7 +834,7 @@ Section Divider32. change (S sq) with (1 + sq). rewrite <-combine_assoc_existT. rewrite combine_wplus_1. - rewrite combine_wplus_2 with (w1:= if weq _ _ then _ else _). + rewrite combine_wplus_2. apply existT_wplus. + apply existT_wlshift with (n:= 1) in H3; rewrite H3. change (S (srr + S DivNumBits)) with (1 + (srr + S DivNumBits)) in *. @@ -883,7 +847,7 @@ Section Divider32. apply EqdepFacts.eq_sigT_fst in H3. cbn; cbn in H3; lia. } - { rewrite combine_one; reflexivity. } + { rewrite !combine_one; reflexivity. } } { do 2 rewrite <-extz_combine. repeat rewrite extz_extz. @@ -1128,7 +1092,7 @@ Section Divider32. nr_split. * reflexivity. * reflexivity. - * reflexivity. + * rewrite WO_combine; reflexivity. * apply nrDivInv_init. simpl in H4. remember (x (Fin.FS Fin.F1)) as w. @@ -1312,7 +1276,8 @@ Section Divider32. intro Hx; subst; elim n0; reflexivity. } specialize (HndiInv HndiDz); clear H5; dest; subst. - assert (x1 = 0) by (cbn in H0; lia); subst; clear H0. + progress change #($0) with 0 in *. + assert (x1 = 0) by (lia); subst; clear H0. assert (x3 = 32) by (apply eq_sigT_fst in H1; cbn in H1; lia); subst. cbn in x2, H1; destruct_existT. diff --git a/Kami/Ex/Divider64.v b/Kami/Ex/Divider64.v index 4493848..1dff3fd 100644 --- a/Kami/Ex/Divider64.v +++ b/Kami/Ex/Divider64.v @@ -1,6 +1,6 @@ From Coq Require Import Bool String List Lia. Require Import Lib.CommonTactics Lib.NatLib Lib.Indexer - Lib.Struct Lib.DepEq Lib.Word Lib.FMap Lib.Reflection. + Lib.Struct Lib.DepEq Lib.Word Lib.WordDerived Lib.FMap Lib.Reflection. Require Import Kami.Syntax Kami.Notations Kami.Semantics Kami.SemFacts Kami.Tactics. From Coq Require Import ZArith Eqdep Equality. @@ -23,7 +23,7 @@ Section Divider64. Definition DivLogNumPhases := 3. Definition DivNumBitsPerPhase := 8. - Local Definition DivNumPhases := wordToNat (wones DivLogNumPhases) + 1. + Local Definition DivNumPhases := pow2 DivLogNumPhases. Local Definition DivNumBits := DivNumPhases * DivNumBitsPerPhase. Local Definition DivBits := DivNumBits + (2 * DivNumBits). @@ -203,52 +203,32 @@ Section Divider64. Definition pn2binBool (b: bool): Z := if b then 1 else -1. - Fixpoint pn2binBitwise {n} (w: word n): Z := - match w with - | WO => 0 - | WS b w' => pn2binBool b + 2 * (pn2binBitwise w') - end. + Fixpoint pn2binBitwise {n} (w: word n) {struct n}: Z := + match n as m return word m -> Z with + | O => fun _ => 0%Z + | S n' => fun w => (pn2binBool (whd w) + 2 * (pn2binBitwise (wtl w)))%Z + end w. + + Lemma pn2binBitwise_eqn: + forall sz (w: word sz), + pn2binBitwise w = (2 * uwordToZ w - Zpow2 sz + 1)%Z. + Proof. + induction sz; intros w; cbn [pn2binBitwise]; cbv [pn2binBool]. + - word_lia_Z. + - rewrite IHsz; word_lia_Z. + Qed. + + Lemma pn2binE_wordToZ: + forall sz (w: word sz), + wordToZ (pn2binE w) = (2 * uwordToZ w - Zpow2 sz + 1)%Z. + Proof. + intros; cbv [pn2binE]; word_lia_Z. + Qed. Lemma pn2bin_bitwise_eq: forall sz (w: word sz), wordToZ (pn2binE w) = pn2binBitwise w. Proof. - dependent induction w; [reflexivity|]. - unfold pn2binE. - destruct b; cbn. - - rewrite wminus_WS_pos'. - rewrite <-IHw. - cbn; unfold pn2binE, zext; cbn. - destruct (wordToZ _); reflexivity. - - rewrite wminus_wordToZ. - + rewrite wminus_WS_pos'. - rewrite wminus_wordToZ'. - * rewrite <-IHw. - cbn; unfold pn2binE, zext; cbn. - destruct (wordToZ _); reflexivity. - * clear; intro Hx. - apply existT_wordToZ in Hx. - dependent destruction w. - { cbn in Hx; discriminate. } - { destruct b; unfold wminus in Hx; simpl in Hx. - { rewrite wneg_WS_0 in Hx. - rewrite <-wplus_WS_0 in Hx. - rewrite wordToZ_WS_0 in Hx. - rewrite wordToZ_WS_1' in Hx. - lia. - } - { rewrite wneg_WS_1 in Hx. - rewrite wplus_comm in Hx. - rewrite <-wplus_WS_0 in Hx. - rewrite wordToZ_WS_0 in Hx. - rewrite wordToZ_WS_1' in Hx. - lia. - } - } - + unfold wminus. - rewrite wneg_WS_0. - rewrite <-wplus_WS_0. - remember (combine (wnot w) WO~0 ^+ ^~ (combine w WO~0)) as ww. - clear; induction n; discriminate. + intros; rewrite pn2binE_wordToZ, pn2binBitwise_eqn; reflexivity. Qed. Corollary pn2binE_lsb_0: @@ -256,9 +236,7 @@ Section Divider64. wordToZ (pn2binE (combine (natToWord 1 0) w)) = (2 * wordToZ (pn2binE w) - 1)%Z. Proof. - intros. - do 2 rewrite pn2bin_bitwise_eq; simpl. - destruct (pn2binBitwise w); reflexivity. + intros; rewrite !pn2binE_wordToZ; word_lia_Z. Qed. Corollary pn2binE_lsb_1: @@ -266,9 +244,7 @@ Section Divider64. wordToZ (pn2binE (combine (natToWord 1 1) w)) = (2 * wordToZ (pn2binE w) + 1)%Z. Proof. - intros. - do 2 rewrite pn2bin_bitwise_eq; simpl. - destruct (pn2binBitwise w); reflexivity. + intros; rewrite !pn2binE_wordToZ; word_lia_Z. Qed. Variable n: nat. @@ -523,7 +499,7 @@ Section Divider64. * change (#(split1 DivNumBits DivNumBits $0)) with 0; Lia.lia. * change (pred (2 * DivNumBits) + 1) with (DivNumBits + DivNumBits) in *. apply zext_size in H1; dest; subst. - { unfold zext; rewrite split1_combine. + { rewrite split1_zext. apply Nat.le_neq; split. { rewrite zext_wordToNat_equal_Z in H0 by discriminate. rewrite Zabs_of_nat in H0. @@ -542,8 +518,8 @@ Section Divider64. + change (pred (2 * DivNumBits) + 1) with (DivNumBits + DivNumBits) in *. destruct (weq _ _); [|remember (split2 _ _ _) as w; clear Heqw; - do 2 dependent destruction w; - destruct b; intuition idtac]. + pose proof (shatter_word_1 w) as Hw; + destruct (whd w); rewrite Hw in *; intuition idtac]. assert (Z.abs (wordToZ (prem ^+ zext d DivNumBits)) < wordToZ (zext d DivNumBits))%Z. { rewrite wordToZ_distr_diff_wmsb @@ -577,7 +553,7 @@ Section Divider64. dest; rewrite H4 in *. do 2 rewrite zext_wordToNat_equal_Z in H2 by discriminate. rewrite Zabs_of_nat in H2. - unfold zext; rewrite split1_combine. + rewrite split1_zext. apply Nat2Z.inj_lt; assumption. - subst. @@ -635,7 +611,7 @@ Section Divider64. apply zext_size_1 in H1; dest. rewrite H1 in *. rewrite zext_wordToNat_equal_Z by discriminate. - unfold zext; rewrite split1_combine. + rewrite split1_zext. reflexivity. } rewrite Zred_factor3 in H. @@ -662,7 +638,7 @@ Section Divider64. lia. } pose proof (Nat2Z.is_nonneg (wordToNat x)). - assert (x = $0) by (apply wordToNat_inj; simpl; lia); subst. + assert (x = $0) by (apply wordToNat_inj; rewrite ?roundTrip_0; simpl; lia); subst. elim n; clear n. simpl in H. @@ -703,15 +679,15 @@ Section Divider64. apply wordToNat_bound. } dest; subst. - unfold zext; do 2 rewrite split1_combine. + rewrite !split1_zext. do 2 rewrite wordToNat_zext in H. auto using Nat2Z.inj. + change (pred (2 * DivNumBits) + 1) with (DivNumBits + DivNumBits) in *. destruct (weq _ _); [|remember (split2 _ _ _) as w; clear Heqw; - do 2 dependent destruction w; - destruct b; intuition idtac]. + pose proof (shatter_word_1 w) as Hw; + destruct (whd w); rewrite Hw in *; intuition idtac]. clear e n0. assert (Z.of_nat (wordToNat d) > 0)%Z by lia. @@ -753,8 +729,12 @@ Section Divider64. change (wordToZ (natToWord _ _)) with 1%Z. split; lia. } + change (DivNumBits + 1) with (S DivNumBits) in *. apply wordToZ_wplus_bound in H5. - assumption. + assert (E : wordToZ (wneg (natToWord (S DivNumBits) 1)) = (-1)%Z) + by reflexivity. + rewrite E in H5. + rewrite wminus_def; lia. } remember (wordToZ pq - 1)%Z as pqa; clear Heqpqa; subst. @@ -762,7 +742,7 @@ Section Divider64. apply zext_size_1 in H3; dest. rewrite H3 in *. rewrite zext_wordToNat_equal_Z by discriminate. - unfold zext; rewrite split1_combine. + rewrite split1_zext. reflexivity. } @@ -796,7 +776,7 @@ Section Divider64. } rewrite H5. - unfold zext; rewrite split1_combine. + rewrite split1_zext. rewrite <-H4, H5. rewrite zext_wordToNat_equal_Z by discriminate. reflexivity. @@ -820,26 +800,10 @@ Section Divider64. split1 DivNumBits 1 (evalExpr (finalRestoringQ prem pq d_pos)) = wdivN x d /\ evalExpr (finalRestoringR prem d_pos) = wremN x d. Proof. - unfold wdivN, wremN, wordBinN; intros. + intros. eapply nrDivInv_final_restoring' in H; eauto; dest. - split. - - apply wordToNat_inj. - rewrite wordToNat_natToWord_2. - + assumption. - + clear -Hd. - remember (wordToNat x) as xn; destruct xn; - [rewrite Nat.div_0_l by assumption; apply zero_lt_pow2|]. - remember (wordToNat d) as dn; destruct dn; [elim Hd; reflexivity|]. - destruct dn; [rewrite Nat.div_1_r, Heqxn; apply wordToNat_bound|]. - etransitivity. - * apply Nat.div_lt; lia. - * rewrite Heqxn; apply wordToNat_bound. - - apply wordToNat_inj. - rewrite wordToNat_natToWord_2. - + assumption. - + etransitivity. - * auto using Nat.mod_upper_bound. - * apply wordToNat_bound. + split; apply wordToNat_inj; + [rewrite wordToNat_wdivN | rewrite wordToNat_wremN]; assumption. Qed. Lemma nrDivInv_nrDivStep: @@ -871,7 +835,7 @@ Section Divider64. change (S sq) with (1 + sq). rewrite <-combine_assoc_existT. rewrite combine_wplus_1. - rewrite combine_wplus_2 with (w1:= if weq _ _ then _ else _). + rewrite combine_wplus_2. apply existT_wplus. + apply existT_wlshift with (n:= 1) in H3; rewrite H3. change (S (srr + S DivNumBits)) with (1 + (srr + S DivNumBits)) in *. @@ -884,7 +848,7 @@ Section Divider64. apply EqdepFacts.eq_sigT_fst in H3. cbn; cbn in H3; lia. } - { rewrite combine_one; reflexivity. } + { rewrite !combine_one; reflexivity. } } { do 2 rewrite <-extz_combine. repeat rewrite extz_extz. @@ -1129,7 +1093,7 @@ Section Divider64. nr_split. * reflexivity. * reflexivity. - * reflexivity. + * rewrite WO_combine; reflexivity. * apply nrDivInv_init. simpl in H4. remember (x (Fin.FS Fin.F1)) as w. diff --git a/Kami/Ex/FifoCorrect.v b/Kami/Ex/FifoCorrect.v index da2c316..0695d06 100644 --- a/Kami/Ex/FifoCorrect.v +++ b/Kami/Ex/FifoCorrect.v @@ -43,8 +43,7 @@ Section ToNative. forall eltv x, fifo_nfifo_elt_not_full eltv (x ^+ $1) 1 = [eltv x]. Proof. intros; simpl; repeat f_equal. - rewrite wminus_def, <-wplus_assoc, wminus_inv, wplus_comm. - apply wplus_unit. + unfold rsz in *; word_lia_Z. Qed. Lemma fifo_nfifo_elt_not_full_prop_2: @@ -68,40 +67,14 @@ Section ToNative. - simpl; f_equal. destruct (weq _ _); auto. elim n; clear n. - rewrite wminus_def, <-wplus_assoc, wminus_inv. - rewrite wplus_comm, wplus_unit. - reflexivity. + unfold rsz in *; word_lia_Z. - unfold fifo_nfifo_elt_not_full in *. fold fifo_nfifo_elt_not_full in *. rewrite <-IHedSub by lia; clear IHedSub. unfold app; f_equal. destruct (weq _ _). - + exfalso. - rewrite natToWord_S with (n:= S edSub) in e. - rewrite wminus_plus_distr in e. - rewrite !wminus_def in e. - rewrite <-wplus_assoc with (x:= enqPv) in e. - rewrite wminus_inv in e. - rewrite wplus_comm with (x:= enqPv), wplus_unit in e. - rewrite wplus_comm in e. - rewrite <-wplus_unit with (x:= enqPv) in e at 2. - apply wplus_cancel in e. - apply wneg_zero in e. - apply natToWord_inj in e. - * inv e. - * pose proof (wordToNat_bound (wones rsz)); lia. - * apply pow2_zero. - + f_equal. - do 2 rewrite wminus_def. - rewrite <-wplus_assoc. - f_equal. - rewrite natToWord_S with (n:= S edSub). - apply wplus_cancel with (c:= $1 ^+ $ (S edSub)). - rewrite <-wplus_assoc, wplus_comm with (x:= ^~ ($1 ^+ $ (S edSub))). - rewrite wminus_inv. - rewrite wplus_comm with (x:= ^~ $ (S edSub)). - rewrite <-wplus_assoc, wminus_inv. - reflexivity. + + exfalso; unfold rsz in *; word_lia_Z. + + f_equal; unfold rsz in *; word_lia_Z. Qed. Lemma fifo_nfifo_elt_not_full_deq: @@ -221,18 +194,18 @@ Section ToNative. - simpl; kinv_action_dest. unfold initRegs, rawInitRegs, getRegInits; simpl. kinv_regmap_red; kinv_constr; kinv_eq. - or3_fst; auto. + or3_fst; repeat split; destruct (weq _ _); congruence. - intros; inv H0; inv HInRules. - intros; inv H0; CommonTactics.dest_in. + simpl in *; kinv_magic_light_with kinv_or3. * or3_thd; repeat split. { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } - * destruct (weq x6 (x5 ^+ $0~1)). + * destruct (weq x6 (x5 ^+ $1)). { or3_snd; repeat split. destruct (weq _ _); auto. } @@ -243,12 +216,12 @@ Section ToNative. + simpl in *; kinv_magic_light_with kinv_or3. * or3_thd; repeat split. { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } - * destruct (weq x5 (x6 ^+ $0~1)). + * destruct (weq x5 (x6 ^+ $1)). { or3_fst; auto. } { or3_thd; auto. } + simpl in *; kinv_magic_light_with kinv_or3. @@ -291,20 +264,16 @@ Section ToNative. { intros; inv H0. } { intros; inv H0. } { kregmap_red; kregmap_clear; meq. - { exfalso; generalize e; apply wplus_one_neq. } - { exfalso; generalize e; apply wplus_one_neq. } + { wplus_one_contra. } + { wplus_one_contra. } { repeat f_equal. simpl; replace (wordToNat _) with 1. { rewrite fifo_nfifo_elt_not_full_prop_1. destruct (weq x6 x6); intuition idtac. } - { rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (x:= $0~1), wplus_assoc. - rewrite wminus_inv, wplus_unit. - simpl; rewrite roundTrip_0; reflexivity. - } + { unfold rsz in *; word_lia_Z. } } - { exfalso; generalize e0; apply wplus_one_neq. } + { wplus_one_contra. } { repeat f_equal. unfold evalExpr. rewrite fifo_nfifo_elt_not_full_enq. @@ -313,98 +282,19 @@ Section ToNative. repeat f_equal. { unfold rsz in *; clear n e n0. destruct (weq _ _); [|clear n]. - { exfalso. - rewrite natToWord_S with (n:= wordToNat _) in e. - rewrite !wminus_plus_distr in e. - rewrite !wminus_def in e. - rewrite <-wplus_assoc with (x:= x5) in e. - rewrite !wminus_inv in e. - rewrite wplus_comm with (x:= x5) in e. - rewrite !wplus_unit in e. - rewrite wplus_comm in e. - rewrite <-wplus_unit in e. - apply wplus_cancel in e. - apply wneg_zero in e. - rewrite natToWord_wordToNat in e. - apply wneg_zero in e. - inv e. - } - { f_equal. - rewrite wminus_plus_distr. - rewrite !wminus_def. - rewrite wminus_inv, wplus_unit. - rewrite <-wplus_assoc; f_equal. - rewrite natToWord_S with (n:= wordToNat _). - rewrite <-wminus_def. - rewrite wminus_plus_distr. - rewrite !wminus_def. - rewrite wminus_inv, wplus_unit. - rewrite natToWord_wordToNat. - rewrite wneg_idempotent. - reflexivity. - } - } - { rewrite wones_wneg_one. - apply wplus_cancel with (c:= x5 ^+ $0~1). - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (y:= x5 ^+ $0~1). - rewrite wminus_inv. - rewrite wplus_comm with (x:= ^~ $1), <-wplus_assoc. - rewrite wminus_inv. - reflexivity. - } - } - { replace (x5 ^- (x5 ^+ $0~1)) with (wones rsz). - { apply Nat.le_refl. } - { rewrite wones_wneg_one. - apply wplus_cancel with (c:= x5 ^+ $0~1). - rewrite wplus_comm, <-wplus_assoc, wminus_inv. - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (y:= x5 ^+ $0~1). - rewrite wminus_inv. - reflexivity. + { exfalso; unfold rsz in *; word_lia_Z. } + { f_equal; unfold rsz in *; word_lia_Z. } } + { unfold rsz in *; word_lia_Z. } } + { unfold rsz in *; word_lia_Z. } } { repeat f_equal; simpl. rewrite fifo_nfifo_elt_not_full_enq. { repeat f_equal. - apply natToWord_inj with (sz:= S sz). - { rewrite natToWord_S. - rewrite !natToWord_wordToNat. - rewrite !wminus_def. - rewrite wplus_assoc, wplus_comm with (x:= $1). - reflexivity. - } - { pose proof (wordToNat_bound (x5 ^- x6)). - remember (Lib.NatLib.pow2 (S sz)) as pt; destruct pt. - { pose proof (pow2_zero (S sz)); lia. } - { apply ->Nat.succ_lt_mono. - assert (wordToNat (x5 ^- x6) <> pt). - { replace pt with (Lib.NatLib.pow2 (S sz) - 1) by lia. - intro Hx. - apply pow2_minus_one_wones in Hx. - elim n0. - apply wplus_cancel with (c:= ^~ $0~1). - rewrite <-wplus_assoc, wminus_inv. - rewrite wplus_comm, wplus_unit. - rewrite wplus_comm. - apply wplus_cancel with (c:= ^~ x6). - rewrite <-wplus_assoc, wminus_inv. - rewrite wplus_comm with (y:= wzero _), wplus_unit. - rewrite <-wminus_def; rewrite Hx. - rewrite wones_wneg_one. - reflexivity. - } - lia. - } - } - { apply wordToNat_bound. } - } - { rewrite wones_pow2_minus_one. - pose proof (wordToNat_bound (x5 ^- x6)). - unfold rsz in *; lia. + unfold rsz in *; word_lia_Z. } + { unfold rsz in *; word_lia_Z. } } } @@ -431,17 +321,9 @@ Section ToNative. { intros; inv H1. } { intros; inv H1. } { kregmap_red; kregmap_clear; meq. - { exfalso; eapply wplus_one_neq; eauto. } - { replace (x6 ^- (x6 ^+ $0~1)) with (wones (S sz)); auto. - apply wplus_cancel with (c:= x6 ^+ $0~1). - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ (x6 ^+ _)). - rewrite wminus_inv, wplus_comm with (y:= $0~1). - rewrite wplus_assoc. - replace ((natToWord sz 0)~1) with (natToWord rsz 1) by reflexivity. - rewrite wones_wneg_one. - rewrite wplus_comm with (y:= $1), wminus_inv. - apply wplus_comm. + { wplus_one_contra. } + { replace (x6 ^- (x6 ^+ $1)) with (wones (S sz)); auto. + unfold rsz in *; word_lia_Z. } } } @@ -456,14 +338,7 @@ Section ToNative. { kregmap_red; kregmap_clear; reflexivity. } { destruct (weq x5 x6); [elim n; auto|]. pose proof (@fifo_nfifo_elt_not_full_prop_2 x7 x5 (wordToNat (x5 ^- x6))). - assert (wordToNat (x5 ^- x6) <> 0). - { intro Hx. - assert ($ (wordToNat (x5 ^- x6)) = natToWord rsz 0) - by (rewrite Hx; reflexivity). - rewrite natToWord_wordToNat in H10. - apply sub_0_eq in H10. - elim n; auto. - } + assert (wordToNat (x5 ^- x6) <> 0) by (unfold rsz in *; word_lia_Z). specialize (H1 H10); clear H10; dest. rewrite H1; reflexivity. } @@ -472,24 +347,12 @@ Section ToNative. { destruct (weq x5 x6); [elim n; auto|]. simpl; repeat f_equal. pose proof (@fifo_nfifo_elt_not_full_prop_2 x7 x5 (wordToNat (x5 ^- x6))). - assert (wordToNat (x5 ^- x6) <> 0). - { intro Hx. - assert ($ (wordToNat (x5 ^- x6)) = natToWord rsz 0) - by (rewrite Hx; reflexivity). - rewrite natToWord_wordToNat in H10. - apply sub_0_eq in H10. - elim n; auto. - } + assert (wordToNat (x5 ^- x6) <> 0) by (unfold rsz in *; word_lia_Z). specialize (H1 H10); clear H10; dest. rewrite H1; unfold listFirstElt, evalExpr; f_equal. rewrite natToWord_wordToNat. - apply wplus_cancel with (c:= x5 ^- x6). - rewrite wminus_def with (y:= x5 ^- x6), <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ (x5 ^- x6)). - rewrite wminus_inv, wminus_def, wplus_comm with (y:= ^~ x6). - rewrite wplus_assoc, wminus_inv. - apply wplus_comm. + unfold rsz in *; word_lia_Z. } } { repeat split. @@ -499,19 +362,11 @@ Section ToNative. { simpl; repeat f_equal. replace (wordToNat _) with 1. { rewrite fifo_nfifo_elt_not_full_prop_1; reflexivity. } - { rewrite wminus_def, <-wplus_assoc, wplus_comm. - rewrite <-wplus_assoc, wplus_comm with (y:= x6), wminus_inv. - rewrite wplus_comm, wplus_unit. - rewrite roundTrip_1; auto. - } + { unfold rsz in *; word_lia_Z. } } { simpl; repeat f_equal. rewrite fifo_nfifo_elt_not_full_deq. - f_equal; rewrite wordToNat_natToWord_pred. - { f_equal. - rewrite wminus_plus_distr; reflexivity. - } - { intro Hx; apply sub_0_eq in Hx; auto. } + f_equal; unfold rsz in *; word_lia_Z. } } } @@ -530,14 +385,7 @@ Section ToNative. destruct (weq x4 x5); [discriminate|]. simpl; apply negb_true_iff. pose proof (@fifo_nfifo_elt_not_full_prop_2 x6 x4 (wordToNat (x4 ^- x5))). - assert (wordToNat (x4 ^- x5) <> 0). - { intro Hx. - assert ($ (wordToNat (x4 ^- x5)) = natToWord rsz 0) - by (rewrite Hx; reflexivity). - rewrite natToWord_wordToNat in H6. - apply sub_0_eq in H6. - elim n; auto. - } + assert (wordToNat (x4 ^- x5) <> 0) by (unfold rsz in *; word_lia_Z). specialize (H1 H6); clear H6; dest. rewrite H1; reflexivity. } @@ -552,24 +400,12 @@ Section ToNative. { unfold rsz in *. destruct (weq x4 x5); [discriminate|]. pose proof (@fifo_nfifo_elt_not_full_prop_2 x6 x4 (wordToNat (x4 ^- x5))). - assert (wordToNat (x4 ^- x5) <> 0). - { intro Hx. - assert ($ (wordToNat (x4 ^- x5)) = natToWord rsz 0) - by (rewrite Hx; reflexivity). - rewrite natToWord_wordToNat in H6. - apply sub_0_eq in H6. - elim n; auto. - } + assert (wordToNat (x4 ^- x5) <> 0) by (unfold rsz in *; word_lia_Z). specialize (H1 H6); clear H6; dest. rewrite H1; unfold listFirstElt. rewrite natToWord_wordToNat. simpl; f_equal. - apply wplus_cancel with (c:= x4 ^- x5). - rewrite wminus_def with (y:= x4 ^- x5), <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ (x4 ^- x5)). - rewrite wminus_inv, wminus_def, wplus_comm with (y:= ^~ x5). - rewrite wplus_assoc, wminus_inv. - apply wplus_comm. + unfold rsz in *; word_lia_Z. } } * repeat split; auto. diff --git a/Kami/Ex/InDepthTutorial.v b/Kami/Ex/InDepthTutorial.v index 739b8d2..a800e58 100644 --- a/Kami/Ex/InDepthTutorial.v +++ b/Kami/Ex/InDepthTutorial.v @@ -548,11 +548,8 @@ Lemma next_f_consistent: f123 (next123 w1) = f123 (next123 w2). Proof. unfold f123, next123; intros. - rewrite 2! wmult_comm with (x:= $2). - repeat rewrite wmult_plus_distr. - f_equal. - rewrite 2! wmult_comm with (y:= $2). - auto. + rewrite !(Zmod.mul_comm (natToWord _ 2)), !Zmod.mul_add_l, + !(Zmod.mul_comm _ (natToWord _ 2)), H; reflexivity. Qed. #[local] Hint Immediate next_f_consistent. Opaque next123 f123. diff --git a/Kami/Ex/Multiplier32.v b/Kami/Ex/Multiplier32.v index 7ca25c0..b28b50a 100644 --- a/Kami/Ex/Multiplier32.v +++ b/Kami/Ex/Multiplier32.v @@ -1,6 +1,6 @@ From Coq Require Import Bool String List Lia. Require Import Lib.CommonTactics Lib.NatLib Lib.Indexer - Lib.Struct Lib.DepEq Lib.Word Lib.FMap Lib.Reflection. + Lib.Struct Lib.DepEq Lib.Word Lib.WordDerived Lib.FMap Lib.Reflection. Require Import Kami.Syntax Kami.Notations Kami.Semantics Kami.SemFacts Kami.Tactics. From Coq Require Import ZArith Eqdep Equality. @@ -11,33 +11,15 @@ Open Scope string. (* Some useful facts about [word], only for the multiplier implementation. *) Section WordEx. - Definition rtrunc1 sz (w: word (S sz)): word sz:= - match w with - | WO => tt - | WS _ w' => w' - end. + Definition rtrunc1 sz (w: word (S sz)): word sz := wtl w. - Definition rtrunc2 sz (w: word (S (S sz))): word sz := - match w with - | WO => tt - | WS _ w' => - match w' with - | WO => tt - | WS _ w'' => w'' - end - end. + Definition rtrunc2 sz (w: word (S (S sz))): word sz := wtl (wtl w). Lemma wordToNat_rtrunc1: forall sz (w: word (S sz)), wordToNat (rtrunc1 w) = wordToNat w / 2. Proof. - dependent destruction w. - unfold rtrunc1, wordToNat; fold wordToNat. - destruct b. - - change (S (wordToNat w * 2)) with (1 + wordToNat w * 2). - rewrite Nat.div_add by discriminate. - reflexivity. - - apply eq_sym, Nat.div_mul; discriminate. + intros; apply wordToNat_wtl. Qed. Lemma combine_wrshifta_rtrunc1_sext: @@ -70,24 +52,8 @@ Section WordEx. forall sz (w: word (S (S sz))), wordToNat (rtrunc2 w) = wordToNat w / 4. Proof. - do 2 dependent destruction w. - unfold rtrunc2, wordToNat; fold wordToNat. - destruct b, b0. - - replace (S (S (wordToNat w * 2) * 2)) - with (3 + wordToNat w * 4) by lia. - rewrite Nat.div_add by discriminate. - reflexivity. - - replace (S (wordToNat w * 2 * 2)) - with (1 + wordToNat w * 4) by lia. - rewrite Nat.div_add by discriminate. - reflexivity. - - replace (S (wordToNat w * 2) * 2) - with (2 + wordToNat w * 4) by lia. - rewrite Nat.div_add by discriminate. - reflexivity. - - replace (wordToNat w * 2 * 2) - with (wordToNat w * 4) by lia. - apply eq_sym, Nat.div_mul; discriminate. + intros; cbv [rtrunc2]; rewrite !wordToNat_wtl, Nat.div_div by discriminate. + reflexivity. Qed. Lemma combine_wrshifta_rtrunc2_sext: @@ -139,7 +105,7 @@ Section Multiplier32. (* 2*4 = 8 bits are calculated per a phase. *) Definition MultNumBitsPerPhase := 2 * MultNumStepsPerPhase. - Definition MultNumPhases := wordToNat (wones MultLogNumPhases) + 1. (* 2^2 = 4 *) + Definition MultNumPhases := pow2 MultLogNumPhases. (* 2^2 = 4 *) Definition MultNumBits := MultNumPhases * MultNumBitsPerPhase. (* 4*8 = 32 *) Definition MultNumBitsExt := MultNumBits + 1. (* 4*8 + 1 = 33 *) Definition MultBits := 2 * MultNumBitsExt + 2. @@ -439,59 +405,60 @@ Section Multiplier32. | _, _ => BZero end. - Definition wencodeB2 (w: word 2): Booth. - Proof. - dependent destruction w. - dependent destruction w. - exact (encodeB2 b0 b). - Defined. - - Fixpoint wordToB2' sz (w: word sz) (p: bool): bword sz := - match w with - | WO => BWO - | WS b w' => BWS (encodeB2 b p) (wordToB2' w' b) - end. + Definition wencodeB2 (w: word 2): Booth := + encodeB2 (whd (wtl w)) (whd w). + + Fixpoint wordToB2' sz (w: word sz) (p: bool) {struct sz}: bword sz := + match sz as s return word s -> bword s with + | O => fun _ => BWO + | S sz' => fun w => BWS (encodeB2 (whd w) p) (wordToB2' (wtl w) (whd w)) + end w. Lemma wordToB2'_rtrunc1_wlsb: forall sz (w: word (S sz)) p, wordToB2' w p = BWS (encodeB2 (wlsb w) p) (wordToB2' (rtrunc1 w) (wlsb w)). Proof. - intros; dependent destruction w; simpl; reflexivity. + intros; reflexivity. Qed. Definition wordToB2 sz (w: word (S sz)): bword sz := - match w with - | WO => tt - | WS b w' => wordToB2' w' b - end. + wordToB2' (wtl w) (whd w). Lemma wordToB2_one: forall (w: word 1), bwordToZ (wordToB2 w) = 0%Z. Proof. - dependent destruction w. - dependent destruction w. - simpl; reflexivity. + intros; reflexivity. + Qed. + + Lemma wordToB2'_S : forall sz (w: word (S sz)) p, + wordToB2' w p = BWS (encodeB2 (whd w) p) (wordToB2' (wtl w) (whd w)). + Proof. reflexivity. Qed. + + Lemma wordToB2'_bwordToZ: + forall sz (w: word (S sz)) b, + bwordToZ (wordToB2' w b) = (wordToZ w + (if b then 1 else 0))%Z. + Proof. + induction sz; intros w b; rewrite wordToB2'_S. + - rewrite (shatter_word_0 (wtl w)), wordToZ_one. + destruct (whd w), b; reflexivity. + - destruct (whd w) eqn:E, b; cbn [encodeB2 bwordToZ]; + rewrite IHsz, wordToZ_succ, E; lia. Qed. Lemma wordToB2_bwordToZ': forall sz (w: word (S sz)) b, bwordToZ (wordToB2 (WS b w)) = (wordToZ w + (if b then 1 else 0))%Z. Proof. - dependent induction w; simpl; intros. - dependent destruction w. - - destruct b, b0; cbn; reflexivity. - - specialize (IHw _ _ eq_refl JMeq_refl). - unfold wordToB2 in IHw; rewrite IHw; clear IHw. - destruct b, b1, b0; cbn; - repeat (rewrite wordToZ_WS_0 || rewrite wordToZ_WS_1); lia. + intros; cbv [wordToB2]; rewrite wtl_WS, whd_WS; apply wordToB2'_bwordToZ. Qed. Lemma wordToB2_bwordToZ: forall sz (w: word sz), bwordToZ (wordToB2 w~0) = wordToZ w. Proof. - dependent destruction w; [reflexivity|]. - rewrite wordToB2_bwordToZ'; lia. + intros sz w; destruct sz. + - rewrite (shatter_word_0 w); reflexivity. + - rewrite wordToB2_bwordToZ'; lia. Qed. Lemma wordToB2_bwordToZ_step: @@ -500,16 +467,9 @@ Section Multiplier32. (2 * bwordToZ (wordToB2 (rtrunc1 w)) + boothToZ (wencodeB2 (split1 2 _ w)))%Z. Proof. - do 2 dependent destruction w; cbn. - remember (bwordToZ (wordToB2' w b0)) as ww; clear Heqww. - destruct ww. - - destruct b, b0; cbn; reflexivity. - - rewrite Pos2Z.inj_xO with (p:= p). - rewrite Z.mul_comm; remember (2 * Z.pos p)%Z as tp; clear Heqtp. - destruct b, b0; cbn; lia. - - rewrite Pos2Z.neg_xO with (p:= p). - rewrite Z.mul_comm; remember (2 * Z.neg p)%Z as tp; clear Heqtp. - destruct b, b0; cbn; lia. + intros; cbv [wordToB2 rtrunc1 wencodeB2]. + rewrite wordToB2'_S, !wtl_split1, !whd_split1. + destruct (whd w), (whd (wtl w)); cbn [encodeB2 boothToZ bwordToZ]; lia. Qed. Definition encodeB4 (b1 b2 b3: bool) := @@ -523,48 +483,66 @@ Section Multiplier32. | _, _, _ => (BZero, BZero) end. - Definition wencodeB4 (w: word 3): Booth * Booth. - Proof. - dependent destruction w. - dependent destruction w. - dependent destruction w. - exact (encodeB4 b1 b0 b). - Defined. - - Fixpoint wordToB4' sz (w: word sz) (p1 p2: bool): bword (S sz). - Proof. - dependent destruction w. - - exact (BWS (encodeB2 p1 p2) BWO). - - dependent destruction w. - + exact (BWS (snd (encodeB4 b p1 p2)) (BWS (fst (encodeB4 b p1 p2)) BWO)). - + refine (BWS (snd (encodeB4 b p1 p2)) (BWS (fst (encodeB4 b p1 p2)) _)). - exact (wordToB4' _ w b0 b). - Defined. - - Definition wordToB4 sz (w: word (S sz)): bword sz. + Definition wencodeB4 (w: word 3): Booth * Booth := + encodeB4 (whd (wtl (wtl w))) (whd (wtl w)) (whd w). + + Fixpoint wordToB4' sz (w: word sz) (p1 p2: bool) {struct sz}: bword (S sz) := + match sz as s return word s -> bword (S s) with + | O => fun _ => BWS (encodeB2 p1 p2) BWO + | S O => fun w => BWS (snd (encodeB4 (whd w) p1 p2)) + (BWS (fst (encodeB4 (whd w) p1 p2)) BWO) + | S (S m) => fun w => BWS (snd (encodeB4 (whd w) p1 p2)) + (BWS (fst (encodeB4 (whd w) p1 p2)) + (wordToB4' (wtl (wtl w)) (whd (wtl w)) (whd w))) + end w. + + Definition wordToB4 sz (w: word (S sz)): bword sz := + match sz as s return word (S s) -> bword s with + | O => fun _ => BWO + | S m => fun w => wordToB4' (wtl (wtl w)) (whd (wtl w)) (whd w) + end w. + + Lemma wordToB4'_1 : forall (v: word 1) p1 p2, + wordToB4' v p1 p2 = + BWS (snd (encodeB4 (whd v) p1 p2)) (BWS (fst (encodeB4 (whd v) p1 p2)) BWO). + Proof. reflexivity. Qed. + + Lemma wordToB4'_SS : forall m (v: word (S (S m))) p1 p2, + wordToB4' v p1 p2 = + BWS (snd (encodeB4 (whd v) p1 p2)) + (BWS (fst (encodeB4 (whd v) p1 p2)) + (wordToB4' (wtl (wtl v)) (whd (wtl v)) (whd v))). + Proof. reflexivity. Qed. + + Lemma wordToB4'_bwordToZ : + forall sz (v: word sz) p1 p2, + bwordToZ (wordToB4' v p1 p2) = (wordToZ (WS p1 v) + (if p2 then 1 else 0))%Z. Proof. - dependent destruction w. - dependent destruction w. - - exact BWO. - - exact (wordToB4' w b0 b). - Defined. + intro sz; induction sz as [sz IH] using (well_founded_induction Wf_nat.lt_wf). + intros v p1 p2; destruct sz as [|[|m]]. + - rewrite (shatter_word_0 v), wordToZ_one, whd_WS. + destruct p1, p2; reflexivity. + - rewrite wordToB4'_1. + rewrite (wordToZ_succ (WS p1 v)), whd_WS, wtl_WS, wordToZ_one. + destruct (whd v), p1, p2; cbn [encodeB4 fst snd bwordToZ]; lia. + - rewrite wordToB4'_SS, (wordToZ_succ (WS p1 v)), whd_WS, wtl_WS, + (wordToZ_succ v). + destruct (whd v) eqn:E1, p1, p2; + cbn [encodeB4 fst snd bwordToZ]; + rewrite IH by lia; + rewrite <- (shatter_word (wtl v)); lia. + Qed. Lemma wordToB2_wordToB4: forall sz (w: word (S sz)), bwordToZ (wordToB2 w) = bwordToZ (wordToB4 w). Proof. - dependent destruction w. - move b at bottom. - dependent induction w; [reflexivity|]. - cbn; cbn in IHw; rewrite IHw; clear IHw. - move b at bottom. - dependent induction w. - - destruct b, b0; cbn; reflexivity. - - rewrite <-IHw; clear IHw. - dependent destruction w. - + destruct b, b0, b1; cbn; reflexivity. - + cbn; remember (bwordToZ (wordToB4' w b0 b)) as ww; clear Heqww. - destruct b, b0, b1, b2; cbn; lia. + intros sz w; destruct sz. + - cbv [wordToB2 wordToB4]; rewrite (shatter_word_0 (wtl w)); reflexivity. + - cbv [wordToB2 wordToB4]. + rewrite wordToB4'_bwordToZ, wordToB2'_bwordToZ. + rewrite <- (shatter_word (wtl w)). + reflexivity. Qed. Lemma wordToB4_bwordToZ_step: @@ -573,24 +551,14 @@ Section Multiplier32. (4 * bwordToZ (wordToB4 (rtrunc2 w)) + bbToZ (wencodeB4 (split1 3 _ w)))%Z. Proof. - do 3 dependent destruction w; cbn. - dependent destruction w. - - destruct b, b0, b1; cbn; reflexivity. - - cbn; remember (bwordToZ (wordToB4' w b2 b1)) as ww; clear Heqww. - destruct ww. - + destruct b, b0, b1; cbn; reflexivity. - + rewrite Pos2Z.inj_xO with (p:= (p~0)%positive). - rewrite Pos2Z.inj_xO with (p:= p). - rewrite Z.mul_comm with (n:= Z.pos p); remember (2 * Z.pos p)%Z as tp; clear Heqtp. - Opaque Z.mul. - destruct b, b0, b1; cbn; lia. - Transparent Z.mul. - + rewrite Pos2Z.neg_xO with (p:= (p~0)%positive). - rewrite Pos2Z.neg_xO with (p:= p). - rewrite Z.mul_comm with (n:= Z.neg p); remember (2 * Z.neg p)%Z as tp; clear Heqtp. - Opaque Z.mul. - destruct b, b0, b1; cbn; lia. - Transparent Z.mul. + intros sz w; cbv [wordToB4 rtrunc2 wencodeB4]; + rewrite !wtl_split1, !whd_split1; destruct sz as [|m]. + - rewrite wordToB4'_1. + destruct (whd w), (whd (wtl w)), (whd (wtl (wtl w))); + cbn [encodeB4 fst snd bwordToZ bbToZ boothToZ]; lia. + - rewrite wordToB4'_SS. + destruct (whd w), (whd (wtl w)), (whd (wtl (wtl w))); + cbn [encodeB4 fst snd bwordToZ bbToZ boothToZ]; lia. Qed. End BoothEncoding. @@ -619,17 +587,11 @@ Section Multiplier32. Lemma natToWord_ZToWord_zero: forall sz, natToWord sz 0 = ZToWord sz 0%Z. - Proof. - intros; simpl. - induction sz; simpl; auto. - rewrite IHsz; reflexivity. - Qed. + Proof. reflexivity. Qed. Lemma wmsb_wzero'_false: - forall sz, wmsb (wzero' sz) false = false. - Proof. - induction sz; simpl; intros; auto. - Qed. + forall sz, wmsb (wzero sz) false = false. + Proof. word_lia_Z. Qed. Lemma boothStepInv_init: forall sz m p, @@ -644,7 +606,7 @@ Section Multiplier32. - instantiate (1:= 0%Z). rewrite <-Zmult_0_r_reverse. rewrite natToWord_ZToWord_zero. - rewrite wordToZ_wzero'. + rewrite wordToZ_wzero. reflexivity. - rewrite Z.add_0_l. replace (S sz - sz - 1) with 0 by lia. @@ -721,11 +683,9 @@ Section Multiplier32. wl <> WO~0~1 -> wl <> WO~1~0 -> wencodeB2 wl = BZero. Proof. - intros. - dependent destruction wl. - dependent destruction wl. - dependent destruction wl. - destruct b, b0; intuition idtac. + intros wl H H0; cbv [wencodeB2]. + rewrite (shatter_word_2 wl) in H, H0. + destruct (whd wl), (whd (wtl wl)); cbn in *; intuition idtac. Qed. Lemma wencodeB4_zero: @@ -734,12 +694,10 @@ Section Multiplier32. wl <> WO~1~0~0 -> wl <> WO~1~0~1 -> wl <> WO~1~1~0 -> wencodeB4 wl = (BZero, BZero). Proof. - intros. - dependent destruction wl. - dependent destruction wl. - dependent destruction wl. - dependent destruction wl. - destruct b, b0, b1; intuition idtac. + intros wl H H0 H1 H2 H3 H4; cbv [wencodeB4]. + rewrite (shatter_word_3 wl) in H, H0, H1, H2, H3, H4. + destruct (whd wl), (whd (wtl wl)), (whd (wtl (wtl wl))); + cbn in *; intuition idtac. Qed. Ltac wordToZ_red := @@ -1199,9 +1157,9 @@ Section Multiplier32. boothMultiplierInv_new. * cbn. eq_rect_simpl. - reflexivity. + rewrite extz_combine; reflexivity. * cbn; eq_rect_simpl. - reflexivity. + rewrite extz_combine; reflexivity. * clear -H4 H12. Opaque split2. simpl in *. @@ -1231,13 +1189,15 @@ Section Multiplier32. elim n; assumption. } - set (extz (combine (x (Fin.FS Fin.F1)) (natToWord (MultNumBitsExt + 1) 0)) 1) as ww. + set (combine (combine (natToWord 1 0) (x (Fin.FS Fin.F1))) + (natToWord (S MultNumBitsExt) 0)) as ww. pose proof (boothStepInv_init (x Fin.F1) (x (Fin.FS Fin.F1))) as Hinv0. assert (pred MultNumBitsExt <> 0) by (cbn; lia). eapply (boothStepInv_boothStep (we:= Var type (SyntaxKind (Bit MultBits)) ww) (sus:= O) - Hx1 eq_refl eq_refl eq_refl H12 eq_refl) in Hinv0; [|reflexivity]. + Hx1 eq_refl eq_refl eq_refl H12 eq_refl) in Hinv0; + [|subst ww; reflexivity]. simpl in Hinv0. destruct Hinv0 as [nwl [nwu [? ?]]]. @@ -1248,6 +1208,7 @@ Section Multiplier32. { subst ww. cbv [evalSignExtendTrunc]. simpl; eq_rect_simpl. + rewrite !extz_combine in H13. rewrite <-H13. reflexivity. } @@ -1268,9 +1229,7 @@ Section Multiplier32. assert (psl >= 9)%nat. { subst; clear -n1. unfold type in x. - do 4 (dependent destruction x). - destruct b, b0, b1; cbn; try lia. - elim n1; reflexivity. + word_to_Z; lia. } do 9 (destruct psl as [|psl]; [lia|]); clear H. @@ -1370,56 +1329,46 @@ Section Multiplier32. Transparent MultNumBits. eexists; split; kinv_constr. - apply boothStepInv_finish in H7; dest. - assert (x3 = MultNumBitsExt) by (apply eq_sigT_fst in H6; cbn; cbn in H6; lia). + apply boothStepInv_finish in H6; dest. + assert (x3 = MultNumBitsExt) + by (apply eq_sigT_fst in H5; cbn in H5; + rewrite ?roundTrip_0 in H5; cbn; cbn in H5; lia). subst; destruct_existT. rewrite idElementwiseId; unfold id. do 3 f_equal. fin_func_eq. - + Opaque split1 split2 wordToZ. + + Opaque split1 split2 Zmod.signed. simpl. unfold eq_rec_r, eq_rec; repeat rewrite <-eq_rect_eq. unfold ilist.ilist_to_fun_m; simpl. repeat f_equal. - rewrite wtl_combine. - unfold wmultZ, wordBinZ. - pose proof (sext_wordToZ 33 bsiM). - cbv [evalSignExtendTrunc]; cbn. - eq_rect_simpl. - cbn in H1; rewrite H1. - pose proof (sext_wordToZ 33 bsiR). - cbn; cbn in H2; rewrite H2. - cbn in H0; rewrite <-H0. - assert (x = 2 * MultNumBitsExt) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - pose proof (sext_wordToZ 1 x4); cbn; cbn in H; rewrite H. - rewrite sext_split1. - rewrite ZToWord_wordToZ. + rewrite split2_split1_combine1. + cbv [evalSignExtendTrunc]; cbn; eq_rect_simpl. + apply Zmod.unsigned_inj. + rewrite unsigned_split1, Zmod.unsigned_mul; canon_unsigned; rewrite !unsigned_sext. + replace (Zpow2 (MultNumBitsExt + 33)) with (Zpow2 66) by reflexivity. + cbn in H0; rewrite Zmult_mod_idemp_l, Zmult_mod_idemp_r, <- H0. + rewrite <- (Zmod.mod_signed x5), Z.mod_mod_divide + by (exists (Zpow2 1); rewrite <- Zpow2_add; reflexivity). reflexivity. - Transparent split1 split2 wordToZ. + Transparent split1 split2 Zmod.signed. - + Opaque split1 split2 wordToZ. + + Opaque split1 split2 Zmod.signed. simpl. unfold eq_rec_r, eq_rec; repeat rewrite <-eq_rect_eq. unfold ilist.ilist_to_fun_m; simpl. repeat f_equal. - rewrite wtl_combine. - unfold wmultZ, wordBinZ. - pose proof (sext_wordToZ 33 bsiM). - cbv [evalSignExtendTrunc]; cbn. - eq_rect_simpl. - cbn in H1; rewrite H1. - pose proof (sext_wordToZ 33 bsiR). - cbn; cbn in H2; rewrite H2. - cbn in H0; rewrite <-H0. - assert (x = 2 * MultNumBitsExt) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - pose proof (sext_wordToZ 1 x4); cbn; cbn in H; rewrite H. - rewrite sext_split1. - rewrite ZToWord_wordToZ. + rewrite split2_split1_combine1. + cbv [evalSignExtendTrunc]; cbn; eq_rect_simpl. + apply Zmod.unsigned_inj. + rewrite unsigned_split1, Zmod.unsigned_mul; canon_unsigned; rewrite !unsigned_sext. + replace (Zpow2 (MultNumBitsExt + 33)) with (Zpow2 66) by reflexivity. + cbn in H0; rewrite Zmult_mod_idemp_l, Zmult_mod_idemp_r, <- H0. + rewrite <- (Zmod.mod_signed x5), Z.mod_mod_divide + by (exists (Zpow2 1); rewrite <- Zpow2_add; reflexivity). reflexivity. - Transparent split1 split2 wordToZ. + Transparent split1 split2 Zmod.signed. - (* "boothStep" |-> . *) kinv_action_dest. diff --git a/Kami/Ex/Multiplier64.v b/Kami/Ex/Multiplier64.v index 6bf370d..06542aa 100644 --- a/Kami/Ex/Multiplier64.v +++ b/Kami/Ex/Multiplier64.v @@ -1,6 +1,6 @@ From Coq Require Import Bool String List Lia. Require Import Lib.CommonTactics Lib.NatLib Lib.Indexer - Lib.Struct Lib.DepEq Lib.Word Lib.FMap Lib.Reflection. + Lib.Struct Lib.DepEq Lib.Word Lib.WordDerived Lib.FMap Lib.Reflection. Require Import Kami.Syntax Kami.Notations Kami.Semantics Kami.SemFacts Kami.Tactics. From Coq Require Import ZArith Eqdep Equality. @@ -11,33 +11,15 @@ Open Scope string. (* Some useful facts about [word], only for the multiplier implementation. *) Section WordEx. - Definition rtrunc1 sz (w: word (S sz)): word sz:= - match w with - | WO => tt - | WS _ w' => w' - end. + Definition rtrunc1 sz (w: word (S sz)): word sz := wtl w. - Definition rtrunc2 sz (w: word (S (S sz))): word sz := - match w with - | WO => tt - | WS _ w' => - match w' with - | WO => tt - | WS _ w'' => w'' - end - end. + Definition rtrunc2 sz (w: word (S (S sz))): word sz := wtl (wtl w). Lemma wordToNat_rtrunc1: forall sz (w: word (S sz)), wordToNat (rtrunc1 w) = wordToNat w / 2. Proof. - dependent destruction w. - unfold rtrunc1, wordToNat; fold wordToNat. - destruct b. - - change (S (wordToNat w * 2)) with (1 + wordToNat w * 2). - rewrite Nat.div_add by discriminate. - reflexivity. - - apply eq_sym, Nat.div_mul; discriminate. + intros; apply wordToNat_wtl. Qed. Lemma combine_wrshifta_rtrunc1_sext: @@ -70,24 +52,8 @@ Section WordEx. forall sz (w: word (S (S sz))), wordToNat (rtrunc2 w) = wordToNat w / 4. Proof. - do 2 dependent destruction w. - unfold rtrunc2, wordToNat; fold wordToNat. - destruct b, b0. - - replace (S (S (wordToNat w * 2) * 2)) - with (3 + wordToNat w * 4) by lia. - rewrite Nat.div_add by discriminate. - reflexivity. - - replace (S (wordToNat w * 2 * 2)) - with (1 + wordToNat w * 4) by lia. - rewrite Nat.div_add by discriminate. - reflexivity. - - replace (S (wordToNat w * 2) * 2) - with (2 + wordToNat w * 4) by lia. - rewrite Nat.div_add by discriminate. - reflexivity. - - replace (wordToNat w * 2 * 2) - with (wordToNat w * 4) by lia. - apply eq_sym, Nat.div_mul; discriminate. + intros; cbv [rtrunc2]; rewrite !wordToNat_wtl, Nat.div_div by discriminate. + reflexivity. Qed. Lemma combine_wrshifta_rtrunc2_sext: @@ -139,7 +105,7 @@ Section Multiplier64. (* 2*4 = 8 bits are calculated per a phase. *) Definition MultNumBitsPerPhase := 2 * MultNumStepsPerPhase. - Definition MultNumPhases := wordToNat (wones MultLogNumPhases) + 1. (* 2^3 = 8 *) + Definition MultNumPhases := pow2 MultLogNumPhases. (* 2^3 = 8 *) Definition MultNumBits := MultNumPhases * MultNumBitsPerPhase. (* 8*8 = 64 *) Definition MultNumBitsExt := MultNumBits + 1. (* 8*8 + 1 = 65 *) Definition MultBits := 2 * MultNumBitsExt + 2. @@ -439,59 +405,60 @@ Section Multiplier64. | _, _ => BZero end. - Definition wencodeB2 (w: word 2): Booth. - Proof. - dependent destruction w. - dependent destruction w. - exact (encodeB2 b0 b). - Defined. - - Fixpoint wordToB2' sz (w: word sz) (p: bool): bword sz := - match w with - | WO => BWO - | WS b w' => BWS (encodeB2 b p) (wordToB2' w' b) - end. + Definition wencodeB2 (w: word 2): Booth := + encodeB2 (whd (wtl w)) (whd w). + + Fixpoint wordToB2' sz (w: word sz) (p: bool) {struct sz}: bword sz := + match sz as s return word s -> bword s with + | O => fun _ => BWO + | S sz' => fun w => BWS (encodeB2 (whd w) p) (wordToB2' (wtl w) (whd w)) + end w. Lemma wordToB2'_rtrunc1_wlsb: forall sz (w: word (S sz)) p, wordToB2' w p = BWS (encodeB2 (wlsb w) p) (wordToB2' (rtrunc1 w) (wlsb w)). Proof. - intros; dependent destruction w; simpl; reflexivity. + intros; reflexivity. Qed. Definition wordToB2 sz (w: word (S sz)): bword sz := - match w with - | WO => tt - | WS b w' => wordToB2' w' b - end. + wordToB2' (wtl w) (whd w). Lemma wordToB2_one: forall (w: word 1), bwordToZ (wordToB2 w) = 0%Z. Proof. - dependent destruction w. - dependent destruction w. - simpl; reflexivity. + intros; reflexivity. + Qed. + + Lemma wordToB2'_S : forall sz (w: word (S sz)) p, + wordToB2' w p = BWS (encodeB2 (whd w) p) (wordToB2' (wtl w) (whd w)). + Proof. reflexivity. Qed. + + Lemma wordToB2'_bwordToZ: + forall sz (w: word (S sz)) b, + bwordToZ (wordToB2' w b) = (wordToZ w + (if b then 1 else 0))%Z. + Proof. + induction sz; intros w b; rewrite wordToB2'_S. + - rewrite (shatter_word_0 (wtl w)), wordToZ_one. + destruct (whd w), b; reflexivity. + - destruct (whd w) eqn:E, b; cbn [encodeB2 bwordToZ]; + rewrite IHsz, wordToZ_succ, E; lia. Qed. Lemma wordToB2_bwordToZ': forall sz (w: word (S sz)) b, bwordToZ (wordToB2 (WS b w)) = (wordToZ w + (if b then 1 else 0))%Z. Proof. - dependent induction w; simpl; intros. - dependent destruction w. - - destruct b, b0; cbn; reflexivity. - - specialize (IHw _ _ eq_refl JMeq_refl). - unfold wordToB2 in IHw; rewrite IHw; clear IHw. - destruct b, b1, b0; cbn; - repeat (rewrite wordToZ_WS_0 || rewrite wordToZ_WS_1); lia. + intros; cbv [wordToB2]; rewrite wtl_WS, whd_WS; apply wordToB2'_bwordToZ. Qed. Lemma wordToB2_bwordToZ: forall sz (w: word sz), bwordToZ (wordToB2 w~0) = wordToZ w. Proof. - dependent destruction w; [reflexivity|]. - rewrite wordToB2_bwordToZ'; lia. + intros sz w; destruct sz. + - rewrite (shatter_word_0 w); reflexivity. + - rewrite wordToB2_bwordToZ'; lia. Qed. Lemma wordToB2_bwordToZ_step: @@ -500,16 +467,9 @@ Section Multiplier64. (2 * bwordToZ (wordToB2 (rtrunc1 w)) + boothToZ (wencodeB2 (split1 2 _ w)))%Z. Proof. - do 2 dependent destruction w; cbn. - remember (bwordToZ (wordToB2' w b0)) as ww; clear Heqww. - destruct ww. - - destruct b, b0; cbn; reflexivity. - - rewrite Pos2Z.inj_xO with (p:= p). - rewrite Z.mul_comm; remember (2 * Z.pos p)%Z as tp; clear Heqtp. - destruct b, b0; cbn; lia. - - rewrite Pos2Z.neg_xO with (p:= p). - rewrite Z.mul_comm; remember (2 * Z.neg p)%Z as tp; clear Heqtp. - destruct b, b0; cbn; lia. + intros; cbv [wordToB2 rtrunc1 wencodeB2]. + rewrite wordToB2'_S, !wtl_split1, !whd_split1. + destruct (whd w), (whd (wtl w)); cbn [encodeB2 boothToZ bwordToZ]; lia. Qed. Definition encodeB4 (b1 b2 b3: bool) := @@ -523,48 +483,66 @@ Section Multiplier64. | _, _, _ => (BZero, BZero) end. - Definition wencodeB4 (w: word 3): Booth * Booth. - Proof. - dependent destruction w. - dependent destruction w. - dependent destruction w. - exact (encodeB4 b1 b0 b). - Defined. - - Fixpoint wordToB4' sz (w: word sz) (p1 p2: bool): bword (S sz). - Proof. - dependent destruction w. - - exact (BWS (encodeB2 p1 p2) BWO). - - dependent destruction w. - + exact (BWS (snd (encodeB4 b p1 p2)) (BWS (fst (encodeB4 b p1 p2)) BWO)). - + refine (BWS (snd (encodeB4 b p1 p2)) (BWS (fst (encodeB4 b p1 p2)) _)). - exact (wordToB4' _ w b0 b). - Defined. - - Definition wordToB4 sz (w: word (S sz)): bword sz. + Definition wencodeB4 (w: word 3): Booth * Booth := + encodeB4 (whd (wtl (wtl w))) (whd (wtl w)) (whd w). + + Fixpoint wordToB4' sz (w: word sz) (p1 p2: bool) {struct sz}: bword (S sz) := + match sz as s return word s -> bword (S s) with + | O => fun _ => BWS (encodeB2 p1 p2) BWO + | S O => fun w => BWS (snd (encodeB4 (whd w) p1 p2)) + (BWS (fst (encodeB4 (whd w) p1 p2)) BWO) + | S (S m) => fun w => BWS (snd (encodeB4 (whd w) p1 p2)) + (BWS (fst (encodeB4 (whd w) p1 p2)) + (wordToB4' (wtl (wtl w)) (whd (wtl w)) (whd w))) + end w. + + Definition wordToB4 sz (w: word (S sz)): bword sz := + match sz as s return word (S s) -> bword s with + | O => fun _ => BWO + | S m => fun w => wordToB4' (wtl (wtl w)) (whd (wtl w)) (whd w) + end w. + + Lemma wordToB4'_1 : forall (v: word 1) p1 p2, + wordToB4' v p1 p2 = + BWS (snd (encodeB4 (whd v) p1 p2)) (BWS (fst (encodeB4 (whd v) p1 p2)) BWO). + Proof. reflexivity. Qed. + + Lemma wordToB4'_SS : forall m (v: word (S (S m))) p1 p2, + wordToB4' v p1 p2 = + BWS (snd (encodeB4 (whd v) p1 p2)) + (BWS (fst (encodeB4 (whd v) p1 p2)) + (wordToB4' (wtl (wtl v)) (whd (wtl v)) (whd v))). + Proof. reflexivity. Qed. + + Lemma wordToB4'_bwordToZ : + forall sz (v: word sz) p1 p2, + bwordToZ (wordToB4' v p1 p2) = (wordToZ (WS p1 v) + (if p2 then 1 else 0))%Z. Proof. - dependent destruction w. - dependent destruction w. - - exact BWO. - - exact (wordToB4' w b0 b). - Defined. + intro sz; induction sz as [sz IH] using (well_founded_induction Wf_nat.lt_wf). + intros v p1 p2; destruct sz as [|[|m]]. + - rewrite (shatter_word_0 v), wordToZ_one, whd_WS. + destruct p1, p2; reflexivity. + - rewrite wordToB4'_1. + rewrite (wordToZ_succ (WS p1 v)), whd_WS, wtl_WS, wordToZ_one. + destruct (whd v), p1, p2; cbn [encodeB4 fst snd bwordToZ]; lia. + - rewrite wordToB4'_SS, (wordToZ_succ (WS p1 v)), whd_WS, wtl_WS, + (wordToZ_succ v). + destruct (whd v) eqn:E1, p1, p2; + cbn [encodeB4 fst snd bwordToZ]; + rewrite IH by lia; + rewrite <- (shatter_word (wtl v)); lia. + Qed. Lemma wordToB2_wordToB4: forall sz (w: word (S sz)), bwordToZ (wordToB2 w) = bwordToZ (wordToB4 w). Proof. - dependent destruction w. - move b at bottom. - dependent induction w; [reflexivity|]. - cbn; cbn in IHw; rewrite IHw; clear IHw. - move b at bottom. - dependent induction w. - - destruct b, b0; cbn; reflexivity. - - rewrite <-IHw; clear IHw. - dependent destruction w. - + destruct b, b0, b1; cbn; reflexivity. - + cbn; remember (bwordToZ (wordToB4' w b0 b)) as ww; clear Heqww. - destruct b, b0, b1, b2; cbn; lia. + intros sz w; destruct sz. + - cbv [wordToB2 wordToB4]; rewrite (shatter_word_0 (wtl w)); reflexivity. + - cbv [wordToB2 wordToB4]. + rewrite wordToB4'_bwordToZ, wordToB2'_bwordToZ. + rewrite <- (shatter_word (wtl w)). + reflexivity. Qed. Lemma wordToB4_bwordToZ_step: @@ -573,24 +551,14 @@ Section Multiplier64. (4 * bwordToZ (wordToB4 (rtrunc2 w)) + bbToZ (wencodeB4 (split1 3 _ w)))%Z. Proof. - do 3 dependent destruction w; cbn. - dependent destruction w. - - destruct b, b0, b1; cbn; reflexivity. - - cbn; remember (bwordToZ (wordToB4' w b2 b1)) as ww; clear Heqww. - destruct ww. - + destruct b, b0, b1; cbn; reflexivity. - + rewrite Pos2Z.inj_xO with (p:= (p~0)%positive). - rewrite Pos2Z.inj_xO with (p:= p). - rewrite Z.mul_comm with (n:= Z.pos p); remember (2 * Z.pos p)%Z as tp; clear Heqtp. - Opaque Z.mul. - destruct b, b0, b1; cbn; lia. - Transparent Z.mul. - + rewrite Pos2Z.neg_xO with (p:= (p~0)%positive). - rewrite Pos2Z.neg_xO with (p:= p). - rewrite Z.mul_comm with (n:= Z.neg p); remember (2 * Z.neg p)%Z as tp; clear Heqtp. - Opaque Z.mul. - destruct b, b0, b1; cbn; lia. - Transparent Z.mul. + intros sz w; cbv [wordToB4 rtrunc2 wencodeB4]; + rewrite !wtl_split1, !whd_split1; destruct sz as [|m]. + - rewrite wordToB4'_1. + destruct (whd w), (whd (wtl w)), (whd (wtl (wtl w))); + cbn [encodeB4 fst snd bwordToZ bbToZ boothToZ]; lia. + - rewrite wordToB4'_SS. + destruct (whd w), (whd (wtl w)), (whd (wtl (wtl w))); + cbn [encodeB4 fst snd bwordToZ bbToZ boothToZ]; lia. Qed. End BoothEncoding. @@ -619,17 +587,11 @@ Section Multiplier64. Lemma natToWord_ZToWord_zero: forall sz, natToWord sz 0 = ZToWord sz 0%Z. - Proof. - intros; simpl. - induction sz; simpl; auto. - rewrite IHsz; reflexivity. - Qed. + Proof. reflexivity. Qed. Lemma wmsb_wzero'_false: - forall sz, wmsb (wzero' sz) false = false. - Proof. - induction sz; simpl; intros; auto. - Qed. + forall sz, wmsb (wzero sz) false = false. + Proof. word_lia_Z. Qed. Lemma boothStepInv_init: forall sz m p, @@ -644,7 +606,7 @@ Section Multiplier64. - instantiate (1:= 0%Z). rewrite <-Zmult_0_r_reverse. rewrite natToWord_ZToWord_zero. - rewrite wordToZ_wzero'. + rewrite wordToZ_wzero. reflexivity. - rewrite Z.add_0_l. replace (S sz - sz - 1) with 0 by lia. @@ -721,11 +683,9 @@ Section Multiplier64. wl <> WO~0~1 -> wl <> WO~1~0 -> wencodeB2 wl = BZero. Proof. - intros. - dependent destruction wl. - dependent destruction wl. - dependent destruction wl. - destruct b, b0; intuition idtac. + intros wl H H0; cbv [wencodeB2]. + rewrite (shatter_word_2 wl) in H, H0. + destruct (whd wl), (whd (wtl wl)); cbn in *; intuition idtac. Qed. Lemma wencodeB4_zero: @@ -734,12 +694,10 @@ Section Multiplier64. wl <> WO~1~0~0 -> wl <> WO~1~0~1 -> wl <> WO~1~1~0 -> wencodeB4 wl = (BZero, BZero). Proof. - intros. - dependent destruction wl. - dependent destruction wl. - dependent destruction wl. - dependent destruction wl. - destruct b, b0, b1; intuition idtac. + intros wl H H0 H1 H2 H3 H4; cbv [wencodeB4]. + rewrite (shatter_word_3 wl) in H, H0, H1, H2, H3, H4. + destruct (whd wl), (whd (wtl wl)), (whd (wtl (wtl wl))); + cbn in *; intuition idtac. Qed. Ltac wordToZ_red := @@ -1199,9 +1157,9 @@ Section Multiplier64. boothMultiplierInv_new. * cbn; eq_rect_simpl. - reflexivity. + rewrite extz_combine; reflexivity. * cbn; eq_rect_simpl. - reflexivity. + rewrite extz_combine; reflexivity. * clear -H4 H12. Opaque split2. simpl in *. @@ -1231,13 +1189,15 @@ Section Multiplier64. elim n; assumption. } - set (extz (combine (x (Fin.FS Fin.F1)) (natToWord (MultNumBitsExt + 1) 0)) 1) as ww. + set (combine (combine (natToWord 1 0) (x (Fin.FS Fin.F1))) + (natToWord (S MultNumBitsExt) 0)) as ww. pose proof (boothStepInv_init (x Fin.F1) (x (Fin.FS Fin.F1))) as Hinv0. assert (pred MultNumBitsExt <> 0) by (cbn; lia). eapply (boothStepInv_boothStep (we:= Var type (SyntaxKind (Bit MultBits)) ww) (sus:= O) - Hx1 eq_refl eq_refl eq_refl H12 eq_refl) in Hinv0; [|reflexivity]. + Hx1 eq_refl eq_refl eq_refl H12 eq_refl) in Hinv0; + [|subst ww; reflexivity]. simpl in Hinv0. destruct Hinv0 as [nwl [nwu [? ?]]]. @@ -1248,6 +1208,7 @@ Section Multiplier64. { subst ww. cbv [evalSignExtendTrunc]. simpl; eq_rect_simpl. + rewrite !extz_combine in H13. rewrite <-H13. reflexivity. } @@ -1268,9 +1229,7 @@ Section Multiplier64. assert (psl >= 9)%nat. { subst; clear -n1. unfold type in x. - do 5 (dependent destruction x). - destruct b, b0, b1, b2; cbn; try lia. - elim n1; reflexivity. + word_to_Z; lia. } do 9 (destruct psl as [|psl]; [lia|]); clear H. @@ -1370,56 +1329,46 @@ Section Multiplier64. Transparent MultNumBits. eexists; split; kinv_constr. - apply boothStepInv_finish in H7; dest. - assert (x3 = MultNumBitsExt) by (apply eq_sigT_fst in H6; cbn; cbn in H6; lia). + apply boothStepInv_finish in H6; dest. + assert (x3 = MultNumBitsExt) + by (apply eq_sigT_fst in H5; cbn in H5; + rewrite ?roundTrip_0 in H5; cbn; cbn in H5; lia). subst; destruct_existT. rewrite idElementwiseId; unfold id. do 3 f_equal. fin_func_eq. - + Opaque split1 split2 wordToZ. + + Opaque split1 split2 Zmod.signed. simpl. unfold eq_rec_r, eq_rec; repeat rewrite <-eq_rect_eq. unfold ilist.ilist_to_fun_m; simpl. repeat f_equal. - rewrite wtl_combine. - unfold wmultZ, wordBinZ. - pose proof (sext_wordToZ 65 bsiM). - cbv [evalSignExtendTrunc]; cbn. - eq_rect_simpl. - cbn in H1; rewrite H1. - pose proof (sext_wordToZ 65 bsiR). - cbn; cbn in H2; rewrite H2. - cbn in H0; rewrite <-H0. - assert (x = 2 * MultNumBitsExt) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - pose proof (sext_wordToZ 1 x4); cbn; cbn in H; rewrite H. - rewrite sext_split1. - rewrite ZToWord_wordToZ. + rewrite split2_split1_combine1. + cbv [evalSignExtendTrunc]; cbn; eq_rect_simpl. + apply Zmod.unsigned_inj. + rewrite unsigned_split1, Zmod.unsigned_mul; canon_unsigned; rewrite !unsigned_sext. + replace (Zpow2 (MultNumBitsExt + 65)) with (Zpow2 130) by reflexivity. + cbn in H0; rewrite Zmult_mod_idemp_l, Zmult_mod_idemp_r, <- H0. + rewrite <- (Zmod.mod_signed x5), Z.mod_mod_divide + by (exists (Zpow2 1); rewrite <- Zpow2_add; reflexivity). reflexivity. - Transparent split1 split2 wordToZ. + Transparent split1 split2 Zmod.signed. - + Opaque split1 split2 wordToZ. + + Opaque split1 split2 Zmod.signed. simpl. unfold eq_rec_r, eq_rec; repeat rewrite <-eq_rect_eq. unfold ilist.ilist_to_fun_m; simpl. repeat f_equal. - rewrite wtl_combine. - unfold wmultZ, wordBinZ. - pose proof (sext_wordToZ 65 bsiM). - cbv [evalSignExtendTrunc]; cbn. - eq_rect_simpl. - cbn in H1; rewrite H1. - pose proof (sext_wordToZ 65 bsiR). - cbn; cbn in H2; rewrite H2. - cbn in H0; rewrite <-H0. - assert (x = 2 * MultNumBitsExt) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - pose proof (sext_wordToZ 1 x4); cbn; cbn in H; rewrite H. - rewrite sext_split1. - rewrite ZToWord_wordToZ. + rewrite split2_split1_combine1. + cbv [evalSignExtendTrunc]; cbn; eq_rect_simpl. + apply Zmod.unsigned_inj. + rewrite unsigned_split1, Zmod.unsigned_mul; canon_unsigned; rewrite !unsigned_sext. + replace (Zpow2 (MultNumBitsExt + 65)) with (Zpow2 130) by reflexivity. + cbn in H0; rewrite Zmult_mod_idemp_l, Zmult_mod_idemp_r, <- H0. + rewrite <- (Zmod.mod_signed x5), Z.mod_mod_divide + by (exists (Zpow2 1); rewrite <- Zpow2_add; reflexivity). reflexivity. - Transparent split1 split2 wordToZ. + Transparent split1 split2 Zmod.signed. - (* "boothStep" |-> . *) kinv_action_dest. diff --git a/Kami/Ex/ProcDecInv.v b/Kami/Ex/ProcDecInv.v index a0b6f7f..0393f48 100644 --- a/Kami/Ex/ProcDecInv.v +++ b/Kami/Ex/ProcDecInv.v @@ -15,46 +15,11 @@ Lemma wnot_not_zero_wplusone: forall {sz} (w2: word sz), wnot w2 <> $0 -> #(w2 ^+ $1) = #w2 + 1. -Proof. - intros. - assert (w2 < wones _). - { apply lt_wlt. - rewrite wones_pow2_minus_one. - pose proof (wordToNat_bound w2). - pose proof (NatLib.pow2_zero sz). - assert (#w2 = NatLib.pow2 sz - 1 \/ (#w2 < NatLib.pow2 sz - 1)%nat) by lia. - destruct H2; [|assumption]. - assert (natToWord sz (#w2) = natToWord sz (NatLib.pow2 sz - 1)) by congruence. - rewrite natToWord_wordToNat, <-wones_natToWord in H3; subst. - rewrite wnot_ones in H. - exfalso; auto. - } - erewrite wordToNat_plusone; [|eassumption]. - lia. -Qed. - -Lemma wminus_wplus_transpose: - forall {sz} (w1 w2 w3: word sz), - w1 ^- w2 = w3 -> w1 = w3 ^+ w2. -Proof. - intros. - replace (w3 ^+ w2) with (w1 ^- w2 ^+ w2). - - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ w2), wminus_inv. - rewrite wplus_wzero_1; reflexivity. - - congruence. -Qed. +Proof. word_lia_Z. Qed. Lemma wnot_zero_wones: forall {sz} (w: word sz), wnot w = $0 -> w = wones _. -Proof. - intros. - rewrite wneg_wnot in H. - apply wminus_wplus_transpose in H. - rewrite wplus_unit in H. - rewrite <- @wneg_idempotent with (w:= w), H. - apply eq_sym, wones_wneg_one. -Qed. +Proof. word_lia_Z. Qed. Section Invariants. Variables addrSize iaddrSize instBytes dataBytes rfIdx: nat. @@ -253,7 +218,7 @@ Section Invariants. unfold type, ilist_to_fun_m; simpl. do 3 f_equal. pose proof (NatLib.pow2_zero iaddrSize). - rewrite wordToNat_natToWord_2; lia. + rewrite wordToNat_natToWord_idempotent' by lia; lia. + apply IHelts; auto. Qed. @@ -299,7 +264,7 @@ Section Invariants. - kinv_dest_custom procDec_inv_tac. kinv_constr. + simpl; auto. - + cbn; repeat rewrite wordToNat_wzero; split; intros; reflexivity. + + cbn; repeat rewrite roundTrip_0; split; intros; reflexivity. + procDec_inv_next 0. - kinvert; [mred|mred|..]. diff --git a/Kami/Ex/ProcDecSC.v b/Kami/Ex/ProcDecSC.v index 6ff0684..56bc0e0 100644 --- a/Kami/Ex/ProcDecSC.v +++ b/Kami/Ex/ProcDecSC.v @@ -130,9 +130,8 @@ Section ProcDecSC. else drainInsts rss rsOfs pgmv w). Proof. unfold listEnq; induction rss; simpl; intros; - [rewrite wplus_wzero_1; reflexivity|]. - rewrite IHrss. - rewrite <-wplus_assoc, <-natToWord_plus; reflexivity. + [replace (rsOfs ^+ $0) with rsOfs by word_lia_Z; reflexivity|]. + rewrite IHrss, (natToWord_S _ (Datatypes.length rss)), Zmod.add_assoc; reflexivity. Qed. Lemma pdec_refines_pinst: pdec <<== pinst. @@ -195,7 +194,7 @@ Section ProcDecSC. + rewrite wones_pow2_minus_one. find_if_inside; [reflexivity|]. elim n; pose proof (NatLib.pow2_zero iaddrSize); lia. - + rewrite wones_wneg_one, wplus_comm, wminus_inv; reflexivity. + + word_lia_Z. - kinv_action_dest. kinv_custom procDec_inv_old. diff --git a/Kami/Ex/SCMMInv.v b/Kami/Ex/SCMMInv.v index 86355bf..19d8d27 100644 --- a/Kami/Ex/SCMMInv.v +++ b/Kami/Ex/SCMMInv.v @@ -87,27 +87,7 @@ Section Invariants. w1 < w2 ^+ $1 -> w1 <> w2 -> w1 < w2. - Proof. - intros. - assert (w2 < wones _). - { apply lt_wlt. - rewrite wones_pow2_minus_one. - pose proof (wordToNat_bound w2). - pose proof (NatLib.pow2_zero sz). - assert (#w2 = NatLib.pow2 sz - 1 \/ (#w2 < NatLib.pow2 sz - 1)%nat) by lia. - destruct H4; [|assumption]. - assert (natToWord sz (#w2) = natToWord sz (NatLib.pow2 sz - 1)) by congruence. - rewrite natToWord_wordToNat, <-wones_natToWord in H5; subst. - rewrite wnot_ones in H. - exfalso; auto. - } - apply wlt_lt in H0. - erewrite wordToNat_plusone in H0 by eassumption. - apply lt_wlt. - assert (#w1 <> #w2) - by (intro Hx; elim H1; apply wordToNat_inj; assumption). - lia. - Qed. + Proof. word_lia_Z. Qed. Lemma scmm_inv_ok': forall init n ll, @@ -121,8 +101,7 @@ Section Invariants. cbn; intros _ iaddr ?. exfalso. - apply wlt_lt in H; rewrite wordToNat_wzero in H. - lia. + word_lia_Z. - kinvert. + mred. diff --git a/Kami/Ex/SimpleFifoCorrect.v b/Kami/Ex/SimpleFifoCorrect.v index e424563..a502c43 100644 --- a/Kami/Ex/SimpleFifoCorrect.v +++ b/Kami/Ex/SimpleFifoCorrect.v @@ -42,8 +42,7 @@ Section Facts. forall eltv x, sfifo_nsfifo_elt_not_full eltv (x ^+ $1) 1 = [eltv x]. Proof. intros; simpl; repeat f_equal. - rewrite wminus_def, <-wplus_assoc, wminus_inv, wplus_comm. - apply wplus_unit. + unfold rsz in *; word_lia_Z. Qed. Lemma sfifo_nsfifo_elt_not_full_prop_2: @@ -67,40 +66,14 @@ Section Facts. - simpl; f_equal. destruct (weq _ _); auto. elim n; clear n. - rewrite wminus_def, <-wplus_assoc, wminus_inv. - rewrite wplus_comm, wplus_unit. - reflexivity. + unfold rsz in *; word_lia_Z. - unfold sfifo_nsfifo_elt_not_full in *. fold sfifo_nsfifo_elt_not_full in *. rewrite <-IHedSub by lia; clear IHedSub. unfold app; f_equal. destruct (weq _ _). - + exfalso. - rewrite natToWord_S with (n:= S edSub) in e. - rewrite wminus_plus_distr in e. - rewrite !wminus_def in e. - rewrite <-wplus_assoc with (x:= enqPv) in e. - rewrite wminus_inv in e. - rewrite wplus_comm with (x:= enqPv), wplus_unit in e. - rewrite wplus_comm in e. - rewrite <-wplus_unit with (x:= enqPv) in e at 2. - apply wplus_cancel in e. - apply wneg_zero in e. - apply natToWord_inj in e. - * inv e. - * pose proof (wordToNat_bound (wones rsz)); lia. - * apply pow2_zero. - + f_equal. - do 2 rewrite wminus_def. - rewrite <-wplus_assoc. - f_equal. - rewrite natToWord_S with (n:= S edSub). - apply wplus_cancel with (c:= $1 ^+ $ (S edSub)). - rewrite <-wplus_assoc, wplus_comm with (x:= ^~ ($1 ^+ $ (S edSub))). - rewrite wminus_inv. - rewrite wplus_comm with (x:= ^~ $ (S edSub)). - rewrite <-wplus_assoc, wminus_inv. - reflexivity. + + exfalso; unfold rsz in *; word_lia_Z. + + f_equal; unfold rsz in *; word_lia_Z. Qed. Lemma sfifo_nsfifo_elt_not_full_deq: @@ -214,18 +187,18 @@ Section Facts. - simpl; kinv_action_dest. unfold initRegs, rawInitRegs, getRegInits; simpl. kinv_regmap_red; kinv_constr; kinv_eq. - or3_fst; auto. + or3_fst; repeat split; destruct (weq _ _); congruence. - intros; inv H0; inv HInRules. - intros; inv H0; CommonTactics.dest_in. + simpl in *; kinv_magic_light_with kinv_or3. * or3_thd; repeat split. { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } - * destruct (weq x6 (x5 ^+ $0~1)). + * destruct (weq x6 (x5 ^+ $1)). { or3_snd; repeat split. destruct (weq _ _); auto. } @@ -236,12 +209,12 @@ Section Facts. + simpl in *; kinv_magic_light_with kinv_or3. * or3_thd; repeat split. { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } { destruct (weq _ _); auto. - exfalso; eapply wplus_one_neq; eauto. + wplus_one_contra. } - * destruct (weq x5 (x6 ^+ $0~1)). + * destruct (weq x5 (x6 ^+ $1)). { or3_fst; auto. } { or3_thd; auto. } - apply sfifo_substeps_updates. @@ -280,20 +253,16 @@ Section Facts. { intros; inv H0. } { intros; inv H0. } { kregmap_red; kregmap_clear; meq. - { exfalso; eapply wplus_one_neq; eauto. } - { exfalso; eapply wplus_one_neq; eauto. } + { wplus_one_contra. } + { wplus_one_contra. } { repeat f_equal. simpl; replace (wordToNat _) with 1. { rewrite sfifo_nsfifo_elt_not_full_prop_1. destruct (weq x6 x6); intuition idtac. } - { rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (x:= $0~1), wplus_assoc. - rewrite wminus_inv, wplus_unit. - simpl; rewrite roundTrip_0; reflexivity. - } + { unfold rsz in *; word_lia_Z. } } - { exfalso; eapply wplus_one_neq; eauto. } + { wplus_one_contra. } { repeat f_equal. unfold evalExpr. rewrite sfifo_nsfifo_elt_not_full_enq. @@ -302,98 +271,19 @@ Section Facts. repeat f_equal. { unfold rsz in *; clear n e n0. destruct (weq _ _); [|clear n]. - { exfalso. - rewrite natToWord_S with (n:= wordToNat _) in e. - rewrite !wminus_plus_distr in e. - rewrite !wminus_def in e. - rewrite <-wplus_assoc with (x:= x5) in e. - rewrite !wminus_inv in e. - rewrite wplus_comm with (x:= x5) in e. - rewrite !wplus_unit in e. - rewrite wplus_comm in e. - rewrite <-wplus_unit in e. - apply wplus_cancel in e. - apply wneg_zero in e. - rewrite natToWord_wordToNat in e. - apply wneg_zero in e. - inv e. - } - { f_equal. - rewrite wminus_plus_distr. - rewrite !wminus_def. - rewrite wminus_inv, wplus_unit. - rewrite <-wplus_assoc; f_equal. - rewrite natToWord_S with (n:= wordToNat _). - rewrite <-wminus_def. - rewrite wminus_plus_distr. - rewrite !wminus_def. - rewrite wminus_inv, wplus_unit. - rewrite natToWord_wordToNat. - rewrite wneg_idempotent. - reflexivity. - } - } - { rewrite wones_wneg_one. - apply wplus_cancel with (c:= x5 ^+ $0~1). - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (y:= x5 ^+ $0~1). - rewrite wminus_inv. - rewrite wplus_comm with (x:= ^~ $1), <-wplus_assoc. - rewrite wminus_inv. - reflexivity. - } - } - { replace (x5 ^- (x5 ^+ $0~1)) with (wones rsz). - { apply Nat.le_refl. } - { rewrite wones_wneg_one. - apply wplus_cancel with (c:= x5 ^+ $0~1). - rewrite wplus_comm, <-wplus_assoc, wminus_inv. - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (y:= x5 ^+ $0~1). - rewrite wminus_inv. - reflexivity. + { exfalso; unfold rsz in *; word_lia_Z. } + { f_equal; unfold rsz in *; word_lia_Z. } } + { unfold rsz in *; word_lia_Z. } } + { unfold rsz in *; word_lia_Z. } } { repeat f_equal; simpl. rewrite sfifo_nsfifo_elt_not_full_enq. { repeat f_equal. - apply natToWord_inj with (sz:= S sz). - { rewrite natToWord_S. - rewrite !natToWord_wordToNat. - rewrite !wminus_def. - rewrite wplus_assoc, wplus_comm with (x:= $1). - reflexivity. - } - { pose proof (wordToNat_bound (x5 ^- x6)). - remember (Lib.NatLib.pow2 (S sz)) as pt; destruct pt. - { pose proof (pow2_zero (S sz)); lia. } - { apply ->Nat.succ_lt_mono. - assert (wordToNat (x5 ^- x6) <> pt). - { replace pt with (Lib.NatLib.pow2 (S sz) - 1) by lia. - intro Hx. - apply pow2_minus_one_wones in Hx. - elim n0. - apply wplus_cancel with (c:= ^~ $0~1). - rewrite <-wplus_assoc, wminus_inv. - rewrite wplus_comm, wplus_unit. - rewrite wplus_comm. - apply wplus_cancel with (c:= ^~ x6). - rewrite <-wplus_assoc, wminus_inv. - rewrite wplus_comm with (y:= wzero _), wplus_unit. - rewrite <-wminus_def; rewrite Hx. - rewrite wones_wneg_one. - reflexivity. - } - lia. - } - } - { apply wordToNat_bound. } - } - { rewrite wones_pow2_minus_one. - pose proof (wordToNat_bound (x5 ^- x6)). - unfold rsz in *; lia. + unfold rsz in *; word_lia_Z. } + { unfold rsz in *; word_lia_Z. } } } @@ -420,17 +310,9 @@ Section Facts. { intros; inv H1. } { intros; inv H1. } { kregmap_red; kregmap_clear; meq. - { exfalso; eapply wplus_one_neq; eauto. } - { replace (x6 ^- (x6 ^+ $0~1)) with (wones (S sz)); auto. - apply wplus_cancel with (c:= x6 ^+ $0~1). - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ (x6 ^+ _)). - rewrite wminus_inv, wplus_comm with (y:= $0~1). - rewrite wplus_assoc. - replace ((natToWord sz 0)~1) with (natToWord rsz 1) by reflexivity. - rewrite wones_wneg_one. - rewrite wplus_comm with (y:= $1), wminus_inv. - apply wplus_comm. + { wplus_one_contra. } + { replace (x6 ^- (x6 ^+ $1)) with (wones (S sz)); auto. + unfold rsz in *; word_lia_Z. } } } @@ -445,14 +327,7 @@ Section Facts. { kregmap_red; kregmap_clear; reflexivity. } { destruct (weq x5 x6); [elim n; auto|]. pose proof (@sfifo_nsfifo_elt_not_full_prop_2 x7 x5 (wordToNat (x5 ^- x6))). - assert (wordToNat (x5 ^- x6) <> 0). - { intro Hx. - assert ($ (wordToNat (x5 ^- x6)) = natToWord rsz 0) - by (rewrite Hx; reflexivity). - rewrite natToWord_wordToNat in H10. - apply sub_0_eq in H10. - elim n; auto. - } + assert (wordToNat (x5 ^- x6) <> 0) by (unfold rsz in *; word_lia_Z). specialize (H1 H10); clear H10; dest. rewrite H1; reflexivity. } @@ -461,24 +336,12 @@ Section Facts. { destruct (weq x5 x6); [elim n; auto|]. simpl; repeat f_equal. pose proof (@sfifo_nsfifo_elt_not_full_prop_2 x7 x5 (wordToNat (x5 ^- x6))). - assert (wordToNat (x5 ^- x6) <> 0). - { intro Hx. - assert ($ (wordToNat (x5 ^- x6)) = natToWord rsz 0) - by (rewrite Hx; reflexivity). - rewrite natToWord_wordToNat in H10. - apply sub_0_eq in H10. - elim n; auto. - } + assert (wordToNat (x5 ^- x6) <> 0) by (unfold rsz in *; word_lia_Z). specialize (H1 H10); clear H10; dest. rewrite H1; unfold listFirstElt, evalExpr; f_equal. rewrite natToWord_wordToNat. - apply wplus_cancel with (c:= x5 ^- x6). - rewrite wminus_def with (y:= x5 ^- x6), <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ (x5 ^- x6)). - rewrite wminus_inv, wminus_def, wplus_comm with (y:= ^~ x6). - rewrite wplus_assoc, wminus_inv. - apply wplus_comm. + unfold rsz in *; word_lia_Z. } } { repeat split. @@ -488,19 +351,11 @@ Section Facts. { simpl; repeat f_equal. replace (wordToNat _) with 1. { rewrite sfifo_nsfifo_elt_not_full_prop_1; reflexivity. } - { rewrite wminus_def, <-wplus_assoc, wplus_comm. - rewrite <-wplus_assoc, wplus_comm with (y:= x6), wminus_inv. - rewrite wplus_comm, wplus_unit. - rewrite roundTrip_1; auto. - } + { unfold rsz in *; word_lia_Z. } } { simpl; repeat f_equal. rewrite sfifo_nsfifo_elt_not_full_deq. - f_equal; rewrite wordToNat_natToWord_pred. - { f_equal. - rewrite wminus_plus_distr; reflexivity. - } - { intro Hx; apply sub_0_eq in Hx; auto. } + f_equal; unfold rsz in *; word_lia_Z. } } } diff --git a/Kami/Lib/Word.v b/Kami/Lib/Word.v index b194ce5..8457903 100644 --- a/Kami/Lib/Word.v +++ b/Kami/Lib/Word.v @@ -1,9 +1,30 @@ -(** Fixed precision machine words *) - -From Coq Require Import Arith NArith ZArith Bool Lia. -From Coq Require Import Eqdep_dec EqdepFacts. -From Coq.Program Require Import Tactics Equality. -From Coq Require Import Ring Ring_polynom Lia. +(** Fixed precision machine words. + + [word n] is the standard library's [Zmod (Zpow2 n)] where [Zpow2 n] is + [2 ^ Z.of_nat n], i.e. it is [bits (Z.of_nat n)], and Kami's operations + are the [Zmod] operations themselves: [wplus] is [Zmod.add], [wneg] is + [Zmod.opp], [wzero sz] is [Zmod.zero], [wordToZ] is [Zmod.signed], [wlt] + is [Z.lt] on [Zmod.unsigned], and so on, so the standard library's + [unsigned_*]/[signed_*] lemmas apply to Kami terms as they are. Only the + operations whose shape the standard library does not have (a [nat] index + or value, a width that changes, Kami's division-by-zero and shift + conventions) are definitions of their own, each with an [unsigned_*] + lemma. + + Facts about words are proved by moving to [Zmod.unsigned] and reasoning + in [Z]: [word_to_Z] rewrites every operation into its [unsigned] + specification, [word_lia_Z] follows it with [lia]/[nia]. + + Side effect on importers: this file requires [ZifyNat] and [ZifyN], so + importing it registers those [Zify] instances globally and [lia]/[nia] + will understand [Nat.pow]/[Nat.div]/[Nat.mod] and their [N] counterparts + everywhere downstream. It also declares the standard library's [Zmod] + operations [simpl never] (see below). *) + +From Stdlib Require Import Arith NArith ZArith Bool Lia ZifyNat ZifyN. +From Stdlib Require Import Eqdep_dec EqdepFacts. +From Stdlib Require Export Zmod. +From Stdlib Require Export Zmod.Bits. From Kami Require Import Nlia NatLib DepEq N_Z_nat_conversions. Set Implicit Arguments. @@ -12,9 +33,13 @@ Set Implicit Arguments. (** * [word] *) -Inductive word : nat -> Set := -| WO : word O -| WS : bool -> forall n, word n -> word (S n). +(** The modulus of an [n]-bit word. A named constant so that [simpl] does not + compute inside it: [2 ^ Z.of_nat (S n)] would become + [Z.pow_pos 2 (Pos.of_succ_nat n)], which no lemma matches any more. *) +Definition Zpow2 (n : nat) : Z := 2 ^ Z.of_nat n. +Arguments Zpow2 _ : simpl never. + +Definition word (n : nat) : Set := Zmod (Zpow2 n). Declare Scope word_scope. Delimit Scope word_scope with word. @@ -22,7305 +47,907 @@ Bind Scope word_scope with word. Open Scope word_scope. -(** * Conversion to and from [nat] (or [N]), zero and one *) - -Fixpoint wordToNat sz (w : word sz) : nat := - match w with - | WO => O - | WS false w' => (wordToNat w') * 2 - | WS true w' => S (wordToNat w' * 2) - end. - -Definition wordToNat' sz (w : word sz) : nat := - match w with - | WO => O - | WS false w' => 2 * wordToNat w' - | WS true w' => S (2 * wordToNat w') - end. - -Fixpoint natToWord (sz n : nat) : word sz := - match sz with - | O => WO - | S sz' => WS (mod2 n) (natToWord sz' (Nat.div2 n)) - end. - -Fixpoint wordToN sz (w : word sz) : N := - match w with - | WO => 0 - | WS false w' => 2 * wordToN w' - | WS true w' => N.succ (2 * wordToN w') - end%N. - -Definition wzero sz := natToWord sz 0. - -Fixpoint wzero' (sz : nat) : word sz := - match sz with - | O => WO - | S sz' => WS false (wzero' sz') - end. - -Fixpoint posToWord (sz : nat) (p : positive) {struct p} : word sz := - match sz with - | O => WO - | S sz' => - match p with - | xI p' => WS true (posToWord sz' p') - | xO p' => WS false (posToWord sz' p') - | xH => WS true (wzero' sz') - end - end. - -Definition NToWord (sz : nat) (n : N) : word sz := - match n with - | N0 => wzero' sz - | Npos p => posToWord sz p - end. - -Definition wone sz := natToWord sz 1. - -Fixpoint wones (sz : nat) : word sz := +Local Notation unsigned := Zmod.unsigned. +Local Notation signed := Zmod.signed. + +(** * The standard library's operations under Kami's names *) + +Notation ZToWord sz z := (Zmod.of_Z (Zpow2 sz) z). +Notation wordToZ := Zmod.signed. +Notation uwordToZ := Zmod.unsigned. + +Notation wzero sz := (@Zmod.zero (Zpow2 sz)). +Notation wone sz := (@Zmod.one (Zpow2 sz)). +Notation wones sz := (@Zmod.opp (Zpow2 sz) Zmod.one). +Notation WO := (@Zmod.zero (Zpow2 0)). + +Notation wneg := Zmod.opp. +Notation wplus := Zmod.add. +Notation wminus := Zmod.sub. +Notation wmult := Zmod.mul. +Notation wnot := Zmod.not. +Notation wor := Zmod.or. +Notation wand := Zmod.and. +Notation wxor := Zmod.xor. +Notation weqb := Zmod.eqb. + +Notation wlt l r := (Z.lt (Zmod.unsigned l) (Zmod.unsigned r)). +Notation wslt l r := (Z.lt (Zmod.signed l) (Zmod.signed r)). +Notation wlt_dec l r := (Z_lt_dec (Zmod.unsigned l) (Zmod.unsigned r)). +Notation wslt_dec l r := (Z_lt_dec (Zmod.signed l) (Zmod.signed r)). + +(** * Operations whose shape the standard library does not have *) + +(** Conversions with [nat] and [N]. *) +Definition natToWord (sz n : nat) : word sz := Zmod.of_Z _ (Z.of_nat n). +Definition NToWord (sz : nat) (n : N) : word sz := Zmod.of_Z _ (Z.of_N n). +Definition wordToNat [sz] (w : word sz) : nat := Z.to_nat (unsigned w). +Definition wordToN [sz] (w : word sz) : N := Z.to_N (unsigned w). + +(** [WS b w] is [w] with [b] appended as the new least significant bit. *) +Definition WS (b : bool) [n : nat] (w : word n) : word (S n) := + Zmod.of_Z _ (Z.b2z b + 2 * unsigned w). + +Definition whd [sz] (w : word (S sz)) : bool := Z.odd (unsigned w). +Definition wtl [sz] (w : word (S sz)) : word sz := Zmod.of_Z _ (unsigned w / 2). +Definition wlsb [sz] (w : word (S sz)) : bool := whd w. + +(** The most significant bit, or [a] for the empty word. *) +Definition wmsb [sz] (w : word sz) (a : bool) : bool := match sz with - | O => WO - | S sz' => WS true (wones sz') - end. - -(** * MSB, LSB, head, and tail *) - -Fixpoint wmsb sz (w : word sz) (a : bool) : bool := - match w with - | WO => a - | WS b x => wmsb x b - end. - -Definition wlsb sz (w: word (S sz)) := - match w with - | WO => tt - | WS b _ => b - end. - -Definition whd sz (w : word (S sz)) : bool := - match w in word sz' return match sz' with - | O => unit - | S _ => bool - end with - | WO => tt - | WS b _ => b - end. - -Definition wtl sz (w : word (S sz)) : word sz := - match w in word sz' return match sz' with - | O => unit - | S sz'' => word sz'' - end with - | WO => tt - | WS _ w' => w' - end. - -Fixpoint rep_bit (n : nat) (b : word 1) : word n := - match n as n0 return (word n0) with - | 0 => WO - | S n0 => WS (whd b) (rep_bit n0 b) + | O => a + | S _ => (signed w Prop with - | O => fun a => a = WO - | S _ => fun a => a = WS (whd a) (wtl a) - end a. - destruct a; eauto. -Qed. - -Lemma shatter_word_S : forall n (a : word (S n)), - exists b, exists c, a = WS b c. -Proof. - intros n a; repeat eexists; apply (shatter_word a). -Qed. -Lemma shatter_word_0 : forall a : word 0, - a = WO. -Proof. - intros a; apply (shatter_word a). -Qed. - -#[global] Hint Resolve shatter_word_0. - -Definition weq : forall sz (x y : word sz), {x = y} + {x <> y}. - refine (fix weq sz (x : word sz) : forall y : word sz, {x = y} + {x <> y} := - match x in word sz return forall y : word sz, {x = y} + {x <> y} with - | WO => fun _ => left _ _ - | WS b x' => fun y => if bool_dec b (whd y) - then if weq _ x' (wtl y) then left _ _ else right _ _ - else right _ _ - end); clear weq. - - abstract (symmetry; apply shatter_word_0). - - abstract (subst; symmetry; apply (shatter_word (n:=S _) _)). - - let y' := y in (* kludge around warning of mechanically generated names not playing well with [abstract] *) - abstract (rewrite (shatter_word y'); simpl; intro H; injection H; intros; - eauto using inj_pair2_eq_dec, Nat.eq_dec). - - let y' := y in (* kludge around warning of mechanically generated names not playing well with [abstract] *) - abstract (rewrite (shatter_word y'); simpl; intro H; injection H; auto). +Definition weq : forall [sz] (x y : word sz), {x = y} + {x <> y}. + refine (fun sz x y => + match Zmod.eqb x y as b return Zmod.eqb x y = b -> {x = y} + {x <> y} with + | true => fun H => left _ + | false => fun H => right _ + end eq_refl); + abstract (destruct (Zmod.eqb_spec x y); congruence). Defined. -Fixpoint weqb sz (x : word sz) : word sz -> bool := - match x in word sz return word sz -> bool with - | WO => fun _ => true - | WS b x' => fun y => - if eqb b (whd y) - then if @weqb _ x' (wtl y) then true else false - else false - end. - -(** * Combining and splitting *) - -Fixpoint combine (sz1 : nat) (w : word sz1) : forall sz2, word sz2 -> word (sz1 + sz2) := - match w in word sz1 return forall sz2, word sz2 -> word (sz1 + sz2) with - | WO => fun _ w' => w' - | WS b w' => fun _ w'' => WS b (combine w' w'') - end. - -Fixpoint split1 (sz1 sz2 : nat) : word (sz1 + sz2) -> word sz1 := - match sz1 with - | O => fun _ => WO - | S sz1' => fun w => WS (whd w) (split1 sz1' sz2 (wtl w)) - end. - -Fixpoint split2 (sz1 sz2 : nat) : word (sz1 + sz2) -> word sz2 := - match sz1 with - | O => fun w => w - | S sz1' => fun w => split2 sz1' sz2 (wtl w) - end. +(** [combine w w'] has [w] in its low bits and [w'] in its high bits. *) +Definition combine [sz1 : nat] (w : word sz1) [sz2 : nat] (w' : word sz2) + : word (sz1 + sz2) := + Zmod.of_Z _ (unsigned w + Zpow2 sz1 * unsigned w'). -(** * Extension operators *) +Definition split1 (sz1 sz2 : nat) (w : word (sz1 + sz2)) : word sz1 := + Zmod.of_Z _ (unsigned w). -Definition sext (sz : nat) (w : word sz) (sz' : nat) : word (sz + sz') := - if wmsb w false then - combine w (wones sz') - else - combine w (wzero sz'). +Definition split2 (sz1 sz2 : nat) (w : word (sz1 + sz2)) : word sz2 := + Zmod.of_Z _ (unsigned w / Zpow2 sz1). -Definition zext (sz : nat) (w : word sz) (sz' : nat) : word (sz + sz') := - combine w (wzero sz'). +Definition sext [sz : nat] (w : word sz) (sz' : nat) : word (sz + sz') := + Zmod.of_Z _ (signed w). -(** * Arithmetic *) +Definition zext [sz : nat] (w : word sz) (sz' : nat) : word (sz + sz') := + Zmod.of_Z _ (unsigned w). -Definition wneg sz (x : word sz) : word sz := - NToWord sz (Npow2 sz - wordToN x). +Definition extz [sz : nat] (w : word sz) (n : nat) : word (n + sz) := + Zmod.of_Z _ (unsigned w * Zpow2 n). -Definition wordBin (f : N -> N -> N) sz (x y : word sz) : word sz := - NToWord sz (f (wordToN x) (wordToN y)). +(** Shifts by a [nat]. *) +Definition wlshift [sz : nat] (w : word sz) (n : nat) : word sz := Zmod.slu w (Z.of_nat n). +Definition wrshift [sz : nat] (w : word sz) (n : nat) : word sz := Zmod.sru w (Z.of_nat n). +Definition wrshifta [sz : nat] (w : word sz) (n : nat) : word sz := Zmod.srs w (Z.of_nat n). -Definition wplus := wordBin Nplus. -Definition wmult := wordBin Nmult. -Definition wdiv := wordBin N.div. -Definition wmod := wordBin Nmod. -Definition wmult' sz (x y : word sz) : word sz := - split2 sz sz (NToWord (sz + sz) (Nmult (wordToN x) (wordToN y))). -Definition wminus sz (x y : word sz) : word sz := wplus x (wneg y). -Definition wnegN sz (x : word sz) : word sz := - natToWord sz (pow2 sz - wordToNat x). -Definition wordBinN (f : nat -> nat -> nat) sz (x y : word sz) : word sz := - natToWord sz (f (wordToNat x) (wordToNat y)). -Definition wplusN := wordBinN plus. +Definition wpow2 sz : word (S sz) := Zmod.of_Z _ (Zpow2 sz). -Definition wmultN := wordBinN mult. -Definition wmultN' sz (x y : word sz) : word sz := - split2 sz sz (natToWord (sz + sz) (mult (wordToNat x) (wordToNat y))). -Definition wdivN := wordBinN Nat.div. -Definition wremN := wordBinN Nat.modulo. +(** Division and remainder with Kami's conventions for a zero divisor + ([x / 0 = 0], [x mod 0 = x], as in [nat] and [Z]); the standard + library's [udiv]/[squot] return all ones there. *) +Definition wdivN [sz] (x y : word sz) : word sz := Zmod.of_Z _ (unsigned x / unsigned y). +Definition wremN [sz] (x y : word sz) : word sz := Zmod.of_Z _ (unsigned x mod unsigned y). +Definition wdivZ [sz] (x y : word sz) : word sz := Zmod.of_Z _ (Z.quot (signed x) (signed y)). +Definition wremZ [sz] (x y : word sz) : word sz := Zmod.of_Z _ (Z.rem (signed x) (signed y)). -Definition wminusN sz (x y : word sz) : word sz := wplusN x (wnegN y). +(** * Notations *) Notation "w ~ 1" := (WS true w) : word_scope. Notation "w ~ 0" := (WS false w) : word_scope. -Notation "^~" := wneg. -Notation "l ^+ r" := (@wplus _ l%word r%word) (at level 50, left associativity). -Notation "l ^* r" := (@wmult _ l%word r%word) (at level 40, left associativity). -Notation "l ^- r" := (@wminus _ l%word r%word) (at level 50, left associativity). -Notation "l ^/ r" := (@wdiv _ l%word r%word) (at level 50, left associativity). -Notation "l ^% r" := (@wmod _ l%word r%word) (at level 50, left associativity). - -(** * Bitwise operators *) - -Fixpoint wnot sz (w : word sz) : word sz := - match w with - | WO => WO - | WS b w' => WS (negb b) (wnot w') - end. - -Fixpoint bitwp (f : bool -> bool -> bool) sz (w1 : word sz) : word sz -> word sz := - match w1 with - | WO => fun _ => WO - | WS b w1' => fun w2 => WS (f b (whd w2)) (bitwp f w1' (wtl w2)) - end. - -Definition wnot' sz := bitwp xorb (wones sz). - -Definition wor := bitwp orb. -Definition wand := bitwp andb. -Definition wxor := bitwp xorb. - -Notation "l ^| r" := (@wor _ l%word r%word) (at level 50, left associativity). -Notation "l ^& r" := (@wand _ l%word r%word) (at level 40, left associativity). - -(** * Conversion to and from [Z] *) - -Definition wordToZ sz (w : word sz) : Z := - if wmsb w false then - (** Negative **) - match wordToN (wneg w) with - | N0 => 0%Z - | Npos x => Zneg x - end - else - (** Positive **) - match wordToN w with - | N0 => 0%Z - | Npos x => Zpos x - end. - -Definition uwordToZ sz (w : word sz) : Z := Z.of_N (wordToN w). - -Definition ZToWord (sz : nat) (z : Z) : word sz := - match z with - | Z0 => wzero' sz - | Zpos x => posToWord sz x - | Zneg x => wneg (posToWord sz x) - end. +Notation "^~" := Zmod.opp. +Notation "l ^+ r" := (Zmod.add l%word r%word) (at level 50, left associativity). +Notation "l ^* r" := (Zmod.mul l%word r%word) (at level 40, left associativity). +Notation "l ^- r" := (Zmod.sub l%word r%word) (at level 50, left associativity). +Notation "l ^| r" := (Zmod.or l%word r%word) (at level 50, left associativity). +Notation "l ^& r" := (Zmod.and l%word r%word) (at level 40, left associativity). -(** * Arithmetic by [Z] *) - -Definition wordBinZ (f : Z -> Z -> Z) sz (x y : word sz) : word sz := - ZToWord sz (f (wordToZ x) (wordToZ y)). - -Definition wplusZ := wordBinZ Z.add. -Definition wminusZ := wordBinZ Z.sub. -Definition wmultZ := wordBinZ Z.mul. -Definition wmultZsu sz (x y : word sz) := - ZToWord sz (Z.mul (wordToZ x) (Z.of_N (wordToN y))). -Definition wdivZ := wordBinZ Z.quot. -Definition wdivZsu sz (x y : word sz) := - ZToWord sz (Z.div (wordToZ x) (Z.of_N (wordToN y))). -Definition wremZ := wordBinZ Z.rem. -Definition wremZsu sz (x y : word sz) := - ZToWord sz (Z.modulo (wordToZ x) (Z.of_N (wordToN y))). - -(** * Comparison predicates and deciders *) - -Definition wlt sz (l r : word sz) : Prop := - N.lt (wordToN l) (wordToN r). -Definition wslt sz (l r : word sz) : Prop := - Z.lt (wordToZ l) (wordToZ r). - -Notation "w1 > w2" := (@wlt _ w2%word w1%word) : word_scope. -Notation "w1 >= w2" := (~(@wlt _ w1%word w2%word)) : word_scope. -Notation "w1 < w2" := (@wlt _ w1%word w2%word) : word_scope. -Notation "w1 <= w2" := (~(@wlt _ w2%word w1%word)) : word_scope. - -Notation "w1 '>s' w2" := (@wslt _ w2%word w1%word) (at level 70, w2 at next level) : word_scope. -Notation "w1 '>s=' w2" := (~(@wslt _ w1%word w2%word)) (at level 70, w2 at next level) : word_scope. -Notation "w1 's' w2" := (wslt w2%word w1%word) (at level 70, w2 at next level) : word_scope. +Notation "w1 '>s=' w2" := (~(wslt w1%word w2%word)) (at level 70, w2 at next level) : word_scope. +Notation "w1 ' nshift + (sz - nshift) = sz. -Proof. - intros; lia. -Qed. +(*! Facts *) -Definition wlshift (sz : nat) (w : word sz) (n : nat) : word sz. - refine (split1 sz n _). - rewrite Nat.add_comm. - exact (combine (wzero n) w). -Defined. +(** * [Zpow2] *) -Definition wrshift (sz : nat) (w : word sz) (n : nat) : word sz. - refine (split2 n sz _). - rewrite Nat.add_comm. - exact (combine w (wzero n)). -Defined. +Local Open Scope Z_scope. -Definition wrshifta (sz : nat) (w : word sz) (n : nat) : word sz. - refine (split2 n sz _). - rewrite Nat.add_comm. - exact (sext w _). -Defined. +Lemma Zpow2_eqn : forall n, Zpow2 n = 2 ^ Z.of_nat n. +Proof. reflexivity. Qed. -Definition extz {sz} (w: word sz) (n: nat) := combine (wzero n) w. +Lemma pow2_Z : forall n, Z.of_nat (pow2 n) = Zpow2 n. +Proof. intros; apply Nat2Z.inj_pow. Qed. -Fixpoint wpow2 sz: word (S sz) := - match sz with - | O => WO~1 - | S sz' => (wpow2 sz')~0 - end. +Lemma Npow2_Z : forall n, Z.of_N (Npow2 n) = Zpow2 n. +Proof. apply NatLib.Z_of_N_Npow2. Qed. -Notation "l ^<< r" := (@wlshift _ _ l%word r%word) (at level 35). -Notation "l ^>> r" := (@wrshift _ _ l%word r%word) (at level 35). +(** [lia] sees [Npow2] as [2 ^ _] ([pow2] is [Nat.pow 2], already known). *) +Lemma Npow2_Z' : forall n, Z.of_N (Npow2 n) = 2 ^ Z.of_nat n. +Proof. apply NatLib.Z_of_N_Npow2. Qed. +#[global] Instance Op_Npow2 : ZifyClasses.UnOp Npow2 := + { ZifyClasses.TUOp := fun x => 2 ^ x; ZifyClasses.TUOpInj := Npow2_Z' }. +Add Zify UnOp Op_Npow2. -(** * Setting an individual bit *) +Lemma Zpow2_0 : Zpow2 0 = 1. +Proof. reflexivity. Qed. -Definition wbit sz sz' (n : word sz') := natToWord sz (pow2 (wordToNat n)). +Lemma Zpow2_S : forall n, Zpow2 (S n) = 2 * Zpow2 n. +Proof. intros; cbv [Zpow2]; rewrite Nat2Z.inj_succ, Z.pow_succ_r; lia. Qed. +Lemma Zpow2_add : forall a b, Zpow2 (a + b) = Zpow2 a * Zpow2 b. +Proof. intros; cbv [Zpow2]; rewrite Nat2Z.inj_add, Z.pow_add_r; lia. Qed. -(*! Facts *) +Lemma Zpow2_mul : forall a b, Zpow2 (a * b) = (Zpow2 a) ^ Z.of_nat b. +Proof. intros; cbv [Zpow2]; rewrite Nat2Z.inj_mul, Z.pow_mul_r; lia. Qed. -#[global] Hint Rewrite div2_double div2_S_double: div2. -Local Hint Resolve mod2_S_double mod2_double. +Lemma Zpow2_pos : forall n, 0 < Zpow2 n. +Proof. intros; apply Z.pow_pos_nonneg; lia. Qed. -Theorem eq_rect_word_offset : forall n n' offset w Heq, - eq_rect n (fun n => word (offset + n)) w n' Heq = - eq_rect (offset + n) (fun n => word n) w (offset + n') (eq_rect_word_offset_helper _ _ _ Heq). -Proof. - intros. - destruct Heq. - rewrite (UIP_dec Nat.eq_dec (eq_rect_word_offset_helper _ _ offset eq_refl) eq_refl). - reflexivity. -Qed. +Lemma Zpow2_eq1 : forall x : nat, Z.of_nat x = 0 -> Zpow2 x = 1. +Proof. intros x H; cbv [Zpow2]; rewrite H; reflexivity. Qed. -Theorem eq_rect_word_mult : forall n n' scale w Heq, - eq_rect n (fun n => word (n * scale)) w n' Heq = - eq_rect (n * scale) (fun n => word n) w (n' * scale) (eq_rect_word_mult_helper _ _ _ Heq). -Proof. - intros. - destruct Heq. - rewrite (UIP_dec Nat.eq_dec (eq_rect_word_mult_helper _ _ scale eq_refl) eq_refl). - reflexivity. -Qed. +Lemma Zpow2_ge2 : forall x : nat, Z.of_nat x <> 0 -> 2 <= Zpow2 x. +Proof. intros x H; destruct x; [lia|]; rewrite Zpow2_S; pose proof (Zpow2_pos x); lia. Qed. -Theorem eq_rect_word_match : forall n n' (w : word n) (H : n = n'), - match H in (_ = N) return (word N) with - | eq_refl => w - end = eq_rect n (fun n => word n) w n' H. -Proof. - intros. - destruct H. - rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. +Lemma Zpow2_even : forall x : nat, Z.of_nat x <> 0 -> Zpow2 x mod 2 = 0. +Proof. intros x H; destruct x; [lia|]; rewrite Zpow2_S, Z.mul_comm; apply Z.mod_mul; lia. Qed. -Theorem whd_match : forall n n' (w : word (S n)) (Heq : S n = S n'), - whd w = whd (match Heq in (_ = N) return (word N) with - | eq_refl => w - end). -Proof. - intros. - rewrite eq_rect_word_match. - generalize dependent w. - remember Heq as Heq'. clear HeqHeq'. - generalize dependent Heq'. - replace (n') with (n) by lia. - intros. rewrite <- (eq_rect_eq_dec Nat.eq_dec). reflexivity. -Qed. +(** * [unsigned] of every operation, in [lia]'s language *) -Theorem wtl_match : forall n n' (w : word (S n)) (Heq : S n = S n') (Heq' : n = n'), - (match Heq' in (_ = N) return (word N) with - | eq_refl => wtl w - end) = wtl (match Heq in (_ = N) return (word N) with - | eq_refl => w - end). -Proof. - intros. - repeat match goal with - | [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf - end. - generalize dependent w; clear. - intros. - generalize Heq Heq'. - subst. - intros. - rewrite (UIP_dec Nat.eq_dec Heq' (refl_equal _)). - rewrite (UIP_dec Nat.eq_dec Heq0 (refl_equal _)). - reflexivity. -Qed. +Lemma unsigned_range : forall sz (w : word sz), 0 <= unsigned w < Zpow2 sz. +Proof. intros; apply Zmod.unsigned_pos_bound, Zpow2_pos. Qed. -Theorem word0: forall (w : word 0), w = WO. +(** Range facts whose width is a compound expression, stated so that the + width arithmetic is already done (the width also occurs in the type of + [w], which blocks rewriting it inside [unsigned w]). *) +Lemma unsigned_range_S : forall sz (w : word (S sz)), 0 <= unsigned w < 2 * Zpow2 sz. Proof. - firstorder. + intros; pose proof (unsigned_range w) as H. + set (x := unsigned w) in *; clearbody x. rewrite Zpow2_S in H; lia. Qed. -Theorem wordToNat_wordToNat' : forall sz (w : word sz), - wordToNat w = wordToNat' w. +Lemma unsigned_range_add : forall sz1 sz2 (w : word (sz1 + sz2)), + 0 <= unsigned w < Zpow2 sz1 * Zpow2 sz2. Proof. - induction w. auto. unfold wordToNat. simpl. rewrite Nat.mul_comm. reflexivity. -Qed. - -Theorem natToWord_wordToNat : forall sz w, natToWord sz (wordToNat w) = w. - induction w as [|b]; rewrite wordToNat_wordToNat'; intuition; f_equal; unfold natToWord, wordToNat'; fold natToWord; fold wordToNat'; - destruct b; f_equal; autorewrite with div2; intuition. + intros; pose proof (unsigned_range w) as H. + set (x := unsigned w) in *; clearbody x. rewrite Zpow2_add in H; lia. Qed. +Arguments unsigned_range_add {_ _} _. +Arguments unsigned_range_S {_} _. -Theorem roundTrip_0 : forall sz, wordToNat (natToWord sz 0) = 0. - induction sz; simpl; intuition lia. -Qed. - -#[global] Hint Rewrite roundTrip_0 : wordToNat. - -Lemma wordToNat_natToWord' : forall sz w, exists k, wordToNat (natToWord sz w) + k * pow2 sz = w. - induction sz as [|sz IHsz]; simpl; intro w; intuition; repeat rewrite untimes2. - - exists w; intuition lia. - - case_eq (mod2 w); intro Hmw. - - specialize (IHsz (Nat.div2 w)); firstorder. - rewrite wordToNat_wordToNat' in *. - let x' := match goal with H : _ + ?x * _ = _ |- _ => x end in - rename x' into x. (* force non-auto-generated name *) - exists x; intuition. - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm x 2). - rewrite Nat.mul_comm. simpl mult at 1. - rewrite (plus_Sn_m (2 * wordToNat' (natToWord sz (Nat.div2 w)))). - rewrite <- Nat.mul_assoc. - rewrite <- Nat.mul_add_distr_l. - rewrite H; clear H. - symmetry; apply div2_odd; auto. - - specialize (IHsz (Nat.div2 w)); firstorder. - let x' := match goal with H : _ + ?x * _ = _ |- _ => x end in - rename x' into x. (* force non-auto-generated name *) - exists x; intuition. - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm x 2). - rewrite <- Nat.mul_assoc. - rewrite Nat.mul_comm. - rewrite <- Nat.mul_add_distr_l. - match goal with H : _ |- _ => rewrite H; clear H end. - symmetry; apply div2_even; auto. -Qed. +Lemma unsigned_ofZ_small : forall sz z, 0 <= z < Zpow2 sz -> unsigned (ZToWord sz z) = z. +Proof. intros; apply Zmod.unsigned_of_Z_small; assumption. Qed. -Theorem wordToNat_natToWord: - forall sz w, exists k, wordToNat (natToWord sz w) = w - k * pow2 sz /\ (k * pow2 sz <= w)%nat. +(** [signed] as a case split on [unsigned], for [lia]. *) +Lemma signed_eqn : forall sz (w : word sz), + signed w = if 2 * unsigned w wordToNat (natToWord sz w) = w. +Lemma unsigned_wones : forall sz, unsigned (wones sz) = Zpow2 sz - 1. Proof. - intros. - pose proof (wordToNat_natToWord sz w). - destruct H0; destruct H0. - rewrite H0 in *; clear H0. - destruct x; lia. + intros; rewrite Zmod.unsigned_m1. pose proof (Zpow2_pos sz). + rewrite <- (Z.mod_add (-1) 1 _), Z.mod_small by lia. lia. Qed. -Lemma natToWord_times2: forall sz x, - ((natToWord sz x)~0)%word = natToWord (S sz) (2 * x). -Proof. - intros. unfold natToWord. fold natToWord. f_equal. - - symmetry. apply mod2_double. - - rewrite div2_double. reflexivity. -Qed. +Lemma unsigned_natToWord : forall sz n, unsigned (natToWord sz n) = Z.of_nat n mod Zpow2 sz. +Proof. intros; apply Zmod.unsigned_of_Z. Qed. -Theorem WS_neq : forall b1 b2 sz (w1 w2 : word sz), - (b1 <> b2 \/ w1 <> w2) - -> WS b1 w1 <> WS b2 w2. - intros b1 b2 sz w1 w2 ? H0; intuition. - apply (f_equal (@whd _)) in H0; tauto. - apply (f_equal (@wtl _)) in H0; tauto. -Qed. +Lemma unsigned_NToWord : forall sz n, unsigned (NToWord sz n) = Z.of_N n mod Zpow2 sz. +Proof. intros; apply Zmod.unsigned_of_Z. Qed. -Theorem weqb_true_iff : forall sz x y, - @weqb sz x y = true <-> x = y. +Lemma unsigned_WS : forall b n (w : word n), unsigned (WS b w) = Z.b2z b + 2 * unsigned w. Proof. - induction x as [|b ? x IHx]; simpl; intros y. - { split; auto. } - { rewrite (shatter_word y) in *. simpl in *. - case_eq (eqb b (whd y)); intros H. - case_eq (weqb x (wtl y)); intros H0. - split; auto; intros. rewrite eqb_true_iff in H. f_equal; eauto. eapply IHx; eauto. - split; intros H1; try congruence. inversion H1; clear H1; subst. - eapply inj_pair2_eq_dec in H4. eapply IHx in H4. congruence. - eapply Nat.eq_dec. - split; intros; try congruence. - inversion H0. apply eqb_false_iff in H. congruence. } -Qed. - -Ltac shatterer := simpl; intuition; - match goal with - | [ w : _ |- _ ] => rewrite (shatter_word w); simpl - end; f_equal; auto. - -Theorem combine_split : forall sz1 sz2 (w : word (sz1 + sz2)), - combine (split1 sz1 sz2 w) (split2 sz1 sz2 w) = w. - induction sz1; shatterer. -Qed. - -Theorem split1_combine : forall sz1 sz2 (w : word sz1) (z : word sz2), - split1 sz1 sz2 (combine w z) = w. - induction sz1; shatterer. -Qed. - -Theorem split2_combine : forall sz1 sz2 (w : word sz1) (z : word sz2), - split2 sz1 sz2 (combine w z) = z. - induction sz1; shatterer. -Qed. - -#[global] Hint Rewrite combine_split. -#[global] Hint Rewrite split1_combine. -#[global] Hint Rewrite split2_combine. - -Theorem combine_assoc : forall n1 (w1 : word n1) n2 n3 (w2 : word n2) (w3 : word n3) Heq, - combine (combine w1 w2) w3 - = match Heq in _ = N return word N with - | refl_equal => combine w1 (combine w2 w3) - end. - induction w1 as [|?? w1 IHw1]; simpl; intros n2 n3 w2 w3 Heq; intuition. - - rewrite (UIP_dec Nat.eq_dec Heq (refl_equal _)); reflexivity. - - rewrite (IHw1 _ _ _ _ (Nat.add_assoc _ _ _)); clear IHw1. - repeat match goal with - | [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf - end. - generalize dependent (combine w1 (combine w2 w3)). - rewrite Nat.add_assoc; intros w Heq0 e. - rewrite (UIP_dec Nat.eq_dec e (refl_equal _)). - rewrite (UIP_dec Nat.eq_dec Heq0 (refl_equal _)). - reflexivity. + intros; cbv [WS]; apply unsigned_ofZ_small. + pose proof (unsigned_range w); rewrite Zpow2_S. + destruct b; cbn [Z.b2z]; lia. Qed. -Theorem split1_iter : forall n1 n2 n3 Heq w, - split1 n1 n2 (split1 (n1 + n2) n3 w) - = split1 n1 (n2 + n3) (match Heq in _ = N return word N with - | refl_equal => w - end). +Lemma unsigned_wtl : forall sz (w : word (S sz)), unsigned (wtl w) = unsigned w / 2. Proof. - induction n1; simpl; intuition. - - f_equal. - apply whd_match. - assert (n1 + n2 + n3 = n1 + (n2 + n3)) as Heq' by lia. - rewrite IHn1 with (Heq:=Heq'). - f_equal. - apply wtl_match. + intros; cbv [wtl]; apply unsigned_ofZ_small. + pose proof (unsigned_range_S w). + Z.div_mod_to_equations; lia. Qed. -Theorem split2_iter : forall n1 n2 n3 Heq w, - split2 n2 n3 (split2 n1 (n2 + n3) w) - = split2 (n1 + n2) n3 (match Heq in _ = N return word N with - | refl_equal => w - end). - induction n1 as [|n1 IHn1]; simpl; intros n2 n3 Heq w; intuition. - - rewrite (UIP_dec Nat.eq_dec Heq (refl_equal _)); reflexivity. - - rewrite (IHn1 _ _ (Nat.add_assoc _ _ _)). - f_equal. - apply wtl_match. -Qed. +Lemma whd_eqn : forall sz (w : word (S sz)), whd w = Z.odd (unsigned w). +Proof. reflexivity. Qed. -Theorem split1_split2 : forall n1 n2 n3 Heq w, - split1 n2 n3 (split2 n1 (n2 + n3) w) = - split2 n1 n2 (split1 (n1 + n2) n3 (match Heq in _ = N return word N with - | refl_equal => w - end)). +Lemma wmsb_eqn : forall sz (w : word sz) b, + wmsb w b = if Z.of_nat sz =? 0 then b else (Zpow2 sz <=? 2 * unsigned w). Proof. - induction n1; simpl; intros. - - rewrite (UIP_dec Nat.eq_dec Heq (refl_equal _)). - reflexivity. - - rewrite (shatter_word w). - simpl. - assert (n1 + (n2 + n3) = n1 + n2 + n3) as Heq' by lia. - rewrite <- wtl_match with (Heq':=Heq'). - rewrite <- IHn1. - f_equal. + intros; destruct sz; [reflexivity|]; cbv [wmsb]. + destruct (Z.eqb_spec (Z.of_nat (S sz)) 0); [lia|]. + rewrite signed_eqn. pose proof (unsigned_range w). + destruct (Z.ltb_spec (2 * unsigned w) (Zpow2 (S sz))); + destruct (Z.leb_spec (Zpow2 (S sz)) (2 * unsigned w)); + destruct (Z.ltb_spec (unsigned w) 0); destruct (Z.ltb_spec (unsigned w - Zpow2 (S sz)) 0); + lia. Qed. -Theorem split2_split1 : forall n1 n2 n3 Heq w, - split2 n1 n2 (split1 (n1+n2) n3 w) = - split1 n2 n3 (split2 n1 (n2+n3) (match Heq in _ = N return word N with - | refl_equal => w - end)). +Lemma unsigned_combine : forall sz1 (w : word sz1) sz2 (w' : word sz2), + unsigned (combine w w') = unsigned w + Zpow2 sz1 * unsigned w'. Proof. - induction n1; simpl; intros. - - rewrite (UIP_dec Nat.eq_dec Heq (refl_equal _)). - reflexivity. - - rewrite (shatter_word w). - simpl. - assert (n1 + n2 + n3 = n1 + (n2 + n3)) as Heq' by lia. - rewrite <- wtl_match with (Heq':=Heq'). - rewrite <- IHn1. - f_equal. + intros; cbv [combine]; apply unsigned_ofZ_small. + pose proof (unsigned_range w); pose proof (unsigned_range w'). + rewrite Zpow2_add. nia. Qed. -Theorem combine_0_n : forall sz2 (w: word 0) (v: word sz2), - combine w v = v. -Proof. - intros. - replace w with WO. - auto. - rewrite word0; auto. -Qed. +Lemma unsigned_split1 : forall sz1 sz2 (w : word (sz1 + sz2)), + unsigned (split1 sz1 sz2 w) = unsigned w mod Zpow2 sz1. +Proof. intros; apply Zmod.unsigned_of_Z. Qed. -Lemma WS_eq_rect : forall b n (w: word n) n' H H', - eq_rect _ word (@WS b n w) _ H = @WS b n' (eq_rect _ word w _ H'). +Lemma unsigned_split2 : forall sz1 sz2 (w : word (sz1 + sz2)), + unsigned (split2 sz1 sz2 w) = unsigned w / Zpow2 sz1. Proof. - destruct n; intros; subst; - eq_rect_simpl; auto. + intros; cbv [split2]; apply unsigned_ofZ_small. + pose proof (unsigned_range_add w). + pose proof (Zpow2_pos sz1); pose proof (Zpow2_pos sz2). + split; [apply Z.div_pos | apply Z.div_lt_upper_bound]; lia. Qed. -Theorem combine_eq_rect2 : forall sz n n' - (H: n = n') H' - (a: word sz) (b: word n), - combine a b = - eq_rect _ word (combine a (eq_rect _ word b _ H)) _ H'. -Proof. - induction a; simpl; intros. - eq_rect_simpl; auto. - erewrite WS_eq_rect. - erewrite IHa. - auto. - - Unshelve. - lia. -Qed. +Lemma unsigned_sext : forall sz (w : word sz) sz', + unsigned (sext w sz') = signed w mod Zpow2 (sz + sz'). +Proof. intros; apply Zmod.unsigned_of_Z. Qed. -Theorem combine_n_0 : forall sz1 (w : word sz1) (v : word 0), - combine w v = eq_rect _ word w _ (plus_n_O sz1). +Lemma unsigned_zext : forall sz (w : word sz) sz', unsigned (zext w sz') = unsigned w. Proof. - induction w; intros. - - replace v with WO; auto. - - simpl; rewrite IHw. - erewrite WS_eq_rect. - reflexivity. + intros; cbv [zext]; apply unsigned_ofZ_small. + pose proof (unsigned_range w); pose proof (Zpow2_pos sz'). rewrite Zpow2_add; nia. Qed. -Lemma whd_eq_rect : forall n w Heq, - whd (eq_rect (S n) word w (S (n + 0)) Heq) = - whd w. +Lemma unsigned_extz : forall sz (w : word sz) n, unsigned (extz w n) = unsigned w * Zpow2 n. Proof. - intros. - generalize Heq. - replace (n + 0) with n by lia. - intros. - f_equal. - eq_rect_simpl. - reflexivity. + intros; cbv [extz]; apply unsigned_ofZ_small. + pose proof (unsigned_range w); pose proof (Zpow2_pos n). rewrite Zpow2_add; nia. Qed. -Lemma wtl_eq_rect : forall n w Heq Heq', - wtl (eq_rect (S n) word w (S (n + 0)) Heq) = - eq_rect n word (wtl w) (n + 0) Heq'. +Lemma unsigned_wlshift : forall sz (w : word sz) n, + unsigned (wlshift w n) = (unsigned w * Zpow2 n) mod Zpow2 sz. Proof. - intros. - generalize dependent Heq. - rewrite <- Heq'; simpl; intros. - rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. + intros; cbv [wlshift Zpow2]; rewrite Zmod.unsigned_slu, Z.shiftl_mul_pow2 by lia; reflexivity. Qed. -Lemma whd_eq_rect_mul : forall n w Heq, - whd (eq_rect (S n) word w (S (n * 1)) Heq) = - whd w. +Lemma unsigned_wrshift : forall sz (w : word sz) n, + unsigned (wrshift w n) = unsigned w / Zpow2 n. Proof. - intros. - generalize Heq. - replace (n * 1) with n by auto. - intros. - eq_rect_simpl. - reflexivity. + intros; cbv [wrshift Zpow2]; rewrite Zmod.unsigned_sru, Z.shiftr_div_pow2 by lia; reflexivity. Qed. -Lemma wtl_eq_rect_mul : forall n w b Heq Heq', - wtl (eq_rect (S n) word (WS b w) (S (n * 1)) Heq) = - eq_rect _ word w _ Heq'. +Lemma unsigned_wrshifta : forall sz (w : word sz) n, + unsigned (wrshifta w n) = (signed w / Zpow2 n) mod Zpow2 sz. Proof. - intros. - generalize Heq. - rewrite <- Heq'. - intros. eq_rect_simpl. - reflexivity. + intros; cbv [wrshifta Zpow2]; rewrite Zmod.unsigned_srs, Z.shiftr_div_pow2 by lia; reflexivity. Qed. -Theorem split1_0 : forall n w Heq, - split1 n 0 (eq_rect _ word w _ Heq) = w. +Lemma unsigned_wpow2 : forall sz, unsigned (wpow2 sz) = Zpow2 sz. Proof. - intros. - induction n; intros. - shatterer. - simpl. - erewrite wtl_eq_rect. - rewrite IHn. - rewrite whd_eq_rect. - simpl. - shatterer. - - Unshelve. - lia. + intros; cbv [wpow2]; apply unsigned_ofZ_small. + rewrite Zpow2_S; pose proof (Zpow2_pos sz); lia. Qed. -Theorem split2_0 : forall n w Heq, - split2 0 n (eq_rect _ word w _ Heq) = w. +Lemma unsigned_wdivN : forall sz (x y : word sz), unsigned (wdivN x y) = unsigned x / unsigned y. Proof. - intros. - simpl. - eq_rect_simpl. - reflexivity. -Qed. - -Theorem combine_end : forall n1 n2 n3 Heq w, - combine (split1 n2 n3 (split2 n1 (n2 + n3) w)) - (split2 (n1 + n2) n3 (match Heq in _ = N return word N with - | refl_equal => w - end)) - = split2 n1 (n2 + n3) w. - induction n1 as [|n1 IHn1]; simpl; intros n2 n3 Heq w. - - rewrite (UIP_dec Nat.eq_dec Heq (refl_equal _)). - apply combine_split. - - rewrite (shatter_word w) in *. - simpl. - eapply trans_eq; [ | apply IHn1 with (Heq := Nat.add_assoc _ _ _) ]; clear IHn1. - repeat f_equal. - repeat match goal with - | [ |- context[match ?pf with refl_equal => _ end] ] => generalize pf - end. - simpl. - generalize dependent w. - rewrite Nat.add_assoc. - intros. - rewrite (UIP_dec Nat.eq_dec e (refl_equal _)). - rewrite (UIP_dec Nat.eq_dec Heq0 (refl_equal _)). - reflexivity. + intros; cbv [wdivN]; apply unsigned_ofZ_small. + pose proof (unsigned_range x); pose proof (unsigned_range y). + destruct (Z.eq_dec (unsigned y) 0) as [E|E]; [rewrite E, Z.div_0_r; lia|]. + split; [apply Z.div_pos | apply Z.div_lt_upper_bound]; nia. Qed. -Lemma Private_plus_reg_l : forall n m p, p + n = p + m -> n = m. -Proof. intros n m p H. now apply ->Nat.add_cancel_l in H. Qed. - -Theorem eq_rect_combine : forall n1 n2 n2' (w1 : word n1) (w2 : word n2') Heq, - eq_rect (n1 + n2') (fun n => word n) - (combine w1 w2) (n1 + n2) Heq = - combine w1 (eq_rect n2' (fun n => word n) w2 n2 (Private_plus_reg_l _ _ _ Heq)). +Lemma unsigned_wremN : forall sz (x y : word sz), unsigned (wremN x y) = unsigned x mod unsigned y. Proof. - intros. - generalize (Private_plus_reg_l n2' n2 n1 Heq); intros. - generalize dependent Heq. - generalize dependent w2. - rewrite e; intros. - repeat rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. + intros; cbv [wremN]; apply unsigned_ofZ_small. + pose proof (unsigned_range x); pose proof (unsigned_range y). + destruct (Z.eq_dec (unsigned y) 0) as [E|E]; [rewrite E, Z.mod_0_r; lia|]. + pose proof (Z.mod_pos_bound (unsigned x) (unsigned y) ltac:(lia)). lia. Qed. -Lemma eq_rect_combine_assoc' : forall a b c H wa wb wc, - eq_rect (a + (b + c)) word (combine wa (combine wb wc)) _ H = combine (combine wa wb) wc. +Lemma unsigned_not : forall sz (w : word sz), unsigned (wnot w) = Zpow2 sz - 1 - unsigned w. Proof. - intros. - erewrite combine_assoc, eq_rect_word_match. - reflexivity. + intros; cbv [Zpow2]; rewrite bits.unsigned_not', Z.ones_equiv; lia. Qed. -Lemma eq_rect_split2_helper : forall a b c, - a = b -> c + a = c + b. -Proof. - intros; lia. -Qed. +Lemma unsigned_or : forall sz (x y : word sz), unsigned (wor x y) = Z.lor (unsigned x) (unsigned y). +Proof. intros; cbv [Zpow2]; apply bits.unsigned_or. Qed. -Theorem eq_rect_split2 : forall n1 n2 n2' (w : word (n1 + n2')) Heq, - eq_rect n2' (fun n => word n) - (split2 n1 n2' w) n2 Heq = - split2 n1 n2 (eq_rect (n1+n2') (fun n => word n) w (n1+n2) (eq_rect_split2_helper _ Heq)). -Proof. - intros. - generalize (eq_rect_split2_helper n1 Heq); intros. - generalize dependent Heq. - generalize dependent w. - assert (n2' = n2) as H' by lia. - generalize dependent e. - rewrite H'; intros. - repeat rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. +Lemma unsigned_and : forall sz (x y : word sz), unsigned (wand x y) = Z.land (unsigned x) (unsigned y). +Proof. intros; cbv [Zpow2]; apply bits.unsigned_and. Qed. -Theorem eq_rect_split2_eq2 : forall n1 n2 n2' (w : word (n1 + n2)) Heq Heq2, - eq_rect n2 (fun n => word n) - (split2 n1 n2 w) n2' Heq = - split2 n1 n2' (eq_rect (n1+n2) (fun n => word n) w (n1+n2') Heq2). -Proof. - intros. - assert (H' := Heq). - generalize dependent w. - generalize dependent Heq. - generalize dependent Heq2. - rewrite H'; intros. - repeat rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. +Lemma unsigned_xor : forall sz (x y : word sz), unsigned (wxor x y) = Z.lxor (unsigned x) (unsigned y). +Proof. intros; cbv [Zpow2]; apply bits.unsigned_xor. Qed. -Theorem eq_rect_split2_eq1 : forall n1 n1' n2 (w: word (n1 + n2)) Heq, - split2 n1 n2 w = split2 n1' n2 - (eq_rect (n1 + n2) (fun y : nat => word y) w - (n1' + n2) Heq). -Proof. - intros. - assert (n1 = n1') as H' by lia. - generalize dependent w. - generalize dependent Heq. - rewrite H'; intros. - rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. +Lemma unsigned_eq_rec : forall n n' (w : word n) (H : n = n'), + unsigned (eq_rec n word w n' H) = unsigned w. +Proof. intros; destruct H; reflexivity. Qed. -Theorem combine_split_eq_rect2 : forall n1 n2 n2' (w : word (n1 + n2)) Heq, - combine (split1 n1 n2 w) - (eq_rect n2 (fun n => word n) (split2 n1 n2 w) - n2' Heq) = - eq_rect (n1 + n2) (fun n => word n) w - (n1 + n2') (eq_rect_split2_helper _ Heq). -Proof. - intros. - assert (n2 = n2') by lia. - generalize dependent Heq. - generalize dependent w. - rewrite <- H; intros. - repeat rewrite <- (eq_rect_eq_dec Nat.eq_dec). - apply combine_split. -Qed. +Lemma unsigned_match_eq : forall n n' (w : word n) (H : n = n'), + unsigned (match H in _ = N return word N with eq_refl => w end) = unsigned w. +Proof. intros; destruct H; reflexivity. Qed. -Lemma eq_rect_split1_helper : forall a b c, - a = b -> a + c = b + c. +Lemma existT_word_eq : forall n1 (w1 : word n1) n2 (w2 : word n2), + n1 = n2 -> unsigned w1 = unsigned w2 -> existT word n1 w1 = existT word n2 w2. Proof. - intros; lia. + intros; subst; f_equal; apply Zmod.unsigned_inj; assumption. Qed. -Lemma eq_rect_split1_eq2_helper : forall a b c, - a = b -> c + a = c + b. +Lemma existT_word_inv : forall n1 (w1 : word n1) n2 (w2 : word n2), + existT word n1 w1 = existT word n2 w2 -> n1 = n2 /\ unsigned w1 = unsigned w2. Proof. - intros; lia. + intros. pose proof (eq_sigT_fst H). subst. + apply inj_pair2_eq_dec in H; [subst; auto | apply Nat.eq_dec]. Qed. -Theorem eq_rect_split1 : forall n1 n1' n2 (w : word (n1' + n2)) Heq, - eq_rect n1' (fun n => word n) - (split1 n1' n2 w) n1 Heq = - split1 n1 n2 (eq_rect (n1'+n2) (fun n => word n) w (n1+n2) (eq_rect_split1_helper _ Heq)). -Proof. - intros. - generalize (eq_rect_split1_helper n2 Heq); intros. - generalize dependent Heq. - generalize dependent w. - assert (n1' = n1) as H' by lia. - generalize dependent e. - rewrite H'; intros. - repeat rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. +(** * A few facts about [mod] and [div] *) -Theorem eq_rect_split1_eq1 : forall n1 n1' n2 (w : word (n1 + n2)) Heq Heq1, - eq_rect n1 (fun n => word n) - (split1 n1 n2 w) n1' Heq = - split1 n1' n2 (eq_rect (n1+n2) (fun n => word n) w (n1'+n2) Heq1). +Lemma Zmod_small_neg : forall a m, 0 < m -> - m <= a < 0 -> a mod m = a + m. Proof. - intros. - generalize dependent w. - generalize dependent Heq1. - rewrite Heq; intros. - repeat rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. + intros. rewrite <- (Z.mod_add a 1 m), Z.mod_small by lia. lia. Qed. -Lemma split1_eq_rect_eq1_helper : forall a b c, b = a -> a + c = b + c. -Proof. intros. subst. reflexivity. Qed. - -Theorem split1_eq_rect_eq1 : forall a a' b H w, - split1 a b w = eq_rect _ word (split1 a' b - (eq_rect _ word w _ (split1_eq_rect_eq1_helper b H))) _ H. +Lemma Zmod_small_2 : forall a m, 0 < m -> m <= a < 2 * m -> a mod m = a - m. Proof. - intros a a' b H. - subst a'; intros; eq_rect_simpl; auto. + intros. rewrite <- (Z.mod_add a (-1) m), Z.mod_small by lia. lia. Qed. -Theorem eq_rect_split1_eq2 : forall n1 n2 n2' (w: word (n1 + n2)) Heq, - split1 n1 n2 w = split1 n1 n2' - (eq_rect (n1 + n2) (fun y : nat => word y) w - (n1 + n2') Heq). +Lemma Zmod_2mul_odd : forall a p, 0 < p -> (2 * a + 1) mod (2 * p) = 1 + 2 * (a mod p). Proof. - intros. - assert (n2 = n2') as H' by lia. - generalize dependent w. - generalize dependent Heq. - rewrite H'; intros. - rewrite <- (eq_rect_eq_dec Nat.eq_dec). - reflexivity. + intros. rewrite Z.rem_mul_r by lia. + replace (2 * a + 1) with (1 + a * 2) by lia. rewrite Z.mod_add, Z.div_add by lia. + rewrite Z.mod_small, Z.div_small by lia. f_equal; f_equal; f_equal; lia. Qed. -Fact eq_rect_combine_dist_helper1 : forall a b c d, b * c = d -> (a + b) * c = a * c + d. -Proof. intros; subst. apply Nat.mul_add_distr_r. Qed. - -Fact eq_rect_combine_dist_helper2 : forall a b c d, b * c = d -> a * c + d = (a + b) * c. -Proof. intros; subst. symmetry; apply Nat.mul_add_distr_r. Qed. - -Theorem eq_rect_combine_dist : forall a b c d (w : word ((a + b) * c)) (H : b * c = d), - b * c = d -> - let H1 := (eq_rect_combine_dist_helper1 a b c H) in - let H2 := (eq_rect_combine_dist_helper2 a b c H) in - let w' := eq_rec ((a + b) * c) word w _ H1 in - w = eq_rec _ word (combine (split1 (a * c) d w') (split2 (a * c) d w')) _ H2. +Lemma Zmod_2mul_odd' : forall a p, 0 < p -> (1 + 2 * a) mod (2 * p) = 1 + 2 * (a mod p). Proof. - intros. - subst d. - rewrite combine_split. - eq_rect_simpl. - generalize dependent w. - generalize dependent H2. - rewrite H1. - intros. - eq_rect_simpl; auto. + intros. rewrite <- Zmod_2mul_odd by lia. f_equal; lia. Qed. -Lemma wzero_dist : forall a b c H, - wzero ((a + b) * c) = eq_rect _ word (wzero (a * c + b * c)) _ H. +Lemma Zmod_2mul_split : forall a p, 0 < p -> a mod (2 * p) = a mod 2 + 2 * ((a / 2) mod p). Proof. - intros a b c H. - rewrite H. - reflexivity. + intros. apply Z.rem_mul_r; lia. Qed. -Lemma wzero_rev : forall (a b : nat) H, - wzero (a + b) = eq_rect _ word (wzero (b + a)) _ H. -Proof. intros a b H. rewrite H. auto. Qed. - -Lemma split1_zero : forall sz1 sz2, split1 sz1 sz2 (natToWord _ O) = natToWord _ O. +Lemma Zmod_mul2_split : forall a p, 0 < p -> a mod (p * 2) = a mod 2 + 2 * ((a / 2) mod p). Proof. - induction sz1; auto; simpl; intros. - f_equal. eauto. + intros. rewrite Z.mul_comm. apply Z.rem_mul_r; lia. Qed. -Lemma split2_zero : forall sz1 sz2, split2 sz1 sz2 (natToWord _ O) = natToWord _ O. +Lemma Zdiv_add_mul_l : forall a b c, c <> 0 -> (a + c * b) / c = a / c + b. Proof. - induction sz1; auto. + intros. rewrite Z.mul_comm. apply Z.div_add; assumption. Qed. -Theorem combine_inj : forall sz1 sz2 a b c d, - @combine sz1 a sz2 b = @combine sz1 c sz2 d -> a = c /\ b = d. +Lemma Zmod_add_mul_l : forall a b c, c <> 0 -> (a + c * b) mod c = a mod c. Proof. - induction sz1; simpl; intros. - - rewrite (word0 a) in *. - rewrite (word0 c) in *. - simpl in *. - intuition. - - rewrite (shatter_word a) in *. - rewrite (shatter_word c) in *. - simpl in *. - inversion H. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H2. - destruct (IHsz1 _ _ _ _ _ H2). - intuition. - f_equal; auto. + intros. rewrite Z.mul_comm. apply Z.mod_add; assumption. Qed. -Theorem combine_wzero : forall sz1 sz2, combine (wzero sz1) (wzero sz2) = wzero (sz1 + sz2). +Lemma Zmod_mul_split : forall a p q, 0 < p -> 0 < q -> a mod (p * q) = a mod p + p * ((a / p) mod q). Proof. - induction sz1; auto. - unfold wzero in *. - intros; simpl; f_equal; auto. + intros. apply Z.rem_mul_r; lia. Qed. -Theorem combine_wones : forall sz1 sz2, combine (wones sz1) (wones sz2) = wones (sz1 + sz2). +Lemma Zopp_mod_idemp : forall a p, p <> 0 -> (- (a mod p)) mod p = (- a) mod p. Proof. - induction sz1; auto. - intros; simpl; f_equal; auto. + intros. rewrite <- (Z.sub_0_l (a mod p)), Zminus_mod_idemp_r, Z.sub_0_l. reflexivity. Qed. -Theorem wordToN_nat : forall sz (w : word sz), wordToN w = N_of_nat (wordToNat w). +Lemma Zmod_opp_sub : forall z p, p <> 0 -> (- z) mod p = (p - z) mod p. Proof. - induction w; intuition. - destruct b; unfold wordToN, wordToNat; fold wordToN; fold wordToNat. - - rewrite N_of_S. - rewrite N_of_mult. - rewrite <- IHw. - rewrite Nmult_comm. - reflexivity. - - rewrite N_of_mult. - rewrite <- IHw. - rewrite Nmult_comm. - reflexivity. + intros. replace (p - z) with (- z + 1 * p) by lia. rewrite Z.mod_add; lia. Qed. -Lemma wordToN_to_nat sz: forall (w: word sz), BinNat.N.to_nat (wordToN w) = wordToNat w. +(** [a mod M] for [a] within one modulus of the range [0, M): three cases. *) +Lemma Zmod_cases : forall a M, 0 < M -> - M <= a < 2 * M -> + (0 <= a < M /\ a mod M = a) \/ (a < 0 /\ a mod M = a + M) \/ (M <= a /\ a mod M = a - M). Proof. - intros. - rewrite wordToN_nat. - rewrite Nnat.Nat2N.id. - reflexivity. + intros. destruct (Z_lt_le_dec a 0); [right; left | destruct (Z_lt_le_dec a M); [left | right; right]]; + (split; [lia|]); [apply Zmod_small_neg | apply Z.mod_small | apply Zmod_small_2]; lia. Qed. -Local Hint Extern 1 (@eq nat _ _) => lia. - -Theorem mod2_S : forall n k, - 2 * k = S n - -> mod2 n = true. - induction n as [n] using strong; intros. - destruct n; simpl in *. - exfalso; lia. - destruct n; simpl in *; auto. - destruct k as [|k]; simpl in *. - discriminate. - apply H with k; auto. -Qed. +(** * Moving word goals to [Z] *) -Theorem wzero'_def : forall sz, wzero' sz = wzero sz. - unfold wzero; induction sz; simpl; intuition. - congruence. -Qed. +Create HintDb unsigned_word. +#[global] Hint Rewrite + unsigned_wones + Zmod.unsigned_of_Z Zmod.unsigned_0 Zmod.unsigned_1 + Zmod.unsigned_add Zmod.unsigned_sub Zmod.unsigned_mul Zmod.unsigned_opp + unsigned_and unsigned_or unsigned_xor unsigned_not + Zmod.unsigned_eq_rect unsigned_eq_rec unsigned_match_eq + unsigned_natToWord unsigned_NToWord + unsigned_WS unsigned_wtl whd_eqn wmsb_eqn + unsigned_combine unsigned_split1 unsigned_split2 + unsigned_sext unsigned_zext unsigned_extz + unsigned_wlshift unsigned_wrshift unsigned_wrshifta unsigned_wpow2 + unsigned_wdivN unsigned_wremN + signed_eqn + : unsigned_word. -Theorem posToWord_nat : forall p sz, posToWord sz p = natToWord sz (nat_of_P p). - induction p as [ p IHp | p IHp | ]; destruct sz; simpl; intuition; f_equal; try rewrite wzero'_def in *. - - rewrite ZL6. - destruct (ZL4 p) as [x Heq]; rewrite Heq; simpl. - replace (x + S x) with (S (2 * x)) by lia. - symmetry; apply mod2_S_double. - - rewrite IHp. - rewrite ZL6. - destruct (nat_of_P p); simpl; intuition. - replace (n + S n) with (S (2 * n)) by lia. - rewrite div2_S_double; auto. - - unfold nat_of_P; simpl. - rewrite ZL6. - replace (nat_of_P p + nat_of_P p) with (2 * nat_of_P p) by lia. - symmetry; apply mod2_double. - - rewrite IHp. - unfold nat_of_P; simpl. - rewrite ZL6. - replace (nat_of_P p + nat_of_P p) with (2 * nat_of_P p) by lia. - rewrite div2_double. - auto. - auto. -Qed. +(** Turn equalities and disequalities of words into ones of [unsigned]. + The type of the equality may be spelled [word n], [Zmod _], or anything + that reduces to it (Kami's [type (Bit n)]). *) +Ltac is_word_type T := + lazymatch eval hnf in T with + | Zmod _ => idtac + | _ => fail + end. -Lemma posToWord_sz0: forall p, posToWord 0 p = $0. -Proof. - intros. unfold posToWord. destruct p; reflexivity. -Qed. +Ltac word_eq_to_unsigned := + repeat match goal with + | |- @eq ?T _ _ => is_word_type T; apply Zmod.unsigned_inj + | |- not (@eq ?T _ _) => + is_word_type T; + let H := fresh "Hw" in intro H; apply (f_equal (@Zmod.unsigned _)) in H + | |- (@eq ?T _ _) -> False => + is_word_type T; + let H := fresh "Hw" in intro H; apply (f_equal (@Zmod.unsigned _)) in H + | H : @eq ?T _ _ |- _ => is_word_type T; apply (f_equal (@Zmod.unsigned _)) in H + | H : not (@eq ?T ?a ?b) |- _ => + is_word_type T; + let H' := fresh "Hw" in + assert (H' : unsigned a <> unsigned b) + by (let E := fresh in intro E; apply H; apply Zmod.unsigned_inj; exact E); + clear H + | H : (@eq ?T ?a ?b) -> False |- _ => + is_word_type T; + let H' := fresh "Hw" in + assert (H' : unsigned a <> unsigned b) + by (let E := fresh in intro E; apply H; apply Zmod.unsigned_inj; exact E); + clear H + | |- existT word _ _ = existT word _ _ => apply existT_word_eq; [ lia | ] + | H : existT word _ _ = existT word _ _ |- _ => + apply existT_word_inv in H; destruct H + end. -Theorem NToWord_nat : forall sz n, NToWord sz n = natToWord sz (nat_of_N n). - destruct n; simpl; intuition; try rewrite wzero'_def in *. - auto. - apply posToWord_nat. -Qed. +(** Case-split the boolean tests produced by [wmsb_eqn], [signed_eqn], [whd_eqn]. *) +Ltac word_split_bools := + repeat match goal with + | H : context [Z.leb _ _] |- _ => revert H + | H : context [Z.ltb _ _] |- _ => revert H + | H : context [Z.eqb _ _] |- _ => revert H + | H : context [Z.odd _] |- _ => revert H + end; + repeat match goal with + | |- context [Z.leb ?a ?b] => destruct (Z.leb_spec a b) + | |- context [Z.ltb ?a ?b] => destruct (Z.ltb_spec a b) + | |- context [Z.eqb ?a ?b] => destruct (Z.eqb_spec a b) + | |- context [Z.odd ?u] => + let E := fresh "Hodd" in + pose proof (Z.div2_odd u) as E; rewrite Z.div2_div in E; revert E; + destruct (Z.odd u); intro E + end; + intros; cbn [Z.b2z] in *. + +(** Replace every [unsigned w] by a fresh integer in range, so that the + width arithmetic can be rewritten afterwards. *) +Ltac gen_unsigned := + repeat match goal with + | H : context [@Zmod.unsigned _ _] |- _ => revert H + end; + repeat match goal with + | |- context [@Zmod.unsigned ?m ?w] => + let H := fresh "Hr" in + pose proof (unsigned_range w) as H; + (* The modulus is an implicit argument and may be spelled + differently at different occurrences (e.g. [0 + n] vs [n]); + make every occurrence use the one from [w]'s type. *) + let m0 := match type of H with + | context [@Zmod.unsigned ?m0 w] => m0 + end in + repeat match goal with + | |- context [@Zmod.unsigned ?m' w] => + tryif constr_eq m' m0 then fail + else (let E := fresh in + assert (E : @Zmod.unsigned m' w = @Zmod.unsigned m0 w) by reflexivity; + rewrite E; clear E) + end; + revert H; generalize (@Zmod.unsigned m0 w) + end; + intros. + +(** Push [Z.of_nat]/[Z.of_N] through arithmetic so that the [Z] lemmas apply. *) +Ltac push_inj := + repeat match goal with + | |- context [Z.of_nat (?a - ?b)] => rewrite (Nat2Z.inj_sub a b) by lia + | H : context [Z.of_nat (?a - ?b)] |- _ => rewrite (Nat2Z.inj_sub a b) in H by lia + end; + repeat first [ rewrite Nat2Z.inj_mul in * | rewrite Nat2Z.inj_add in * | rewrite pow2_Z in * + | rewrite Nat2Z.inj_div in * | rewrite Nat2Z.inj_mod in * | rewrite Npow2_Z in * + | rewrite N2Z.inj_mul in * | rewrite N2Z.inj_add in * | rewrite N2Z.inj_div in * + | rewrite N2Z.inj_mod in * | rewrite N2Z.inj_pow in * | rewrite nat_N_Z in * ]; + change (Z.of_nat 0) with 0%Z in *; change (Z.of_nat 1) with 1%Z in *; + change (Z.of_nat 2) with 2%Z in *; + change (Z.of_N 0) with 0%Z in *; change (Z.of_N 1) with 1%Z in *; + change (Z.of_N 2) with 2%Z in *. + +(** A closed [Zpow2 n] is a numeral. *) +Ltac Zpow2_compute_one x := + let v := eval vm_compute in (Zpow2 x) in + lazymatch v with + | Zpos _ => replace (Zpow2 x) with v in * by (vm_compute; reflexivity) + | _ => fail + end. + +Ltac Zpow2_compute := + repeat match goal with + | |- context [Zpow2 ?x] => Zpow2_compute_one x + | H : context [Zpow2 ?x] |- _ => Zpow2_compute_one x + end. -Theorem wplus_alt : forall sz (x y : word sz), wplus x y = wplusN x y. - unfold wplusN, wplus, wordBinN, wordBin; intros. +Ltac pow2_normalize := + repeat first [ rewrite pow2_S in * | rewrite pow2_add_mul in * | rewrite Npow2_S in * + | rewrite Zpow2_S in * | rewrite Zpow2_add in * | rewrite Zpow2_mul in * ]; + push_inj; + rewrite ?Zpow2_0, ?Z.pow_0_r, ?Z.pow_1_r in *; + Zpow2_compute. + +(** [lia] is exponentially slow in the number of [mod] terms it sees; + prove side conditions with the [mod]-carrying hypotheses cleared. *) +Ltac clear_mods := + repeat match goal with H : context [Z.modulo _ _] |- _ => clear H end. + +(** Tell [lia] that [Zpow2 x] is positive, and what it is when the context + already knows whether [x] is zero. (Posing the two implications + unconditionally makes [lia] case-split, which is exponential once [mod] + terms are around.) *) +Ltac pow2_fact x := + lazymatch goal with + | _ : (0 < Zpow2 x)%Z |- _ => fail + | _ => pose proof (Zpow2_pos x); + let Hx := fresh "Hx" in + first [ assert (Hx : Z.of_nat x = 0%Z) by (clear_mods; lia); + pose proof (Zpow2_eq1 x Hx); clear Hx + | assert (Hx : Z.of_nat x <> 0%Z) by (clear_mods; lia); + pose proof (Zpow2_ge2 x Hx); clear Hx + | idtac ] + end. + +(** A product of two powers of two dominates both factors; [lia] treats the + product as an atom, so say it. *) +Lemma Zpow2_prod : forall a b, + 0 < Zpow2 a * Zpow2 b /\ Zpow2 a <= Zpow2 a * Zpow2 b /\ Zpow2 b <= Zpow2 a * Zpow2 b. +Proof. intros; pose proof (Zpow2_pos a); pose proof (Zpow2_pos b); nia. Qed. + +Ltac pow2_prod_fact a b := + lazymatch goal with + | _ : 0 < Zpow2 a * Zpow2 b /\ _ |- _ => fail + | _ => pose proof (Zpow2_prod a b) + end. + +Ltac pow2_facts := + repeat match goal with + | |- context [Zpow2 ?x] => pow2_fact x + | H : context [Zpow2 ?x] |- _ => pow2_fact x + end; + repeat match goal with + | |- context [(Zpow2 ?a * Zpow2 ?b)%Z] => pow2_prod_fact a b + | H : context [(Zpow2 ?a * Zpow2 ?b)%Z] |- _ => pow2_prod_fact a b + end. - repeat rewrite wordToN_nat; repeat rewrite NToWord_nat. - rewrite nat_of_Nplus. - repeat rewrite nat_of_N_of_nat. - reflexivity. -Qed. +(** [pow2]/[Npow2] are the [nat]/[N]-valued powers of two; [lia] sees their + injections as [2 ^ _], so relate them to [Zpow2]. *) +Ltac pow2_nat_fact x := + lazymatch goal with + | _ : Z.of_nat (pow2 x) = Zpow2 x |- _ => fail + | _ => pose proof (pow2_Z x) + end. -Theorem wmult_alt : forall sz (x y : word sz), wmult x y = wmultN x y. - unfold wmultN, wmult, wordBinN, wordBin; intros. +Ltac Npow2_fact x := + lazymatch goal with + | _ : Z.of_N (Npow2 x) = Zpow2 x |- _ => fail + | _ => pose proof (Npow2_Z x) + end. - repeat rewrite wordToN_nat; repeat rewrite NToWord_nat. - rewrite nat_of_Nmult. - repeat rewrite nat_of_N_of_nat. - reflexivity. -Qed. +Ltac pow2_nat_facts := + repeat match goal with + | |- context [pow2 ?x] => pow2_nat_fact x + | H : context [pow2 ?x] |- _ => pow2_nat_fact x + | |- context [Npow2 ?x] => Npow2_fact x + | H : context [Npow2 ?x] |- _ => Npow2_fact x + end. -Theorem wneg_alt : forall sz (x : word sz), wneg x = wnegN x. - unfold wnegN, wneg; intros. - repeat rewrite wordToN_nat; repeat rewrite NToWord_nat. - rewrite nat_of_Nminus. - do 2 f_equal. - apply Npow2_nat. - apply nat_of_N_of_nat. -Qed. +(** The implicit modulus of [@Zmod.unsigned m t] must be spelled exactly as + the width in the type of [t] for the rewrite rules to match (e.g. + [S sz] vs [1 + sz]); make it so. *) +Ltac canon_unsigned_one m t := + let T := type of t in + lazymatch T with + | word ?n => + let m0 := constr:(Zpow2 n) in + tryif constr_eq m m0 then fail + else (let E := fresh in + assert (E : @Zmod.unsigned m t = @Zmod.unsigned m0 t) by reflexivity; + rewrite E in *; clear E) + | _ => fail + end. + +Ltac canon_unsigned := + repeat match goal with + | |- context [@Zmod.unsigned ?m ?t] => canon_unsigned_one m t + | H : context [@Zmod.unsigned ?m ?t] |- _ => canon_unsigned_one m t + end. -Theorem wminus_Alt : forall sz (x y : word sz), wminus x y = wminusN x y. - intros; unfold wminusN, wminus; rewrite wneg_alt; apply wplus_alt. -Qed. +Ltac word_to_Z := + intros; + repeat match goal with x := _ |- _ => subst x end; + word_eq_to_unsigned; + cbv [wordToNat wordToN wlsb] in *; + rewrite ?unsigned_wones in *; + repeat progress (canon_unsigned; autorewrite with unsigned_word in *); + word_split_bools; + gen_unsigned; + pow2_normalize; + repeat match goal with + | |- context [Z.of_nat (Z.to_nat ?z)] => rewrite (Z2Nat.id z) in * by lia + | H : context [Z.of_nat (Z.to_nat ?z)] |- _ => rewrite (Z2Nat.id z) in * by lia + | |- context [Z.of_N (Z.to_N ?z)] => rewrite (Z2N.id z) in * by lia + | H : context [Z.of_N (Z.to_N ?z)] |- _ => rewrite (Z2N.id z) in * by lia + end; + repeat match goal with b : bool |- _ => destruct b end; + cbn [Z.b2z] in *; + rewrite ?Z.add_0_l, ?Z.add_0_r, ?Z.mul_1_l, ?Z.mul_1_r, ?Z.mul_0_l, ?Z.mul_0_r in *; + rewrite <- ?Z.mul_opp_r in *; + pow2_nat_facts; pow2_facts. + +Ltac word_side := clear_mods; first [ lia | nia ]. + +(** Value-range conditioned rules, tried at every occurrence. *) +Ltac word_mod_small_all := + repeat match goal with + | |- context [(?a mod ?p)%Z] => + first [ rewrite (Z.mod_small a p) in * by word_side + | rewrite (@Zmod_small_neg a p) in * by word_side + | rewrite (@Zmod_small_2 a p) in * by word_side ] + | H : context [(?a mod ?p)%Z] |- _ => + first [ rewrite (Z.mod_small a p) in * by word_side + | rewrite (@Zmod_small_neg a p) in * by word_side + | rewrite (@Zmod_small_2 a p) in * by word_side ] + | |- context [(?a / ?p)%Z] => rewrite (Z.div_small a p) in * by word_side + | H : context [(?a / ?p)%Z] |- _ => rewrite (Z.div_small a p) in * by word_side + end. -Theorem wplus_unit : forall sz (x : word sz), natToWord sz 0 ^+ x = x. - intros; rewrite wplus_alt; unfold wplusN, wordBinN; intros. - rewrite roundTrip_0; apply natToWord_wordToNat. -Qed. +(** Shape-conditioned rules (side conditions are positivity of moduli). *) +Ltac word_mod_rules := + (rewrite Z.mod_0_l in * by word_side) || (rewrite Z.div_0_l in * by word_side) + || (rewrite Z.mod_mod in * by word_side) + || rewrite Zplus_mod_idemp_l in * || rewrite Zplus_mod_idemp_r in * + || rewrite Zmult_mod_idemp_l in * || rewrite Zmult_mod_idemp_r in * + || (rewrite Z.mul_mod_distr_l in * by word_side) || (rewrite Z.mul_mod_distr_r in * by word_side) + || (rewrite Z.div_mul_cancel_l in * by word_side) || (rewrite Z.div_mul_cancel_r in * by word_side) + || (rewrite Z.mod_add in * by word_side) || (rewrite Z.div_add in * by word_side) + || (rewrite Zmod_add_mul_l in * by word_side) || (rewrite Zdiv_add_mul_l in * by word_side) + || (rewrite Z.div_div in * by word_side) + || rewrite Zminus_mod_idemp_l in * || rewrite Zminus_mod_idemp_r in * + || (rewrite Zopp_mod_idemp in * by word_side) + || (rewrite Zmod_2mul_odd in * by word_side) || (rewrite Zmod_2mul_odd' in * by word_side) + || (rewrite Zmod_opp_sub in * by word_side) + || (rewrite Zmod_2mul_split in * by word_side) + || (rewrite Zmod_mul2_split in * by word_side) + || (rewrite Zmod_mul_split in * by word_side). + +Ltac word_mod_simpl := + repeat progress (word_mod_small_all; repeat word_mod_rules). + +Ltac mod_args_unify_1 x y := + tryif constr_eq x y then fail else + lazymatch x with + | context [y] => fail + | _ => lazymatch y with + | context [x] => fail + | _ => replace y with x in * by lia + end + end. -Theorem wplus_comm : forall sz (x y : word sz), x ^+ y = y ^+ x. - intros; repeat rewrite wplus_alt; unfold wplusN, wordBinN; f_equal; auto. -Qed. +Ltac mod_args_unify := + repeat match goal with + | |- context [(?x mod ?p)%Z] => + match goal with + | |- context [(?y mod ?p)%Z] => mod_args_unify_1 x y + | H : context [(?y mod ?p)%Z] |- _ => mod_args_unify_1 x y + end + | H : context [(?x mod ?p)%Z] |- _ => + match goal with + | |- context [(?y mod ?p)%Z] => mod_args_unify_1 x y + | H' : context [(?y mod ?p)%Z] |- _ => mod_args_unify_1 x y + end + end. -Theorem drop_sub : - forall sz n k, - (k * pow2 sz <= n)%nat -> - natToWord sz (n - k * pow2 sz) = natToWord sz n. -Proof. - induction sz as [|sz IHsz]; simpl; intros n k *; intuition; repeat rewrite untimes2 in *; f_equal. - - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm k). - rewrite <- Nat.mul_assoc. - apply drop_mod2. - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm 2). - rewrite <- Nat.mul_assoc. - auto. - - rewrite <- (IHsz (Nat.div2 n) k). - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm k). - rewrite <- Nat.mul_assoc. - rewrite div2_minus_2. - reflexivity. - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm 2). - rewrite <- Nat.mul_assoc. - auto. - - apply div2_bound. - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm 2). - rewrite <- Nat.mul_assoc. - auto. -Qed. +(** Replace every innermost [a mod M] whose argument is within one modulus of + range by a variable and the three-way case split of [Zmod_cases], so that + [lia] can finish. *) +Ltac word_mod_case a M := + let HM := fresh "HM" in + let HB := fresh "HB" in + let r := fresh "r" in + let H := fresh "Hmod" in + assert (HM : (0 < M)%Z) by (clear_mods; first [ lia | nia ]); + assert (HB : (- M <= a < 2 * M)%Z) by (clear_mods; first [ lia | nia ]); + pose proof (@Zmod_cases a M HM HB) as H; clear HM HB; + set (r := (a mod M)%Z) in *; clearbody r. + +Ltac word_mod_cases := + repeat match goal with + | |- context [(?a mod ?M)%Z] => + lazymatch a with context [Z.modulo _ _] => fail | _ => word_mod_case a M end + | H : context [(?a mod ?M)%Z] |- _ => + lazymatch a with context [Z.modulo _ _] => fail | _ => word_mod_case a M end + end. -Local Hint Extern 1 (_ <= _)%nat => lia. +(** A big hammer: the case split, the rewrite rules, then [nia]. *) +Ltac word_lia_Z := + word_to_Z; try subst; rewrite ?Z.sub_diag in *; + lazymatch goal with + | |- @eq bool _ _ => first [ reflexivity | exfalso ] + | _ => idtac + end; + first [ (word_mod_cases; first [ lia | nia ]) + | (word_mod_simpl; mod_args_unify; first [ lia | (f_equal; lia) | congruence | nia ]) + | (word_mod_simpl; word_mod_cases; first [ lia | nia ]) + | nia + | (zify; Z.div_mod_to_equations; nia) ]. -Theorem wplus_assoc : forall sz (x y z : word sz), x ^+ (y ^+ z) = x ^+ y ^+ z. - intros sz x y z *; repeat rewrite wplus_alt; unfold wplusN, wordBinN; intros. +(** * Structural views *) - repeat match goal with - | [ |- context[wordToNat (natToWord ?sz ?w)] ] => - let Heq := fresh "Heq" in - destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq - end. +Lemma word0 : forall (w : word 0), w = WO. +Proof. intros; apply Zmod.unsigned_inj; rewrite bits.unsigned_width0; reflexivity. Qed. - match goal with - | [ |- context[wordToNat ?x + wordToNat ?y - ?x1 * pow2 ?sz + wordToNat ?z] ] - => replace (wordToNat x + wordToNat y - x1 * pow2 sz + wordToNat z) - with (wordToNat x + wordToNat y + wordToNat z - x1 * pow2 sz) by auto - end. - match goal with - | [ |- context[wordToNat ?x + (wordToNat ?y + wordToNat ?z - ?x0 * pow2 ?sz)] ] - => replace (wordToNat x + (wordToNat y + wordToNat z - x0 * pow2 sz)) - with (wordToNat x + wordToNat y + wordToNat z - x0 * pow2 sz) by auto - end. - repeat rewrite drop_sub; auto. -Qed. +Lemma shatter_word : forall n (w : word (S n)), w = WS (whd w) (wtl w). +Proof. word_lia_Z. Qed. -Theorem roundTrip_1 : forall sz, wordToNat (natToWord (S sz) 1) = 1. - induction sz; simpl in *; intuition. -Qed. +Lemma whd_WS : forall b n (w : word n), whd (WS b w) = b. +Proof. word_lia_Z. Qed. -Theorem roundTrip_1': forall sz, sz <> 0 -> wordToNat (natToWord sz 1) = 1. -Proof. - intros. - destruct sz. - - tauto. - - apply roundTrip_1. -Qed. +Lemma wtl_WS : forall b n (w : word n), wtl (WS b w) = w. +Proof. word_lia_Z. Qed. +(** The eliminator of [word] seen as built from [WO] and [WS]; use it as + [induction w using word_rect]. *) +Fixpoint word_rect (P : forall n, word n -> Type) + (HO : P O WO) + (HS : forall (b : bool) (n : nat) (w : word n), P n w -> P (S n) (WS b w)) + (n : nat) {struct n} : forall w : word n, P n w := + match n return forall w : word n, P n w with + | O => fun w => eq_rect_r (P O) HO (word0 w) + | S n' => fun w => + eq_rect_r (P (S n')) + (HS (whd w) n' (wtl w) (word_rect P HO HS (wtl w))) + (shatter_word w) + end. -Theorem mod2_WS : forall sz (x : word sz) b, mod2 (wordToNat (WS b x)) = b. - intros sz x b. rewrite wordToNat_wordToNat'. - destruct b; simpl. +Definition word_ind (P : forall n, word n -> Prop) := word_rect P. +Definition word_rec (P : forall n, word n -> Set) := word_rect P. - rewrite untimes2. - case_eq (2 * wordToNat x); intuition. - eapply mod2_S; eauto. - rewrite <- (mod2_double (wordToNat x)); f_equal; lia. -Qed. +Lemma destruct_word_S : forall n (w : word (S n)), exists (v : word n) (b : bool), w = WS b v. +Proof. intros; exists (wtl w), (whd w); apply shatter_word. Qed. -Theorem div2_WS : forall sz (x : word sz) b, Nat.div2 (wordToNat (WS b x)) = wordToNat x. - destruct b; rewrite wordToNat_wordToNat'; unfold wordToNat'; fold wordToNat'. - apply div2_S_double. - apply div2_double. -Qed. +(** [word_destruct w] splits a [word (S _)] into its head bit, named [b], + and its tail, which reuses the name [w]. *) +Tactic Notation "word_destruct" ident(w) := + (try (intros until w)); + let b := fresh "b" in + let v := fresh "v" in + let Hv := fresh "Hv" in + destruct (destruct_word_S w) as [v [b Hv]]; subst w; rename v into w. -Theorem wmult_unit : forall sz (x : word sz), natToWord sz 1 ^* x = x. - intros sz x; rewrite wmult_alt; unfold wmultN, wordBinN; intros. - destruct sz; simpl. - rewrite (shatter_word x); reflexivity. - rewrite roundTrip_0; simpl. - rewrite Nat.add_0_r. - rewrite (shatter_word x). - f_equal. +Local Close Scope Z_scope. - apply mod2_WS. +(** * The [nat] view *) - rewrite div2_WS. - apply natToWord_wordToNat. -Qed. +Lemma wordToNat_bound : forall sz (w : word sz), (#w < pow2 sz)%nat. +Proof. word_lia_Z. Qed. -Theorem wmult_comm : forall sz (x y : word sz), x ^* y = y ^* x. - intros; repeat rewrite wmult_alt; unfold wmultN, wordBinN; auto with arith. -Qed. +Lemma natToWord_wordToNat : forall sz (w : word sz), $ (#w) = w. +Proof. word_lia_Z. Qed. -Theorem wmult_unit_r : forall sz (x : word sz), x ^* natToWord sz 1 = x. -Proof. - intros. - rewrite wmult_comm. - apply wmult_unit. -Qed. +Lemma wordToNat_natToWord_idempotent' : forall sz n, (n < pow2 sz)%nat -> #(natToWord sz n) = n. +Proof. word_lia_Z. Qed. -Lemma wmult_neut_l: forall (sz : nat) (x : word sz), $0 ^* x = $0. -Proof. - intros. unfold wmult. unfold wordBin. do 2 rewrite wordToN_nat. - rewrite <- Nnat.Nat2N.inj_mul. rewrite roundTrip_0. - rewrite Nat.mul_0_l. simpl. rewrite wzero'_def. reflexivity. -Qed. +Lemma wordToNat_inj : forall sz (a b : word sz), #a = #b -> a = b. +Proof. word_lia_Z. Qed. -Lemma wmult_neut_r: forall (sz : nat) (x : word sz), x ^* $0 = $0. -Proof. - intros. unfold wmult. unfold wordBin. do 2 rewrite wordToN_nat. - rewrite <- Nnat.Nat2N.inj_mul. rewrite roundTrip_0. - rewrite Nat.mul_0_r. simpl. rewrite wzero'_def. reflexivity. -Qed. +Lemma roundTrip_0 : forall sz, #(natToWord sz 0) = 0. +Proof. word_lia_Z. Qed. -Theorem wmult_assoc : forall sz (x y z : word sz), x ^* (y ^* z) = x ^* y ^* z. - intros sz x y z; repeat rewrite wmult_alt; unfold wmultN, wordBinN; intros. +Lemma roundTrip_1 : forall sz, #(natToWord (S sz) 1) = 1. +Proof. word_lia_Z. Qed. - repeat match goal with - | [ |- context[wordToNat (natToWord ?sz ?w)] ] => - let Heq := fresh "Heq" in - destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq - end. +Lemma wones_pow2_minus_one : forall sz, #(wones sz) = pow2 sz - 1. +Proof. word_lia_Z. Qed. - rewrite Nat.mul_sub_distr_l. - rewrite Nat.mul_sub_distr_r. - match goal with - | [ |- natToWord _ (_ - _ * (?x0' * _)) = natToWord _ (_ - ?x1' * _ * _) ] - => rename x0' into x0, x1' into x1 (* force the names to not be autogenerated *) - end. - rewrite (Nat.mul_assoc (wordToNat x) x0). - rewrite <- (Nat.mul_assoc x1). - rewrite (Nat.mul_comm (pow2 sz)). - rewrite (Nat.mul_assoc x1). - repeat rewrite drop_sub; auto with arith. - rewrite (Nat.mul_comm x1). - rewrite <- (Nat.mul_assoc (wordToNat x)). - rewrite (Nat.mul_comm (wordToNat y)). - rewrite Nat.mul_assoc. - rewrite (Nat.mul_comm (wordToNat x)). - repeat rewrite <- Nat.mul_assoc. - auto with arith. - repeat rewrite <- Nat.mul_assoc. - auto with arith. -Qed. +Lemma natToWord_S : forall sz n, natToWord sz (S n) = $1 ^+ natToWord sz n. +Proof. word_lia_Z. Qed. -Theorem wmult_plus_distr : forall sz (x y z : word sz), (x ^+ y) ^* z = (x ^* z) ^+ (y ^* z). - intros sz x y z; repeat rewrite wmult_alt; repeat rewrite wplus_alt; unfold wmultN, wplusN, wordBinN; intros. +Lemma natToWord_plus : forall sz n m, natToWord sz (n + m) = $n ^+ $m. +Proof. word_lia_Z. Qed. - repeat match goal with - | [ |- context[wordToNat (natToWord ?sz ?w)] ] => - let Heq := fresh "Heq" in - destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq - end. +Lemma wones_natToWord : forall sz, wones sz = natToWord sz (pow2 sz - 1). +Proof. word_lia_Z. Qed. - rewrite Nat.mul_sub_distr_r. +Lemma wplus_one_neq : forall sz (w : word (S sz)), w ^+ $1 <> w. +Proof. word_lia_Z. Qed. + +(** Close a goal from a hypothesis [w ^+ $1 = w] or [w = w ^+ $1]. *) +Ltac wplus_one_contra := + exfalso; eapply wplus_one_neq; match goal with - | [ |- natToWord _ (_ - ?x0' * _ * _) = natToWord _ (_ - ?x1' * _ + (_ - ?x2' * _)) ] - => rename x0' into x0, x1' into x1, x2' into x2 (* force the names to not be autogenerated *) + | H : _ = _ |- _ => first [ exact H | exact (eq_sym H) ] end. - rewrite <- (Nat.mul_assoc x0). - rewrite (Nat.mul_comm (pow2 sz)). - rewrite (Nat.mul_assoc x0). - - replace (wordToNat x * wordToNat z - x1 * pow2 sz + - (wordToNat y * wordToNat z - x2 * pow2 sz)) - with (wordToNat x * wordToNat z + wordToNat y * wordToNat z - x1 * pow2 sz - x2 * pow2 sz). - repeat rewrite drop_sub; auto with arith. - rewrite (Nat.mul_comm x0). - rewrite (Nat.mul_comm (wordToNat x + wordToNat y)). - rewrite <- (Nat.mul_assoc (wordToNat z)). - auto with arith. - generalize dependent (wordToNat x * wordToNat z). - generalize dependent (wordToNat y * wordToNat z). - intros. - lia. -Qed. - -Theorem wminus_def : forall sz (x y : word sz), x ^- y = x ^+ ^~ y. - reflexivity. -Qed. -Theorem wordToNat_bound : forall sz (w : word sz), (wordToNat w < pow2 sz)%nat. - induction w as [|b]; simpl; intuition. - destruct b; simpl; lia. -Qed. +(** * Uniqueness of equality proofs on words *) -Theorem natToWord_pow2 : forall sz, natToWord sz (pow2 sz) = natToWord sz 0. - induction sz as [|sz]; simpl; intuition. - - generalize (div2_double (pow2 sz)); simpl; intro Hr; rewrite Hr; clear Hr. - f_equal. - generalize (mod2_double (pow2 sz)); auto. - auto. -Qed. - -Theorem wminus_inv : forall sz (x : word sz), x ^+ ^~ x = wzero sz. - intros sz x; rewrite wneg_alt; rewrite wplus_alt; unfold wnegN, wplusN, wzero, wordBinN; intros. - - repeat match goal with - | [ |- context[wordToNat (natToWord ?sz ?w)] ] => - let Heq := fresh "Heq" in - destruct (wordToNat_natToWord sz w) as [? [Heq ?]]; rewrite Heq - end. - - match goal with - | [ |- context[wordToNat ?x + (pow2 ?sz - wordToNat ?x - ?x0 * pow2 ?sz)] ] - => replace (wordToNat x + (pow2 sz - wordToNat x - x0 * pow2 sz)) - with (pow2 sz - x0 * pow2 sz) - end. - rewrite drop_sub; auto with arith. - apply natToWord_pow2. - generalize (wordToNat_bound x). - lia. -Qed. - -Lemma wminus_diag: forall sz (w: word sz), - w ^- w = $0. -Proof. - intros. unfold wminus. apply wminus_inv. -Qed. - -Lemma wneg_0_wminus: forall {sz: nat} (x: word sz), - ^~ x = $0 ^- x. -Proof. - intros. - rewrite <- wplus_unit at 1. - reflexivity. -Qed. - -Definition wring (sz : nat) : ring_theory (wzero sz) (wone sz) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) (@eq _) := - mk_rt _ _ _ _ _ _ _ - (@wplus_unit _) (@wplus_comm _) (@wplus_assoc _) - (@wmult_unit _) (@wmult_comm _) (@wmult_assoc _) - (@wmult_plus_distr _) (@wminus_def _) (@wminus_inv _). - -Theorem weqb_sound : forall sz (x y : word sz), weqb x y = true -> x = y. -Proof. - eapply weqb_true_iff. -Qed. - -Arguments weqb_sound : clear implicits. - -Lemma weqb_eq: forall sz (a b: word sz), a = b -> weqb a b = true. -Proof. intros. rewrite weqb_true_iff. assumption. Qed. - -Lemma weqb_ne: forall sz (a b: word sz), a <> b -> weqb a b = false. -Proof. - intros. destruct (weqb a b) eqn: E. - - rewrite weqb_true_iff in E. contradiction. - - reflexivity. -Qed. - -Lemma weqb_false: forall sz (a b: word sz), weqb a b = false -> a <> b. -Proof. - intros. destruct (weqb a b) eqn: E. - - discriminate. - - intro C. subst. rewrite weqb_eq in E; congruence. -Qed. - -Ltac is_nat_cst n := - match eval hnf in n with - | O => constr:(true) - | S ?n' => is_nat_cst n' - | _ => constr:(false) - end. - -Ltac isWcst w := - match eval hnf in w with - | WO => constr:(true) - | WS ?b ?w' => - match eval hnf in b with - | true => isWcst w' - | false => isWcst w' - | _ => constr:(false) - end - | natToWord _ ?n => is_nat_cst n - | _ => constr:(false) - end. - -Ltac wcst w := - let b := isWcst w in - match b with - | true => w - | _ => constr:(NotConstant) - end. - -(* Here's how you can add a ring for a specific bit-width. - There doesn't seem to be a polymorphic method, so this code really does need to be copied. *) - -(* -Definition wring8 := wring 8. -Add Ring wring8 : wring8 (decidable (weqb_sound 8), constants [wcst]). -*) - -Ltac noptac x := idtac. - -Ltac PackWring sz F := - let RNG := (fun proj => proj - inv_morph_nothing inv_morph_nothing noptac noptac - (word sz) (@eq (word sz)) (wzero sz) (wone sz) - (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) - (BinNums.Z) (BinNums.N) (id_phi_N) - (pow_N (wone sz) (@wmult sz)) - (ring_correct (@Eqsth (word sz)) - (Eq_ext _ _ _) - (Rth_ARth (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz)) - (gen_phiZ_morph (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz)) - (pow_N_th _ _ (@Eqsth (word sz))) - (triv_div_th (@Eqsth (word sz)) - (Eq_ext _ _ _) - (Rth_ARth (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz)) - (gen_phiZ_morph (@Eqsth (word sz)) (Eq_ext _ _ _) (wring sz))) - ) - tt) in - F RNG (@nil (word sz)) (@nil (word sz)). - -Ltac ring_sz sz := PackWring sz Ring_gen. - -Fact bitwp_wtl : forall sz (w w' : word (S sz)) op, bitwp op (wtl w) (wtl w') = wtl (bitwp op w w'). -Proof. - intros. - rewrite (shatter_word w), (shatter_word w'). - auto. -Qed. - -Lemma split1_bitwp_dist : forall sz1 sz2 w w' op, - split1 sz1 sz2 (bitwp op w w') = bitwp op (split1 sz1 sz2 w) (split1 sz1 sz2 w'). -Proof. - induction sz1; intros; auto. - simpl. - f_equal. - rewrite (shatter_word w), (shatter_word w'); auto. - rewrite <- IHsz1, bitwp_wtl. - reflexivity. -Qed. - -Lemma split2_bitwp_dist : forall sz1 sz2 w w' op, - split2 sz1 sz2 (bitwp op w w') = bitwp op (split2 sz1 sz2 w) (split2 sz1 sz2 w'). -Proof. - induction sz1; intros; auto. - simpl; rewrite <- IHsz1, bitwp_wtl. - reflexivity. -Qed. - -Lemma combine_bitwp : forall sz1 sz2 (wa wa' : word sz1) (wb wb' : word sz2) op, - combine (bitwp op wa wa') (bitwp op wb wb') = bitwp op (combine wa wb) (combine wa' wb'). -Proof. - induction sz1; intros; rewrite (shatter_word wa), (shatter_word wa'); simpl; f_equal; auto. -Qed. - -Lemma eq_rect_bitwp : forall a b Heq f w1 w2, - bitwp f w1 w2 = eq_rect a word ( - bitwp f (eq_rect b word w1 a Heq) (eq_rect b word w2 a Heq)) b (eq_sym Heq). -Proof. - intros a b H; subst a. - intros; eq_rect_simpl; reflexivity. -Qed. - -Fact eq_rect_bitwp' : forall a b Heq f w1 w2, - eq_rect b word (bitwp f w1 w2) a Heq = bitwp f (eq_rect b word w1 a Heq) (eq_rect b word w2 a Heq). -Proof. - intros a b H1; subst a. - intros; eq_rect_simpl; reflexivity. -Qed. - -Fact eq_rect_bitwp_1 : forall a b Heq f w1 w2, - bitwp f (eq_rect a word w1 b Heq) w2 = eq_rect a word (bitwp f w1 (eq_rect b word w2 a (eq_sym Heq))) b Heq. -Proof. - intros a b H. - subst a; intros; eq_rect_simpl; auto. -Qed. - -Theorem wnot_wnot'_equiv : forall sz (w : word sz), wnot w = wnot' w. -Proof. - unfold wnot'. - induction sz; intros w; shatterer. -Qed. - -Theorem wnot_split1 : forall sz1 sz2 w, wnot (split1 sz1 sz2 w) = split1 sz1 sz2 (wnot w). -Proof. - intros. - repeat rewrite wnot_wnot'_equiv. - unfold wnot'. - erewrite <- split1_combine with (w := wones _). - rewrite <- split1_bitwp_dist, combine_wones. - reflexivity. -Qed. - -Theorem wnot_split2 : forall sz1 sz2 w, wnot (split2 sz1 sz2 w) = split2 sz1 sz2 (wnot w). -Proof. - intros. - repeat rewrite wnot_wnot'_equiv. - unfold wnot'. - erewrite <- split2_combine with (z := wones _). - rewrite <- split2_bitwp_dist, combine_wones. - reflexivity. -Qed. - -Theorem wnot_combine : forall sz1 sz2 (w1 : word sz1) (w2 : word sz2), - wnot (combine w1 w2) = combine (wnot w1) (wnot w2). -Proof. - intros. - repeat rewrite wnot_wnot'_equiv. - unfold wnot'. - rewrite <- combine_wones, combine_bitwp. - reflexivity. -Qed. - -Theorem wnot_zero: forall sz, wnot (wzero sz) = wones sz. -Proof. - induction sz; simpl; f_equal; eauto. -Qed. - -Theorem wnot_ones : forall sz, wnot (wones sz) = wzero sz. -Proof. - induction sz; simpl; f_equal; try rewrite IHsz; eauto. -Qed. - -Theorem wnot_eq_rect : forall a b H (w : word a), wnot (eq_rect a word w b H) = eq_rect a word (wnot w) b H. -Proof. - intros. - subst b; eq_rect_simpl; auto. -Qed. - -Theorem wor_unit : forall sz (x : word sz), wzero sz ^| x = x. -Proof. - unfold wzero, wor; induction x; simpl; intuition congruence. -Qed. - -Theorem wor_comm : forall sz (x y : word sz), x ^| y = y ^| x. -Proof. - unfold wor; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool. -Qed. - -Theorem wor_assoc : forall sz (x y z : word sz), x ^| (y ^| z) = x ^| y ^| z. -Proof. - unfold wor; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool. -Qed. - -Theorem wand_unit : forall sz (x : word sz), wones sz ^& x = x. -Proof. - unfold wand; induction x; simpl; intuition congruence. -Qed. - -Theorem wand_kill : forall sz (x : word sz), wzero sz ^& x = wzero sz. -Proof. - unfold wzero, wand; induction x; simpl; intuition congruence. -Qed. - -Theorem wand_comm : forall sz (x y : word sz), x ^& y = y ^& x. -Proof. - unfold wand; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool. -Qed. - -Theorem wand_assoc : forall sz (x y z : word sz), x ^& (y ^& z) = x ^& y ^& z. -Proof. - unfold wand; induction x; intro y; rewrite (shatter_word y); simpl; intuition; f_equal; auto with bool. -Qed. - -Theorem wand_or_distr : forall sz (x y z : word sz), (x ^| y) ^& z = (x ^& z) ^| (y ^& z). -Proof. - unfold wand, wor; induction x; intro y; rewrite (shatter_word y); intro z; rewrite (shatter_word z); simpl; intuition; f_equal; auto with bool. - destruct (whd y); destruct (whd z); destruct b; reflexivity. -Qed. - -Lemma wor_wones : forall sz w, wones sz ^| w = wones sz. -Proof. - unfold wor; induction sz; intros; simpl; auto. - rewrite IHsz; auto. -Qed. - -Lemma wor_wzero : forall sz w, wzero sz ^| w = w. -Proof. - unfold wor; induction sz; shatterer. -Qed. - -Lemma wand_wones : forall sz w, wones sz ^& w = w. -Proof. - unfold wand; induction sz; shatterer. -Qed. - -Lemma wand_wzero : forall sz w, wzero sz ^& w = wzero sz. -Proof. - intros. rewrite <- wzero'_def. - unfold wand; induction sz; shatterer. -Qed. - -Lemma wxor_wones : forall sz w, wxor (wones sz) w = wnot w. -Proof. - unfold wxor; induction sz; shatterer. -Qed. - -Lemma wxor_wzero : forall sz w, wxor (wzero sz) w = w. -Proof. - unfold wxor; induction sz; shatterer; destruct (whd w); auto. -Qed. - -Lemma wxor_comm : forall sz (w1 w2 : word sz), wxor w1 w2 = wxor w2 w1. -Proof. - unfold wxor; induction sz. shatterer. - intros. rewrite (shatter_word w1), (shatter_word w2). - simpl. - rewrite xorb_comm, IHsz. - reflexivity. -Qed. - -Lemma wxor_assoc : forall sz (w1 w2 w3 : word sz), wxor w1 (wxor w2 w3) = wxor (wxor w1 w2) w3. -Proof. - unfold wxor. - induction sz; intros; rewrite (shatter_word w1), (shatter_word w2), (shatter_word w3); auto. - simpl; f_equal. - rewrite xorb_assoc_reverse; auto. - rewrite IHsz. - reflexivity. -Qed. - -Lemma wor_wone : forall sz (w : word sz) b, - WS b w ^| wone _ = WS true w. -Proof. - intros. - compute [wone natToWord wor]. simpl. - fold natToWord. - change (natToWord sz 0) with (wzero sz). - rewrite orb_true_r. - rewrite wor_comm, wor_wzero. - reflexivity. -Qed. - -Lemma wand_wone : forall sz (w : word sz) b, - WS b w ^& wone _ = WS b (wzero _). -Proof. - intros. - compute [wone natToWord wand]. simpl. - fold natToWord. - change (natToWord sz 0) with (wzero sz). - rewrite andb_true_r. - rewrite wand_comm, wand_wzero. - reflexivity. -Qed. - -Lemma wxor_wone : forall sz (w : word sz) b, - wxor (WS b w) (wone _) = WS (negb b) w. -Proof. - intros. - compute [wone natToWord wxor]. simpl. - fold natToWord. - change (natToWord sz 0) with (wzero sz). - rewrite xorb_true_r. - rewrite wxor_comm, wxor_wzero. - reflexivity. -Qed. - -Definition wbring (sz : nat) : semi_ring_theory (wzero sz) (wones sz) (@wor sz) (@wand sz) (@eq _) := - mk_srt _ _ _ _ _ - (@wor_unit _) (@wor_comm _) (@wor_assoc _) - (@wand_unit _) (@wand_kill _) (@wand_comm _) (@wand_assoc _) - (@wand_or_distr _). - -(** * Inequality proofs *) - -Ltac word_simpl := unfold sext, zext, wzero in *; simpl in *. - -Ltac word_eq := ring. - -Ltac word_eq1 := match goal with - | _ => ring - | [ H : _ = _ |- _ ] => ring [H] - end. - -Theorem word_neq : forall sz (w1 w2 : word sz), - w1 ^- w2 <> wzero sz - -> w1 <> w2. - intros; intro; subst. - unfold wminus in H. - rewrite wminus_inv in H. - tauto. -Qed. - -Ltac word_neq := apply word_neq; let H := fresh "H" in intro H; simpl in H; ring_simplify in H; try discriminate. - -Ltac word_contra := match goal with - | [ H : _ <> _ |- False ] => apply H; ring - end. - -Ltac word_contra1 := match goal with - | [ H : _ <> _ |- False ] => apply H; - match goal with - | _ => ring - | [ H' : _ = _ |- _ ] => ring [H'] - end - end. - -Lemma not_wlt_ge : forall sz (l r : word sz), - ((l < r) -> False) -> (r <= l). -Proof. - intros. - case_eq (wlt_dec l r); intros; - try contradiction; - auto. -Qed. - -Lemma not_wle_gt : forall sz (l r : word sz), - ((l <= r) -> False) -> (r < l). -Proof. - intros. - case_eq (wlt_dec r l); intros; - try contradiction; - auto. -Qed. - -Lemma lt_le : forall sz (a b : word sz), - a < b -> a <= b. -Proof. - unfold wlt, N.lt. intros sz a b H H0. rewrite N.compare_antisym in H0. rewrite H in H0. simpl in *. congruence. -Qed. - -Lemma eq_le : forall sz (a b : word sz), - a = b -> a <= b. -Proof. - intros; subst. unfold wlt, N.lt. rewrite N.compare_refl. congruence. -Qed. - -Lemma wordToN_inj : forall sz (a b : word sz), - wordToN a = wordToN b -> a = b. -Proof. - induction a; intro b0; rewrite (shatter_word b0); intuition. - simpl in H. - destruct b; destruct (whd b0); intros. - f_equal. eapply IHa. eapply N.succ_inj in H. - destruct (wordToN a); destruct (wordToN (wtl b0)); try congruence. - destruct (wordToN (wtl b0)); destruct (wordToN a); inversion H. - destruct (wordToN (wtl b0)); destruct (wordToN a); inversion H. - f_equal. eapply IHa. - destruct (wordToN a); destruct (wordToN (wtl b0)); try congruence. -Qed. - -Lemma wordToNat_inj : forall sz (a b : word sz), - wordToNat a = wordToNat b -> a = b. -Proof. - intros; apply wordToN_inj. - repeat rewrite wordToN_nat. - apply Nat2N.inj_iff; auto. -Qed. - -Lemma unique_inverse : forall sz (a b1 b2 : word sz), - a ^+ b1 = wzero _ -> - a ^+ b2 = wzero _ -> - b1 = b2. -Proof. - intros sz a b1 b2 H *. - transitivity (b1 ^+ wzero _). - rewrite wplus_comm. rewrite wplus_unit. auto. - transitivity (b1 ^+ (a ^+ b2)). congruence. - rewrite wplus_assoc. - rewrite (wplus_comm b1). rewrite H. rewrite wplus_unit. auto. -Qed. - -Lemma sub_0_eq : forall sz (a b : word sz), - a ^- b = wzero _ -> a = b. -Proof. - intros sz a b H. destruct (weq (wneg b) (wneg a)) as [e|n]. - transitivity (a ^+ (^~ b ^+ b)). - rewrite (wplus_comm (^~ b)). rewrite wminus_inv. - rewrite wplus_comm. rewrite wplus_unit. auto. - rewrite e. rewrite wplus_assoc. rewrite wminus_inv. rewrite wplus_unit. auto. - unfold wminus in H. - generalize (unique_inverse a (wneg a) (^~ b)). - intro H0. exfalso. apply n. symmetry; apply H0. - apply wminus_inv. - auto. -Qed. - -Lemma le_neq_lt : forall sz (a b : word sz), - b <= a -> a <> b -> b < a. -Proof. - intros sz a b H H0; destruct (wlt_dec b a) as [?|n]; auto. - exfalso. apply H0. unfold wlt, N.lt in *. - eapply wordToN_inj. eapply Ncompare_eq_correct. - case_eq ((wordToN a ?= wordToN b)%N); auto; try congruence. - intros H1. rewrite N.compare_antisym in n. rewrite H1 in n. simpl in *. congruence. -Qed. - - -#[global] Hint Resolve word_neq lt_le eq_le sub_0_eq le_neq_lt : worder. - -Ltac shatter_word x := - match type of x with - | word 0 => try rewrite (shatter_word_0 x) in * - | word (S ?N) => - let x' := fresh in - let H := fresh in - destruct (@shatter_word_S N x) as [ ? [ x' H ] ]; - rewrite H in *; clear H; shatter_word x' - end. - - -(** Uniqueness of equality proofs **) -Lemma rewrite_weq : forall sz (a b : word sz) - (pf : a = b), - weq a b = left _ pf. -Proof. - intros sz a b *; destruct (weq a b); try solve [ exfalso; auto ]. - f_equal. - eapply UIP_dec. eapply weq. -Qed. - - -(** * Some more useful derived facts *) - -Lemma natToWord_plus : forall sz n m, natToWord sz (n + m) = natToWord _ n ^+ natToWord _ m. - destruct sz as [|sz]; intros n m; intuition. - rewrite wplus_alt. - unfold wplusN, wordBinN. - destruct (wordToNat_natToWord (S sz) n); intuition. - destruct (wordToNat_natToWord (S sz) m); intuition. - do 2 match goal with H : _ |- _ => rewrite H; clear H end. - match goal with - | [ |- context[?n - ?x * pow2 (S ?sz) + (?m - ?x0 * pow2 (S ?sz))] ] - => replace (n - x * pow2 (S sz) + (m - x0 * pow2 (S sz))) with (n + m - x * pow2 (S sz) - x0 * pow2 (S sz)) - by lia - end. - repeat rewrite drop_sub; auto; lia. -Qed. - -Lemma natToWord_S : forall sz n, natToWord sz (S n) = natToWord _ 1 ^+ natToWord _ n. - intros sz n; change (S n) with (1 + n); apply natToWord_plus. -Qed. - -Theorem natToWord_inj : forall sz n m, natToWord sz n = natToWord sz m - -> (n < pow2 sz)%nat - -> (m < pow2 sz)%nat - -> n = m. - intros sz n m H H0 H1. - apply (f_equal (@wordToNat _)) in H. - destruct (wordToNat_natToWord sz n) as [x H2]. - destruct (wordToNat_natToWord sz m) as [x0 H3]. - intuition. - match goal with - | [ H : wordToNat ?x = wordToNat ?y, H' : wordToNat ?x = ?a, H'' : wordToNat ?y = ?b |- _ ] - => let H0 := fresh in assert (H0 : a = b) by congruence; clear H H' H''; rename H0 into H - end. - assert (x = 0) by (destruct x; lia). - assert (x0 = 0) by (destruct x0; lia). - subst; simpl in *; lia. -Qed. - -Lemma wordToNat_natToWord_idempotent : forall sz n, - (N.of_nat n < Npow2 sz)%N - -> wordToNat (natToWord sz n) = n. - intros sz n H. - destruct (wordToNat_natToWord sz n) as [x]; intuition. - destruct x as [|x]. - simpl in *; lia. - simpl in *. - apply Nlt_out in H. - autorewrite with N in *. - rewrite Npow2_nat in *. - generalize dependent (x * pow2 sz). - intros; lia. -Qed. - -Lemma wplus_cancel : forall sz (a b c : word sz), - a ^+ c = b ^+ c - -> a = b. - intros sz a b c H. - apply (f_equal (fun x => x ^+ ^~ c)) in H. - repeat rewrite <- wplus_assoc in H. - rewrite wminus_inv in H. - repeat rewrite (wplus_comm _ (wzero sz)) in H. - repeat rewrite wplus_unit in H. - assumption. -Qed. - -Lemma wminus_plus_distr: - forall {sz} (x y z: word sz), x ^- (y ^+ z) = x ^- y ^- z. -Proof. - intros. - apply wplus_cancel with (c:= y ^+ z). - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (y:= y ^+ z), wminus_inv. - rewrite wplus_comm with (x:= x), wplus_unit. - rewrite !wminus_def, <-wplus_assoc. - rewrite wplus_assoc with (x:= ^~ z). - rewrite wplus_comm with (x:= ^~ z). - rewrite <-wplus_assoc with (x:= y). - rewrite wplus_comm with (x:= ^~ z), wminus_inv. - rewrite wplus_comm with (x:= y), wplus_unit. - rewrite <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ y), wminus_inv. - rewrite wplus_comm, wplus_unit. - reflexivity. -Qed. - -Lemma wminus_wplus_undo: forall sz (a b: word sz), - a ^- b ^+ b = a. -Proof. - intros. - rewrite wminus_def. - rewrite <- wplus_assoc. - rewrite (wplus_comm (^~ b)). - rewrite wminus_inv. - rewrite wplus_comm. - rewrite wplus_unit. - reflexivity. -Qed. - -Lemma wneg_zero: - forall {sz} (w: word sz), ^~ w = (natToWord sz 0) -> w = natToWord sz 0. -Proof. - intros. - apply wplus_cancel with (c:= ^~ w). - rewrite wminus_inv, wplus_unit; auto. -Qed. - -Lemma wneg_idempotent: - forall {sz} (w: word sz), ^~ (^~ w) = w. -Proof. - intros. - apply sub_0_eq. - rewrite wminus_def. - rewrite wplus_comm. - apply wminus_inv. -Qed. - -Lemma wneg_zero': forall sz, - wneg (natToWord sz 0) = natToWord sz 0. -Proof. - intros. apply wneg_zero. apply wneg_idempotent. -Qed. - -Lemma wplus_one_neq: forall {sz} (w: word (S sz)), w ^+ (natToWord (S sz) 1) <> w. -Proof. - intros; intro Hx. - rewrite wplus_comm in Hx. - assert ((natToWord (S sz) 1) ^+ w ^- w = w ^- w) by (rewrite Hx; reflexivity). - clear Hx. - do 2 rewrite wminus_def in H. - rewrite <-wplus_assoc in H. - rewrite wminus_inv in H. - rewrite wplus_comm, wplus_unit in H. - inversion H. -Qed. - -Lemma wneg_one_pow2_minus_one: forall {sz}, wordToNat (^~ (natToWord sz 1)) = pow2 sz - 1. -Proof. - destruct sz; auto. - unfold wneg; intros. - rewrite wordToN_nat, roundTrip_1. - simpl BinNat.N.of_nat. - rewrite NToWord_nat, Nnat.N2Nat.inj_sub, Npow2_nat. - apply wordToNat_natToWord_2. - pose (pow2_zero (S sz)). - lia. -Qed. - -Lemma wones_pow2_minus_one: forall {sz}, wordToNat (wones sz) = pow2 sz - 1. -Proof. - induction sz; simpl; auto; - rewrite IHsz; pose (pow2_zero sz); - lia. -Qed. - -Lemma pow2_minus_one_wones: forall {sz} (w: word sz), - wordToNat w = pow2 sz - 1 -> w = wones sz. -Proof. - intros; rewrite <-wones_pow2_minus_one in H. - apply wordToNat_inj; auto. -Qed. - -Lemma wones_natToWord: forall sz, - wones sz = $ (pow2 sz - 1). -Proof. - induction sz. - - reflexivity. - - unfold wones. fold wones. rewrite IHsz. - unfold natToWord at 2. fold natToWord. f_equal. - + rewrite mod2sub. - * simpl. rewrite mod2_pow2_twice. reflexivity. - * pose proof (zero_lt_pow2 (S sz)). lia. - + f_equal. unfold pow2 at 2. fold pow2. - rewrite <- (div2_S_double (pow2 sz - 1)). f_equal. - pose proof (zero_lt_pow2 sz). lia. -Qed. - -Lemma wones_wneg_one: forall {sz}, wones sz = ^~ (natToWord sz 1). -Proof. - intros; apply wordToNat_inj. - rewrite wneg_one_pow2_minus_one. - rewrite wones_pow2_minus_one. - reflexivity. -Qed. - -Lemma wordToNat_natToWord_pred: - forall {sz} (w: word sz), w <> wzero sz -> - pred (wordToNat w) = - wordToNat (w ^- (natToWord sz 1)). -Proof. - intros; remember (wordToNat w) as wn; destruct wn; simpl in *. - - elim H. - apply wordToNat_inj. - rewrite roundTrip_0; auto. - - apply natToWord_inj with (sz:= sz). - + rewrite natToWord_wordToNat. - apply wplus_cancel with (c:= (natToWord sz 1)). - rewrite wminus_def, <-wplus_assoc. - rewrite wplus_comm with (x:= ^~ (natToWord sz 1)). - rewrite wminus_inv. - rewrite wplus_comm with (x:= w). - rewrite wplus_unit. - rewrite wplus_comm, <-natToWord_S. - apply wordToNat_inj. - rewrite wordToNat_natToWord_2; auto. - rewrite Heqwn. - apply wordToNat_bound. - + pose proof (wordToNat_bound w); lia. - + apply wordToNat_bound. -Qed. - -Lemma natToWord_mult : forall sz n m, natToWord sz (n * m) = natToWord _ n ^* natToWord _ m. -Proof. - destruct sz; intuition. - rewrite wmult_alt. - unfold wmultN, wordBinN. - destruct (wordToNat_natToWord (S sz) n); intuition. - destruct (wordToNat_natToWord (S sz) m); intuition. - rewrite H0; rewrite H2; clear H0 H2. - replace ((n - x * pow2 (S sz)) * (m - x0 * pow2 (S sz))) - with ((n - x * pow2 (S sz)) * m - (n - x * pow2 (S sz)) * (x0 * pow2 (S sz))) - by (rewrite Nat.mul_sub_distr_l; auto). - rewrite Nat.mul_assoc; rewrite drop_sub. - repeat rewrite Nat.mul_comm with (m:=m). - replace (m * (n - x * pow2 (S sz))) - with (m * n - m * (x * pow2 (S sz))) - by (rewrite Nat.mul_sub_distr_l; auto). - rewrite Nat.mul_assoc; rewrite drop_sub. - auto. - rewrite <- Nat.mul_assoc; apply Nat.mul_le_mono_l; auto. - rewrite <- Nat.mul_assoc; apply Nat.mul_le_mono_l; auto. -Qed. - -Lemma wlt_lt: forall sz (a b : word sz), a < b -> - (wordToNat a < wordToNat b)%nat. -Proof. - intros. - unfold wlt in H. - repeat rewrite wordToN_nat in *. - apply Nlt_out in H. - repeat rewrite Nat2N.id in *. - auto. -Qed. - -Lemma wle_le: forall sz (a b : word sz), (a <= b)%word -> - (wordToNat a <= wordToNat b)%nat. -Proof. - intros. - unfold wlt in H. - repeat rewrite wordToN_nat in *. - apply Nge_out in H. - repeat rewrite Nat2N.id in *. - auto. -Qed. - -Lemma wlt_lt': forall sz a b, (a < pow2 sz)%nat - -> natToWord sz a < b - -> (wordToNat (natToWord sz a) < wordToNat b)%nat. -Proof. - intros. - apply wlt_lt. - auto. -Qed. - -Lemma lt_word_lt_nat : forall (sz:nat) (n:word sz) (m:nat), - (n < (natToWord sz m))%word -> - (wordToNat n < m)%nat. -Proof. - intros. - apply wlt_lt in H. - destruct (wordToNat_natToWord' sz m). - rewrite <- H0. - apply Nat.lt_le_trans with (1 := H). - now apply Nat.le_add_r. -Qed. - -Lemma le_word_le_nat : forall (sz:nat) (n:word sz) (m:nat), - (n <= (natToWord sz m))%word -> - (wordToNat n <= m)%nat. -Proof. - intros. - apply wle_le in H. - destruct (wordToNat_natToWord' sz m). - rewrite <- H0. - apply Nat.le_trans with (1 := H). - now apply Nat.le_add_r. -Qed. - -(* Chain [lt_word_lt_nat] and [Nat.lt_le_incl] - Avoids using [Hint Resolve Nat.lt_le_incl] for this specific lemma, - though this may be a premature optimization. *) -Lemma lt_word_le_nat : forall (sz:nat) (n:word sz) (m:nat), - (n < (natToWord sz m))%word -> - (wordToNat n <= m)%nat. -Proof. - intros. - apply lt_word_lt_nat in H. - apply Nat.lt_le_incl. - assumption. -Qed. - -#[global] Hint Resolve lt_word_le_nat. - -Lemma wordToNat_natToWord_idempotent' : forall sz n, - (n < pow2 sz)%nat - -> wordToNat (natToWord sz n) = n. -Proof. - intros. - destruct (wordToNat_natToWord sz n); intuition. - destruct x. - simpl in *; lia. - simpl in *. - generalize dependent (x * pow2 sz). - intros; lia. -Qed. - -Lemma le_word_le_nat': forall (sz:nat) n m, - (n < pow2 sz)%nat -> - (natToWord sz n <= m)%word -> - (n <= wordToNat m)%nat. -Proof. - intros. - apply wle_le in H0. - rewrite wordToNat_natToWord_idempotent' in H0; auto. -Qed. - -Lemma wordToNat_natToWord_bound : forall sz n (bound : word sz), - (n <= wordToNat bound)%nat - -> wordToNat (natToWord sz n) = n. -Proof. - intros. - apply wordToNat_natToWord_idempotent'. - eapply Nat.le_lt_trans; eauto. - apply wordToNat_bound. -Qed. - -Lemma wordToNat_natToWord_le : forall sz n, - (wordToNat (natToWord sz n) <= n)%nat. -Proof. - intros. - case_eq (lt_dec n (pow2 sz)); intros. - rewrite wordToNat_natToWord_idempotent'; auto. - eapply Nat.le_trans. - apply Nat.lt_le_incl. - apply wordToNat_bound. - lia. -Qed. - -Lemma wordToNat_natToWord_lt : forall sz n b, - (n < b -> wordToNat (natToWord sz n) < b)%nat. -Proof. - intros. - eapply Nat.le_lt_trans. - apply wordToNat_natToWord_le. - auto. -Qed. - -Lemma wordToNat_eq_natToWord : forall sz (w : word sz) n, - wordToNat w = n - -> w = natToWord sz n. -Proof. - intros. rewrite <- H. rewrite natToWord_wordToNat. auto. -Qed. - -Lemma wlt_lt_bound: forall sz (a : word sz) (b bound : nat), - (a < natToWord sz b)%word - -> (b <= wordToNat (natToWord sz bound))%nat - -> (wordToNat a < b)%nat. -Proof. - intros. - apply wlt_lt in H. - erewrite wordToNat_natToWord_bound in H; eauto. -Qed. - -Lemma natplus1_wordplus1_eq: - forall sz (a bound : word sz), - (0 < sz)%nat -> - (a < bound)%word -> - (wordToNat a) + 1 = wordToNat (a ^+ (natToWord sz 1)). -Proof. - intros. - rewrite wplus_alt. unfold wplusN, wordBinN. simpl. - assert ((1 < pow2 sz)%nat). - inversion H. - simpl; auto. - apply one_lt_pow2. - erewrite wordToNat_natToWord_bound. - rewrite wordToNat_natToWord_idempotent' by auto. - reflexivity. - apply wlt_lt in H0. - rewrite wordToNat_natToWord_idempotent' by auto. - instantiate (1:=bound). lia. -Qed. - -Lemma lt_wlt: forall sz (n : word sz) m, (wordToNat n < wordToNat m)%nat -> - n < m. -Proof. - intros. - unfold wlt. - repeat rewrite wordToN_nat. - apply Nlt_in. - repeat rewrite Nat2N.id. - auto. -Qed. - -Lemma le_wle: forall sz (n : word sz) m, (wordToNat n <= wordToNat m)%nat -> - n <= m. -Proof. - intros. - unfold wlt. - repeat rewrite wordToN_nat. - apply N.le_ngt. - apply N.ge_le. - apply Nge_in. - repeat rewrite Nat2N.id. - auto. -Qed. - -Lemma wlt_wle_incl : forall sz (a b : word sz), - (a < b)%word -> (a <= b)%word. -Proof. - intros. - apply wlt_lt in H. - apply le_wle. - lia. -Qed. - -Lemma wminus_Alt2: forall sz x y, y <= x -> - @wminusN sz x y = wordBinN minus x y. -Proof. - intros. - unfold wminusN, wplusN, wnegN, wordBinN. - destruct (weq y (natToWord sz 0)); subst. - - rewrite roundTrip_0. - repeat rewrite Nat.sub_0_r. - rewrite <- drop_sub with (k:=1) (n:=pow2 sz); try lia. - replace (pow2 sz - 1 * pow2 sz) with (0) by lia. - rewrite roundTrip_0. - rewrite <- plus_n_O. - reflexivity. - - rewrite wordToNat_natToWord_idempotent' with (n:=pow2 sz - wordToNat y). - rewrite <- drop_sub with (k:=1). - simpl. - rewrite <- plus_n_O. - replace (wordToNat x + (pow2 sz - wordToNat y) - pow2 sz) with (wordToNat x - wordToNat y). - auto. - rewrite Nat.add_sub_assoc. - lia. - - remember (wordToNat_bound y); lia. - - simpl. rewrite <- plus_n_O. - rewrite Nat.add_sub_assoc; [| remember (wordToNat_bound y); lia ]. - rewrite Nat.add_comm. - rewrite <- Nat.add_sub_assoc. - lia. - - apply Nat.nlt_ge. - unfold not in *; intros. - apply H. - apply lt_wlt; auto. - - apply Nat.sub_lt. - remember (wordToNat_bound y); lia. - - assert (wordToNat y <> 0); try lia. - - assert (wordToN y <> wordToN (natToWord sz 0)). - unfold not in *. intros. apply n. - apply wordToN_inj. - auto. - - repeat rewrite wordToN_nat in H0. - unfold not in *. intros. apply H0. - apply N2Nat.inj. - repeat rewrite Nat2N.id. - rewrite roundTrip_0. - auto. -Qed. - -Theorem wlt_wf: - forall sz, well_founded (@wlt sz). -Proof. - intros. - eapply well_founded_lt_compat with (f:=@wordToNat sz). - apply wlt_lt. -Qed. - -Ltac wlt_ind := - match goal with - | [ |- forall (n: word ?len), ?P ] => - refine (well_founded_ind (@wlt_wf len) (fun n => P) _) - end. - -Theorem wordToNat_plusone: forall sz w w', w < w' -> - wordToNat (w ^+ natToWord sz 1) = S (wordToNat w). -Proof. - intros. - - destruct sz. - exfalso. - rewrite word0 with (w:=w') in H. - rewrite word0 with (w:=w) in H. - apply wlt_lt in H. - lia. - - rewrite wplus_alt. - unfold wplusN, wordBinN. - rewrite wordToNat_natToWord_idempotent'. - - rewrite roundTrip_1. - lia. - - eapply Nat.le_lt_trans; [| apply wordToNat_bound ]. - rewrite wordToNat_natToWord_idempotent'; - [| erewrite <- roundTrip_1 at 1; apply wordToNat_bound ]. - apply wlt_lt in H. - instantiate (1:=w'). - lia. -Qed. - - -Theorem wordToNat_minus_one': forall sz n, n <> natToWord sz 0 -> - S (wordToNat (n ^- natToWord sz 1)) = wordToNat n. -Proof. - intros. - destruct sz. - rewrite word0 with (w:=n) in H. - rewrite word0 with (w:=natToWord 0 0) in H. - exfalso; auto. - - destruct (weq n (natToWord (S sz) 0)); intuition. - rewrite wminus_Alt. - rewrite wminus_Alt2. - unfold wordBinN. - rewrite roundTrip_1. - erewrite wordToNat_natToWord_bound with (bound:=n); try lia. - assert (wordToNat n <> 0); try lia. - unfold not; intros; apply n0; clear n0. - rewrite <- H0; rewrite natToWord_wordToNat; auto. - unfold not; intros; apply n0; clear n0. - apply wlt_lt in H0. - replace n with (natToWord (S sz) (wordToNat n)) by (rewrite natToWord_wordToNat; auto). - f_equal; rewrite roundTrip_1 in *. - lia. -Qed. - -Theorem wordToNat_minus_one: forall sz n, n <> natToWord sz 0 -> - wordToNat (n ^- natToWord sz 1) = wordToNat n - 1. -Proof. - intros. - erewrite Nat.succ_inj with (n2 := wordToNat (n ^- (natToWord sz 1))); auto. - rewrite wordToNat_minus_one'; auto. - assert (wordToNat n <> 0). - intuition. - erewrite <- roundTrip_0 with (sz := sz) in H0. - apply wordToNat_inj in H0; tauto. - lia. -Qed. - -Lemma lt_minus : forall a b c, - (b <= a -> b < c -> a < c -> a - b < c)%nat. -Proof. - intros; lia. -Qed. - -Lemma wminus_minus : forall sz (a b : word sz), - b <= a - -> wordToNat (a ^- b) = wordToNat a - wordToNat b. -Proof. - intros. - rewrite wminus_Alt. - rewrite wminus_Alt2; auto. - unfold wordBinN. - eapply wordToNat_natToWord_idempotent'. - apply lt_minus. - apply wle_le; auto. - apply wordToNat_bound. - apply wordToNat_bound. -Qed. - -Lemma wminus_minus': forall (sz : nat) (a b : word sz), - (#b <= #a)%nat -> - #(a ^- b) = #a - #b. -Proof. - intros. apply wminus_minus. - unfold wlt. intro C. - apply Nlt_out in C. - rewrite! wordToN_to_nat in *. - lia. -Qed. - -Lemma wordToNat_neq_inj: forall sz (a b : word sz), - a <> b <-> wordToNat a <> wordToNat b. -Proof. - split; intuition. - apply wordToNat_inj in H0; auto. - subst; auto. -Qed. - -Lemma natToWord_discriminate: forall sz, (sz > 0)%nat -> natToWord sz 0 <> natToWord sz 1. -Proof. - unfold not. - intros. - induction sz. - lia. - unfold natToWord in H0; fold natToWord in H0. - discriminate H0. -Qed. - -Definition bit_dec : forall (a : word 1), {a = $0} + {a = $1}. - intro. - rewrite (shatter_word a). - replace (wtl a) with WO by auto. - destruct (whd a). - right; apply eq_refl. - left; apply eq_refl. -Defined. - -Lemma neq0_wneq0: forall sz (n : word sz), - wordToNat n <> 0 <-> n <> $0. -Proof. - split; intros. - apply wordToNat_neq_inj. - rewrite roundTrip_0; auto. - apply wordToNat_neq_inj in H. - rewrite roundTrip_0 in H; auto. -Qed. - -Lemma gt0_wneq0: forall sz (n : word sz), - (wordToNat n > 0)%nat <-> n <> $0. -Proof. - split; intros. - apply neq0_wneq0; lia. - apply wordToNat_neq_inj in H. - rewrite roundTrip_0 in H; lia. -Qed. - -Lemma weq_minus1_wlt: forall sz (a b : word sz), - (a <> $0 -> a ^- $1 = b -> a > b)%word. -Proof. - intros. - apply lt_wlt; subst. - rewrite wordToNat_minus_one; auto. - apply gt0_wneq0 in H. - lia. -Qed. - -Lemma wordnat_minus1_eq : forall sz n (w : word sz), - (n > 0)%nat - -> n = wordToNat w - -> n - 1 = wordToNat (w ^- $1). -Proof. - intros; rewrite wordToNat_minus_one; auto. - apply gt0_wneq0; subst; auto. -Qed. - -Theorem wlshift_0 : forall sz (w : word sz), @wlshift sz w 0 = w. -Proof. - intros. - unfold wlshift. - eapply split1_0. -Qed. - -Theorem wrshift_0 : forall sz (w : word sz), @wrshift sz w 0 = w. -Proof. - intros. - unfold wrshift. - simpl. - rewrite combine_n_0. - eq_rect_simpl. reflexivity. -Qed. - -Theorem wlshift_gt : forall sz n (w : word sz), (n > sz)%nat -> - wlshift w n = wzero sz. -Proof. - intros sz n w H. - generalize dependent w. - remember (n - sz) as e. - assert (n = sz + e) by lia; subst n. - intros w. - unfold wlshift. - rewrite <- combine_wzero. - erewrite combine_assoc, eq_rect_word_match. - eq_rect_simpl. - rewrite eq_rect_combine. - apply split1_combine. - Unshelve. lia. -Qed. - -Theorem wrshift_gt : forall sz n (w : word sz), (n > sz)%nat -> - wrshift w n = wzero sz. -Proof. - intros sz n w H. - generalize dependent w. - remember (n - sz) as e. - assert (n = sz + e) by lia; subst n. - intros w. - unfold wrshift. - erewrite wzero_rev, <- combine_wzero. - eq_rect_simpl. - rewrite <- eq_rect_word_match, <- eq_rect_combine, eq_rect_word_match. - eq_rect_simpl. - rewrite eq_rect_combine_assoc', split2_combine. - reflexivity. - Unshelve. lia. -Qed. - -Theorem wlshift_bitwp : forall sz (w1 w2 : word sz) f n, - wlshift (bitwp f w1 w2) n = split1 sz n ( - eq_rec _ word (combine (wzero n) (bitwp f w1 w2)) _ (eq_sym (Nat.add_comm sz n))). -Proof. - intros. - unfold wlshift. - eq_rect_simpl. - reflexivity. -Qed. - -Theorem wrshift_bitwp : forall sz (w1 w2 : word sz) f n, - wrshift (bitwp f w1 w2) n = split2 n sz ( - eq_rect _ word (combine (bitwp f w1 w2) (wzero n)) _ (eq_sym (Nat.add_comm n sz))). -Proof. - intros. - unfold wrshift. - eq_rect_simpl. - reflexivity. -Qed. - -Theorem wnot_wlshift : forall sz (w : word sz) n, - wnot (wlshift w n) = split1 sz n (eq_rect _ word (combine (wones n) (wnot w)) _ (eq_sym (Nat.add_comm sz n))). -Proof. - intros. - unfold wlshift. - rewrite wnot_split1. - eq_rect_simpl. - rewrite wnot_eq_rect. - rewrite wnot_combine. - rewrite wnot_zero. - reflexivity. -Qed. - -Theorem wnot_wrshift : forall sz (w : word sz) n, - wnot (wrshift w n) = split2 n sz (eq_rect _ word (combine (wnot w) (wones n)) _ (eq_sym (Nat.add_comm n sz))). -Proof. - intros. - unfold wrshift. - rewrite wnot_split2. - eq_rect_simpl. - rewrite wnot_eq_rect. - rewrite wnot_combine. - rewrite wnot_zero. - reflexivity. -Qed. - -Theorem div2_pow2_twice: forall n, - Nat.div2 (pow2 n + (pow2 n + 0)) = pow2 n. -Proof. - intros. - replace (pow2 n + (pow2 n + 0)) with (2 * pow2 n) by lia. - rewrite Nat.div2_double. - auto. -Qed. - -Theorem zero_or_wordToNat_S: forall sz (n : word sz), - n = $0 \/ - exists nn, wordToNat n = S nn /\ wordToNat (n ^- $1) = nn. -Proof. - intros. - destruct sz. - left. rewrite (word0 n). auto. - destruct (weq n $0); intuition. - right. - exists (wordToNat (n ^- $1)); intuition. - rewrite wminus_Alt. - rewrite wminus_Alt2. - unfold wordBinN. - rewrite roundTrip_1. - erewrite wordToNat_natToWord_bound with (bound:=n); try lia. - assert (wordToNat n <> 0); try lia. - unfold not; intros; apply n0; clear n0. - rewrite <- H. rewrite natToWord_wordToNat; auto. - unfold not; intros; apply n0; clear n0. - apply wlt_lt in H. - replace n with (natToWord (S sz) (wordToNat n)) by (rewrite natToWord_wordToNat; auto). - f_equal. - rewrite roundTrip_1 in *. - lia. -Qed. - -Theorem wbit_or_same : forall sz sz' (n : word sz'), (wordToNat n < sz)%nat - -> (wbit sz n) ^| (wbit sz n) <> wzero sz. -Proof. - unfold not. - induction sz; intros; try lia. - unfold wbit, wzero, wor in *. - simpl in *. - destruct (zero_or_wordToNat_S n). - subst; rewrite roundTrip_0 in *. discriminate. - destruct H1. destruct H1. - rewrite H1 in *. - inversion H0. - apply (inj_pair2_eq_dec _ Nat.eq_dec) in H5. - rewrite div2_pow2_twice in H5. - repeat rewrite <- H2 in H5. - eapply IHsz; eauto. - lia. -Qed. - -Theorem wbit_or_other : forall sz sz' (n1 n2 : word sz'), (wordToNat n1 < sz)%nat - -> (wordToNat n2 < sz)%nat - -> (n1 <> n2) - -> (wbit sz n1) ^& (wbit sz n2) = wzero sz. -Proof. - induction sz; intros; try lia. - unfold wbit, wzero, wand. - simpl. - destruct (zero_or_wordToNat_S n1); destruct (zero_or_wordToNat_S n2); - try congruence; destruct_conjs; subst; try rewrite roundTrip_0. - - repeat rewrite H4; simpl; repeat rewrite mod2_pow2_twice; f_equal. - rewrite wand_kill; auto. - - repeat rewrite H4; simpl; repeat rewrite mod2_pow2_twice; f_equal. - rewrite wand_comm; rewrite wand_kill; auto. - - repeat rewrite H4; repeat rewrite H6; simpl. - repeat rewrite mod2_pow2_twice; f_equal. - repeat rewrite div2_pow2_twice. - eapply IHsz; try lia. - - apply word_neq. - unfold not in *; intros; apply H1; clear H1. - apply sub_0_eq; rewrite <- H2. - ring_sz sz'. -Qed. - -Theorem wbit_and_not: forall sz sz' (n : word sz'), (wordToNat n < sz)%nat - -> (wbit sz n) ^& wnot (wbit sz n) = wzero sz. -Proof. - induction sz; intros; try lia. - unfold wbit, wzero, wand, wnot. - simpl. - f_equal. - apply andb_negb_r. - - destruct (zero_or_wordToNat_S n); subst. - rewrite roundTrip_0; simpl. - apply wand_kill. - - do 2 destruct H0. - rewrite H0; simpl. - rewrite div2_pow2_twice. - fold wnot. - rewrite <- H1. - eapply IHsz. - lia. -Qed. - -Theorem wbit_and_not_other: forall sz sz' (n1 n2 : word sz'), (wordToNat n1 < sz)%nat - -> (wordToNat n2 < sz)%nat - -> n1 <> n2 - -> (wbit sz n1) ^& wnot (wbit sz n2) = wbit sz n1. -Proof. - induction sz; intros; try lia. - unfold wbit, wzero, wand, wnot. - simpl. - destruct (zero_or_wordToNat_S n1); destruct (zero_or_wordToNat_S n2); - try congruence; destruct_conjs; subst; fold wnot; try rewrite roundTrip_0; simpl; - f_equal. - - rewrite H4; simpl; rewrite mod2_pow2_twice; auto. - rewrite H4; simpl; rewrite div2_pow2_twice; apply wand_kill. - - rewrite H4; simpl; rewrite mod2_pow2_twice; auto. - rewrite H4; simpl; rewrite div2_pow2_twice. - rewrite wnot_zero. rewrite wand_comm. apply wand_unit. - - rewrite H4; simpl; rewrite mod2_pow2_twice; simpl; apply andb_true_r. - rewrite H4; rewrite H6; simpl. - repeat rewrite div2_pow2_twice. - apply IHsz; try lia. - - apply word_neq. - unfold not in *; intros; apply H1. - apply sub_0_eq. - rewrite <- H2. - ring_sz sz'. -Qed. - -Lemma wordToNat_wzero: - forall sz, wordToNat (wzero sz) = 0. -Proof. - unfold wzero; intros. - apply roundTrip_0. -Qed. - -Lemma wordToN_wzero: - forall sz, wordToN (wzero sz) = 0%N. -Proof. - intros; rewrite wordToN_nat. - rewrite wordToNat_wzero. - reflexivity. -Qed. - -Lemma combine_zero: - forall n m, combine (natToWord n 0) (natToWord m 0) = natToWord _ 0. -Proof. - induction n; simpl; intros; [reflexivity|]. - rewrite IHn; reflexivity. -Qed. - -Lemma combine_one: - forall n m, combine (natToWord (S n) 1) (natToWord m 0) = natToWord _ 1. -Proof. - cbn; intros. - rewrite combine_zero; reflexivity. -Qed. - -Lemma wmsb_wzero': - forall sz, wmsb (wzero' sz) false = false. -Proof. induction sz; auto. Qed. - -Lemma wmsb_wzero: - forall sz, wmsb (wzero sz) false = false. -Proof. - intros. - rewrite <-wzero'_def. - apply wmsb_wzero'. -Qed. - -Lemma wmsb_wones: - forall sz, wmsb (wones (S sz)) false = true. -Proof. - induction sz; cbn; auto. -Qed. - -Lemma wmsb_0: forall sz (m: word (S sz)) default, - (# m < pow2 sz)%nat -> - @wmsb (S sz) m default = false. -Proof. - induction sz; intros. - - simpl in *. assert (#m = 0) as N by lia. - rewrite <- (roundTrip_0 1) in N. - apply wordToNat_inj in N. subst m. - simpl. reflexivity. - - pose proof (shatter_word_S m) as P. - destruct P as [b [m0 E]]. subst. - unfold wmsb. fold wmsb. - apply IHsz. - simpl in H. destruct b; lia. -Qed. - -Lemma wmsb_1: forall sz (m: word (S sz)) default, - pow2 sz <= # m < 2 * pow2 sz -> - @wmsb (S sz) m default = true. -Proof. - induction sz; intros. - - simpl in *. assert (#m = 1) as N by lia. - rewrite <- (roundTrip_1 1) in N. - apply (wordToNat_inj m ($ 1)) in N. subst m. - simpl. reflexivity. - - pose proof (shatter_word_S m) as P. - destruct P as [b [m0 E]]. subst. - unfold wmsb. fold wmsb. - apply IHsz. - simpl in H. destruct b; lia. -Qed. - -Lemma wmsb_0_natToWord: forall sz n default, - (2 * n < pow2 (S sz))%nat -> - @wmsb (S sz) (natToWord (S sz) n) default = false. -Proof. - intros. apply wmsb_0. - pose proof (wordToNat_natToWord_le (S sz) n). unfold pow2 in H. fold pow2 in H. lia. -Qed. - -Lemma wmsb_1_natToWord: forall sz n default, - pow2 sz <= n < 2 * pow2 sz -> - @wmsb (S sz) (natToWord (S sz) n) default = true. -Proof. - intros. apply wmsb_1. - rewrite wordToNat_natToWord_idempotent'; simpl; lia. -Qed. - -Lemma wordToN_wzero': - forall sz, wordToN (wzero' sz) = 0%N. -Proof. - induction sz; simpl; auto. - rewrite IHsz; auto. -Qed. - -Lemma wordToZ_wzero': - forall sz, wordToZ (wzero' sz) = 0%Z. -Proof. - unfold wordToZ; intros. - rewrite wmsb_wzero'. - rewrite wordToN_wzero'. - reflexivity. -Qed. - -Lemma wordToZ_wzero: - forall sz, wordToZ (wzero sz) = 0%Z. -Proof. - unfold wordToZ; intros. - rewrite wmsb_wzero. - rewrite wordToN_wzero. - reflexivity. -Qed. - -Lemma wmsb_existT: (* Note: not axiom free *) - forall sz1 (w1: word sz1) sz2 (w2: word sz2), - existT word _ w1 = existT word _ w2 -> - forall b, wmsb w1 b = wmsb w2 b. -Proof. - intros. - assert (sz1 = sz2) by (apply eq_sigT_fst in H; auto); subst. - destruct_existT; reflexivity. -Qed. - -Lemma destruct_word_S: forall sz (w: word (S sz)), - exists v b, w = WS b v. -Proof. - intros. - refine (match w with - | WO => _ - | WS b v => _ - end); unfold IDProp; eauto. -Qed. - -Lemma induct_word_S: forall (P : forall n : nat, word (S n) -> Prop), - (forall b, P 0 (WS b WO)) -> - (forall b b0 n (w : word n), P n (WS b0 w) -> P (S n) (WS b (WS b0 w))) -> - forall (n : nat) (w : word (S n)), P n w. -Proof. - induction n; intros. - - destruct (destruct_word_S w) as [v [b E]]. subst w. - rewrite (word0 v). - apply H. - - destruct (destruct_word_S w) as [v [b E]]. subst w. - destruct (destruct_word_S v) as [w [b0 E]]. subst v. - apply H0. - apply IHn. -Qed. - -Lemma wmsb_eq_rect: - forall sz1 (w: word sz1) sz2 (Hsz: sz1 = sz2) b, - wmsb w b = wmsb (eq_rect _ word w _ Hsz) b. -Proof. - intros. - apply wmsb_existT. - apply eq_sym, existT_eq_rect. -Qed. - -Lemma wmsb_ws: - forall sz (w: word (S sz)) b a, wmsb (WS b w) a = wmsb w a. -Proof. - intros; cbn. - dependent destruction w. - reflexivity. -Qed. - -Lemma wmsb_extz: - forall sz (w: word sz) n, - wmsb (extz w n) false = wmsb w false. -Proof. - induction n; intros; auto. -Qed. - -Lemma wmsb_default: - forall sz (w: word sz) b1 b2, - sz <> 0 -> wmsb w b1 = wmsb w b2. -Proof. - dependent induction w; intros; intuition. -Qed. - -Lemma wmsb_split2: - forall sz (w: word (sz + 1)) b, - wmsb w b = if weq (split2 _ 1 w) (natToWord _ 0) then false else true. -Proof. - dependent destruction w; intros; [lia|]. - assert (sz = n) by lia; subst; clear x0. - - move w at top. - dependent induction w. - - cbn in *. - do 2 dependent destruction w0. - destruct b0; cbn; reflexivity. - - simpl in w0. - dependent destruction w0. - specialize (IHw b w0). - - cbn; cbn in IHw. - apply IHw; clear -x. - remember (WS b w) as ww; clear Heqww. - generalize dependent w0. - simpl; replace (n + 1) with (S n) by lia. - intros. - inversion x; subst; destruct_existT. - inversion H0; subst; destruct_existT. - reflexivity. -Qed. - -Lemma wmsb_true_split2_wones: - forall sz (w: word (sz + 1)) b, - wmsb w b = true -> - wones 1 = split2 sz 1 w. -Proof. - intros. - pose proof (wmsb_split2 _ w b). - destruct (weq _ _). - - rewrite H in H0; discriminate. - - clear -n. - remember (split2 sz 1 w) as ww; clear Heqww w. - do 2 dependent destruction ww. - destruct b; intuition. -Qed. - -Lemma wmsb_false_split2_wzero: - forall sz (w: word (sz + 1)) b, - wmsb w b = false -> - wzero 1 = split2 sz 1 w. -Proof. - intros. - pose proof (wmsb_split2 _ w b). - destruct (weq _ _); auto. - rewrite H in H0; discriminate. -Qed. - -Lemma wmsb_split1_sext: - forall sz (w: word (sz + 1)), - wmsb w false = wmsb (split1 _ 1 w) false -> - exists sw, sext sw 1 = w. -Proof. - unfold sext; intros. - pose proof (combine_split _ _ w) as Hw. - rewrite <-Hw; rewrite <-Hw in H at 2; clear Hw. - rewrite split1_combine in H. - exists (split1 sz 1 w). - destruct (wmsb (split1 sz 1 w) false). - - rewrite <-wmsb_true_split2_wones with (b:= false) by assumption. - reflexivity. - - rewrite <-wmsb_false_split2_wzero with (b:= false) by assumption. - reflexivity. -Qed. - -Lemma wmsb_combine_WO: - forall sz (w: word sz) b, - wmsb (combine w WO) b = wmsb w b. -Proof. - dependent induction w; cbn; intros; auto. -Qed. - -Lemma wmsb_combine: - forall sz1 sz2 (w1: word sz1) (w2: word sz2) b1 b2, - sz2 <> 0 -> - wmsb (combine w1 w2) b1 = wmsb w2 b2. -Proof. - dependent induction w1; cbn; intros. - - auto using wmsb_default. - - auto using IHw1. -Qed. - -Lemma wmsb_combine_existT: - forall sz (w: word sz) sz1 (w1: word sz1) sz2 (w2: word sz2) b1 b2, - sz2 <> 0 -> - existT word _ w = existT word _ (combine w1 w2) -> - wmsb w b1 = wmsb w2 b2. -Proof. - intros. - pose proof (eq_sigT_fst H0); subst. - destruct_existT. - auto using wmsb_combine. -Qed. - -Lemma wmsb_zext: - forall sz (w: word sz) b n, n <> 0 -> wmsb (zext w n) b = false. -Proof. - destruct n; cbn; intros; [elim H; reflexivity|]. - unfold zext. - erewrite wmsb_combine with (b2:= false) by discriminate. - apply wmsb_wzero. -Qed. - -Lemma wordToN_zext: - forall sz (w: word sz) n, - wordToN (zext w n) = wordToN w. -Proof. - dependent induction w; cbn; intros. - - induction n; cbn; intros; [reflexivity|]. - unfold wzero in IHn; rewrite IHn; reflexivity. - - rewrite IHw; reflexivity. -Qed. - -Lemma wordToNat_zext: - forall sz (w: word sz) n, - wordToNat (zext w n) = wordToNat w. -Proof. - dependent induction w; cbn; intros. - - induction n; cbn; intros; [reflexivity|]. - unfold wzero in IHn; rewrite IHn; reflexivity. - - rewrite IHw; reflexivity. -Qed. - -Lemma zext_wordToNat_equal_Z: - forall sz (w: word sz) n, - n <> 0 -> wordToZ (zext w n) = Z.of_nat (wordToNat w). -Proof. - unfold wordToZ, zext; intros. - rewrite wmsb_combine with (b2:= false) by assumption. - rewrite wmsb_wzero. - replace (combine w (wzero n)) with (zext w n) by reflexivity. - rewrite wordToN_zext. - rewrite wordToN_nat. - rewrite <-nat_N_Z. - unfold Z.of_N; reflexivity. -Qed. - -Lemma wordToN_WS_0: - forall sz (w: word sz), wordToN w~0 = (2 * wordToN w)%N. -Proof. reflexivity. Qed. - -Lemma wordToN_WS_1: - forall sz (w: word sz), wordToN w~1 = (2 * wordToN w + 1)%N. -Proof. - intros; cbn. - unfold N.succ_double. - destruct (wordToN w); reflexivity. -Qed. - -Lemma NToWord_WS_0: - forall sz n, NToWord (S sz) (2 * n) = (NToWord sz n)~0. -Proof. - destruct n; intros; [reflexivity|]. - replace (2 * N.pos p)%N with (N.pos (p~0)) by reflexivity. - reflexivity. -Qed. - -Lemma NToWord_WS_1: - forall sz n, NToWord (S sz) (2 * n + 1) = (NToWord sz n)~1. -Proof. - destruct n; intros; [reflexivity|]. - replace (2 * N.pos p)%N with (N.pos (p~0)) by reflexivity. - reflexivity. -Qed. - -Lemma wneg_WS_0: - forall sz (w: word sz), wneg w~0 = (wneg w)~0. -Proof. - unfold wneg; intros. - rewrite wordToN_WS_0. - replace (Npow2 (S sz)) with (2 * Npow2 sz)%N by reflexivity. - rewrite <-N.mul_sub_distr_l. - apply NToWord_WS_0. -Qed. - -Lemma NToWord_wordToN: - forall sz (w: word sz), NToWord sz (wordToN w) = w. -Proof. - intros. - rewrite wordToN_nat, NToWord_nat. - rewrite Nat2N.id. - apply natToWord_wordToNat. -Qed. - -Lemma roundTripN_0: - forall sz, wordToN (NToWord sz 0) = 0%N. -Proof. - intros. - rewrite wordToN_nat, NToWord_nat. - rewrite roundTrip_0; reflexivity. -Qed. - -Lemma wordToN_NToWord: - forall sz n, - exists k, wordToN (NToWord sz n) = (n - k * Npow2 sz)%N /\ (k * Npow2 sz <= n)%N. -Proof. - intros. - rewrite wordToN_nat, NToWord_nat. - pose proof (wordToNat_natToWord sz (N.to_nat n)). - destruct H as [k [? ?]]. - exists (N.of_nat k). - split. - - apply N2Nat.inj. - rewrite Nat2N.id, N2Nat.inj_sub, N2Nat.inj_mul. - rewrite Nat2N.id. - rewrite Npow2_nat. - assumption. - - rewrite nat_compare_le, Nat2N.inj_compare in H0. - rewrite Nat2N.inj_mul, <-Npow2_nat in H0. - do 2 rewrite N2Nat.id in H0. - assumption. -Qed. - -Lemma wordToN_NToWord_2: - forall sz n, (n < Npow2 sz)%N -> wordToN (NToWord sz n) = n. -Proof. - intros. - rewrite wordToN_nat, NToWord_nat. - rewrite wordToNat_natToWord_2. - - apply N2Nat.id. - - rewrite <-Npow2_nat. - apply Nlt_out; auto. -Qed. - -Lemma wordToN_bound: - forall sz (w: word sz), (wordToN w < Npow2 sz)%N. -Proof. - intros. - rewrite wordToN_nat. - apply Nlt_in. - rewrite Npow2_nat, Nat2N.id. - apply wordToNat_bound. -Qed. - -Lemma wordToN_plus: forall sz (a b: word sz), - (wordToN a + wordToN b < Npow2 sz)%N -> - wordToN (a ^+ b) = (wordToN a + wordToN b)%N. -Proof. - intros. unfold wplus, wordBin. - rewrite wordToN_NToWord_2 by assumption. - reflexivity. -Qed. - -Lemma wordToN_mult: forall sz (a b: word sz), - (wordToN a * wordToN b < Npow2 sz)%N -> - wordToN (a ^* b) = (wordToN a * wordToN b)%N. -Proof. - intros. unfold wmult, wordBin. - rewrite wordToN_NToWord_2 by assumption. - reflexivity. -Qed. - -Lemma wnot_def: - forall sz (w: word sz), wnot w = NToWord sz (Npow2 sz - wordToN w - 1). -Proof. - dependent induction w; cbn; [reflexivity|]. - destruct b; cbn. - - rewrite IHw; clear IHw. - rewrite <-NToWord_WS_0. - f_equal. - destruct (Npow2 n); [reflexivity|]. - destruct (wordToN w). - + change (N.pos p~0) with (2 * N.pos p)%N. - do 2 rewrite N.mul_sub_distr_l. - do 2 rewrite <-N.sub_add_distr. - reflexivity. - + change (N.pos p~0) with (2 * N.pos p)%N. - change (N.pos p0~0) with (2 * N.pos p0)%N. - rewrite <-N.add_1_l. - do 2 rewrite N.mul_sub_distr_l. - do 2 rewrite <-N.sub_add_distr. - rewrite N.add_comm with (n:= 1%N). - rewrite <-N.add_assoc. - reflexivity. - - rewrite IHw; clear IHw. - rewrite <-NToWord_WS_1. - f_equal. - pose proof (wordToN_bound w). - remember (Npow2 n) as pn; destruct pn; - [exfalso; eapply Npow2_not_zero; eauto|clear Heqpn]. - destruct (wordToN w). - + change (N.pos p~0) with (2 * N.pos p)%N. - do 2 rewrite N.mul_sub_distr_l. - do 2 rewrite <-N.sub_add_distr. - destruct p; cbn; reflexivity. - + change (N.pos p~0) with (2 * N.pos p)%N. - change (N.pos p0~0) with (2 * N.pos p0)%N. - rewrite N.mul_sub_distr_l. - rewrite <-N.mul_sub_distr_l with (n:= N.pos p). - assert (exists pp, N.pos p - N.pos p0 = N.pos pp)%N. - { apply N.sub_gt in H. - destruct (N.pos p - N.pos p0)%N; [intuition idtac|]. - eexists; reflexivity. - } - destruct H0; rewrite H0. - destruct x; cbn; reflexivity. -Qed. - -Lemma wneg_wnot: - forall sz (w: word sz), wnot w = wneg w ^- (natToWord _ 1). -Proof. - unfold wneg; intros. - rewrite wnot_def. - - destruct (weq w (wzero _)); subst. - - - rewrite wordToN_nat. - unfold wzero; rewrite roundTrip_0; cbn. - rewrite N.sub_0_r. - do 2 rewrite NToWord_nat. - rewrite Npow2_nat, natToWord_pow2, N2Nat.inj_sub. - change (N.to_nat 1%N) with 1. - rewrite Npow2_nat. - apply wordToNat_inj. - rewrite wordToNat_natToWord_2 by (pose proof (zero_lt_pow2 sz); lia). - unfold wminus. - rewrite wplus_unit, <-wones_wneg_one. - apply eq_sym, wones_pow2_minus_one. - - - pose proof (wordToN_bound w). - assert (Npow2 sz - wordToN w < Npow2 sz)%N. - { apply N.sub_lt. - { apply N.lt_le_incl; auto. } - { assert (wordToN w <> 0)%N. - { replace 0%N with (wordToN (wzero sz)). - { intro Hx; elim n. - apply wordToN_inj; auto. - } - { rewrite wordToN_nat. - unfold wzero; rewrite roundTrip_0; reflexivity. - } - } - nlia. - } - } - apply N.sub_gt in H. - remember (Npow2 sz - wordToN w)%N as p; clear Heqp. - do 2 rewrite NToWord_nat. - rewrite N2Nat.inj_sub. - change (N.to_nat 1%N) with 1. - assert (N.to_nat p < pow2 sz)%nat - by (rewrite <-Npow2_nat; apply Nlt_out; auto); clear H0. - assert (N.to_nat p <> 0) - by (change 0 with (N.to_nat 0%N); intro Hx; elim H; apply N2Nat.inj; auto); clear H. - apply wordToNat_inj. - rewrite <-wordToNat_natToWord_pred. - + do 2 rewrite wordToNat_natToWord_2 by lia. - lia. - + intro Hx; elim H0. - apply natToWord_inj with (sz:= sz); try lia. - assumption. -Qed. - -Lemma wzero_wneg: - forall n, wneg (wzero n) = wzero n. -Proof. - intros. - pose proof (wminus_inv (wzero n)). - rewrite wplus_unit in H; auto. -Qed. - -Lemma pow2_wneg: - forall sz, wneg (natToWord (S sz) (pow2 sz)) = natToWord (S sz) (pow2 sz). -Proof. - unfold wneg; intros. - rewrite <-Npow2_nat, <-NToWord_nat. - rewrite wordToN_NToWord_2 - by (apply Nlt_in; do 2 rewrite Npow2_nat; - pose proof (zero_lt_pow2 sz); simpl; lia). - rewrite Npow2_S. - f_equal; nlia. -Qed. - -Lemma wneg_WS_1: - forall sz (w: word sz), wneg w~1 = (wnot w)~1. -Proof. - intros. - apply wordToN_inj. - simpl; rewrite wnot_def. - unfold wneg. - rewrite wordToN_NToWord_2 - by (apply N.sub_lt; [apply N.lt_le_incl, wordToN_bound|nlia]). - rewrite wordToN_NToWord_2. - - rewrite wordToN_WS_1. - change (Npow2 (S sz)) with (2 * Npow2 sz)%N. - rewrite N.sub_add_distr. - rewrite <-N.mul_sub_distr_l. - assert (Npow2 sz - wordToN w <> 0)%N - by (pose proof (wordToN_bound w); nlia). - remember (Npow2 sz - wordToN w)%N as n; clear Heqn. - destruct n; [intuition idtac|]. - remember (N.pos p - 1)%N as pp; destruct pp. - + apply eq_sym, N.sub_0_le in Heqpp. - apply N.le_1_r in Heqpp; destruct Heqpp; [discriminate|]. - rewrite H0; reflexivity. - + change (N.pos p0~0) with (2 * N.pos p0)%N. - rewrite Heqpp. - rewrite <-N.add_1_r. - rewrite N.mul_sub_distr_l. - clear; destruct p; cbn; reflexivity. - - rewrite <-N.sub_add_distr. - apply N.sub_lt; [|nlia]. - pose proof (wordToN_bound w). - apply N.le_succ_l in H. - rewrite N.add_1_r; assumption. -Qed. - -Lemma wordToZ_WS_0: - forall sz (w: word sz), wordToZ w~0 = (2 * wordToZ w)%Z. -Proof. - dependent destruction w; [reflexivity|]. - unfold wordToZ. - rewrite wmsb_ws. - destruct (wmsb (WS b w) false). - - rewrite wneg_WS_0. - rewrite wordToN_WS_0. - destruct (wordToN (wneg (WS b w))); cbn; lia. - - rewrite wordToN_WS_0. - destruct (wordToN (WS b w)); cbn; lia. -Qed. - -Lemma wordToZ_WS_1: - forall sz (w: word (S sz)), wordToZ w~1 = (2 * wordToZ w + 1)%Z. -Proof. - dependent destruction w. - unfold wordToZ. - rewrite wmsb_ws. - remember (wmsb (WS b w) false) as msb. - destruct msb. - - rewrite wneg_WS_1. - rewrite wordToN_WS_1. - rewrite wnot_def. - unfold wneg. - - assert (Npow2 (S sz) - wordToN (WS b w) <> 0)%N. - { pose proof (wordToN_bound (WS b w)); nlia. } - assert (Npow2 (S sz) - wordToN (WS b w) < Npow2 (S sz))%N. - { apply N.sub_lt. - { apply N.lt_le_incl, wordToN_bound. } - { assert (wordToN (WS b w) <> 0)%N. - { replace 0%N with (wordToN (wzero (S sz))). - { intro Hx. - apply wordToN_inj in Hx. - rewrite Hx in Heqmsb. - rewrite wmsb_wzero in Heqmsb; discriminate. - } - { rewrite wordToN_nat. - unfold wzero; rewrite roundTrip_0; reflexivity. - } - } - nlia. - } - } - remember (Npow2 (S sz) - wordToN (WS b w))%N as n; clear Heqn. - - rewrite wordToN_NToWord_2 by nlia. - rewrite wordToN_NToWord_2 by nlia. - destruct n; [intuition idtac|]. - destruct p; cbn; reflexivity. - - - rewrite wordToN_WS_1. - destruct (wordToN (WS b w)); cbn; lia. -Qed. - -Lemma wordToZ_WS_1': - forall sz (w: word (sz + 1)), wordToZ w~1 = (2 * wordToZ w + 1)%Z. -Proof. - intro sz. - replace (sz + 1) with (S sz) by lia. - intros. - apply wordToZ_WS_1. -Qed. - -Lemma wordToZ_inj: - forall sz (w1 w2: word sz), - wordToZ w1 = wordToZ w2 -> w1 = w2. -Proof. - unfold wordToZ; intros. - remember (wmsb w1 false) as msb1. - remember (wmsb w2 false) as msb2. - destruct msb1, msb2. - - remember (wordToN (wneg w1)) as wn1. - remember (wordToN (wneg w2)) as wn2. - destruct wn1, wn2; try discriminate. - + assert (wneg w1 = wneg w2). - { apply wordToN_inj. - rewrite <-Heqwn1, <-Heqwn2; reflexivity. - } - rewrite <-wneg_idempotent with (w:= w1). - rewrite <-wneg_idempotent with (w:= w2). - rewrite H0; reflexivity. - + inversion H; subst; clear H. - assert (wneg w1 = wneg w2). - { apply wordToN_inj. - rewrite <-Heqwn1, <-Heqwn2; reflexivity. - } - rewrite <-wneg_idempotent with (w:= w1). - rewrite <-wneg_idempotent with (w:= w2). - rewrite H; reflexivity. - - remember (wordToN (wneg w1)) as wn1. - remember (wordToN w2) as wn2. - destruct wn1, wn2; try discriminate. - rewrite <-wordToN_wzero with (sz:= sz) in Heqwn1, Heqwn2. - apply wordToN_inj in Heqwn1. - apply wordToN_inj in Heqwn2. - assert (w1 = wzero sz). - { rewrite <-wneg_idempotent with (w:= w1), <-Heqwn1. - apply wzero_wneg. - } - subst; reflexivity. - - remember (wordToN w1) as wn1. - remember (wordToN (wneg w2)) as wn2. - destruct wn1, wn2; try discriminate. - rewrite <-wordToN_wzero with (sz:= sz) in Heqwn1, Heqwn2. - apply wordToN_inj in Heqwn1. - apply wordToN_inj in Heqwn2. - assert (w2 = wzero sz). - { rewrite <-wneg_idempotent with (w:= w2), <-Heqwn2. - apply wzero_wneg. - } - subst; reflexivity. - - remember (wordToN w1) as wn1. - remember (wordToN w2) as wn2. - destruct wn1, wn2; try discriminate. - + rewrite <-wordToN_wzero with (sz:= sz) in Heqwn1, Heqwn2. - rewrite Heqwn1 in Heqwn2. - apply wordToN_inj in Heqwn2; auto. - + inversion H; subst; clear H. - rewrite Heqwn1 in Heqwn2. - apply wordToN_inj in Heqwn2; auto. -Qed. - -Lemma wordToZ_wones: - forall sz, sz <> 0 -> wordToZ (wones sz) = (-1)%Z. -Proof. - induction sz; intros; [elim H; reflexivity|]. - simpl; destruct sz; [reflexivity|]. - rewrite wordToZ_WS_1. - rewrite IHsz by discriminate. - reflexivity. -Qed. - -Lemma wordToNat_eq_rect: - forall sz (w: word sz) nsz Hsz, - wordToNat (eq_rect _ word w nsz Hsz) = wordToNat w. -Proof. - intros; subst; simpl; reflexivity. -Qed. - -Lemma wordToNat_existT: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) (Hsz: sz1 = sz2), - wordToNat w1 = wordToNat w2 -> - existT word _ w1 = existT word _ w2. -Proof. - intros; subst. - apply wordToNat_inj in H; subst. - reflexivity. -Qed. - -Lemma existT_wordToNat: - forall sz1 (w1: word sz1) sz2 (w2: word sz2), - existT word _ w1 = existT word _ w2 -> - wordToNat w1 = wordToNat w2. -Proof. - intros. - pose proof (eq_sigT_fst H); subst. - destruct_existT; reflexivity. -Qed. - -Lemma wordToZ_eq_rect: - forall sz (w: word sz) nsz Hsz, - wordToZ (eq_rect _ word w nsz Hsz) = wordToZ w. -Proof. - intros; subst; simpl; reflexivity. -Qed. - -Lemma wordToZ_existT: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) (Hsz: sz1 = sz2), - wordToZ w1 = wordToZ w2 -> - existT word _ w1 = existT word _ w2. -Proof. - intros; subst. - apply wordToZ_inj in H; subst. - reflexivity. -Qed. - -Lemma existT_wordToZ: - forall sz1 (w1: word sz1) sz2 (w2: word sz2), - existT word _ w1 = existT word _ w2 -> - wordToZ w1 = wordToZ w2. -Proof. - intros. - pose proof (eq_sigT_fst H); subst. - destruct_existT. - reflexivity. -Qed. - -Lemma wplus_WS_0: - forall sz (w1 w2: word sz) b, WS b (w1 ^+ w2) = WS b w1 ^+ w2~0. -Proof. - intros. - unfold wplus, wordBin; intros. - rewrite wordToN_WS_0. - destruct b. - - rewrite wordToN_WS_1. - rewrite <-N.add_assoc. - rewrite N.add_comm with (n:= 1%N). - rewrite N.add_assoc. - rewrite <-N.mul_add_distr_l. - apply eq_sym, NToWord_WS_1. - - rewrite wordToN_WS_0. - rewrite <-N.mul_add_distr_l. - apply eq_sym, NToWord_WS_0. -Qed. - -Corollary wplus_WS_0': - forall sz (w1 w2: word sz) b, WS b (w1 ^+ w2) = w1~0 ^+ WS b w2. -Proof. - intros. - rewrite wplus_comm with (x:= w1). - rewrite wplus_comm with (x:= w1~0). - apply wplus_WS_0. -Qed. - -Lemma wpow2_pow2: - forall sz, wordToNat (wpow2 sz) = pow2 sz. -Proof. - induction sz; simpl; intros; [reflexivity|]. - rewrite IHsz. - lia. -Qed. - -Lemma wpow2_Npow2: - forall sz, wordToN (wpow2 sz) = Npow2 sz. -Proof. - induction sz; simpl; intros; [reflexivity|]. - rewrite IHsz; reflexivity. -Qed. - -Lemma wpow2_wneg: - forall sz, wneg (wpow2 sz) = wpow2 sz. -Proof. - induction sz; simpl; intros; [reflexivity|]. - rewrite wneg_WS_0. - rewrite IHsz; reflexivity. -Qed. - -Lemma wpow2_wmsb: - forall sz, wmsb (wpow2 sz) false = true. -Proof. - induction sz; simpl; intros; auto. -Qed. - -Lemma wmsb_wnot: - forall sz (w: word (S sz)) b1 b2, - wmsb (wnot w) b1 = negb (wmsb w b2). -Proof. - dependent destruction w; intros. - simpl; move w at bottom; move b at bottom. - dependent induction w; simpl; auto. -Qed. - -Lemma wmsb_wneg_true: - forall sz (w: word (S sz)), - w <> wpow2 sz -> - forall b1 b2, - wmsb w b1 = true -> - wmsb (wneg w) b2 = false. -Proof. - dependent destruction w. - dependent induction w; intros; - [simpl in *; subst; elim H; reflexivity|]. - - destruct b. - - rewrite wneg_WS_1. - rewrite wmsb_ws. - rewrite wmsb_wnot with (b2:= false). - simpl; apply negb_false_iff; assumption. - - rewrite wneg_WS_0. - destruct b0; simpl. - + rewrite wneg_WS_1; simpl. - dependent destruction w. - * elim H; reflexivity. - * simpl in H0. - rewrite wmsb_wnot with (b2:= false). - simpl; apply negb_false_iff; assumption. - + eapply IHw with (b1:= false); eauto. - intro Hx; elim H. - clear -Hx. - simpl; rewrite Hx; reflexivity. -Qed. - -Lemma wmsb_wneg_false: - forall sz (w: word (S sz)), - wordToNat w <> 0 -> - forall b1 b2, - wmsb w b1 = false -> - wmsb (wneg w) b2 = true. -Proof. - dependent destruction w. - dependent induction w; intros; - [simpl in *; subst; elim H; reflexivity|]. - - destruct b. - - rewrite wneg_WS_1. - rewrite wmsb_ws. - rewrite wmsb_ws in H0. - rewrite wmsb_wnot with (b2:= false). - apply negb_true_iff; assumption. - - rewrite wneg_WS_0. - destruct b0; simpl. - + rewrite wneg_WS_1; simpl. - dependent destruction w. - * discriminate. - * simpl in H0. - rewrite wmsb_wnot with (b2:= false). - simpl; apply negb_true_iff; assumption. - + eapply IHw with (b1:= false); eauto. - intro Hx; elim H. - clear -Hx. - simpl in *; lia. -Qed. - -Lemma zext_WO_wzero: - forall n, zext WO n = wzero n. -Proof. - reflexivity. -Qed. - -Lemma wmsb_wneg_zext: - forall sz (w: word sz) b n, - n <> 0 -> wordToNat w <> 0 -> - wmsb (wneg (zext w n)) b = true. -Proof. - intros. - dependent destruction w; [elim H0; reflexivity|]. - apply wmsb_wneg_false with (b1:= false). - - rewrite <-wordToNat_zext with (n:= n0) in H0. - assumption. - - apply wmsb_zext; assumption. -Qed. - -Lemma wminus_WS_pos: - forall sz (w1 w2: word (S sz)), - wordToZ (WS true w1 ^- WS false w2) = - (2 * wordToZ (w1 ^- w2) + 1)%Z. -Proof. - unfold wminus; intros. - cbn. - rewrite wneg_WS_0. - rewrite <-wplus_WS_0. - rewrite wordToZ_WS_1. - reflexivity. -Qed. - -Lemma wminus_WS_pos': - forall sz (w1 w2: word (sz + 1)), - wordToZ (WS true w1 ^- WS false w2) = - (2 * wordToZ (w1 ^- w2) + 1)%Z. -Proof. - intro sz. - replace (sz + 1) with (S sz) by lia. - intros. - apply wminus_WS_pos. -Qed. - -Lemma wtl_combine: - forall (x: word 1) sz (y: word sz), - wtl (combine x y) = y. -Proof. - intros. - do 2 dependent destruction x. - reflexivity. -Qed. - -Lemma extz_combine: - forall sz (w: word sz) n, extz w n = combine (natToWord n 0) w. -Proof. - reflexivity. -Qed. - -Lemma combine_assoc_existT: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) sz3 (w3: word sz3), - existT word (sz1 + (sz2 + sz3)) (combine w1 (combine w2 w3)) = - existT word (sz1 + sz2 + sz3) (combine (combine w1 w2) w3). -Proof. - intros; apply EqdepFacts.eq_sigT_sig_eq. - assert (Hsz: sz1 + (sz2 + sz3) = sz1 + sz2 + sz3) by lia. - exists Hsz. - rewrite (combine_assoc w1 w2 w3 Hsz). - reflexivity. -Qed. - -Lemma sext_combine: - forall sz n (w: word (sz + n)) sz1 (w1: word sz1) - sz2 (Hsz2: sz2 <> 0) (w2: word sz2), - existT word _ w = existT word _ (combine w1 (sext w2 n)) -> - exists sw, w = sext sw n /\ existT word _ sw = existT word _ (combine w1 w2). -Proof. - intros; unfold sext in H. - remember (wmsb w2 false) as msb2; destruct msb2. - - rewrite combine_assoc_existT in H. - assert (sz = sz1 + sz2) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - exists (combine w1 w2). - split; [|reflexivity]. - unfold sext. - dependent destruction w2; [discriminate|]. - rewrite wmsb_combine with (b2:= false) by discriminate. - rewrite <-Heqmsb2. - reflexivity. - - rewrite combine_assoc_existT in H. - assert (sz = sz1 + sz2) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - exists (combine w1 w2). - split; [|reflexivity]. - unfold sext. - dependent destruction w2; [intuition idtac|]. - rewrite wmsb_combine with (b2:= false) by discriminate. - rewrite <-Heqmsb2. - reflexivity. -Qed. - -Lemma wplus_wzero_1: - forall sz (w: word sz), w ^+ (wzero _) = w. -Proof. - unfold wplus, wordBin; intros. - rewrite wordToN_wzero. - rewrite N.add_0_r. - apply NToWord_wordToN. -Qed. - -Lemma wplus_wzero_2: - forall sz (w: word sz), (wzero _) ^+ w = w. -Proof. - unfold wplus, wordBin; intros. - rewrite wordToN_wzero. - rewrite N.add_0_l. - apply NToWord_wordToN. -Qed. - -Lemma combine_wplus_1: - forall sl (w1: word sl) su (w2 w3: word su), - combine w1 (w2 ^+ w3) = combine w1 w2 ^+ extz w3 sl. -Proof. - dependent induction w1; intros; [reflexivity|]. - cbn; rewrite IHw1. - rewrite <-wplus_WS_0. - rewrite extz_combine; reflexivity. -Qed. - -Lemma combine_wplus_2: - forall sl (w1: word sl) su (w2 w3: word su), - combine w1 (w2 ^+ w3) = extz w2 sl ^+ combine w1 w3. -Proof. - intros. - rewrite wplus_comm. - rewrite combine_wplus_1. - apply wplus_comm. -Qed. - -Lemma existT_wplus: - forall sz (w1 w2: word sz) sz' (w3 w4: word sz'), - existT word _ w1 = existT word _ w3 -> - existT word _ w2 = existT word _ w4 -> - existT word _ (w1 ^+ w2) = existT word _ (w3 ^+ w4). -Proof. - intros. - rewrite eq_sigT_sig_eq in H; destruct H as [Hsz1 ?]. - rewrite eq_sigT_sig_eq in H0; destruct H0 as [Hsz2 ?]. - subst; do 2 rewrite <-(eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. - -Lemma existT_wminus: - forall sz (w1 w2: word sz) sz' (w3 w4: word sz'), - existT word _ w1 = existT word _ w3 -> - existT word _ w2 = existT word _ w4 -> - existT word _ (w1 ^- w2) = existT word _ (w3 ^- w4). -Proof. - intros. - rewrite eq_sigT_sig_eq in H; destruct H as [Hsz1 ?]. - rewrite eq_sigT_sig_eq in H0; destruct H0 as [Hsz2 ?]. - subst; do 2 rewrite <-(eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. - - -Lemma existT_sext: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) n, - existT word _ w1 = existT word _ w2 -> - existT word _ (sext w1 n) = existT word _ (sext w2 n). -Proof. - intros; inversion H; reflexivity. -Qed. - -Lemma existT_extz: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) n, - existT word _ w1 = existT word _ w2 -> - existT word _ (extz w1 n) = existT word _ (extz w2 n). -Proof. - intros; inversion H; reflexivity. -Qed. - -Lemma existT_wrshifta: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) n, - existT word _ w1 = existT word _ w2 -> - existT word _ (wrshifta w1 n) = existT word _ (wrshifta w2 n). -Proof. - intros; inversion H; reflexivity. -Qed. - -Lemma existT_wlshift: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) n, - existT word _ w1 = existT word _ w2 -> - existT word _ (wlshift w1 n) = existT word _ (wlshift w2 n). -Proof. - intros; inversion H; reflexivity. -Qed. - -Lemma eq_rect_wplus: - forall sz (w1 w2: word sz) sz' Hsz, - eq_rect sz word (w1 ^+ w2) sz' Hsz = - (eq_rect sz word w1 sz' Hsz) ^+ (eq_rect sz word w2 sz' Hsz). -Proof. - intros; subst. - eq_rect_simpl; reflexivity. -Qed. - -Lemma eq_rect_2: - forall sz (pa: word sz) sz' Heq1 Heq2, - eq_rect sz' word (eq_rect sz word pa sz' Heq1) sz Heq2 = pa. -Proof. - intros; subst. - do 2 rewrite <-(eq_rect_eq_dec Nat.eq_dec). - reflexivity. -Qed. - -Lemma wzero_eq_rect: - forall sz1 sz2 Heq, - eq_rect sz1 word (wzero sz1) sz2 Heq = wzero sz2. -Proof. - intros; subst. - apply eq_sym, (eq_rect_eq_dec Nat.eq_dec). -Qed. - -Lemma wrshifta_0: - forall sz (w: word sz), wrshifta w 0 = w. -Proof. - unfold wrshifta; intros; simpl. - eq_rect_simpl. - unfold sext. - destruct (wmsb w false). - - cbn; rewrite combine_n_0. - rewrite eq_rect_2; reflexivity. - - cbn; rewrite combine_n_0. - rewrite eq_rect_2; reflexivity. -Qed. - -Lemma wrshifta_WO: - forall n, wrshifta WO n = WO. -Proof. - unfold wrshifta; cbn; intros. - eq_rect_simpl. - rewrite wzero_eq_rect. - rewrite <-combine_wzero. - rewrite split2_combine. - reflexivity. -Qed. - -Lemma split2_WO: - forall n w, split2 n 0 w = WO. -Proof. - induction n; cbn; intros; auto. -Qed. - -Lemma sext_wzero: - forall sz n, sext (wzero sz) n = wzero (sz + n). -Proof. - unfold sext; intros. - rewrite wmsb_wzero. - apply combine_wzero. -Qed. - -Lemma wrshifta_wzero: - forall sz n, wrshifta (wzero sz) n = wzero _. -Proof. - intros. - unfold wrshifta; cbn. - rewrite sext_wzero. - eq_rect_simpl. - rewrite wzero_eq_rect. - rewrite <-combine_wzero. - rewrite split2_combine. - reflexivity. -Qed. - -Lemma extz_sext: - forall sz (w: word sz) n1 n2, - existT word _ (extz (sext w n1) n2) = - existT word _ (sext (extz w n2) n1). -Proof. - dependent destruction w; cbn; intros. - - unfold wzero, extz, sext. - rewrite combine_wzero. - rewrite combine_wzero. - rewrite wmsb_wzero. - rewrite combine_wzero. - replace (n2 + 0 + n1) with (n2 + n1) by lia. - reflexivity. - - unfold wzero, extz, sext. - rewrite wmsb_combine with (b2:= false) by discriminate. - destruct (wmsb (WS b w) false); - try (rewrite <-combine_assoc_existT; reflexivity). -Qed. - -Lemma sext_WS: - forall sz (w: word (S sz)) b n, - sext (WS b w) n = WS b (sext w n). -Proof. - unfold sext; intros. - rewrite wmsb_ws. - destruct (wmsb w false); reflexivity. -Qed. - -Lemma sext_wordToZ: - forall sz n (w: word sz), - wordToZ (sext w n) = wordToZ w. -Proof. - dependent induction w; cbn; intros; [apply wordToZ_wzero|]. - dependent destruction w. - - unfold sext; simpl. - destruct b; cbn. - + rewrite wordToZ_wones by discriminate. - reflexivity. - + rewrite wordToZ_wzero; reflexivity. - - remember (WS b0 w) as ww; clear Heqww. - rewrite sext_WS. - destruct b. - + change (S n0 + n) with (S (n0 + n)) in *. - repeat rewrite wordToZ_WS_1. - rewrite IHw. - reflexivity. - + change (S n0 + n) with (S (n0 + n)) in *. - repeat rewrite wordToZ_WS_0. - rewrite IHw. - reflexivity. -Qed. - -Lemma sext_natToWord': forall sz1 sz2 n, - (2 * n < pow2 sz1)%nat -> - sext (natToWord sz1 n) sz2 = natToWord (sz1 + sz2) n. -Proof. - induction sz1; intros. - - simpl. unfold sext. simpl. unfold wzero. unfold pow2 in *. - assert (n=0) by lia. subst n. reflexivity. - - unfold sext in *. - assert (@wmsb (S sz1) (natToWord (S sz1) n) false = false) as E by - (apply wmsb_0_natToWord; assumption). - rewrite E. clear E. - simpl. unfold natToWord. f_equal. fold natToWord. - specialize (IHsz1 sz2 (Nat.div2 n)). - rewrite <- IHsz1. - + assert (@wmsb sz1 (natToWord sz1 (Nat.div2 n)) false = false) as E. { - destruct sz1. - - reflexivity. - - apply wmsb_0_natToWord. unfold pow2 in *. fold pow2 in *. - assert ((2 * Nat.div2 n <= n)%nat) by apply two_times_div2_bound. lia. - } - rewrite E. clear E. reflexivity. - + replace (pow2 (S sz1)) with (2 * (pow2 sz1)) in H. - * assert ((2 * Nat.div2 n <= n)%nat) by apply two_times_div2_bound. lia. - * reflexivity. -Qed. - -Lemma sext_natToWord: forall sz2 sz1 sz n (e: sz1 + sz2 = sz), - (2 * n < pow2 sz1)%nat -> - eq_rect (sz1 + sz2) word (sext (natToWord sz1 n) sz2) sz e = natToWord sz n. -Proof. - intros. rewrite sext_natToWord' by assumption. rewrite e. reflexivity. -Qed. - -Lemma sext_wneg_natToWord'': forall sz1 sz2 n, - pow2 sz1 <= 2 * n < pow2 (S sz1) -> - sext (natToWord sz1 n) sz2 = natToWord (sz1 + sz2) (pow2 (sz1+sz2) - (pow2 sz1 - n)). -Proof. - induction sz1; intros. - - unfold pow2 in H. lia. (* contradiction *) - - unfold sext in *. - assert (@wmsb (S sz1) (natToWord (S sz1) n) false = true) as E. { - apply wmsb_1. - rewrite wordToNat_natToWord_idempotent'; - (unfold pow2 in *; fold pow2 in *; lia). - } - rewrite E. - match goal with - | |- _ = $ ?a => remember a as b - end. - simpl. unfold natToWord. f_equal. - + subst b. rewrite mod2sub. - * rewrite mod2sub. - { replace (S sz1 + sz2) with (S (sz1 + sz2)) by lia. - simpl. - do 2 rewrite mod2_pow2_twice. - do 2 rewrite Bool.xorb_false_l. - reflexivity. - } - simpl in *. lia. - * rewrite pow2_add_mul in *. unfold pow2 in *. fold pow2 in *. - apply Nat.le_trans with (m := 2 * pow2 sz1); [lia|]. - rewrite <- Nat.mul_assoc. - apply Nat.mul_le_mono_l. - rewrite <- Nat.mul_1_r at 1. - apply Nat.mul_le_mono_l. - apply one_le_pow2. - + fold natToWord. - specialize (IHsz1 sz2 (Nat.div2 n)). - assert (Nat.div2 b = pow2 (sz1 + sz2) - (pow2 sz1 - (Nat.div2 n))) as D2. { - rewrite minus_minus. - - subst b. replace (S sz1 + sz2) with (S (sz1 + sz2)) by lia. - unfold pow2. fold pow2. - rewrite minus_minus. - * rewrite <- Nat.mul_sub_distr_l. - rewrite <- (Nat.add_comm n). - rewrite div2_plus_2. - apply Nat.add_comm. - * rewrite pow2_add_mul. clear IHsz1. unfold pow2 in *. fold pow2 in *. - split; [lia|]. - apply Nat.mul_le_mono_l. - rewrite <- Nat.mul_1_r at 1. - apply Nat.mul_le_mono_l. - apply one_le_pow2. - - unfold pow2 in H. fold pow2 in H. - split. - * pose proof (@div2_compat_lt_l (pow2 sz1) n) as P. lia. - * rewrite pow2_add_mul. clear IHsz1. - rewrite <- Nat.mul_1_r at 1. - apply Nat.mul_le_mono_l. - apply one_le_pow2. - } - rewrite D2. - destruct sz1 as [|sz1']. - * simpl in H. assert (n=1) by lia. subst n. simpl in D2. simpl. - apply wones_natToWord. - * assert (n <= S (2 * Nat.div2 n))%nat. { - destruct (even_odd_destruct n) as [[m C]|[m C]]; subst n. - - rewrite Nat.div2_double. constructor. constructor. - - replace (2 * m + 1) with (S (2 * m)) by lia. rewrite Nat.div2_succ_double. - constructor. - } - rewrite <- IHsz1. - { assert (@wmsb (S sz1') (natToWord (S sz1') (Nat.div2 n)) false = true) as F. { - apply wmsb_1_natToWord. - unfold pow2 in *. fold pow2 in *. - assert (2 * Nat.div2 n <= n)%nat by apply two_times_div2_bound. - clear -H H0 H1. - lia. } - { rewrite F. reflexivity. } - } - { assert (2 * Nat.div2 n <= n)%nat by apply two_times_div2_bound. - clear -H H0 H1. - unfold pow2 in *. fold pow2 in *. - lia. } -Qed. - -Lemma sext_wneg_natToWord': forall sz1 sz2 n, - (2 * n < pow2 sz1)%nat -> - sext (wneg (natToWord sz1 n)) sz2 = wneg (natToWord (sz1 + sz2) n). -Proof. - intros. rewrite wneg_alt. unfold wnegN. - destruct n as [|n]. - - rewrite roundTrip_0. rewrite Nat.sub_0_r. rewrite natToWord_pow2. - unfold sext. - assert (wmsb (natToWord sz1 0) false = false) as W. { - destruct sz1. - + simpl. reflexivity. - + apply wmsb_0_natToWord. assumption. - } - rewrite W. - rewrite combine_wzero. - symmetry. - apply wneg_zero'. - - rewrite sext_wneg_natToWord''. - + rewrite wneg_alt. unfold wnegN. - rewrite wordToNat_natToWord_idempotent' by lia. - rewrite wordToNat_natToWord_idempotent'. - * replace (pow2 sz1 - (pow2 sz1 - S n)) with (S n) by lia. - reflexivity. - * rewrite pow2_add_mul. - apply Nat.le_trans with (m := pow2 sz1); [lia|]. - rewrite <- Nat.mul_1_r at 1. - apply Nat.mul_le_mono_l. - apply one_le_pow2. - + rewrite wordToNat_natToWord_idempotent' by lia. - simpl. lia. -Qed. - -Lemma sext_wneg_natToWord: forall sz2 sz1 sz n (e: sz1 + sz2 = sz), - (2 * n < pow2 sz1)%nat -> - eq_rect (sz1 + sz2) word (sext (wneg (natToWord sz1 n)) sz2) sz e = wneg (natToWord sz n). -Proof. - intros. rewrite sext_wneg_natToWord' by assumption. rewrite e. reflexivity. -Qed. - -Lemma wordToNat_split1: - forall sz1 sz2 (w: word (sz1 + sz2)), - wordToNat (split1 _ _ w) = - Nat.modulo (wordToNat w) (pow2 sz1). -Proof. - induction sz1; intros; [reflexivity|]. - dependent destruction w. - simpl; rewrite IHsz1. - pose proof (zero_lt_pow2 sz1). - destruct b. - - change (pow2 sz1 + (pow2 sz1 + 0)) with (2 * pow2 sz1). - replace (S (wordToNat w * 2)) with (1 + 2 * wordToNat w) by lia. - rewrite Nat.add_mod by lia. - rewrite Nat.mul_mod_distr_l; [|lia|discriminate]. - rewrite Nat.mod_1_l by lia. - rewrite Nat.mul_comm with (n:= 2). - change (1 + wordToNat w mod pow2 sz1 * 2) with (S (wordToNat w mod pow2 sz1 * 2)). - apply eq_sym, Nat.mod_small. - assert (pow2 sz1 <> 0) by lia. - pose proof (Nat.mod_upper_bound (wordToNat w) (pow2 sz1) H0). - lia. - - change (pow2 sz1 + (pow2 sz1 + 0)) with (2 * pow2 sz1). - rewrite Nat.mul_comm with (n:= 2). - rewrite Nat.mul_mod_distr_r; [|lia|discriminate]. - reflexivity. -Qed. - -Lemma wordToNat_split2: - forall sz1 sz2 (w: word (sz1 + sz2)), - wordToNat (split2 _ _ w) = - Nat.div (wordToNat w) (pow2 sz1). -Proof. - induction sz1; intros; - [rewrite Nat.div_1_r; reflexivity|]. - dependent destruction w. - change (split2 (S sz1) sz2 (WS b w)) - with (split2 sz1 sz2 w). - rewrite IHsz1. - destruct b. - - unfold pow2; fold pow2. - replace (@wordToNat (S sz1 + sz2) w~1) - with (1 + 2 * wordToNat w) by (simpl; lia). - rewrite <-Nat.div_div; - [|discriminate|pose proof (zero_lt_pow2 sz1); lia]. - rewrite Nat.mul_comm, Nat.div_add by discriminate. - rewrite Nat.div_small with (b := 2) by lia. - reflexivity. - - unfold pow2; fold pow2. - replace (@wordToNat (S sz1 + sz2) w~0) - with (2 * wordToNat w) by (simpl; lia). - rewrite Nat.div_mul_cancel_l; - [|pose proof (zero_lt_pow2 sz1); lia|discriminate]. - reflexivity. -Qed. - -Lemma wordToNat_wrshifta: - forall sz (w: word sz) n, - wordToNat (wrshifta w n) = - Nat.div (wordToNat (sext w n)) (pow2 n). -Proof. - unfold wrshifta; intros. - rewrite wordToNat_split2. - eq_rect_simpl. - rewrite wordToNat_eq_rect. - reflexivity. -Qed. - -Lemma wordToNat_combine: - forall sz1 (w1: word sz1) sz2 (w2: word sz2), - wordToNat (combine w1 w2) = - wordToNat w1 + pow2 sz1 * wordToNat w2. -Proof. - dependent induction w1; intros; [simpl; lia|]. - unfold pow2; fold pow2. - rewrite Nat.mul_comm with (n:= 2). (* to avoid [simpl] *) - simpl; destruct b. - - rewrite IHw1; simpl. - rewrite Nat.mul_comm with (n:= pow2 n * 2). - rewrite Nat.mul_assoc. - rewrite <-Nat.mul_add_distr_r. - rewrite Nat.mul_comm with (n:= pow2 n). - reflexivity. - - rewrite IHw1. - rewrite Nat.mul_comm with (n:= pow2 n * 2). - rewrite Nat.mul_assoc. - rewrite <-Nat.mul_add_distr_r. - rewrite Nat.mul_comm with (n:= pow2 n). - reflexivity. -Qed. - -Lemma wordToNat_wlshift: - forall sz (w: word sz) n, - wordToNat (wlshift w n) = - Nat.mul (Nat.modulo (wordToNat w) (pow2 (sz - n))) (pow2 n). -Proof. - intros; destruct (le_dec n sz). - - - unfold wlshift; intros. - rewrite wordToNat_split1. - eq_rect_simpl. - rewrite wordToNat_eq_rect. - rewrite wordToNat_combine. - rewrite wordToNat_wzero; simpl. - replace (pow2 sz) with (pow2 (sz - n + n)) by (f_equal; lia). - rewrite pow2_add_mul. - rewrite Nat.mul_comm with (n:= pow2 (sz - n)). - rewrite Nat.mul_mod_distr_l; - [|pose proof (zero_lt_pow2 (sz - n)); lia - |pose proof (zero_lt_pow2 n); lia]. - apply Nat.mul_comm. - - - assert (n > sz)%nat by lia. - rewrite wlshift_gt by assumption. - replace (sz - n) with 0 by lia. - rewrite wordToNat_wzero; simpl; reflexivity. -Qed. - -Lemma wordToNat_extz: - forall sz (w: word sz) n, - wordToNat (extz w n) = pow2 n * wordToNat w. -Proof. - unfold extz; intros. - rewrite wordToNat_combine. - rewrite wordToNat_wzero. - reflexivity. -Qed. - -Lemma extz_is_mult_pow2: forall sz n d, - extz (natToWord sz n) d = natToWord (d + sz) (pow2 d * n). -Proof. - intros. induction d. - - unfold extz. - rewrite combine_0_n. - simpl. - f_equal. - lia. - - unfold extz in *. - change (pow2 (S d) * n) with (2 * pow2 d * n). - rewrite <- Nat.mul_assoc. - change ((S d) + sz) with (S (d + sz)) in *. - rewrite <- natToWord_times2. - simpl. - fold natToWord. - f_equal. - exact IHd. -Qed. - -Lemma extz_is_mult_pow2_neg: forall sz n d, - extz (wneg (natToWord sz n)) d = wneg (natToWord (d + sz) (pow2 d * n)). -Proof. - intros. induction d. - - unfold extz. - rewrite combine_0_n. - simpl. - f_equal. f_equal. - lia. - - unfold extz in *. - change (pow2 (S d) * n) with (2 * pow2 d * n). - rewrite <- Nat.mul_assoc. - change ((S d) + sz) with (S (d + sz)) in *. - rewrite <- natToWord_times2. - simpl. - fold natToWord. - f_equal. - rewrite wneg_WS_0. - f_equal. - exact IHd. -Qed. - -Lemma wordToNat_sext_bypass: - forall sz1 (w1: word sz1) sz2 (w2: word sz2) (Hsz: sz1 = sz2) n, - wordToNat w1 = wordToNat w2 -> - wordToNat (sext w1 n) = wordToNat (sext w2 n). -Proof. - intros; subst. - apply wordToNat_inj in H; subst. - reflexivity. -Qed. - -Lemma combine_sext: - forall sz1 (w1: word sz1) sz2 (w2: word (S sz2)) n, - existT word _ (combine w1 (sext w2 n)) = - existT word _ (sext (combine w1 w2) n). -Proof. - unfold sext; intros. - rewrite wmsb_combine with (b2:= false) by discriminate. - destruct (wmsb w2 false); apply combine_assoc_existT. -Qed. - -Lemma extz_extz: - forall sz (w: word sz) n1 n2, - existT word _ (extz (extz w n1) n2) = - existT word _ (extz w (n2 + n1)). -Proof. - unfold extz; cbn; intros. - rewrite combine_assoc_existT. - rewrite combine_wzero. - reflexivity. -Qed. - -Lemma wrshifta_extz_sext: - forall sz (w: word sz) n1 n2, - existT word _ (wrshifta (extz w (n1 + n2)) n1) = - existT word _ (sext (extz w n2) n1). -Proof. - intros. - rewrite <-extz_sext. - apply wordToNat_existT; [lia|]. - rewrite wordToNat_wrshifta. - - replace (wordToNat (sext (extz w (n1 + n2)) n1)) - with (wordToNat (sext (extz (extz w n2) n1) n1)). - - replace (wordToNat (sext (extz (extz w n2) n1) n1)) - with (wordToNat (extz (sext (extz w n2) n1) n1)) - by apply existT_wordToNat, extz_sext. - do 2 rewrite wordToNat_extz. - rewrite Nat.mul_comm, Nat.div_mul - by (pose proof (zero_lt_pow2 n1); lia). - replace (wordToNat (sext (extz w n2) n1)) - with (wordToNat (extz (sext w n1) n2)) - by apply existT_wordToNat, extz_sext. - rewrite wordToNat_extz. - reflexivity. - - apply wordToNat_sext_bypass; [lia|]. - apply existT_wordToNat. - apply extz_extz. -Qed. - -Lemma wordToNat_sext_modulo: - forall sz (w: word sz) n, - Nat.modulo (wordToNat (sext w n)) (pow2 sz) = wordToNat w. -Proof. - unfold sext; intros. - pose proof (zero_lt_pow2 sz). - destruct (wmsb w false). - - rewrite wordToNat_combine. - rewrite Nat.mul_comm, Nat.mod_add by lia. - apply Nat.mod_small. - apply wordToNat_bound. - - rewrite wordToNat_combine. - rewrite Nat.mul_comm, Nat.mod_add by lia. - apply Nat.mod_small. - apply wordToNat_bound. -Qed. - -Lemma wlshift_sext_extz: - forall sz (w: word sz) n, - existT word _ (wlshift (sext w n) n) = - existT word _ (extz w n). -Proof. - intros; apply wordToNat_existT; [lia|]. - rewrite wordToNat_wlshift. - rewrite wordToNat_extz. - replace (sz + n - n) with sz by lia. - rewrite wordToNat_sext_modulo. - apply Nat.mul_comm. -Qed. - -Lemma wlshift_combine_extz: - forall sn sl (wl: word sl) ssu (wu: word (ssu + sn)), - existT word (sl + (ssu + sn)) (wlshift (combine wl wu) sn) = - existT word (sn + (sl + ssu)) (extz (combine wl (split1 ssu _ wu)) sn). -Proof. - intros; apply wordToNat_existT; [lia|]. - rewrite wordToNat_wlshift. - rewrite wordToNat_combine. - rewrite wordToNat_extz. - rewrite wordToNat_combine. - rewrite wordToNat_split1. - - replace (sl + (ssu + sn) - sn) with (sl + ssu) by lia. - rewrite Nat.mul_comm; f_equal. - rewrite pow2_add_mul. - pose proof (zero_lt_pow2 sl). - pose proof (zero_lt_pow2 ssu). - rewrite Nat.mod_mul_r; try lia. - rewrite Nat.mul_comm with (n:= pow2 sl) at 1. - rewrite Nat.mod_add; [|lia]. - rewrite Nat.mod_small by apply wordToNat_bound. - do 3 f_equal. - rewrite Nat.mul_comm, Nat.div_add; [|lia]. - rewrite Nat.div_small by apply wordToNat_bound. - reflexivity. -Qed. - -Lemma extz_sext_eq_rect: - forall sz (w: word sz) n1 n2 nsz Hnsz1, - exists Hnsz2, - eq_rect (n2 + (sz + n1)) word (extz (sext w n1) n2) nsz Hnsz1 = - eq_rect (n2 + sz + n1) word (sext (extz w n2) n1) nsz Hnsz2. -Proof. - intros; subst; simpl. - assert (Hsz: n2 + sz + n1 = n2 + (sz + n1)) by lia. - exists Hsz. - pose proof (extz_sext w n1 n2). - pose proof (eq_sigT_snd H). - rewrite <-H0. - eq_rect_simpl. - reflexivity. -Qed. - -Lemma sext_zero: - forall n m, sext (natToWord n 0) m = natToWord _ 0. -Proof. - unfold sext; intros. - rewrite wmsb_wzero. - rewrite combine_wzero. - reflexivity. -Qed. - -Lemma sext_split1: - forall sz (w: word sz) n, - split1 sz _ (sext w n) = w. -Proof. - unfold sext; intros. - destruct (wmsb w false); apply split1_combine. -Qed. - -Lemma sext_sext: - forall sz (w: word sz) n1 n2, - existT word _ (sext w (n1 + n2)) = existT word _ (sext (sext w n1) n2). -Proof. - unfold sext; intros. - remember (wmsb w false) as wmsb; destruct wmsb. - - destruct n1 as [|n1]. - + cbn; rewrite wmsb_combine_WO, <-Heqwmsb. - rewrite <-combine_assoc_existT. - reflexivity. - + rewrite wmsb_combine with (b2:= false) by discriminate. - rewrite wmsb_wones. - rewrite <-combine_assoc_existT. - rewrite combine_wones. - reflexivity. - - destruct n1 as [|n1]. - + cbn; rewrite wmsb_combine_WO, <-Heqwmsb. - rewrite <-combine_assoc_existT. - reflexivity. - + rewrite wmsb_combine with (b2:= false) by discriminate. - rewrite wmsb_wzero. - rewrite <-combine_assoc_existT. - rewrite combine_wzero. - reflexivity. -Qed. - -Lemma wneg_wordToN: - forall sz (w: word sz), - wordToN w <> 0%N -> - wordToN (wneg w) = (Npow2 sz - wordToN w)%N. -Proof. - unfold wneg; intros. - rewrite wordToN_NToWord_2. - - reflexivity. - - pose proof (wordToN_bound w). - nlia. -Qed. - -Lemma Nmul_two: - forall n, (n + n = 2 * n)%N. -Proof. - intros. - destruct n; simpl; auto. - rewrite Pos.add_diag. - reflexivity. -Qed. - -Lemma wmsb_false_bound: - forall sz (w: word (S sz)), - wmsb w false = false -> (wordToN w < Npow2 sz)%N. -Proof. - dependent destruction w. - dependent induction w; - [simpl; intros; subst; nlia|]. - intros; rewrite Npow2_S, Nmul_two. - destruct b. - - destruct b0. - + specialize (IHw H). - rewrite wordToN_WS_1. - rewrite N.add_comm. - apply N.mul_2_mono_l; auto. - + dependent destruction w. - * simpl; clear; nlia. - * specialize (IHw H). - rewrite wordToN_WS_1, wordToN_WS_0. - rewrite wordToN_WS_1 in IHw. - rewrite N.add_comm. - apply N.mul_2_mono_l. - nlia. - - destruct b0. - + dependent destruction w. - * simpl in H; discriminate. - * specialize (IHw H). - rewrite wordToN_WS_0, wordToN_WS_1. - rewrite wordToN_WS_0 in IHw. - apply N.mul_lt_mono_pos_l; [nlia|]. - rewrite Npow2_S, Nmul_two in IHw. - apply N.mul_lt_mono_pos_l in IHw; [|nlia]. - rewrite Npow2_S, Nmul_two. - rewrite N.add_comm. - apply N.mul_2_mono_l. - assumption. - + specialize (IHw H). - rewrite wordToN_WS_0. - apply N.mul_lt_mono_pos_l; [nlia|]. - assumption. -Qed. - -Lemma wmsb_true_bound: - forall sz (w: word (S sz)), - wmsb w false = true -> (Npow2 sz <= wordToN w)%N. -Proof. - dependent destruction w. - dependent induction w; - [simpl; intros; subst; reflexivity|]. - intros; rewrite Npow2_S, Nmul_two. - destruct b. - - destruct b0. - + specialize (IHw H). - rewrite wordToN_WS_1. - apply N.mul_le_mono_nonneg_l with (p:= 2%N) in IHw; [|compute; discriminate]. - rewrite N.add_1_r. - apply N.le_le_succ_r. - assumption. - + dependent destruction w. - * simpl in H; discriminate. - * specialize (IHw H). - rewrite wordToN_WS_1, wordToN_WS_0. - rewrite wordToN_WS_1 in IHw. - apply N.lt_eq_cases in IHw; destruct IHw. - { apply N.lt_succ_r. - rewrite <-N.add_1_r. - replace (2 * (2 * wordToN (WS b w)) + 1 + 1)%N - with (2 * (2 * wordToN (WS b w)) + 2 * 1)%N by nlia. - rewrite <-N.mul_add_distr_l. - apply N.mul_lt_mono_pos_l; [nlia|]. - assumption. - } - { exfalso. - rewrite Npow2_S, Nmul_two in H0. - assert (N.even (2 * Npow2 n) = N.even (2 * wordToN (WS b w) + 1)) - by (rewrite H0; reflexivity). - rewrite N.even_mul, N.even_2 in H1. - rewrite N.add_comm, N.even_add_mul_2, N.even_1 in H1. - discriminate. - } - - destruct b0. - + dependent destruction w. - * simpl in H; discriminate. - * specialize (IHw H). - rewrite wordToN_WS_0, wordToN_WS_1. - rewrite wordToN_WS_0 in IHw. - apply N.mul_le_mono_nonneg_l; [compute; discriminate|]. - rewrite N.add_1_r. - apply N.le_le_succ_r. - assumption. - + specialize (IHw H). - rewrite wordToN_WS_0. - apply N.mul_le_mono_nonneg_l; [compute; discriminate|]. - assumption. -Qed. - -Lemma ZToWord_wordToZ: - forall sz (w: word sz), ZToWord sz (wordToZ w) = w. -Proof. - unfold ZToWord, wordToZ; intros. - remember (wmsb w false) as msb; destruct msb. - - remember (wordToN (wneg w)) as ww. - destruct ww. - + assert (wneg w = wzero _). - { apply wordToN_inj; rewrite <-Heqww. - rewrite wordToN_nat. - rewrite roundTrip_0. - reflexivity. - } - rewrite wzero'_def. - rewrite <-wneg_idempotent, H. - apply eq_sym, wzero_wneg. - + assert (wneg w = NToWord _ (N.pos p)). - { apply wordToN_inj; rewrite Heqww. - rewrite NToWord_wordToN. - reflexivity. - } - rewrite <-wneg_idempotent, H. - reflexivity. - - remember (wordToN w) as ww. - destruct ww. - + assert (w = wzero _); subst. - { apply wordToN_inj; rewrite <-Heqww. - rewrite wordToN_nat. - rewrite roundTrip_0. - reflexivity. - } - apply wzero'_def. - + assert (w = NToWord _ (N.pos p)); subst. - { apply wordToN_inj; rewrite Heqww. - rewrite NToWord_wordToN. - reflexivity. - } - reflexivity. -Qed. - -Lemma wordToZ_ZToWord: - forall z sz, - (- Z.of_nat (pow2 sz) <= z < Z.of_nat (pow2 sz))%Z -> - wordToZ (ZToWord (S sz) z) = z. -Proof. - unfold wordToZ, ZToWord; intros. - destruct z. - - rewrite wmsb_wzero'. - rewrite wordToN_wzero'. - reflexivity. - - - rewrite posToWord_nat. - remember (wmsb (natToWord (S sz) (Pos.to_nat p)) false) as msb. - destruct msb. - + exfalso. - simpl in H; destruct H. - apply eq_sym, wmsb_true_bound in Heqmsb. - rewrite <-positive_N_nat, <-NToWord_nat in Heqmsb. - rewrite <-positive_nat_Z in H0. - apply Nat2Z.inj_lt in H0. - rewrite <-positive_N_nat, <-Npow2_nat in H0. - apply Nlt_in in H0. - pose proof (wordToN_NToWord (S sz) (N.pos p)). - destruct H1 as [k [? ?]]. - rewrite H1 in Heqmsb. - assert (N.pos p - k * Npow2 (S sz) <= N.pos p)%N by apply N.le_sub_l. - assert (Npow2 sz <= N.pos p)%N by (etransitivity; eassumption). - apply N.le_ngt in H4; auto. - + rewrite wordToN_nat, wordToNat_natToWord_2. - * rewrite positive_nat_N; reflexivity. - * rewrite <-Npow2_nat, <-positive_N_nat. - apply Nlt_out. - destruct H. - rewrite <-N2Z.inj_pos, <-N_nat_Z in H0. - apply Nat2Z.inj_lt in H0. - rewrite <-Npow2_nat in H0. - apply Nlt_in. - rewrite Npow2_S, N2Nat.inj_add. - lia. - - - rewrite wneg_idempotent. - rewrite posToWord_nat. - remember (wmsb (wneg (natToWord (S sz) (Pos.to_nat p))) false) as msb. - destruct msb. - + rewrite wordToN_nat, wordToNat_natToWord_2. - * rewrite positive_nat_N; reflexivity. - * rewrite <-Npow2_nat, <-positive_N_nat. - apply Nlt_out. - destruct H. - apply Z.opp_le_mono in H. - rewrite Pos2Z.opp_neg, Z.opp_involutive in H. - rewrite <-N2Z.inj_pos, <-N_nat_Z in H. - apply Nat2Z.inj_le in H. - rewrite <-Npow2_nat in H. - apply Nlt_in. - rewrite Npow2_S, N2Nat.inj_add. - assert (N.to_nat (Npow2 sz) > 0)%nat by (rewrite Npow2_nat; apply pow2_zero). - lia. - + exfalso. - simpl in H. - apply eq_sym, wmsb_false_bound in Heqmsb. - rewrite wneg_wordToN in Heqmsb. - * rewrite Npow2_S in Heqmsb. - rewrite <-N.add_0_r in Heqmsb. - rewrite <-N.add_sub_assoc in Heqmsb. - { apply N.add_lt_mono_l in Heqmsb. - exfalso; eapply N.nlt_0_r; eauto. - } - { destruct H. - apply Z.opp_le_mono in H. - rewrite Pos2Z.opp_neg, Z.opp_involutive in H. - rewrite <-N2Z.inj_pos, <-N_nat_Z in H. - apply Nat2Z.inj_le in H. - rewrite positive_N_nat in H. - rewrite <-positive_N_nat, <-NToWord_nat. - pose proof (wordToN_NToWord (S sz) (N.pos p)). - destruct H1 as [k [? ?]]; rewrite H1. - etransitivity; [apply N.le_sub_l|]. - rewrite <-Npow2_nat in H. - rewrite <-positive_N_nat in H. - unfold N.le; rewrite N2Nat.inj_compare. - apply nat_compare_le; auto. - } - * intro Hx. - replace 0%N with (wordToN (wzero (S sz))) in Hx by apply wordToN_wzero. - apply wordToN_inj in Hx. - assert (wordToNat (natToWord (S sz) (Pos.to_nat p)) = 0) - by (rewrite Hx; apply wordToNat_wzero). - rewrite wordToNat_natToWord_2 in H0. - { clear -H0. - induction p; simpl in H0; try discriminate. - elim IHp; rewrite Pos2Nat.inj_xO in H0; lia. - } - { destruct H. - apply Z.opp_le_mono in H. - rewrite Pos2Z.opp_neg, Z.opp_involutive in H. - rewrite <-N2Z.inj_pos, <-N_nat_Z in H. - apply Nat2Z.inj_le in H. - rewrite positive_N_nat in H. - simpl. - pose proof (pow2_zero sz). - lia. - } -Qed. - -Lemma wordToZ_ZToWord'': forall (sz: nat), - (0 < sz)%nat -> - forall n: Z, - (- 2 ^ (Z.of_nat sz - 1) <= n < 2 ^ (Z.of_nat sz - 1))%Z -> - wordToZ (ZToWord sz n) = n. -Proof. - intros. - destruct sz; [lia|]. - apply wordToZ_ZToWord. - replace (Z.of_nat (S sz) - 1)%Z with (Z.of_nat sz) in * by lia. - rewrite Nat2Z.inj_pow. - assumption. -Qed. - -Lemma wordToZ_wordToN: - forall sz (w: word sz), - wordToZ w = (Z.of_N (wordToN w) - Z.of_N (if wmsb w false then Npow2 sz else 0))%Z. -Proof. - unfold wordToZ; intros. - remember (wmsb w false) as msb; destruct msb; - [|simpl; rewrite Z.sub_0_r; reflexivity]. - destruct (weq w (wzero _)); subst; - [rewrite wmsb_wzero in Heqmsb; discriminate|]. - rewrite wneg_wordToN. - - pose proof (wordToN_bound w). - replace (Z.of_N (wordToN w) - Z.of_N (Npow2 sz))%Z - with (- (Z.of_N (Npow2 sz) - Z.of_N (wordToN w)))%Z by lia. - rewrite <-N2Z.inj_sub by (apply N.lt_le_incl; assumption). - clear; destruct (Npow2 sz - wordToN w)%N; reflexivity. - - intro Hx; elim n. - rewrite <-wordToN_wzero with (sz:= sz) in Hx. - apply wordToN_inj in Hx; auto. -Qed. - -Lemma ZToWord_Z_of_N: - forall sz n, - ZToWord sz (Z.of_N n) = NToWord sz n. -Proof. - unfold ZToWord, NToWord; intros. - destruct n; reflexivity. -Qed. - -Lemma ZToWord_Z_of_nat: forall sz x, ZToWord sz (Z.of_nat x) = natToWord sz x. -Proof. - intros. - rewrite <- nat_N_Z. - rewrite ZToWord_Z_of_N. - rewrite NToWord_nat. - rewrite Nnat.Nat2N.id. - reflexivity. -Qed. - -Lemma natToWord_Z_to_nat: forall sz n, - (0 <= n)%Z -> - natToWord sz (Z.to_nat n) = ZToWord sz n. -Proof. - intros. rewrite <- ZToWord_Z_of_nat. - rewrite Z2Nat.id by assumption. - reflexivity. -Qed. - -Lemma ZToWord_sz0: forall z, ZToWord 0 z = $0. -Proof. - intros. unfold ZToWord. destruct z; try rewrite posToWord_sz0; reflexivity. -Qed. - -Lemma ZToWord_0: forall sz, ZToWord sz 0 = wzero sz. -Proof. - intros. unfold ZToWord. apply wzero'_def. -Qed. - -Lemma ZToWord_1{sz : nat}: ZToWord sz 1 = wone sz. -Proof. - intros. - rewrite <- natToWord_Z_to_nat by (cbv; discriminate). - reflexivity. -Qed. - -Lemma natToWord_pow2_add: - forall sz n, - natToWord sz (n + pow2 sz) = natToWord sz n. -Proof. - induction sz; intros; [reflexivity|]. - unfold natToWord, pow2; fold natToWord pow2. - rewrite drop_mod2_add, div2_plus_2, IHsz. - reflexivity. -Qed. - -Lemma nat_add_pow2_wzero: - forall sz n1 n2, - n1 + n2 = pow2 sz -> - natToWord sz n1 ^+ natToWord sz n2 = wzero sz. -Proof. - intros. - rewrite <-natToWord_plus, H. - rewrite natToWord_pow2. - reflexivity. -Qed. - -Lemma Npos_Npow2_wzero: - forall sz p1 p2, - N.pos (p1 + p2) = Npow2 sz -> - posToWord sz p1 ^+ posToWord sz p2 = wzero sz. -Proof. - intros. - do 2 rewrite posToWord_nat. - assert (Pos.to_nat p1 + Pos.to_nat p2 = pow2 sz). - { rewrite <-Pos2Nat.inj_add, <-Npow2_nat. - rewrite <-positive_N_nat. - rewrite H; reflexivity. - } - apply nat_add_pow2_wzero; auto. -Qed. - -Lemma ZToWord_Npow2_sub: - forall sz z, - ZToWord sz (z - Z.of_N (Npow2 sz)) = ZToWord sz z. -Proof. - unfold ZToWord; intros. - remember (z - Z.of_N (Npow2 sz))%Z as zz. - destruct z. - - destruct zz. - + assert (Z.of_N (Npow2 sz) = 0)%Z by lia. - change 0%Z with (Z.of_N 0%N) in H. - apply N2Z.inj in H. - exfalso; eapply Npow2_not_zero; eauto. - + pose proof (N2Z.is_nonneg (Npow2 sz)). - destruct (Z.of_N (Npow2 sz)); simpl in Heqzz, H; - try discriminate. - pose proof (Pos2Z.neg_is_neg p0); lia. - + assert (Z.of_N (Npow2 sz) = Z.pos p). - { rewrite Z.sub_0_l, <-Pos2Z.opp_pos in Heqzz. - apply Z.opp_inj in Heqzz; auto. - } - rewrite <-N2Z.inj_pos in H. - apply N2Z.inj in H. - rewrite posToWord_nat, <-positive_N_nat, <-H. - rewrite Npow2_nat, natToWord_pow2. - rewrite wzero_wneg. - apply eq_sym, wzero'_def. - - - destruct zz. - + assert (Z.of_N (Npow2 sz) = Z.pos p) by lia. - rewrite <-N2Z.inj_pos in H. - apply N2Z.inj in H. - rewrite posToWord_nat, <-positive_N_nat, <-H. - rewrite Npow2_nat, natToWord_pow2. - apply wzero'_def. - + assert (Z.pos p = Z.pos p0 + Z.of_N (Npow2 sz))%Z by lia. - do 2 rewrite <-N2Z.inj_pos in H. - rewrite <-N2Z.inj_add in H. - apply N2Z.inj in H. - apply eq_sym. - do 2 rewrite posToWord_nat, <-positive_N_nat. - rewrite H, N2Nat.inj_add, Npow2_nat. - apply natToWord_pow2_add. - + assert (Z.pos p - Z.neg p0 = Z.of_N (Npow2 sz))%Z by lia. - simpl in H. - remember (Npow2 sz) as n; destruct n; - [exfalso; eapply Npow2_not_zero; eauto|]. - rewrite N2Z.inj_pos in H; inversion H; subst; clear H. - apply eq_sym, sub_0_eq. - rewrite wminus_def, wneg_idempotent. - apply Npos_Npow2_wzero; auto. - - - destruct zz. - + assert (Z.neg p = Z.of_N (Npow2 sz))%Z by lia. - pose proof (N2Z.is_nonneg (Npow2 sz)). - rewrite <-H in H0. - pose proof (Pos2Z.neg_is_neg p); lia. - + assert (Z.neg p = Z.pos p0 + Z.of_N (Npow2 sz))%Z by lia. - pose proof (N2Z.is_nonneg (Npow2 sz)). - destruct (Z.of_N (Npow2 sz)); simpl in H; - try discriminate. - pose proof (Pos2Z.neg_is_neg p1); lia. - + assert (Pos.to_nat p0 = Pos.to_nat p + pow2 sz). - { rewrite <-Npow2_nat. - do 2 rewrite <-positive_N_nat. - rewrite <-N2Nat.inj_add. - f_equal. - pose proof (N2Z.is_nonneg (Npow2 sz)). - remember (Z.of_N (Npow2 sz)) as z; destruct z. - { change 0%Z with (Z.of_N 0) in Heqz. - apply N2Z.inj in Heqz. - exfalso; eapply Npow2_not_zero; eauto. - } - { simpl in Heqzz; inversion Heqzz; subst. - rewrite <-N2Z.inj_pos in Heqz. - apply N2Z.inj in Heqz. - rewrite <-Heqz. - reflexivity. - } - { pose proof (Zlt_neg_0 p1); lia. } - } - f_equal. - do 2 rewrite posToWord_nat. - rewrite H. - apply natToWord_pow2_add. -Qed. - -Lemma wplus_wplusZ: - forall sz (w1 w2: word sz), - w1 ^+ w2 = wplusZ w1 w2. -Proof. - unfold wplus, wplusZ, wordBin, wordBinZ; intros. - do 2 rewrite wordToZ_wordToN. - match goal with - | [ |- context[(?z1 - ?z2 + (?z3 - ?z4))%Z] ] => - replace (z1 - z2 + (z3 - z4))%Z with (z1 + z3 - z2 - z4)%Z by lia - end. - rewrite <-N2Z.inj_add. - destruct (wmsb w1 false); destruct (wmsb w2 false). - - simpl; do 2 rewrite ZToWord_Npow2_sub. - apply eq_sym, ZToWord_Z_of_N. - - simpl; rewrite Z.sub_0_r, ZToWord_Npow2_sub. - apply eq_sym, ZToWord_Z_of_N. - - simpl; rewrite Z.sub_0_r, ZToWord_Npow2_sub. - apply eq_sym, ZToWord_Z_of_N. - - simpl; do 2 rewrite Z.sub_0_r. - apply eq_sym, ZToWord_Z_of_N. -Qed. - -Lemma ZToWord_Npow2_sub_k : forall (sz : nat) (z : Z) (k: nat), - ZToWord sz (z - Z.of_nat k * Z.of_N (Npow2 sz)) = ZToWord sz z. -Proof. - intros. induction k. - - simpl. f_equal. lia. - - rewrite <- IHk. - replace (z - Z.of_nat (S k) * Z.of_N (Npow2 sz))%Z - with ((z - Z.of_nat k * Z.of_N (Npow2 sz)) - Z.of_N (Npow2 sz))%Z by nia. - apply ZToWord_Npow2_sub. -Qed. - -Lemma ZToWord_Npow2_add_k : forall (sz : nat) (z : Z) (k: nat), - ZToWord sz (z + Z.of_nat k * Z.of_N (Npow2 sz)) = ZToWord sz z. -Proof. - intros. - replace z with (z + Z.of_nat k * Z.of_N (Npow2 sz) - Z.of_nat k * Z.of_N (Npow2 sz))%Z at 2 - by lia. - symmetry. - apply ZToWord_Npow2_sub_k. -Qed. - -Lemma ZToWord_Npow2_sub_z : forall (sz : nat) (z : Z) (k: Z), - ZToWord sz (z - k * Z.of_N (Npow2 sz)) = ZToWord sz z. -Proof. - intros. destruct k. - - simpl. f_equal. lia. - - rewrite <- positive_nat_Z. apply ZToWord_Npow2_sub_k. - - rewrite <- Pos2Z.opp_pos. - replace (z - - Z.pos p * Z.of_N (Npow2 sz))%Z - with (z + Z.pos p * Z.of_N (Npow2 sz))%Z by nia. - rewrite <- positive_nat_Z. apply ZToWord_Npow2_add_k. -Qed. - -Lemma ZToWord_Npow2_add_k': forall sz z k, - ZToWord sz (z + k * Z.of_N (Npow2 sz)) = ZToWord sz z. -Proof. - intros. assert (0 <= k \/ k < 0)%Z as C by lia. destruct C as [C | C]. - - pose proof (ZToWord_Npow2_add_k sz z (Z.to_nat k)) as Q. - rewrite Znat.Z2Nat.id in Q; assumption. - - pose proof (ZToWord_Npow2_sub_k sz z (Z.to_nat (- k))) as Q. - rewrite Znat.Z2Nat.id in Q by lia. - rewrite <- Q. - f_equal. - lia. -Qed. - -Lemma wordToZ_ZToWord': forall sz w, - exists k, wordToZ (ZToWord sz w) = (w - k * Z.of_N (Npow2 sz))%Z. -Proof. - intros. - destruct sz. - - simpl. exists w%Z. rewrite ZToWord_sz0. rewrite wordToZ_wzero. lia. - - exists ((w + Z.of_nat (pow2 sz)) / Z.of_N (Npow2 (S sz)))%Z. - erewrite <- ZToWord_Npow2_sub_z. - rewrite wordToZ_ZToWord. - + reflexivity. - + replace w with ((- Z.of_nat (pow2 sz)) + (w + Z.of_nat (pow2 sz)))%Z at 1 3 by lia. - rewrite <- Z.add_sub_assoc. - replace (Z.of_N (Npow2 (S sz))) with (2 * Z.of_nat (pow2 sz))%Z. - * remember (Z.of_nat (pow2 sz)) as M. - assert (M > 0)%Z. { - subst. destruct (pow2 sz) eqn: E. - - exfalso. eapply pow2_ne_zero. exact E. - - simpl. constructor. - } - rewrite <- Zdiv.Zmod_eq_full by lia. - pose proof (Zdiv.Z_mod_lt (w + M) (2 * M)). lia. - * rewrite <- Npow2_nat. rewrite N_nat_Z. - rewrite Npow2_S. rewrite N2Z.inj_add. lia. -Qed. - -Lemma ZToWord_plus: forall sz a b, ZToWord sz (a + b) = ZToWord sz a ^+ ZToWord sz b. -Proof. - destruct sz as [|sz]; intros n m; intuition auto with worder. - rewrite wplus_wplusZ. - unfold wplusZ, wordBinZ. - destruct (wordToZ_ZToWord' (S sz) n) as [k1 D1]. - destruct (wordToZ_ZToWord' (S sz) m) as [k2 D2]. - rewrite D1. - rewrite D2. - replace (n - k1 * Z.of_N (Npow2 (S sz)) + (m - k2 * Z.of_N (Npow2 (S sz))))%Z - with (n + m - (k1 + k2) * Z.of_N (Npow2 (S sz)))%Z by nia. - symmetry. - apply ZToWord_Npow2_sub_z. -Qed. - -Lemma wplus_Z: forall sz (a b : word sz), - a ^+ b = ZToWord sz (wordToZ a + wordToZ b). -Proof. - intros. rewrite ZToWord_plus. rewrite! ZToWord_wordToZ. reflexivity. -Qed. - -Lemma else_0_to_ex_N: forall (b: bool) (a: N), - exists k, (if b then a else 0%N) = (k * a)%N. -Proof. - intros. destruct b. - - exists 1%N. nia. - - exists 0%N. reflexivity. -Qed. - -Local Lemma wmultZ_helper: forall a b k1 k2 p, - ((a - k1 * p) * (b - k2 * p) = a * b - (k1 * b + k2 * a - k1 * k2 * p) * p)%Z. -Proof. intros. nia. Qed. - -Lemma wmult_wmultZ: forall (sz : nat) (w1 w2 : word sz), w1 ^* w2 = wmultZ w1 w2. -Proof. - unfold wmultZ, wmult, wordBinZ, wordBin. intros. - do 2 rewrite wordToZ_wordToN. - destruct (else_0_to_ex_N (wmsb w1 false) (Npow2 sz)) as [k1 E1]. rewrite E1. clear E1. - destruct (else_0_to_ex_N (wmsb w2 false) (Npow2 sz)) as [k2 E2]. rewrite E2. clear E2. - do 2 rewrite N2Z.inj_mul. - rewrite wmultZ_helper. - rewrite <- N2Z.inj_mul. - rewrite ZToWord_Npow2_sub_z. - rewrite ZToWord_Z_of_N. - reflexivity. -Qed. - -Lemma ZToWord_mult: forall sz a b, ZToWord sz (a * b) = ZToWord sz a ^* ZToWord sz b. -Proof. - intros. rewrite wmult_wmultZ. unfold wmultZ, wordBinZ. - destruct (wordToZ_ZToWord' sz a) as [k1 D1]. rewrite D1. clear D1. - destruct (wordToZ_ZToWord' sz b) as [k2 D2]. rewrite D2. clear D2. - rewrite wmultZ_helper. - symmetry. - apply ZToWord_Npow2_sub_z. -Qed. - -Lemma wmult_Z: forall sz (a b : word sz), - a ^* b = ZToWord sz (wordToZ a * wordToZ b). -Proof. - intros. rewrite ZToWord_mult. rewrite! ZToWord_wordToZ. reflexivity. -Qed. - -Lemma wordToZ_wplus_bound: - forall sz (w1 w2: word (S sz)), - (- Z.of_nat (pow2 sz) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 sz))%Z -> - (wordToZ w1 + wordToZ w2 = wordToZ (w1 ^+ w2))%Z. -Proof. - intros. - rewrite wplus_wplusZ. - unfold wplusZ, wordBinZ. - remember (wordToZ w1 + wordToZ w2)%Z as z; clear Heqz. - apply eq_sym, wordToZ_ZToWord; assumption. -Qed. - -Lemma wordToZ_wplus_bound': - forall sz (w1 w2: word sz), - sz <> 0 -> - (- Z.of_nat (pow2 (pred sz)) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 (pred sz)))%Z -> - (wordToZ w1 + wordToZ w2 = wordToZ (w1 ^+ w2))%Z. -Proof. - intros. - destruct sz; [exfalso; auto|clear H]. - apply wordToZ_wplus_bound; auto. -Qed. - -Lemma wordToZ_size': - forall sz (w: word (S sz)), - (- Z.of_nat (pow2 sz) <= wordToZ w < Z.of_nat (pow2 sz))%Z. -Proof. - unfold wordToZ; intros. - remember (wmsb w false) as msb; destruct msb. - - destruct (weq w (wpow2 _)). - + subst; rewrite wpow2_wneg. - rewrite wpow2_Npow2. - remember (Npow2 sz) as np. - destruct np; [exfalso; eapply Npow2_not_zero; eauto|]. - split. - * rewrite <-Pos2Z.opp_pos, <-N2Z.inj_pos. - rewrite Heqnp. - rewrite <-Npow2_nat. - rewrite N_nat_Z. - reflexivity. - * etransitivity. - { apply Pos2Z.neg_is_neg. } - { change 0%Z with (Z.of_nat 0). - apply Nat2Z.inj_lt. - apply zero_lt_pow2. - } - + assert (wordToN (wneg w) < Npow2 sz)%N. - { apply wmsb_false_bound. - eapply wmsb_wneg_true; eauto. - } - remember (wordToN (wneg w)) as ww; clear Heqww. - destruct ww; simpl. - * split; try lia; - change 0%Z with (Z.of_nat 0); - apply Nat2Z.inj_lt; - apply zero_lt_pow2. - * split. - { rewrite <-Pos2Z.opp_pos, <-N2Z.inj_pos. - rewrite <-Npow2_nat. - rewrite N_nat_Z. - rewrite <-Z.opp_le_mono. - apply N2Z.inj_le. - apply N.lt_le_incl. - assumption. - } - { etransitivity. - { apply Pos2Z.neg_is_neg. } - { change 0%Z with (Z.of_nat 0). - apply Nat2Z.inj_lt. - apply zero_lt_pow2. - } - } - - apply eq_sym, wmsb_false_bound in Heqmsb. - destruct (wordToN w); simpl. - * split; try lia; - change 0%Z with (Z.of_nat 0); - apply Nat2Z.inj_lt; - apply zero_lt_pow2. - * split. - { etransitivity. - { apply Z.opp_nonpos_nonneg. - change 0%Z with (Z.of_nat 0). - apply Nat2Z.inj_le. - pose proof (zero_lt_pow2 sz); lia. - } - { pose proof (Pos2Z.is_pos p); lia. } - } - { rewrite <-N2Z.inj_pos. - rewrite <-Npow2_nat. - rewrite N_nat_Z. - apply N2Z.inj_lt. - assumption. - } -Qed. - -Lemma wordToZ_size: - forall sz (w: word (S sz)), - (Z.abs (wordToZ w) <= Z.of_nat (pow2 sz))%Z. -Proof. - intros. - pose proof (wordToZ_size' w). - destruct H. - apply Z.abs_le. - split; lia. -Qed. - -Lemma wordToZ_size'': forall (sz : nat), - (0 < sz)%nat -> - forall w : word sz, - (- 2 ^ (Z.of_nat sz - 1) <= wordToZ w < 2 ^ (Z.of_nat sz - 1))%Z. -Proof. - intros. - destruct sz; [lia|]. - pose proof (@wordToZ_size' sz w) as P. - replace (Z.of_nat (S sz) - 1)%Z with (Z.of_nat sz) by lia. - rewrite Nat2Z.inj_pow in P. - exact P. -Qed. - -Lemma wneg_wzero: - forall sz (w: word sz), wneg w = wzero sz -> w = wzero sz. -Proof. - intros. - pose proof (wminus_inv w). - rewrite H in H0. - rewrite wplus_comm, wplus_unit in H0; subst. - reflexivity. -Qed. - -Lemma wmsb_false_pos: - forall sz (w: word sz), - wmsb w false = false <-> (wordToZ w >= 0)%Z. -Proof. - unfold wordToZ; split; intros. - - rewrite H. - destruct (wordToN w). - + lia. - + pose proof (Zgt_pos_0 p); lia. - - remember (wmsb w false) as b; destruct b; auto. - remember (wordToN (wneg w)) as n; destruct n. - + replace 0%N with (wordToN (wzero sz)) in Heqn. - * apply wordToN_inj in Heqn. - apply eq_sym, wneg_wzero in Heqn; subst. - rewrite wmsb_wzero in Heqb; discriminate. - * rewrite <-wzero'_def. - apply wordToN_wzero'. - + exfalso; pose proof (Zlt_neg_0 p); lia. -Qed. - -Lemma wmsb_true_neg: - forall sz (w: word sz), - wmsb w false = true <-> (wordToZ w < 0)%Z. -Proof. - unfold wordToZ; split; intros. - - rewrite H. - remember (wordToN (wneg w)) as n; destruct n. - + replace 0%N with (wordToN (wzero sz)) in Heqn. - * apply wordToN_inj in Heqn. - apply eq_sym, wneg_wzero in Heqn; subst. - rewrite wmsb_wzero in H; discriminate. - * rewrite <-wzero'_def. - apply wordToN_wzero'. - + pose proof (Zlt_neg_0 p); lia. - - remember (wmsb w false) as b; destruct b; auto. - remember (wordToN w) as n; destruct n. - + lia. - + pose proof (Zgt_pos_0 p); lia. -Qed. - -Lemma wordToZ_distr_diff_wmsb: - forall sz (w1 w2: word sz), - wmsb w1 false = negb (wmsb w2 false) -> - wordToZ (w1 ^+ w2) = (wordToZ w1 + wordToZ w2)%Z. -Proof. - intros. - destruct sz; - [rewrite (shatter_word w1), (shatter_word w2); reflexivity|]. - eapply eq_sym, wordToZ_wplus_bound. - pose proof (wordToZ_size' w1). - pose proof (wordToZ_size' w2). - remember (wmsb w1 false) as msb1; destruct msb1. - - apply eq_sym, wmsb_true_neg in Heqmsb1. - apply eq_sym, negb_true_iff, wmsb_false_pos in H. - destruct H0, H1. - split; lia. - - apply eq_sym, wmsb_false_pos in Heqmsb1. - apply eq_sym, negb_false_iff, wmsb_true_neg in H. - destruct H0, H1. - split; lia. -Qed. - -Lemma sext_wplus_wordToZ_distr: - forall sz (w1 w2: word sz) n, - n <> 0 -> wordToZ (sext w1 n ^+ sext w2 n) = - (wordToZ (sext w1 n) + wordToZ (sext w2 n))%Z. -Proof. - intros. - destruct n; [exfalso; auto|clear H]. - apply eq_sym, wordToZ_wplus_bound'; [lia|]. - - do 2 rewrite sext_wordToZ. - destruct sz. - - rewrite (shatter_word w1), (shatter_word w2). - cbn; split; try (pose proof (pow2_zero n); lia). - - replace (pred (S sz + S n)) with (S (sz + n)) by lia. - pose proof (wordToZ_size' w1); destruct H. - pose proof (wordToZ_size' w2); destruct H1. - split. - + rewrite pow2_S_z. - etransitivity; [|apply Z.add_le_mono; eassumption]. - rewrite <-Z.add_diag, Z.opp_add_distr. - apply Z.add_le_mono; - rewrite <-Z.opp_le_mono; apply Nat2Z.inj_le, pow2_le; lia. - + rewrite pow2_S_z. - eapply Z.lt_le_trans; [apply Z.add_lt_mono; eassumption|]. - rewrite <-Z.add_diag. - apply Z.add_le_mono; apply Nat2Z.inj_le, pow2_le; lia. -Qed. - -Lemma sext_wplus_wordToZ_distr_existT: - forall sz (w1 w2: word sz) ssz (sw1 sw2: word ssz) n, - existT word _ w1 = existT word _ (sext sw1 n) -> - existT word _ w2 = existT word _ (sext sw2 n) -> - n <> 0 -> wordToZ (w1 ^+ w2) = (wordToZ w1 + wordToZ w2)%Z. -Proof. - intros. - assert (sz = ssz + n) by (apply eq_sigT_fst in H; auto); subst. - destruct_existT. - apply sext_wplus_wordToZ_distr; auto. -Qed. - -Lemma split1_existT: - forall n sz1 (w1: word (n + sz1)) sz2 (w2: word (n + sz2)), - existT word _ w1 = existT word _ w2 -> - split1 n _ w1 = split1 n _ w2. -Proof. - intros. - assert (sz1 = sz2) by (apply eq_sigT_fst in H; lia); subst. - destruct_existT. - reflexivity. -Qed. - -Lemma word_combinable: - forall sz1 sz2 (w: word (sz1 + sz2)), - exists w1 w2, w = combine w1 w2. -Proof. - intros. - exists (split1 _ _ w), (split2 _ _ w). - apply eq_sym, combine_split. -Qed. - -Lemma split1_combine_existT: - forall sz n (w: word (n + sz)) sl (wl: word (n + sl)) su (wu: word su), - existT word _ w = existT word _ (combine wl wu) -> - split1 n _ w = split1 n _ wl. -Proof. - intros. - pose proof (word_combinable _ _ w). - destruct H0 as [? [? ?]]; subst. - pose proof (word_combinable _ _ wl). - destruct H0 as [? [? ?]]; subst. - assert (sz = sl + su) by (apply eq_sigT_fst in H; lia); subst. - pose proof (word_combinable _ _ x0). - destruct H0 as [? [? ?]]; subst. - do 2 rewrite split1_combine. - rewrite combine_assoc_existT in H. - destruct_existT. - assert (split1 _ _ (split1 _ _ (combine (combine x x3) x4)) = - split1 _ _ (split1 _ _ (combine (combine x1 x2) wu))) - by (rewrite H; reflexivity). - repeat rewrite split1_combine in H0. - assumption. -Qed. - -Lemma extz_pow2_wordToZ: - forall sz (w: word sz) n, - wordToZ (extz w n) = (wordToZ w * Z.of_nat (pow2 n))%Z. -Proof. - induction n; [cbn; lia|]. - rewrite pow2_S_z. - change (wordToZ (extz w (S n))) with (wordToZ (combine (natToWord n 0) w)~0). - rewrite wordToZ_WS_0. - unfold extz, wzero in IHn. - rewrite IHn. - rewrite Z.mul_assoc. - rewrite Z.mul_comm with (n:= 2%Z). - apply eq_sym, Z.mul_assoc. -Qed. - -Lemma extz_wneg: - forall sz (w: word sz) n, - extz (wneg w) n = wneg (extz w n). -Proof. - induction n; intros; [reflexivity|]. - cbn; rewrite wneg_WS_0. - unfold extz, wzero in IHn. - rewrite IHn. - reflexivity. -Qed. - -Lemma wneg_wordToZ: - forall sz (w: word (S sz)), - w <> wpow2 sz -> - wordToZ (wneg w) = (- wordToZ w)%Z. -Proof. - intros. - assert (wordToZ (wneg w) + wordToZ w = 0)%Z. - { destruct (weq w (wzero _)). - { subst; rewrite wzero_wneg, wordToZ_wzero. - reflexivity. - } - { rewrite <-wordToZ_distr_diff_wmsb. - { rewrite wplus_comm, wminus_inv. - apply wordToZ_wzero. - } - { remember (wmsb w false) as msb; destruct msb. - { eapply wmsb_wneg_true; eauto. } - { eapply wmsb_wneg_false; eauto. - intro Hx; elim n. - apply wordToNat_inj. - rewrite wordToNat_wzero, Hx; reflexivity. - } - } - } - } - lia. -Qed. - -Lemma wneg_wordToZ': - forall sz (w: word (S sz)) z, - w <> wpow2 sz -> - (z + wordToZ (wneg w))%Z = (z - wordToZ w)%Z. -Proof. - intros. - rewrite wneg_wordToZ by assumption. - lia. -Qed. - -Lemma wneg_wplus_distr: - forall sz (w1 w2: word sz), - wneg (w1 ^+ w2) = wneg w1 ^+ wneg w2. -Proof. - intros. - apply wplus_cancel with (c:= w1 ^+ w2). - rewrite wplus_comm, wminus_inv. - rewrite wplus_comm, wplus_assoc. - rewrite <-wplus_assoc with (x:= w1). - rewrite wplus_comm with (x:= w2). - rewrite wplus_assoc. - rewrite wminus_inv. - rewrite wplus_wzero_2. - rewrite wminus_inv. - reflexivity. -Qed. - -Lemma wminus_wneg: - forall sz (w1 w2: word sz), - wneg (w1 ^- w2) = w2 ^- w1. -Proof. - unfold wminus; intros. - rewrite wneg_wplus_distr. - rewrite wneg_idempotent. - apply wplus_comm. -Qed. - -Lemma wminus_wordToZ: - forall sz (w1 w2: word (S sz)), - w2 ^- w1 <> wpow2 sz -> - wordToZ (w1 ^- w2) = (- wordToZ (w2 ^- w1))%Z. -Proof. - intros. - rewrite <-wneg_idempotent with (w:= w1 ^- w2). - rewrite wminus_wneg. - rewrite wneg_wordToZ by assumption. - reflexivity. -Qed. - -Lemma wminus_wordToZ': - forall sz (w1 w2: word (sz + 1)), - existT word _ (w2 ^- w1) <> existT word _ (wpow2 sz) -> - wordToZ (w1 ^- w2) = (- wordToZ (w2 ^- w1))%Z. -Proof. - intro sz. - replace (sz + 1) with (S sz) by lia. - intros. - apply wminus_wordToZ. - intro Hx; elim H. - rewrite Hx; reflexivity. -Qed. - -Lemma wminus_wminusZ: forall (sz : nat) (w1 w2 : word sz), w1 ^- w2 = wminusZ w1 w2. -Proof. - unfold wminusZ, wminus, wordBinZ. intros. rewrite <- Z.add_opp_r. - rewrite wplus_wplusZ. unfold wplusZ, wordBinZ. - destruct sz. - - do 2 rewrite ZToWord_sz0. reflexivity. - - destruct (weq w2 (wpow2 sz)). - + subst. rewrite wpow2_wneg. - replace (wordToZ w1 + - wordToZ (wpow2 sz))%Z - with (wordToZ w1 + wordToZ (wpow2 sz) - 2 * wordToZ (wpow2 sz))%Z by lia. - replace (2 * wordToZ (wpow2 sz))%Z with (- 1 * Z.of_N (Npow2 (S sz)))%Z. - * symmetry. apply ZToWord_Npow2_sub_z. - * rewrite wordToZ_wordToN. - rewrite wpow2_wmsb. - rewrite wpow2_Npow2. - rewrite Npow2_S. - rewrite N2Z.inj_add. - lia. - + rewrite wneg_wordToZ by assumption. reflexivity. -Qed. - -Local Lemma wminusZ_helper: forall a b k1 k2 p, - ((a - k1 * p) - (b - k2 * p) = a - b - (k1 - k2) * p)%Z. -Proof. intros. nia. Qed. - -Lemma ZToWord_minus: forall sz a b, ZToWord sz (a - b) = ZToWord sz a ^- ZToWord sz b. -Proof. - intros. rewrite wminus_wminusZ. unfold wminusZ, wordBinZ. - destruct (wordToZ_ZToWord' sz a) as [k1 D1]. rewrite D1. clear D1. - destruct (wordToZ_ZToWord' sz b) as [k2 D2]. rewrite D2. clear D2. - rewrite wminusZ_helper. - symmetry. - apply ZToWord_Npow2_sub_z. -Qed. - -Lemma wminus_Z: forall sz (a b : word sz), - a ^- b = ZToWord sz (wordToZ a - wordToZ b). -Proof. - intros. rewrite ZToWord_minus. rewrite! ZToWord_wordToZ. reflexivity. -Qed. - -Lemma ZToWord_opp_wneg{sz: nat}: forall (x: Z), - ZToWord sz (- x) = ^~ (ZToWord sz x). -Proof. - intros. - rewrite wneg_0_wminus. - rewrite wminus_wminusZ. - unfold wminusZ, wordBinZ. - rewrite wordToZ_wzero. - rewrite (Z.sub_0_l (wordToZ (ZToWord sz x))). - destruct (wordToZ_ZToWord' sz x) as [k E]. - rewrite E. - rewrite Z.opp_sub_distr. - rewrite ZToWord_Npow2_add_k'. - reflexivity. -Qed. - -Lemma Zeqb_true_ZToWord: forall {sz: nat} (x y: Z), - (x =? y)%Z = true -> - ZToWord sz x = ZToWord sz y. -Proof. - intros. apply Z.eqb_eq in H. congruence. -Qed. - -Lemma word_ring_theory_Z: forall (sz: nat), - ring_theory (ZToWord sz 0) (ZToWord sz 1) - (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) eq. -Proof. - intros. - rewrite ZToWord_0. - rewrite ZToWord_1. - apply wring. -Qed. - -Lemma word_ring_morph_Z: forall (sz: nat), - ring_morph (ZToWord sz 0) (ZToWord sz 1) (@wplus sz) (@wmult sz) (@wminus sz) (@wneg sz) - eq 0%Z 1%Z Z.add Z.mul Z.sub Z.opp Z.eqb - (ZToWord sz). -Proof. - constructor. - + reflexivity. - + reflexivity. - + exact (@ZToWord_plus sz). - + exact (@ZToWord_minus sz). - + exact (@ZToWord_mult sz). - + exact (@ZToWord_opp_wneg sz). - + exact (@Zeqb_true_ZToWord sz). -Qed. - -Lemma extz_zero: - forall sz n, extz (natToWord sz 0) n = wzero _. -Proof. - unfold wzero; intros. - rewrite extz_combine. - apply combine_zero. -Qed. - -Lemma sext_eq_rect: - forall sz (w: word sz) n nsz Hsz1, - exists Hsz2, - eq_rect (sz + n) word (sext w n) (nsz + n) Hsz1 = - sext (eq_rect sz word w nsz Hsz2) n. -Proof. - intros. - assert (Hsz: sz = nsz) by lia. - exists Hsz. - subst; simpl. - eq_rect_simpl. - reflexivity. -Qed. - -Lemma wmsb_sext: - forall sz (w: word sz) n, - wmsb (sext w n) false = wmsb w false. -Proof. - unfold sext; intros. - remember (wmsb w false) as ww; destruct ww. - - destruct n; cbn. - + rewrite wmsb_combine_WO; auto. - + rewrite wmsb_combine with (b2:= false) by discriminate; cbn. - clear; induction n; cbn; auto. - - destruct n; cbn. - + rewrite wmsb_combine_WO; auto. - + rewrite wmsb_combine with (b2:= false) by discriminate; cbn. - clear; induction n; cbn; auto. -Qed. - -Lemma wmsb_wlshift_sext: - forall sz (w: word sz) n, - wmsb (sext w n) false = wmsb (wlshift (sext w n) n) false. -Proof. - intros. - pose proof (wlshift_sext_extz w n). - apply wmsb_existT with (b:= false) in H. - rewrite H. - rewrite wmsb_sext. - rewrite wmsb_extz. - reflexivity. -Qed. - -Lemma wordToZ_wordToNat_pos: - forall sz (w: word sz), - wmsb w false = false -> - Z.of_nat (wordToNat w) = wordToZ w. -Proof. - unfold wordToZ; intros. - rewrite H. - rewrite <-wordToN_to_nat. - destruct (wordToN w). - - reflexivity. - - simpl; apply positive_nat_Z. -Qed. - -Corollary wmsb_Zabs_pos: - forall sz (w: word sz), - wmsb w false = false -> Z.abs (wordToZ w) = wordToZ w. -Proof. - intros. - apply wmsb_false_pos in H. - unfold Z.abs. - destruct (wordToZ w); auto. - pose proof (Zlt_neg_0 p); lia. -Qed. - -Corollary wmsb_Zabs_neg: - forall sz (w: word sz), - wmsb w false = true -> (Z.abs (wordToZ w) = - wordToZ w)%Z. -Proof. - intros. - apply wmsb_true_neg in H. - unfold Z.abs. - destruct (wordToZ w); auto. - pose proof (Zgt_pos_0 p); lia. -Qed. - -Lemma wordToN_combine: - forall sz1 (w1: word sz1) sz2 (w2: word sz2), - wordToN (combine w1 w2) = (wordToN w1 + Npow2 sz1 * wordToN w2)%N. -Proof. - intros. - repeat rewrite wordToN_nat. - rewrite pow2_N. - rewrite <-Nat2N.inj_mul, <-Nat2N.inj_add. - rewrite wordToNat_combine; reflexivity. -Qed. - -Lemma word_exists_bound: - forall sz z, - (- Z.of_nat (pow2 sz) <= z < Z.of_nat (pow2 sz))%Z -> - exists w: word (S sz), wordToZ w = z. -Proof. - intros. - exists (ZToWord (S sz) z). - apply wordToZ_ZToWord; assumption. -Qed. - -Lemma sext_size: - forall sz n (w: word (sz + n)), - sz <> 0 -> - (- Z.of_nat (pow2 (sz - 1)) <= wordToZ w < Z.of_nat (pow2 (sz - 1)))%Z -> - exists sw, w = sext sw n. -Proof. - intros. - destruct sz; [exfalso; auto|clear H]. - simpl in *. - replace (sz - 0) with sz in H0 by lia. - apply word_exists_bound in H0. - destruct H0 as [sw ?]. - exists sw. - apply wordToZ_inj. - change (S (sz + n)) with (S sz + n). - rewrite sext_wordToZ. - auto. -Qed. - -Lemma wordToZ_combine_WO: - forall sz (w: word sz), - wordToZ (combine w WO) = wordToZ w. -Proof. - dependent induction w; [reflexivity|]. - simpl; destruct b. - - destruct n; [rewrite (shatter_word w); reflexivity|]. - change (S n + 0) with (S (n + 0)) in *. - do 2 rewrite wordToZ_WS_1. - rewrite IHw; reflexivity. - - do 2 rewrite wordToZ_WS_0. - rewrite IHw; reflexivity. -Qed. - -Lemma combine_WO: - forall sz (w: word sz), - combine w WO = eq_rect _ word w _ (Nat.add_comm 0 sz). -Proof. - intros. - apply wordToZ_inj. - rewrite wordToZ_eq_rect. - apply wordToZ_combine_WO. -Qed. - -Lemma zext_zero: - forall sz (w: word sz), - zext w 0 = eq_rect _ word w _ (Nat.add_comm 0 sz). -Proof. - unfold zext; intros. - apply combine_WO. -Qed. - -Lemma wmsb_false_wordToNat_eq: - forall sz (w: word (S sz)), - wmsb w false = false -> - wordToNat w = wordToNat (split1 sz _ (eq_rect _ word w _ (Nat.add_comm 1 sz))). -Proof. - intros. - remember (eq_rect _ word w _ (Nat.add_comm 1 sz)) as ww. - assert (wmsb ww false = false) by (subst; rewrite <-wmsb_eq_rect; assumption). - replace (wordToNat w) with (wordToNat ww) by (subst; rewrite wordToNat_eq_rect; reflexivity). - clear Heqww H w. - apply wmsb_false_split2_wzero in H0. - rewrite <-combine_split with (w:= ww) at 1. - rewrite wordToNat_combine. - rewrite <-H0. - cbn; lia. -Qed. - -Lemma wordToZ_bound_weakened: - forall z n, (Z.abs z < n)%Z -> (- n <= z < n)%Z. -Proof. - intros. - apply Z.abs_lt in H. - lia. -Qed. - -Lemma zext_size: - forall sz n (w: word (sz + n)), - (- Z.of_nat (pow2 sz) <= wordToZ w < Z.of_nat (pow2 sz))%Z -> - wmsb w false = false -> - exists sw, w = zext sw n. -Proof. - intros. - destruct n. - - exists (eq_rect _ word w _ (Nat.add_comm _ _)). - rewrite zext_zero. - apply eq_sym, eq_rect_2. - - apply word_exists_bound in H. - destruct H as [ssw ?]. - assert (wmsb ssw false = false). - { apply wmsb_false_pos; apply wmsb_false_pos in H0. - rewrite H; assumption. - } - eexists. - apply wordToZ_inj. - rewrite zext_wordToNat_equal_Z by discriminate. - rewrite <-H. - rewrite <-wordToZ_wordToNat_pos by assumption. - rewrite wmsb_false_wordToNat_eq by assumption. - reflexivity. -Qed. - -Lemma zext_size_1: - forall sz (w: word (sz + 1)), - wmsb w false = false -> - exists sw, w = zext sw 1. -Proof. - intros. - apply zext_size; auto. - generalize dependent w. - replace (sz + 1) with (S sz) by lia. - intros. - unfold wordToZ. - rewrite H. - apply wmsb_false_bound in H. - remember (wordToN w) as n; destruct n; simpl. - - split. - + lia. - + pose proof (pow2_zero sz); lia. - - rewrite <-N2Z.inj_pos. - rewrite <-N_nat_Z. - split; [lia|]. - apply inj_lt. - rewrite <-Npow2_nat. - apply Nlt_out; auto. -Qed. - -Lemma sext_wplus_exist: - forall sz (w1 w2: word sz) n, - exists w: word (S sz), - existT word _ (sext w1 (S n) ^+ sext w2 (S n)) = - existT word _ (sext w n). -Proof. - intros; eexists. - apply wordToZ_existT; [lia|]. - rewrite sext_wplus_wordToZ_distr by discriminate. - do 3 rewrite sext_wordToZ. - assert (- Z.of_nat (pow2 sz) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 sz))%Z. - { clear n. - dependent destruction w1. - { rewrite (shatter_word w2); cbn; lia. } - { remember (WS b w1) as ww1; clear Heqww1 w1 b. - pose proof (wordToZ_size' ww1). - pose proof (wordToZ_size' w2). - destruct H, H0. - split. - { simpl; do 2 rewrite Nat2Z.inj_add; lia. } - { simpl; do 2 rewrite Nat2Z.inj_add; lia. } - } - } - apply wordToZ_ZToWord in H. - rewrite <-H. - reflexivity. -Qed. - -(* Making wlt_dec opaque is necessary to prevent the [exact H] in the - * example below from blowing up.. - *) -Global Opaque wlt_dec. -Definition test_wlt_f (a : nat) (b : nat) : nat := - if wlt_dec (natToWord 64 a) $0 then 0 else 0. -Theorem test_wlt_f_example: forall x y z, test_wlt_f x y = 0 -> test_wlt_f x z = 0. -Proof. - intros. - exact H. -Qed. - -Lemma wordToNat_eq1: forall sz (a b: word sz), a = b -> wordToNat a = wordToNat b. -Proof. - intros; subst; reflexivity. -Qed. - -Lemma wordToNat_eq2: forall sz (a b: word sz), wordToNat a = wordToNat b -> a = b. -Proof. - intros. - rewrite <- natToWord_wordToNat with (w := a). - rewrite <- natToWord_wordToNat with (w := b). - rewrite H. - reflexivity. -Qed. - -Lemma wordToNat_lt1: forall sz (a b: word sz), a < b -> (wordToNat a < wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. - -Lemma wordToNat_lt2: forall sz (a b: word sz), (wordToNat a < wordToNat b)%nat -> a < b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. - -Lemma wordToNat_gt1: forall sz (a b: word sz), a > b -> (wordToNat a > wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. - -Lemma wordToNat_gt2: forall sz (a b: word sz), (wordToNat a > wordToNat b)%nat -> a > b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. - -Lemma wordToNat_le1: forall sz (a b: word sz), a <= b -> (wordToNat a <= wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. - -Lemma wordToNat_le2: forall sz (a b: word sz), (wordToNat a <= wordToNat b)%nat -> a <= b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. - -Lemma wordToNat_ge1: forall sz (a b: word sz), a >= b -> (wordToNat a >= wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. - -Lemma wordToNat_ge2: forall sz (a b: word sz), (wordToNat a >= wordToNat b)%nat -> a >= b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. - -Lemma wordToNat_neq1: forall sz (a b: word sz), a <> b -> wordToNat a <> wordToNat b. -Proof. - unfold not. - intros. - apply wordToNat_eq2 in H0. - tauto. -Qed. - -Lemma wordToNat_neq2: forall sz (a b: word sz), wordToNat a <> wordToNat b -> a <> b. -Proof. - unfold not. - intros. - subst. - tauto. -Qed. - -Lemma wordToNat_wplus': forall sz (a b: word sz), - (#a + #b < pow2 sz)%nat -> - #(a ^+ b) = #a + #b. -Proof. - intros. - rewrite <-? wordToN_to_nat in *. - rewrite <-? Nnat.N2Nat.inj_add in *. - rewrite <- Npow2_nat in *. - apply Nlt_in in H. - rewrite wordToN_plus by assumption. - reflexivity. -Qed. - -Lemma wordToNat_wplus'': forall sz (a: word sz) (b: nat), - (#a + b < pow2 sz)%nat -> #(a ^+ $b) = #a + b. -Proof. - intros. rewrite wordToNat_wplus'; - rewrite wordToNat_natToWord_2; lia. -Qed. - -Lemma wordToNat_wmult': forall sz (a b: word sz), - (#a * #b < pow2 sz)%nat -> - #(a ^* b) = #a * #b. -Proof. - intros. - rewrite <-? wordToN_to_nat in *. - rewrite <-? Nnat.N2Nat.inj_mul in *. - rewrite <- Npow2_nat in *. - apply Nlt_in in H. - rewrite wordToN_mult by assumption. - reflexivity. -Qed. - -Lemma wordNotNot: forall sz (a b: word sz), (a <> b -> False) -> a = b. -Proof. - intros. - destruct (weq a b); subst; tauto. -Qed. - -Ltac pre_word_lia := - unfold wzero, wone in *; - repeat match goal with - | H: @eq ?T ?a ?b |- _ => - match T with - | word ?sz => - apply (@wordToNat_eq1 sz a b) in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - end - | |- @eq ?T ?a ?b => - match T with - | word ?sz => - apply (@wordToNat_eq2 sz a b); - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - end - | H: ?a < ?b |- _ => - apply wordToNat_lt1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a < ?b => - apply wordToNat_lt2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a > ?b |- _ => - apply wordToNat_gt1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a > ?b => - apply wordToNat_gt2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a <= ?b |- _ => - apply wordToNat_le1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a <= ?b => - apply wordToNat_le2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a > ?b -> False |- _ => - apply wordToNat_le1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a > ?b -> False => - apply wordToNat_le2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a < ?b -> False |- _ => - apply wordToNat_ge1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a < ?b -> False => - apply wordToNat_ge2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: not (@eq ?T ?a ?b) |- _ => - match T with - | word ?sz => - apply (@wordToNat_neq1 sz a b) in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - end - | |- not (@eq ?T ?a ?b) => - match T with - | word ?sz => - apply (@wordToNat_neq2 sz a b); - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - end - | H: @eq ?T ?a ?b -> False |- _ => - match T with - | word ?sz => - apply (@wordToNat_neq1 sz a b) in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - end - | |- @eq ?T ?a ?b -> False => - match T with - | word ?sz => - apply (@wordToNat_neq2 sz a b); - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - end - | H: (@eq ?T ?a ?b -> False) -> False |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - | H: (not (@eq ?T ?a ?b)) -> False |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - | H: not (@eq ?T ?a ?b -> False) |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - | H: not (not (@eq ?T ?a ?b)) |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - end. - - -Ltac word_lia := pre_word_lia; lia. - - - -Lemma word_le_ge_eq sz (w1 w2: word sz): w1 <= w2 -> w1 >= w2 -> w1 = w2. -Proof. - intros; word_lia. -Qed. - -Lemma word_le_zero sz (w: word sz): w <= wzero sz -> w = wzero sz. -Proof. - intros; word_lia. -Qed. - -Close Scope word_scope. - -Open Scope word_scope. -Local Open Scope nat. - -Lemma wzero_wones: forall sz, sz >= 1 -> - natToWord sz 0 <> wones sz. -Proof. - intros. - unfold not. - intros. - pose proof (f_equal (@wordToNat sz) H0) as sth. - unfold wzero in *. - rewrite roundTrip_0 in *. - rewrite wones_pow2_minus_one in sth. - destruct sz; [lia | ]. - pose proof (NatLib.one_lt_pow2 sz). - lia. -Qed. - -Lemma wzero_wplus: forall sz w, wzero sz ^+ w = w. -Proof. - intros. - unfold wzero. - apply wplus_unit. -Qed. - -Lemma wordToNat_nonZero sz (w: word sz): - w <> wzero sz -> wordToNat w > 0. -Proof. - induction w; simpl; unfold wzero; simpl; intros. - - tauto. - - destruct b. - + lia. - + assert (sth: w <> (natToWord n 0)). - { intro. - subst. - tauto. - } - assert (sth2: wordToNat w <> 0). - { intro sth3. - specialize (IHw sth). - lia. - } - lia. -Qed. - -Lemma split2_pow2: forall sz n, - 2 ^ sz <= n < 2 ^ S sz -> - wordToNat (split2 sz 1 (natToWord (sz + 1) n)) = 1. -Proof. - intros. - rewrite wordToNat_split2. - simpl in *. - rewrite Nat.add_0_r in *. - rewrite wordToNat_natToWord_bound with (bound := wones _). - - destruct H. - assert (sth: pow2 sz <> 0) by lia. - pose proof (Nat.div_le_mono _ _ (pow2 sz) sth H) as sth2. - rewrite Nat.div_same in sth2 by auto. - apply Nat.lt_le_pred in H0. - pose proof (Nat.div_le_mono _ _ (pow2 sz) sth H0) as sth3. - rewrite <- Nat.sub_1_r in sth3. - assert (sth4: pow2 sz = 1 * pow2 sz) by lia. - rewrite sth4 in sth3 at 2. - assert (sth5: 1 * pow2 sz + pow2 sz - 1 = 1 * pow2 sz + (pow2 sz - 1)) by lia. - rewrite sth5 in sth3. - rewrite Nat.div_add_l in sth3 by lia. - rewrite Nat.div_small with (a := pow2 sz - 1) in sth3 by lia. - lia. - - rewrite wones_pow2_minus_one. - assert (sth: sz + 1 = S sz) by lia. - rewrite sth. - simpl. - lia. -Qed. - -Lemma combine_wones_WO sz: - forall w, w <> wzero sz -> split2 sz 1 (combine (wones sz) ($ 0) ^+ combine w ($ 0)) = WO~1. -Proof. - intros. - match goal with - | |- split2 _ _ (?a ^+ ?b) = _ => - rewrite <- (@natToWord_wordToNat _ a); - rewrite <- (@natToWord_wordToNat _ b) - end. - rewrite <- natToWord_plus. - rewrite ?wordToNat_combine. - simpl. - rewrite wones_pow2_minus_one. - pose proof (wordToNat_bound w) as sth. - pose proof (wordToNat_nonZero H). - assert (sth2: 2^sz <= 2 ^ sz - 1 + wordToNat w < 2 ^ (S sz)). { - pose proof (pow2_zero sz) as sth3. - split; simpl; lia. - } - apply split2_pow2 in sth2. - rewrite Nat.mul_0_r. - rewrite ?Nat.add_0_r. - apply (f_equal (natToWord 1)) in sth2. - rewrite natToWord_wordToNat in sth2. - assumption. -Qed. - -Lemma wordToNat_plus sz (w1 w2: word sz): - natToWord sz (wordToNat w1 + wordToNat w2) = w1 ^+ w2. -Proof. - rewrite natToWord_plus. - rewrite ?natToWord_wordToNat. - auto. -Qed. - -Lemma wordToNat_natToWord_eqn sz: - forall n, - wordToNat (natToWord sz n) = n mod (pow2 sz). -Proof. - intros. - pose proof (wordToNat_natToWord sz n). - destruct H as [? [? ?]]. - rewrite H. - assert (sth: pow2 sz * x = x * pow2 sz) by (apply Nat.mul_comm). - rewrite <- sth in *. - clear sth. - pose proof (wordToNat_bound (natToWord sz n)). - apply (Nat.mod_unique n (pow2 sz) x (n - pow2 sz * x)); try lia. -Qed. - -Lemma mod_factor a b c: - b <> 0 -> - c <> 0 -> - (a mod (b * c)) mod b = a mod b. -Proof. - intros. - pose proof (Nat.mod_mul_r a _ _ H H0). - rewrite H1. - rewrite Nat.add_mod_idemp_l by auto. - rewrite Nat.add_mod by auto. - assert (sth: b * ((a/b) mod c) = (a/b) mod c * b) by (apply Nat.mul_comm). - rewrite sth. - rewrite Nat.mod_mul by auto. - rewrite Nat.add_0_r. - rewrite Nat.mod_mod by auto. - auto. -Qed. - -Lemma split1_combine_wplus sz1 sz2 (w11 w21: word sz1) (w12 w22: word sz2): - split1 _ _ (combine w11 w12 ^+ combine w21 w22) = w11 ^+ w21. -Proof. - rewrite <- natToWord_wordToNat at 1. - rewrite wordToNat_split1. - rewrite <- wordToNat_plus. - rewrite ?wordToNat_combine. - assert (sth: #w11 + pow2 sz1 * #w12 + (#w21 + pow2 sz1 * #w22) = #w11 + #w21 + pow2 sz1 * (#w12 + #w22)) by ring. - rewrite wordToNat_natToWord_eqn. - rewrite sth. - rewrite Nat.pow_add_r. - assert (pow2 sz1 <> 0) by (pose proof (pow2_zero sz1); intro; lia). - assert (pow2 sz2 <> 0) by (pose proof (pow2_zero sz2); intro; lia). - rewrite mod_factor by auto. - rewrite Nat.add_mod by auto. - assert (sth2: pow2 sz1 * (# w12 + #w22) = (#w12 + #w22) * pow2 sz1) by ring. - rewrite sth2. - rewrite Nat.mod_mul by auto. - rewrite Nat.add_0_r. - rewrite Nat.mod_mod by auto. - rewrite <- wordToNat_natToWord_eqn. - rewrite natToWord_wordToNat. - rewrite natToWord_plus. - rewrite ?natToWord_wordToNat. - auto. -Qed. - -Lemma div_2 a b: - b <> 0 -> - a < b * 2 -> - a >= b -> - a / b = 1. -Proof. - intros. - assert (sth: b * 1 <= a) by lia. - pose proof (Nat.div_le_lower_bound a b 1 H sth). - pose proof (Nat.div_lt_upper_bound a b 2 H H0). - lia. -Qed. - -Lemma mod_sub a b: - b <> 0 -> - a < b * 2 -> - a >= b -> - a mod b = a - b. -Proof. - intros. - rewrite Nat.mod_eq; auto. - repeat f_equal. - rewrite div_2 by auto. - rewrite Nat.mul_1_r; auto. -Qed. - -Lemma wordToNat_wneg_non_0 sz: forall (a: word sz), - a <> natToWord _ 0 -> - # (wneg a) = pow2 sz - #a. -Proof. - intros. - unfold wneg. - rewrite pow2_N. - rewrite NToWord_nat. - rewrite Nnat.N2Nat.inj_sub. - rewrite wordToN_to_nat. - rewrite Nnat.Nat2N.id. - simpl. - rewrite wordToNat_natToWord_idempotent'; auto. - assert (#a <> 0) by word_lia. - pose proof (pow2_zero sz). - lia. -Qed. - -Lemma wordToNat_wnot sz: forall (a: word sz), - # (wnot a) = pow2 sz - #a - 1. -Proof. - intros. - rewrite wnot_def. - rewrite pow2_N. - rewrite NToWord_nat. - rewrite Nnat.N2Nat.inj_sub. - rewrite Nnat.N2Nat.inj_sub. - rewrite wordToN_to_nat. - rewrite Nnat.Nat2N.id. - simpl. - rewrite wordToNat_natToWord_idempotent'; auto; - pose proof (pow2_zero sz); - unfold Pos.to_nat; simpl; - lia. -Qed. - -Lemma wzero_wor: forall sz w, w ^| wzero sz = w. -Proof. - intros. - rewrite wor_comm. - rewrite wor_wzero. - auto. -Qed. - -Lemma bool_prop1: forall a b, a && negb (a && b) = a && negb b. -Proof. - destruct a, b; simpl; auto. -Qed. - -Lemma wordToNat_wplus sz (w1 w2: word sz): - #(w1 ^+ w2) = (#w1 + #w2) mod (pow2 sz). -Proof. - rewrite <- (natToWord_wordToNat w1) at 1. - rewrite <- (natToWord_wordToNat w2) at 1. - rewrite <- natToWord_plus. - rewrite wordToNat_natToWord_eqn. - auto. -Qed. - -Lemma wordToNat_wmult : forall (sz : nat) (w1 w2 : word sz), - #(w1 ^* w2) = (#w1 * #w2) mod pow2 sz. -Proof using . - clear. intros. - rewrite <- (natToWord_wordToNat w1) at 1. - rewrite <- (natToWord_wordToNat w2) at 1. - rewrite <- natToWord_mult. - rewrite wordToNat_natToWord_eqn. - reflexivity. -Qed. - -Local Arguments natToWord : simpl never. -Local Arguments weq : simpl never. - -Lemma wor_r_wzero_1 sz: (* Note: not axiom free *) - forall w1 w2, - w1 ^| w2 = natToWord sz 0 -> - w2 = natToWord sz 0. -Proof. - induction w1; simpl; auto; intros. - pose proof (shatter_word w2) as sth. - simpl in sth. - rewrite sth in *. - unfold wor in H. - simpl in H. - unfold natToWord in H. - unfold natToWord. - fold (natToWord n (Nat.div2 0)) in *. - unfold Nat.div2, mod2 in *. - inversion H. - destruct_existT. - rewrite (IHw1 _ H2). - f_equal. - destruct b, (whd w2); auto. -Qed. - -Lemma wor_r_wzero_2 sz: (* Note: not axiom free *) - forall w1 w2, - w1 ^| w2 = natToWord sz 0 -> - w1 = natToWord sz 0. -Proof. - induction w1; simpl; auto; intros. - pose proof (shatter_word w2) as sth. - simpl in sth. - rewrite sth in *. - unfold wor in H. - simpl in H. - unfold natToWord in H. - unfold natToWord. - fold (natToWord n (Nat.div2 0)) in *. - unfold Nat.div2, mod2 in *. - inversion H. - destruct_existT. - rewrite (IHw1 _ H2). - f_equal. - destruct b, (whd w2); auto. -Qed. - -Lemma wordToNat_zero sz: forall (w: word sz), #w = 0 -> w = natToWord _ 0. -Proof. - intros. - apply (f_equal (natToWord sz)) in H. - rewrite natToWord_wordToNat in H. - auto. -Qed. - -Lemma wordToNat_notZero sz: forall (w: word sz), #w <> 0 -> w <> natToWord _ 0. -Proof. - intros. - intro. - subst. - pose proof (wordToNat_wzero sz); unfold wzero in *. - tauto. -Qed. - - -Lemma natToWord_nzero sz x: - 0 < x -> - x < pow2 sz -> - natToWord sz x <> natToWord sz 0. -Proof. - intros. - pre_word_lia. - rewrite wordToNat_natToWord_idempotent'; lia. -Qed. - -Lemma pow2_lt_pow2_S: - forall n, pow2 n < pow2 (n+1). -Proof. - induction n; simpl; lia. -Qed. - -Lemma combine_shiftl_plus_n n x: - x < pow2 n -> - (combine (natToWord n x) WO~1) = (natToWord (n + 1) (pow2 n)) ^+ natToWord (n + 1) x. -Proof. - intros. - apply wordToNat_eq2. - rewrite ?wordToNat_combine. - rewrite ?wordToNat_natToWord_idempotent'; simpl; auto. - rewrite <- wordToNat_plus. - pose proof (pow2_lt_pow2_S n) as sth. - rewrite ?wordToNat_natToWord_idempotent'; simpl; try lia. - rewrite ?wordToNat_natToWord_idempotent'; simpl; try lia. - apply Nat.lt_add_lt_sub_l. - rewrite Nat.add_1_r. - simpl. - lia. -Qed. - -Lemma combine_natToWord_wzero n: - forall x, - x < pow2 n -> - combine (natToWord n x) (natToWord 1 0) = natToWord (n+1) x. -Proof. - intros. - apply wordToNat_eq2. - rewrite ?wordToNat_combine. - simpl. - rewrite Nat.mul_0_r. - rewrite Nat.add_0_r. - pose proof (pow2_lt_pow2_S n) as sth2. - rewrite ?wordToNat_natToWord_idempotent' by lia. - reflexivity. -Qed. - -Lemma word_cancel_l sz (a b c: word sz): - a = b -> c ^+ a = c ^+ b. -Proof. - intro H; rewrite H; reflexivity. -Qed. - - -Lemma word_cancel_r sz (a b c: word sz): - a = b -> a ^+ c = b ^+ c. -Proof. - intro H; rewrite H; reflexivity. -Qed. - -Lemma word_cancel_m sz (a b c a' b': word sz): - a ^+ a' = b ^+ b'-> a ^+ c ^+ a' = b ^+ c ^+ b'. -Proof. - intros. - assert (sth: a ^+ c ^+ a' = a ^+ a'^+ c ). - rewrite <- wplus_assoc. - rewrite wplus_comm with (y := a'). - rewrite wplus_assoc. - reflexivity. - rewrite sth. - rewrite H. - rewrite <- wplus_assoc. - rewrite wplus_comm with (x := b'). - rewrite wplus_assoc. - reflexivity. -Qed. - -Lemma move_wplus_wminus sz (a b c: word sz): - a ^+ b = c <-> a = c ^- b. -Proof. - split; intro. - + rewrite <- H. - rewrite wminus_def. - rewrite <- wplus_assoc. - rewrite wminus_inv. - rewrite wplus_wzero_1. - reflexivity. - + rewrite H. - rewrite wminus_def. - rewrite <- wplus_assoc. - rewrite wplus_comm with (x:= ^~b). - rewrite wminus_inv. - rewrite wplus_wzero_1. - reflexivity. -Qed. - -Lemma move_wplus_pow2 sz (w1 w2: word (S sz)): - w1 = w2 ^+ $(pow2 sz) <-> - w1 ^+ $(pow2 sz) = w2. -Proof. - split. - + intro. - apply move_wplus_wminus. - rewrite wminus_def. - rewrite pow2_wneg. - assumption. - + intro. - apply move_wplus_wminus in H. - rewrite <- pow2_wneg. - assumption. -Qed. - -Lemma move_wminus_pow2 sz (w1 w2: word (S sz)): - w1 = w2 ^- $(pow2 sz) <-> - w1 ^- $(pow2 sz) = w2. -Proof. - split. - + intro. - apply <- move_wplus_wminus. - rewrite pow2_wneg. - assumption. - + intro. - apply move_wplus_wminus. - rewrite <- pow2_wneg. - rewrite <- wminus_def. - assumption. -Qed. - -Lemma pow2_wzero sz : - $(pow2 sz) = wzero sz. -Proof. - apply wordToNat_eq2. - rewrite wordToNat_natToWord_eqn. - rewrite Nat.mod_same. - rewrite wordToNat_wzero; auto. - pose proof (zero_lt_pow2 sz) as sth. - lia. -Qed. - -Lemma pow2_wplus_wzero sz: - $(pow2 sz) ^+ $(pow2 sz) = wzero (sz + 1). -Proof. - apply wordToNat_eq2. - rewrite <- natToWord_plus. - rewrite <- mul2_add. - assert (pow2_1_mul: pow2 1 = 2) by auto. - rewrite <- pow2_1_mul at 2. - rewrite <- pow2_add_mul. - rewrite pow2_wzero; auto. -Qed. - -Lemma wplus_wplus_pow2 sz (x1 x2 y1 y2: word (sz + 1)): - x1 = y1 ^+ $(pow2 sz) -> - x2 = y2 ^+ $(pow2 sz) -> - x1 ^+ x2 = y1 ^+ y2. -Proof. - intros. - rewrite H. - rewrite <- wplus_assoc. - rewrite wplus_comm. - rewrite wplus_comm in H0. - rewrite H0. - rewrite wplus_assoc. - rewrite pow2_wplus_wzero. - rewrite wzero_wplus. - rewrite wplus_comm. - reflexivity. -Qed. - - - -Lemma wlt_meaning sz (w1 w2: word sz): - (w1 < w2)%word <-> #w1 < #w2. -Proof. - pose proof (@wordToNat_gt1 sz w2 w1). - pose proof (@wordToNat_gt2 sz w2 w1). - tauto. -Qed. - -Lemma word1_neq (w: word 1): - w <> WO~0 -> - w <> WO~1 -> - False. -Proof. - shatter_word w; intros. - destruct x; tauto. -Qed. - -Lemma combine_1 sz: - sz > 1 -> - natToWord (sz + 1) 1 = combine ($ 1) WO~0. -Proof. - intros. - rewrite <- natToWord_wordToNat. - f_equal. - rewrite wordToNat_combine; simpl. - rewrite Nat.mul_0_r, Nat.add_0_r. - rewrite wordToNat_natToWord_idempotent'; auto. - destruct sz; simpl; try lia; - pose proof (pow2_zero sz); - lia. -Qed. - -Lemma wordToNat_cast ni no (pf: ni = no): - forall w, - #w = #(match pf in _ = Y return _ Y with - | eq_refl => w - end). -Proof. - destruct pf; intros; auto. -Qed. - -(* Usually this kind of lemmas would need a guarantee that "(wordToN a mod wordToN b)%N" - does not overflow, but fortunately this can never overflow. - And also, we don't need to prevent b from being 0. *) -Lemma wordToN_mod: forall sz (a b: word sz), - wordToN (a ^% b) = (wordToN a mod wordToN b)%N. -Proof. - intros. unfold wmod, wordBin. - rewrite wordToN_NToWord_2; [ reflexivity | ]. - destruct (wordToN b) eqn: E. - - unfold N.modulo, N.div_eucl. destruct (wordToN a) eqn: F; simpl. - + apply Npow2_pos. - + rewrite <- F. apply wordToN_bound. - - eapply N.lt_trans. - + apply N.mod_upper_bound. congruence. - + rewrite <- E. apply wordToN_bound. -Qed. - -Lemma wordToNat_mod: forall sz (a b: word sz), - b <> $0 -> - #(a ^% b) = #a mod #b. -Proof. - intros. - rewrite <-? wordToN_to_nat in *. - rewrite <-? N2Nat.inj_mod in *. - - rewrite wordToN_mod by assumption. - reflexivity. - - intro. apply H. replace 0%N with (wordToN (natToWord sz 0)) in H0. - + apply wordToN_inj. exact H0. - + erewrite <- wordToN_wzero. reflexivity. -Qed. - -Lemma wlshift_mul_pow2: forall sz n (a: word sz), - wlshift a n = a ^* $ (pow2 n). -Proof. - intros. - apply wordToNat_inj. - unfold wlshift. - rewrite? wordToNat_split1. - eq_rect_simpl. - rewrite? wordToNat_eq_rect. - rewrite? wordToNat_combine. - rewrite? wordToNat_wzero. - rewrite wordToNat_wmult. - rewrite wordToNat_natToWord_eqn. - rewrite Nat.add_0_l. - rewrite Nat.mul_mod_idemp_r by (apply pow2_ne_zero). - rewrite Nat.mul_comm. - reflexivity. -Qed. - -Lemma wlshift_mul_Zpow2: forall sz n (a: word sz), - (0 <= n)%Z -> - wlshift a (Z.to_nat n) = a ^* ZToWord sz (2 ^ n). -Proof. - intros. rewrite wlshift_mul_pow2. f_equal. - change 2 with (Z.to_nat 2). - rewrite <- Z2Nat.inj_pow by lia. - apply natToWord_Z_to_nat. - apply Z.pow_nonneg. - lia. -Qed. - -Lemma wlshift_distr_plus: forall sz n (a b: word sz), - wlshift (a ^+ b) n = wlshift a n ^+ wlshift b n. -Proof. - intros. - rewrite? wlshift_mul_pow2. - apply wmult_plus_distr. -Qed. - -Lemma wlshift_iter: forall sz n1 n2 (a: word sz), - wlshift (wlshift a n1) n2 = wlshift a (n1 + n2). -Proof. - intros. rewrite? wlshift_mul_pow2. - rewrite <- wmult_assoc. - rewrite <- natToWord_mult. - do 2 f_equal. - symmetry. - apply Nat.pow_add_r. -Qed. - -Lemma wlshift_zero: forall sz n, wlshift $0 n = natToWord sz 0. -Proof. - intros. - apply wordToNat_inj. - unfold wlshift. - rewrite? wordToNat_split1. - eq_rect_simpl. - rewrite? wordToNat_eq_rect. - rewrite? wordToNat_combine. - rewrite? wordToNat_wzero. - rewrite Nat.mul_0_r. - change (0 + 0) with 0. - rewrite Nat.mod_0_l by (apply pow2_ne_zero). - reflexivity. -Qed. - -Lemma wordToN_wordToZ: forall (sz : nat) (w : word sz), - wordToN w = Z.to_N (wordToZ w + Z.of_N (if wmsb w false then Npow2 sz else 0%N)). -Proof. - intros. - rewrite (wordToZ_wordToN w). - remember (if wmsb w false then Npow2 sz else 0%N) as c; clear Heqc. - rewrite Z.sub_add. - symmetry. - apply N2Z.id. -Qed. - -Lemma uwordToZ_ZToWord_0: forall (sz : nat) (z : Z), - (0 <= z < Z.of_N (Npow2 sz))%Z -> - uwordToZ (ZToWord sz z) = z. -Proof. - intros. - unfold uwordToZ. - pose proof (Z2N.id _ (proj1 H)). - remember (Z.to_N z) as n; clear Heqn. subst z. - apply proj2 in H. - f_equal. - rewrite ZToWord_Z_of_N. - apply wordToN_NToWord_2. - apply N2Z.inj_lt. - assumption. -Qed. - -Lemma uwordToZ_ZToWord: forall (sz : nat) (z : Z), - (0 <= z < 2 ^ (Z.of_nat sz))%Z -> - uwordToZ (ZToWord sz z) = z. -Proof. - intros. apply uwordToZ_ZToWord_0. - intuition idtac. - change 2%Z with (Z.of_nat 2) in H1. - rewrite <- Nat2Z.inj_pow in H1. - rewrite <- N_nat_Z. - rewrite Npow2_nat. - assumption. -Qed. - -Lemma NToWord_Z_to_N: forall sz n, - (0 <= n)%Z -> - NToWord sz (Z.to_N n) = ZToWord sz n. -Proof. - intros. - rewrite <- ZToWord_Z_of_N. - rewrite Z2N.id by assumption. - reflexivity. -Qed. - -Lemma uwordToZ_ZToWord_k: forall (sz : nat) (n : Z), - (0 <= n)%Z -> - exists k, uwordToZ (ZToWord sz n) = (n - k * 2 ^ Z.of_nat sz)%Z /\ (k * 2 ^ Z.of_nat sz <= n)%Z. -Proof. - intros *. intro C. - unfold uwordToZ. - pose proof (wordToN_NToWord sz (Z.to_N n)) as P. - destruct P as [k [P Q]]. - exists (Z.of_N k). - rewrite NToWord_Z_to_N in P by assumption. - rewrite P. clear P. - rewrite <- Z_of_N_Npow2 in *. - rewrite <- N2Z.inj_mul. - rewrite N2Z.inj_sub by assumption. - apply N2Z.inj_le in Q. - rewrite Z2N.id in * by assumption. - auto. -Qed. - -Lemma Zpow2_pos: forall n, (2 ^ Z.of_nat n > 0)%Z. -Proof. - intros. pose proof (Z.pow_pos_nonneg 2 (Z.of_nat n)). lia. -Qed. - -Lemma uwordToZ_bound: forall sz (a: word sz), - (0 <= uwordToZ a < 2 ^ Z.of_nat sz)%Z. -Proof. - intros. - unfold uwordToZ. - split. - + apply N2Z.is_nonneg. - + pose proof (wordToN_bound a) as P. - apply N2Z.inj_lt in P. - rewrite Z_of_N_Npow2 in P. - assumption. -Qed. - -Lemma uwordToZ_ZToWord_mod: forall (sz : nat) (z : Z), - (0 <= z)%Z -> - uwordToZ (ZToWord sz z) = (z mod 2 ^ (Z.of_nat sz))%Z. -Proof. - intros. - pose proof (uwordToZ_ZToWord_k sz H) as P. - destruct P as [k [P Q]]. - pose proof (uwordToZ_bound (ZToWord sz z)) as B. - rewrite P in *. clear P. - rewrite Zdiv.Zmod_eq by (apply Zpow2_pos). - pose proof (Z.div_unique_pos z (2 ^ Z.of_nat sz) k (z - k * 2 ^ Z.of_nat sz)) as U. - rewrite U. - - reflexivity. - - lia. - - rewrite Z.mul_comm. lia. -Qed. - -Section ZScope. - Import Zdiv. - Local Open Scope Z_scope. - Lemma uwordToZ_ZToWord_full - (sz : nat) (width_nonneg : (0 < sz)%nat) (z : Z) - : uwordToZ (ZToWord sz z) - = z mod 2 ^ Z.of_nat sz. - Proof. - rewrite <-(ZToWord_Npow2_sub_z sz z (-Z.abs z)). - rewrite Z_of_N_Npow2. - rewrite uwordToZ_ZToWord_mod, <-Zdiv.Zminus_mod_idemp_r, Zdiv.Z_mod_mult, Z.sub_0_r; trivial. - eapply Zle_minus_le_0. - rewrite Z.mul_opp_l. - replace z with (-(-z)) at 2 by Lia.lia. - rewrite <-Z.opp_le_mono. - etransitivity; cycle 1. - { eapply Z.mul_le_mono_nonneg_l; [Lia.lia|]. - eapply Z.pow_le_mono_r; [Lia.lia|]. - instantiate (1:= 1); Lia.lia. } - change (2^1) with 2. - Lia.lia. - Qed. - - Lemma pow2_times2: forall i, - 0 < i -> - 2 ^ i = 2 * 2 ^ (i - 1). - Proof. - intros. - rewrite <- Z.pow_succ_r by lia. - f_equal. - lia. - Qed. - - Lemma wordToZ_ZToWord_full sz (H: (0 < sz)%nat) (z:Z) : - wordToZ (ZToWord sz z) = - ( z - + 2 ^ (Z.of_nat sz - 1) - ) mod (2 ^ Z.of_nat sz) - - 2 ^ (Z.of_nat sz - 1). - Proof. - pose proof @wordToZ_size'' sz ltac:(trivial) (ZToWord _ z). - assert ( wordToZ (ZToWord sz z) = - (wordToZ (ZToWord sz z) + - 2 ^ (Z.of_nat sz - 1)) - mod (2*2 ^ (Z.of_nat sz - 1)) - - 2 ^ (Z.of_nat sz - 1)) - by (rewrite Z.mod_small; Lia.lia). - assert (2^Z.of_nat sz = 2 * 2 ^ (Z.of_nat sz - 1)) by - (rewrite pow2_times2; Lia.lia). - rewrite <-H2 in H1; rewrite H1. - f_equal. - case (wordToZ_ZToWord' sz z) as [y Hy]; rewrite Hy. - replace (z - y * Z.of_N (Npow2 sz) + 2 ^ (Z.of_nat sz - 1)) - with ((z + 2 ^ (Z.of_nat sz - 1)) - y * Z.of_N (Npow2 sz)) by Lia.lia. - rewrite <-Zminus_mod_idemp_r. - enough (y * (Z.of_N (Npow2 sz)) mod 2 ^ Z.of_nat sz = 0) by - (f_equal; Lia.lia). - rewrite <-Zmult_mod_idemp_r. - enough ((Z.of_N (Npow2 sz)) mod 2 ^ Z.of_nat sz = 0) by - (rewrite H3, Z.mul_0_r, Zmod_0_l; trivial). - rewrite pow2_N, nat_N_Z, Nat2Z.inj_pow; apply Z_mod_same_full. - Qed. - - Lemma wordToZ_ZToWord_full_post sz (H: (0 < sz)%nat) (z:Z) : - wordToZ (ZToWord sz z) = - ( wordToZ (ZToWord sz z) - + 2 ^ (Z.of_nat sz - 1) - ) mod (2 ^ Z.of_nat sz) - - 2 ^ (Z.of_nat sz - 1). - Proof. - pose proof @wordToZ_size'' sz ltac:(trivial) (ZToWord _ z). - case (wordToZ_ZToWord' sz z) as [y Hy]. - assert ( wordToZ (ZToWord sz z) = - (wordToZ (ZToWord sz z) + - 2 ^ (Z.of_nat sz - 1)) - mod (2*2 ^ (Z.of_nat sz - 1)) - - 2 ^ (Z.of_nat sz - 1)) - by (rewrite Z.mod_small; Lia.lia). - enough (2^Z.of_nat sz = 2 * 2 ^ (Z.of_nat sz - 1)) - by congruence; clear -H. - rewrite pow2_times2; Lia.lia. - Qed. -End ZScope. - -Lemma ZToWord_uwordToZ: forall sz (a: word sz), - ZToWord sz (uwordToZ a) = a. -Proof. - intros. - unfold uwordToZ. - rewrite ZToWord_Z_of_N. - apply NToWord_wordToN. -Qed. - -Lemma wordToN_neq_0: forall sz (b : word sz), - b <> $0 -> - wordToN b <> 0%N. -Proof. - intros. - intro C. - apply H. - apply wordToN_inj. - erewrite <- wordToN_wzero in C. - unfold wzero in C. - exact C. -Qed. - -(* These counterexamples will hopefully be found by users who use commands - such as "Search ((_ ^+ _) ^% _)" *) -Lemma wmod_plus_distr_does_not_hold: ~ forall sz (a b m: word sz), - m <> $0 -> - (a ^+ b) ^% m = ((a ^% m) ^+ (b ^% m)) ^% m. -Proof. - intro C. - specialize (C 4 $9 $11 $7). cbv in C. - match type of C with (?A -> _) => assert A by (intro; discriminate) end. - specialize (C H). discriminate. -Qed. - -Lemma wmul_mod_distr_does_not_hold: ~ forall sz (a b n: word sz), - n <> $0 -> - (a ^* b) ^% n = ((a ^% n) ^* (b ^% n)) ^% n. -Proof. - intro C. - specialize (C 4 $9 $11 $7). cbv in C. - match type of C with (?A -> _) => assert A by (intro; discriminate) end. - specialize (C H). discriminate. -Qed. - -Lemma Nmod_0_r: forall a : N, (a mod 0)%N = a. -Proof. - intros. destruct a; reflexivity. -Qed. - -Lemma wordToN_0: forall sz, - wordToN (natToWord sz 0) = 0%N. -Proof. - intros. change (natToWord sz 0) with (wzero sz). - apply wordToN_wzero. -Qed. - -Lemma NToWord_0: forall sz, - NToWord sz 0 = $ (0). -Proof. - intros. change 0%nat with (N.to_nat 0). - apply NToWord_nat. -Qed. - -Lemma wmod_0_r: forall sz (a: word sz), a ^% $0 = a. -Proof. - intros. unfold wmod, wordBin. - rewrite wordToN_0. - rewrite Nmod_0_r. - apply NToWord_wordToN. -Qed. - -Lemma wordToN_NToWord_eqn: forall sz (n : N), - wordToN (NToWord sz n) = (n mod Npow2 sz)%N. -Proof. - intros. - pose proof (Npow2_not_zero sz). - apply Nnat.N2Nat.inj. - rewrite wordToN_to_nat. - rewrite N2Nat.inj_mod by assumption. - rewrite Npow2_nat. - rewrite <- wordToNat_natToWord_eqn. - rewrite <- NToWord_nat. - reflexivity. -Qed. - -Lemma Nminus_mod_idemp_r: forall a b n : N, - (n <> 0)%N -> - (b <= a)%N -> - ((a - b mod n) mod n)%N = ((a - b) mod n)%N. -Proof. - intros. - apply N2Z.inj. - rewrite? N2Z.inj_mod by assumption. - pose proof (N.mod_le b n H). - rewrite N2Z.inj_sub by (eapply N.le_trans; eassumption). - rewrite N2Z.inj_sub by assumption. - rewrite? N2Z.inj_mod by assumption. - apply Zdiv.Zminus_mod_idemp_r. -Qed. - -Lemma drop_sub_N: forall sz (n k : N), - (k * Npow2 sz <= n)%N -> - NToWord sz (n - k * Npow2 sz) = NToWord sz n. -Proof. - intros. - apply wordToN_inj. - pose proof (Npow2_not_zero sz). - do 2 rewrite wordToN_NToWord_eqn. - rewrite <- Nminus_mod_idemp_r by assumption. - rewrite N.mod_mul by assumption. - rewrite N.sub_0_r. - reflexivity. -Qed. - -Lemma wmod_divides: forall sz (a b: word sz), - a ^% b = $0 -> - exists k, a = b ^* k. -Proof. - intros. destruct (weq b $0). - - subst b. rewrite wmod_0_r in *. subst a. exists (natToWord sz 0). - symmetry. apply wmult_neut_r. - - unfold wmod, wmult, wordBin in *. - pose proof (N.mod_divides (wordToN a) (wordToN b)) as P. - apply wordToN_neq_0 in n. - specialize (P n). - destruct P as [ [k P] _]. - + apply (f_equal (@wordToN sz)) in H. - rewrite wordToN_NToWord_2 in H. - * rewrite H. apply wordToN_0. - * pose proof (wordToN_bound a). remember (wordToN a) as c. clear Heqc a. - pose proof (wordToN_bound b). remember (wordToN b) as d. clear Heqd b. - pose proof (N.mod_upper_bound c d n). - nlia. - + exists (NToWord sz (k - k / (Npow2 sz) * Npow2 sz)). - rewrite wordToN_NToWord_2. - { rewrite N.mul_sub_distr_l. - rewrite N.mul_assoc. - rewrite drop_sub_N. - - rewrite <- P. symmetry. apply NToWord_wordToN. - - rewrite <- N.mul_assoc. - rewrite <- (N.mul_comm (Npow2 sz)). - apply N.mul_le_mono_l. - apply (N.mul_div_le k (Npow2 sz)). - apply Npow2_not_zero. - } - { rewrite <- N.mul_comm. rewrite <- N.mod_eq by (apply Npow2_not_zero). - apply N.mod_upper_bound. apply Npow2_not_zero. } -Qed. - -Lemma wmod_divides_other_direction_does_not_hold: ~ forall sz (a b: word sz), - b <> $0 -> - (exists k, a = b ^* k) -> - a ^% b = $0. -Proof. - intro C. specialize (C 4 $14 $5). - match type of C with (?A -> _) => assert A by (intro; discriminate) end. - specialize (C H). - match type of C with (?A -> _) => assert A as B end. - - exists (natToWord 4 6). reflexivity. - - specialize (C B). cbv in C. discriminate. -Qed. - -Lemma wmod_mul_does_not_hold: ~ forall sz (a b: word sz), - b <> $0 -> - (a ^* b) ^% b = $0. -Proof. - intro C. - specialize (C 4 $6 $5). - match type of C with (?A -> _) => assert A by (intro; discriminate) end. - specialize (C H). - cbv in C. - discriminate. -Qed. - -Lemma wmult_plus_distr_l: forall (sz : nat) (x y z : word sz), - z ^* (x ^+ y) = z ^* x ^+ z ^* y. -Proof. - intros. rewrite! (wmult_comm z). - apply wmult_plus_distr. -Qed. - -Lemma wmod_same: forall sz (a: word sz), a ^% a = $0. -Proof. - intros. destruct (weq a $0). - - subst a. rewrite wmod_0_r in *. reflexivity. - - unfold wmod, wordBin. apply wordToN_neq_0 in n. rewrite N.mod_same by assumption. - apply NToWord_0. -Qed. - -Lemma wmod_0_l: forall sz (m: word sz), - $0 ^% m = $0. -Proof. - intros. unfold wmod, wordBin. - rewrite wordToN_0. - destruct (N.eq_dec (wordToN m) 0%N). - - rewrite e. change (0 mod 0)%N with 0%N. apply NToWord_0. - - rewrite N.mod_0_l by assumption. apply NToWord_0. -Qed. - -Lemma wmod_plus_distr: forall sz (a b m: word sz), - (exists k, (wordToN m * k)%N = Npow2 sz) -> - (a ^+ b) ^% m = ((a ^% m) ^+ (b ^% m)) ^% m. -Proof. - intros. destruct H as [k E]. - assert (wordToN m <> 0%N) as H. { - intro C. rewrite C in E. simpl in E. symmetry in E. - apply Npow2_not_zero in E. - assumption. - } - unfold wplus, wmod, wordBin. - pose proof (wordToN_bound a). remember (wordToN a) as c. clear Heqc a. - pose proof (wordToN_bound b). remember (wordToN b) as d. clear Heqd b. - pose proof (wordToN_bound m). remember (wordToN m) as n. clear Heqn m. - pose proof (N.mod_upper_bound c n H). - pose proof (N.mod_upper_bound d n H). - rewrite (@wordToN_NToWord_2 sz (c mod n)) by nlia. - rewrite (@wordToN_NToWord_2 sz (d mod n)) by nlia. - repeat match goal with - | |- context [wordToN (NToWord ?sz ?n)] => - let k := fresh "k" in - let E := fresh "E" in - let B := fresh "B" in - destruct (wordToN_NToWord sz n) as [ k [E B] ]; - rewrite E in *; clear E - end. - rewrite <- E in *. - rewrite <- Nminus_mod_idemp_r by assumption. - rewrite <- (@Nminus_mod_idemp_r (c mod n + d mod n)) by assumption. - rewrite (N.mul_comm n k). - do 2 rewrite N.mul_assoc. - do 2 rewrite N.mod_mul by assumption. - do 2 rewrite N.sub_0_r. - f_equal. - apply N.add_mod. - assumption. -Qed. - -Lemma wmod_mul: forall sz (a b: word sz), - (exists k, (wordToN b * k)%N = Npow2 sz) -> - (a ^* b) ^% b = $0. -Proof. - intros. destruct H as [k E]. - assert (wordToN b <> 0%N) as H. { - intro C. rewrite C in E. simpl in E. symmetry in E. - apply Npow2_not_zero in E. - assumption. - } - unfold wmult, wmod, wordBin. - pose proof (wordToN_bound a). remember (wordToN a) as c. clear Heqc a. - pose proof (wordToN_bound b). remember (wordToN b) as d. clear Heqd b. - pose proof (N.mod_upper_bound c d H). - repeat match goal with - | |- context [wordToN (NToWord ?sz ?n)] => - let k := fresh "k" in - let E := fresh "E" in - let B := fresh "B" in - destruct (wordToN_NToWord sz n) as [ k [E B] ]; - rewrite E in *; clear E - end. - rewrite <- E in *. - rewrite <- Nminus_mod_idemp_r by assumption. - rewrite (N.mul_comm d k). - rewrite N.mul_assoc. - rewrite N.mod_mul by assumption. - rewrite N.sub_0_r. - rewrite N.mul_mod by assumption. - rewrite N.mod_same by assumption. - rewrite N.mul_0_r. - rewrite N.mod_0_l by assumption. - apply NToWord_0. -Qed. - -Lemma combine_zero_general sz1 sz2: - forall (w: word sz1) (b: word sz2), (combine w b = $ 0 -> w = $ 0 /\ b = $ 0)%word. -Proof. - intros. - pre_word_lia. - rewrite wordToNat_combine in *. - assert (sth1: wordToNat w = 0) by lia. - pose proof (pow2_zero sz1) as sth2. - assert (sth3: wordToNat b = 0) by nia. - split; eapply wordToNat_zero; eauto. -Qed. - -Lemma combine_lt sz1 sz2: - forall (w1 w2: word sz1) (b1 b2: word sz2), (combine w1 b1 < combine w2 b2 -> - b1 <= b2)%word. -Proof. - intros. - pre_word_lia. - rewrite ?wordToNat_combine in *. - pose proof (pow2_zero sz1). - pose proof (wordToNat_bound w1). - pose proof (wordToNat_bound w2). - nia. -Qed. - -Lemma split2_le sz1 sz2: - forall (w1 w2: word (sz1 + sz2)), (w1 <= w2 -> - split2 _ _ w1 <= split2 _ _ w2)%word. -Proof. - intros. - pre_word_lia. - rewrite ?wordToNat_split2. - pose proof (pow2_zero sz1). - apply Nat.div_le_mono; auto. - lia. -Qed. - -Lemma word1_neq': forall w : word 1, w <> WO~1 -> w = WO~0. -Proof. - intros. - shatter_word w. - destruct x; auto; tauto. -Qed. - -Lemma combine_ge sz1 sz2 (x1 y1: word sz1) (x2 y2: word sz2): - (combine x1 x2 <= combine y1 y2 -> - x2 < y2 \/ (x2 = y2 /\ x1 <= y1))%word. -Proof. - intros. - pre_word_lia. - rewrite ?wordToNat_combine in *. - pose proof (pow2_zero sz1). - pose proof (pow2_zero sz2). - destruct (weq x2 y2); subst. - - right; split; auto. - word_lia. - - left. - pose proof (wordToNat_bound x1). - pose proof (wordToNat_bound y1). - pre_word_lia. - nia. -Qed. +Lemma weq_dec_eq : forall sz (a b : word sz) (pf1 pf2 : a = b), pf1 = pf2. +Proof. intros; apply UIP_dec, weq. Qed. diff --git a/Kami/Lib/WordDerived.v b/Kami/Lib/WordDerived.v new file mode 100644 index 0000000..3ea89b7 --- /dev/null +++ b/Kami/Lib/WordDerived.v @@ -0,0 +1,656 @@ +(** Derived facts used by the Kami examples (Fifo, Multiplier, Divider). *) +From Stdlib Require Import ZArith Lia Eqdep_dec EqdepFacts. +From Kami Require Import NatLib Word. + +Set Implicit Arguments. +Local Open Scope Z_scope. + +(** [z] just below a multiple [2*p*t] of [2*p] reduces to [z - 2*p*t + 2*p]. *) +Lemma Zmod_upper : forall z p t, 0 < p -> 0 < t -> + 2 * p * t - p <= z < 2 * p * t -> z mod (2 * p) = z - 2 * p * t + 2 * p. +Proof. + intros; rewrite <- (Z.mod_add z (1 - t) (2 * p)) by lia. + rewrite Z.mod_small by nia. lia. +Qed. + +(** The most significant bit of [combine]: the two directions, as [Z] facts. *) +Lemma msb_combine_lt : forall p1 p2 z0 z, 0 < p1 -> 0 < p2 -> p2 mod 2 = 0 -> + 0 <= z0 < p1 -> 2 * z < p2 -> 2 * (z0 + p1 * z) < p1 * p2. +Proof. + intros. assert (2 * z <= p2 - 2) by lia. + assert (p1 * (2 * z) <= p1 * (p2 - 2)) by (apply Z.mul_le_mono_nonneg_l; lia). nia. +Qed. + +Lemma msb_combine_ge : forall p1 p2 z0 z, 0 < p1 -> 0 < p2 -> + 0 <= z0 -> p2 <= 2 * z -> p1 * p2 <= 2 * (z0 + p1 * z). +Proof. + intros. assert (p1 * p2 <= p1 * (2 * z)) by (apply Z.mul_le_mono_nonneg_l; lia). nia. +Qed. + +Ltac msb_combine_contra := + match goal with + | H : (?p1 * ?p2 <= 2 * (?z0 + ?p1 * ?z))%Z, H' : (2 * ?z < ?p2)%Z |- _ => + exfalso; pose proof (@msb_combine_lt p1 p2 z0 z); lia + | H : (2 * (?z0 + ?p1 * ?z) < ?p1 * ?p2)%Z, H' : (?p2 <= 2 * ?z)%Z |- _ => + exfalso; pose proof (@msb_combine_ge p1 p2 z0 z); lia + end. + +Local Close Scope Z_scope. + +Lemma WO_combine : forall sz (w : word sz), combine WO w = w. +Proof. word_lia_Z. Qed. + +Lemma WS_true_natToWord_0 : forall sz, WS true (natToWord sz 0) = natToWord (S sz) 1. +Proof. word_lia_Z. Qed. + +Lemma ZToWord_wordToZ : forall sz (w : word sz), ZToWord sz (wordToZ w) = w. +Proof. word_lia_Z. Qed. + +Lemma combine_assoc_existT : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2) sz3 (w3 : word sz3), + existT word (sz1 + (sz2 + sz3)) (combine w1 (combine w2 w3)) = + existT word (sz1 + sz2 + sz3) (combine (combine w1 w2) w3). +Proof. word_lia_Z. Qed. + +Lemma combine_one : forall n m, combine (natToWord (S n) 1) (natToWord m 0) = natToWord _ 1. +Proof. word_lia_Z. Qed. + +Lemma combine_sext : + forall sz1 (w1 : word sz1) sz2 (w2 : word (S sz2)) n, + existT word _ (combine w1 (sext w2 n)) = existT word _ (sext (combine w1 w2) n). +Proof. word_lia_Z. Qed. + +Lemma combine_wplus_1 : + forall sl (w1 : word sl) su (w2 w3 : word su), + combine w1 (w2 ^+ w3) = combine w1 w2 ^+ extz w3 sl. +Proof. word_lia_Z. Qed. + +Lemma combine_wplus_2 : + forall sl (w1 : word sl) su (w2 w3 : word su), + combine w1 (w2 ^+ w3) = extz w2 sl ^+ combine w1 w3. +Proof. word_lia_Z. Qed. + +Lemma existT_sext : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2) n, + existT word _ w1 = existT word _ w2 -> + existT word _ (sext w1 n) = existT word _ (sext w2 n). +Proof. + intros; apply existT_word_inv in H; destruct H; subst. + apply Zmod.unsigned_inj in H0; subst; reflexivity. +Qed. + +Lemma existT_wlshift : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2) n, + existT word _ w1 = existT word _ w2 -> + existT word _ (wlshift w1 n) = existT word _ (wlshift w2 n). +Proof. + intros; apply existT_word_inv in H; destruct H; subst. + apply Zmod.unsigned_inj in H0; subst; reflexivity. +Qed. + +Lemma existT_wminus : + forall sz (w1 w2 : word sz) sz' (w3 w4 : word sz'), + existT word _ w1 = existT word _ w3 -> + existT word _ w2 = existT word _ w4 -> + existT word _ (w1 ^- w2) = existT word _ (w3 ^- w4). +Proof. + intros; apply existT_word_inv in H; apply existT_word_inv in H0; destruct H, H0; subst. + apply Zmod.unsigned_inj in H1; apply Zmod.unsigned_inj in H2; subst; reflexivity. +Qed. + +Lemma existT_wordToNat : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2), + existT word _ w1 = existT word _ w2 -> wordToNat w1 = wordToNat w2. +Proof. + intros; apply existT_word_inv in H; destruct H; subst. + apply Zmod.unsigned_inj in H0; subst; reflexivity. +Qed. + +Lemma existT_wplus : + forall sz (w1 w2 : word sz) sz' (w3 w4 : word sz'), + existT word _ w1 = existT word _ w3 -> + existT word _ w2 = existT word _ w4 -> + existT word _ (w1 ^+ w2) = existT word _ (w3 ^+ w4). +Proof. + intros; apply existT_word_inv in H; apply existT_word_inv in H0; destruct H, H0; subst. + apply Zmod.unsigned_inj in H1; apply Zmod.unsigned_inj in H2; subst; reflexivity. +Qed. + +Lemma existT_wrshifta : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2) n, + existT word _ w1 = existT word _ w2 -> + existT word _ (wrshifta w1 n) = existT word _ (wrshifta w2 n). +Proof. + intros; apply existT_word_inv in H; destruct H; subst. + apply Zmod.unsigned_inj in H0; subst; reflexivity. +Qed. + +Lemma extz_combine : forall sz (w : word sz) n, extz w n = combine (natToWord n 0) w. +Proof. word_lia_Z. Qed. + +Lemma extz_extz : + forall sz (w : word sz) n1 n2, + existT word _ (extz (extz w n1) n2) = existT word _ (extz w (n2 + n1)). +Proof. word_lia_Z. Qed. + +Lemma extz_pow2_wordToZ : + forall sz (w : word sz) n, wordToZ (extz w n) = (wordToZ w * Z.of_nat (pow2 n))%Z. +Proof. word_lia_Z. Qed. + +Lemma extz_sext : + forall sz (w : word sz) n1 n2, + existT word _ (extz (sext w n1) n2) = existT word _ (sext (extz w n2) n1). +Proof. word_lia_Z. Qed. + +Lemma extz_zero : forall sz n, extz (natToWord sz 0) n = wzero _. +Proof. word_lia_Z. Qed. + +Theorem natToWord_inj : forall sz n m, natToWord sz n = natToWord sz m + -> (n < pow2 sz)%nat -> (m < pow2 sz)%nat -> n = m. +Proof. word_lia_Z. Qed. + +Lemma pow2_minus_one_wones : forall {sz} (w : word sz), + wordToNat w = (pow2 sz - 1)%nat -> w = wones sz. +Proof. word_lia_Z. Qed. + +Lemma sext_combine : + forall sz n (w : word (sz + n)) sz1 (w1 : word sz1) sz2 (Hsz2 : sz2 <> 0) (w2 : word sz2), + existT word _ w = existT word _ (combine w1 (sext w2 n)) -> + exists sw, w = sext sw n /\ existT word _ sw = existT word _ (combine w1 w2). +Proof. + intros. apply existT_word_inv in H; destruct H. + assert (sz = sz1 + sz2)%nat by lia. subst sz. + exists (combine w1 w2). split; [|reflexivity]. + apply Zmod.unsigned_inj. rewrite H0. clear H0 H. + word_to_Z; pose proof (Zpow2_even sz2 ltac:(lia)). + all: try msb_combine_contra. + all: word_mod_simpl; nia. +Qed. + +Lemma sext_size : + forall sz n (w : word (sz + n)), + sz <> 0 -> + (- Z.of_nat (pow2 (sz - 1)) <= wordToZ w < Z.of_nat (pow2 (sz - 1)))%Z -> + exists sw, w = sext sw n. +Proof. + intros; destruct sz; [lia|]. + replace (S sz - 1)%nat with sz in H0 by lia. + exists (split1 (S sz) n w). + word_to_Z. + - rewrite (Z.mod_small z) by lia; rewrite Z.mod_small by lia; reflexivity. + - rewrite (Z.mod_small z) in * by lia; lia. + - rewrite (@Zmod_upper z (Zpow2 sz) (Zpow2 n)) in * by lia; lia. + - rewrite (@Zmod_upper z (Zpow2 sz) (Zpow2 n)) by lia. + replace (z - 2 * Zpow2 sz * Zpow2 n + 2 * Zpow2 sz - 2 * Zpow2 sz)%Z + with (z + (-1) * (2 * Zpow2 sz * Zpow2 n))%Z by ring. + rewrite Z.mod_add by lia; rewrite Z.mod_small by lia; reflexivity. +Qed. + +Lemma sext_split1 : forall sz (w : word sz) n, split1 sz _ (sext w n) = w. +Proof. word_lia_Z. Qed. + +Lemma sext_wordToZ : forall sz n (w : word sz), wordToZ (sext w n) = wordToZ w. +Proof. word_lia_Z. Qed. + +Lemma sext_wplus_exist : + forall sz (w1 w2 : word sz) n, + exists w : word (S sz), + existT word _ (sext w1 (S n) ^+ sext w2 (S n)) = existT word _ (sext w n). +Proof. + intros; exists (ZToWord (S sz) (wordToZ w1 + wordToZ w2)). + word_lia_Z. +Qed. + +Lemma sext_wplus_wordToZ_distr : + forall sz (w1 w2 : word sz) n, + n <> 0 -> wordToZ (sext w1 n ^+ sext w2 n) = (wordToZ (sext w1 n) + wordToZ (sext w2 n))%Z. +Proof. word_lia_Z. Qed. + +Lemma sext_wzero : forall sz n, sext (wzero sz) n = wzero (sz + n). +Proof. word_lia_Z. Qed. + +Lemma shatter_word_0 : forall a : word 0, a = WO. +Proof. intros; apply word0. Qed. + +Lemma shatter_word_1 : forall (w : word 1), w = WS (whd w) WO. +Proof. intros; rewrite (shatter_word w) at 1; f_equal; apply shatter_word_0. Qed. + +Lemma shatter_word_2 : forall (w : word 2), w = WS (whd w) (WS (whd (wtl w)) WO). +Proof. intros; rewrite (shatter_word w) at 1; f_equal; apply shatter_word_1. Qed. + +Lemma shatter_word_3 : forall (w : word 3), + w = WS (whd w) (WS (whd (wtl w)) (WS (whd (wtl (wtl w))) WO)). +Proof. intros; rewrite (shatter_word w) at 1; f_equal; apply shatter_word_2. Qed. + +Theorem split1_combine : forall sz1 sz2 (w : word sz1) (z : word sz2), + split1 sz1 sz2 (combine w z) = w. +Proof. word_lia_Z. Qed. + +Lemma split1_combine_existT : + forall sz n (w : word (n + sz)) sl (wl : word (n + sl)) su (wu : word su), + existT word _ w = existT word _ (combine wl wu) -> + split1 n _ w = split1 n _ wl. +Proof. + intros; apply existT_word_inv in H; destruct H. + apply Zmod.unsigned_inj; rewrite !unsigned_split1, H0, unsigned_combine. + rewrite <- (Z.mod_add (Zmod.unsigned wl) (Zpow2 sl * Zmod.unsigned wu) (Zpow2 n)) + by (pose proof (Zpow2_pos n); lia). + f_equal; f_equal; rewrite (Zpow2_add n sl); ring. +Qed. + +Theorem split2_combine : forall sz1 sz2 (w : word sz1) (z : word sz2), + split2 sz1 sz2 (combine w z) = z. +Proof. word_lia_Z. Qed. + +Lemma split2_split1_combine1 : forall n m (x : word 1) (y : word (n + m)), + split2 1 n (split1 (S n) m (combine x y)) = split1 n m y. +Proof. word_lia_Z. Qed. + +Lemma sub_0_eq : forall sz (a b : word sz), a ^- b = wzero _ -> a = b. +Proof. word_lia_Z. Qed. + +Lemma whd_split1 : forall n m (w : word (S n + m)), whd (split1 (S n) m w) = whd w. +Proof. word_lia_Z. Qed. + +Lemma wtl_split1 : forall n m (w : word (S n + m)), + wtl (split1 (S n) m w) = split1 n m (wtl w). +Proof. word_lia_Z. Qed. + +Lemma wlshift_combine_extz : + forall sn sl (wl : word sl) ssu (wu : word (ssu + sn)), + existT word (sl + (ssu + sn)) (wlshift (combine wl wu) sn) = + existT word (sn + (sl + ssu)) (extz (combine wl (split1 ssu _ wu)) sn). +Proof. + word_to_Z; pose proof (Zpow2_pos sl); pose proof (Zpow2_pos sn); pose proof (Zpow2_pos ssu). + replace (Zpow2 sl * (Zpow2 ssu * Zpow2 sn))%Z with ((Zpow2 sl * Zpow2 ssu) * Zpow2 sn)%Z by ring. + rewrite Z.mul_mod_distr_r by nia. + f_equal. + assert (Hq : z = (Zpow2 ssu * (z / Zpow2 ssu) + z mod Zpow2 ssu)%Z) by (apply Z.div_mod; lia). + assert (Hm : (0 <= z mod Zpow2 ssu < Zpow2 ssu)%Z) by (apply Z.mod_pos_bound; lia). + rewrite Hq at 1. + replace (z0 + Zpow2 sl * (Zpow2 ssu * (z / Zpow2 ssu) + z mod Zpow2 ssu))%Z + with ((z0 + Zpow2 sl * (z mod Zpow2 ssu)) + (z / Zpow2 ssu) * (Zpow2 sl * Zpow2 ssu))%Z by ring. + rewrite Z.mod_add by nia. + apply Z.mod_small; nia. +Qed. + +Lemma wlshift_sext_extz : + forall sz (w : word sz) n, existT word _ (wlshift (sext w n) n) = existT word _ (extz w n). +Proof. word_lia_Z. Qed. + +Theorem wminus_def : forall sz (x y : word sz), x ^- y = x ^+ ^~ y. +Proof. intros; symmetry; apply Zmod.add_opp_r. Qed. + +Theorem wminus_inv : forall sz (x : word sz), x ^+ ^~ x = wzero sz. +Proof. intros; apply Zmod.add_opp_same_r. Qed. + +Lemma wminus_plus_distr : forall {sz} (x y z : word sz), x ^- (y ^+ z) = x ^- y ^- z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_wordToNat_pos : + forall sz (w : word sz), wmsb w false = false -> Z.of_nat (wordToNat w) = wordToZ w. +Proof. word_lia_Z. Qed. + +Corollary wmsb_Zabs_pos : + forall sz (w : word sz), wmsb w false = false -> Z.abs (wordToZ w) = wordToZ w. +Proof. intros; rewrite <- wordToZ_wordToNat_pos by assumption; lia. Qed. + +Lemma wmsb_combine : + forall sz1 sz2 (w1 : word sz1) (w2 : word sz2) b1 b2, + sz2 <> 0 -> wmsb (combine w1 w2) b1 = wmsb w2 b2. +Proof. + word_to_Z; try reflexivity; exfalso; try lia; + pose proof (Zpow2_even sz2 ltac:(lia)); first [ nia | msb_combine_contra ]. +Qed. + +Lemma wmsb_combine_existT : + forall sz (w : word sz) sz1 (w1 : word sz1) sz2 (w2 : word sz2) b1 b2, + sz2 <> 0 -> existT word _ w = existT word _ (combine w1 w2) -> wmsb w b1 = wmsb w2 b2. +Proof. + intros; apply existT_word_inv in H0; destruct H0; subst. + apply Zmod.unsigned_inj in H1; subst; apply wmsb_combine; assumption. +Qed. + +Lemma wmsb_existT : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2), + existT word _ w1 = existT word _ w2 -> forall b, wmsb w1 b = wmsb w2 b. +Proof. + intros; apply existT_word_inv in H; destruct H; subst. + apply Zmod.unsigned_inj in H0; subst; reflexivity. +Qed. + +Lemma wmsb_extz : forall sz (w : word sz) n, wmsb (extz w n) false = wmsb w false. +Proof. word_lia_Z. Qed. + +Lemma wmsb_false_pos : forall sz (w : word sz), wmsb w false = false <-> (wordToZ w >= 0)%Z. +Proof. split; word_lia_Z. Qed. + +Lemma wmsb_split1_sext : + forall sz (w : word (sz + 1)), + wmsb w false = wmsb (split1 _ 1 w) false -> exists sw, sext sw 1 = w. +Proof. intros; exists (split1 sz 1 w). word_lia_Z. Qed. + +Lemma wmsb_split2 : + forall sz (w : word (sz + 1)) b, + wmsb w b = if weq (split2 _ 1 w) (natToWord _ 0) then false else true. +Proof. intros; destruct (weq (split2 sz 1 w) (natToWord 1 0)); word_lia_Z. Qed. + +Lemma wmsb_true_neg : forall sz (w : word sz), wmsb w false = true <-> (wordToZ w < 0)%Z. +Proof. split; word_lia_Z. Qed. + +Lemma wmsb_wlshift_sext : + forall sz (w : word sz) n, wmsb (sext w n) false = wmsb (wlshift (sext w n) n) false. +Proof. + intros. + assert (E : Zmod.unsigned (wlshift (sext w n) n) = (Zmod.unsigned w * Zpow2 n)%Z). + { rewrite unsigned_wlshift, unsigned_sext, Zpow2_add. + pose proof (Zpow2_pos sz); pose proof (Zpow2_pos n). + rewrite Z.mul_mod_distr_r by lia. + rewrite Z.mod_mod_divide by (exists (Zpow2 n); ring). + rewrite <- (Zmod.mod_signed w); reflexivity. } + rewrite !wmsb_eqn, E, unsigned_sext, signed_eqn, Zpow2_add. + pose proof (unsigned_range w); pose proof (Zpow2_pos sz); pose proof (Zpow2_pos n); + pose proof (Zpow2_prod sz n). + destruct (Z.eqb_spec (Z.of_nat (sz + n)) 0) as [E0|E0]. + - reflexivity. + - destruct (Z.ltb_spec (2 * Zmod.unsigned w) (Zpow2 sz)). + + rewrite Z.mod_small by nia. + destruct (Z.leb_spec (Zpow2 sz * Zpow2 n) (2 * Zmod.unsigned w)); + destruct (Z.leb_spec (Zpow2 sz * Zpow2 n) (2 * (Zmod.unsigned w * Zpow2 n))); try reflexivity; nia. + + rewrite (@Zmod_small_neg (Zmod.unsigned w - Zpow2 sz)) by nia. + destruct (Z.leb_spec (Zpow2 sz * Zpow2 n) (2 * (Zmod.unsigned w - Zpow2 sz + Zpow2 sz * Zpow2 n))); + destruct (Z.leb_spec (Zpow2 sz * Zpow2 n) (2 * (Zmod.unsigned w * Zpow2 n))); try reflexivity; nia. +Qed. + +Lemma wmsb_wneg_zext : + forall sz (w : word sz) b n, n <> 0 -> wordToNat w <> 0 -> wmsb (wneg (zext w n)) b = true. +Proof. word_lia_Z. Qed. + +Lemma wmsb_wzero : forall sz, wmsb (wzero sz) false = false. +Proof. word_lia_Z. Qed. + +Lemma wmsb_zext : forall sz (w : word sz) b n, n <> 0 -> wmsb (zext w n) b = false. +Proof. word_lia_Z. Qed. + +Lemma wneg_idempotent : forall {sz} (w : word sz), ^~ (^~ w) = w. +Proof. word_lia_Z. Qed. + +Lemma wneg_wnot : forall sz (w : word sz), wnot w = wneg w ^- (natToWord _ 1). +Proof. word_lia_Z. Qed. + +Lemma wneg_wordToZ : + forall sz (w : word (S sz)), w <> wpow2 sz -> wordToZ (wneg w) = (- wordToZ w)%Z. +Proof. word_lia_Z. Qed. + +Lemma wneg_zero : forall {sz} (w : word sz), ^~ w = natToWord sz 0 -> w = natToWord sz 0. +Proof. word_lia_Z. Qed. + +Lemma wones_wneg_one : forall {sz}, wones sz = ^~ (natToWord sz 1). +Proof. word_lia_Z. Qed. + +Theorem wplus_assoc : forall sz (x y z : word sz), x ^+ (y ^+ z) = x ^+ y ^+ z. +Proof. intros; apply Zmod.add_assoc. Qed. + +Lemma wplus_cancel : forall sz (a b c : word sz), a ^+ c = b ^+ c -> a = b. +Proof. word_lia_Z. Qed. + +Theorem wplus_comm : forall sz (x y : word sz), x ^+ y = y ^+ x. +Proof. intros; apply Zmod.add_comm. Qed. + +Theorem wplus_unit : forall sz (x : word sz), natToWord sz 0 ^+ x = x. +Proof. word_lia_Z. Qed. + +Lemma wplus_wzero_1 : forall sz (w : word sz), w ^+ wzero sz = w. +Proof. word_lia_Z. Qed. + +Lemma wpow2_wmsb : forall sz, wmsb (wpow2 sz) false = true. +Proof. word_lia_Z. Qed. + +Lemma wrshifta_extz_sext : + forall sz (w : word sz) n1 n2, + existT word _ (wrshifta (extz w (n1 + n2)) n1) = existT word _ (sext (extz w n2) n1). +Proof. word_lia_Z. Qed. + +Lemma split1_zext : forall sz (w : word sz) n, split1 sz n (zext w n) = w. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_wdivN : forall sz (x y : word sz), wordToNat (wdivN x y) = (wordToNat x / wordToNat y)%nat. +Proof. + intros; cbv [wordToNat]; rewrite unsigned_wdivN. + apply Z2Nat.inj_div; apply unsigned_range. +Qed. + +Lemma wordToNat_wremN : forall sz (x y : word sz), wordToNat (wremN x y) = (wordToNat x mod wordToNat y)%nat. +Proof. + intros; cbv [wordToNat]; rewrite unsigned_wremN. + apply Z2Nat.inj_mod; apply unsigned_range. +Qed. + +Lemma unsigned_natToWord_small : + forall sz n, (n < pow2 sz)%nat -> uwordToZ (natToWord sz n) = Z.of_nat n. +Proof. word_lia_Z. Qed. + +Lemma wrshifta_wzero : forall sz n, wrshifta (wzero sz) n = wzero _. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_combine : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2), + wordToNat (combine w1 w2) = (wordToNat w1 + pow2 sz1 * wordToNat w2)%nat. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_existT : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2) (Hsz : sz1 = sz2), + wordToNat w1 = wordToNat w2 -> existT word _ w1 = existT word _ w2. +Proof. intros; subst; f_equal; apply wordToNat_inj; assumption. Qed. + +Lemma wordToNat_natToWord_2 : forall sz w : nat, + (w < pow2 sz)%nat -> wordToNat (natToWord sz w) = w. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_natToWord_pred : + forall {sz} (w : word sz), w <> wzero sz -> pred (wordToNat w) = wordToNat (w ^- (natToWord sz 1)). +Proof. word_lia_Z. Qed. + +Lemma wordToNat_wrshifta : + forall sz (w : word sz) n, wordToNat (wrshifta w n) = Nat.div (wordToNat (sext w n)) (pow2 n). +Proof. word_lia_Z. Qed. + +Lemma wordToNat_wtl : forall sz (w : word (S sz)), wordToNat (wtl w) = (wordToNat w / 2)%nat. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_zext : forall sz (w : word sz) n, wordToNat (zext w n) = wordToNat w. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_bound_weakened : forall z n, (Z.abs z < n)%Z -> (- n <= z < n)%Z. +Proof. intros; lia. Qed. + +Lemma wordToZ_distr_diff_wmsb : + forall sz (w1 w2 : word sz), + wmsb w1 false = negb (wmsb w2 false) -> wordToZ (w1 ^+ w2) = (wordToZ w1 + wordToZ w2)%Z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_eq_rect : + forall sz (w : word sz) nsz Hsz, wordToZ (eq_rect _ word w nsz Hsz) = wordToZ w. +Proof. intros; subst; reflexivity. Qed. + +Lemma wordToZ_existT : + forall sz1 (w1 : word sz1) sz2 (w2 : word sz2) (Hsz : sz1 = sz2), + wordToZ w1 = wordToZ w2 -> existT word _ w1 = existT word _ w2. +Proof. intros; subst; f_equal; apply Zmod.signed_inj; assumption. Qed. + +Lemma wordToZ_one : forall (w : word 1), wordToZ w = (if whd w then -1 else 0)%Z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_size' : + forall sz (w : word (S sz)), (- Z.of_nat (pow2 sz) <= wordToZ w < Z.of_nat (pow2 sz))%Z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_succ : forall sz (w : word (S (S sz))), + wordToZ w = (2 * wordToZ (wtl w) + (if whd w then 1 else 0))%Z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_wplus_bound : + forall sz (w1 w2 : word (S sz)), + (- Z.of_nat (pow2 sz) <= wordToZ w1 + wordToZ w2 < Z.of_nat (pow2 sz))%Z -> + (wordToZ w1 + wordToZ w2 = wordToZ (w1 ^+ w2))%Z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_wzero : forall sz, wordToZ (wzero sz) = 0%Z. +Proof. word_lia_Z. Qed. + +Lemma zext_size : + forall sz n (w : word (sz + n)), + (- Z.of_nat (pow2 sz) <= wordToZ w < Z.of_nat (pow2 sz))%Z -> + wmsb w false = false -> exists sw, w = zext sw n. +Proof. + intros; exists (split1 sz n w). + word_to_Z; try lia; rewrite Z.mod_small by lia; lia. +Qed. + +Lemma zext_size_1 : + forall sz (w : word (sz + 1)), wmsb w false = false -> exists sw, w = zext sw 1. +Proof. intros; exists (split1 sz 1 w). word_lia_Z. Qed. + +Lemma zext_wordToNat_equal_Z : + forall sz (w : word sz) n, n <> 0 -> wordToZ (zext w n) = Z.of_nat (wordToNat w). +Proof. word_lia_Z. Qed. + + +(** * Facts the bedrock2 processor proofs use *) + +Notation wzero' sz := (wzero sz). + +Lemma wordToN_bound : forall sz (w : word sz), (wordToN w < Npow2 sz)%N. +Proof. word_lia_Z. Qed. + +Theorem combine_split : forall sz1 sz2 (w : word (sz1 + sz2)), + combine (split1 sz1 sz2 w) (split2 sz1 sz2 w) = w. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_inj : forall sz (w1 w2 : word sz), wordToZ w1 = wordToZ w2 -> w1 = w2. +Proof. intros; apply Zmod.signed_inj; assumption. Qed. + +Lemma wordToN_inj : forall sz (a b : word sz), wordToN a = wordToN b -> a = b. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_ZToWord : forall z sz, + (- Z.of_nat (pow2 sz) <= z < Z.of_nat (pow2 sz))%Z -> wordToZ (ZToWord (S sz) z) = z. +Proof. word_lia_Z. Qed. + +Lemma wordToN_combine : forall sz1 (w1 : word sz1) sz2 (w2 : word sz2), + wordToN (combine w1 w2) = (wordToN w1 + Npow2 sz1 * wordToN w2)%N. +Proof. word_lia_Z. Qed. + +Lemma wordToN_NToWord_2 : forall sz n, (n < Npow2 sz)%N -> wordToN (NToWord sz n) = n. +Proof. word_lia_Z. Qed. + +Theorem split1_0 : forall n w Heq, split1 n 0 (eq_rect _ word w _ Heq) = w. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_combine_WO : forall sz (w : word sz), wordToZ (combine w WO) = wordToZ w. +Proof. word_lia_Z. Qed. + +Lemma wordToN_0 : forall sz, wordToN (natToWord sz 0) = 0%N. +Proof. word_lia_Z. Qed. + +Lemma wordToN_wzero : forall sz, wordToN (wzero sz) = 0%N. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_natToWord_le : forall sz n, (wordToNat (natToWord sz n) <= n)%nat. +Proof. + intros; cbv [wordToNat]; rewrite unsigned_natToWord; pose proof (Zpow2_pos sz). + pose proof (Z.mod_le (Z.of_nat n) (Zpow2 sz) ltac:(lia) ltac:(lia)). + pose proof (Z.mod_pos_bound (Z.of_nat n) (Zpow2 sz) ltac:(lia)); lia. +Qed. + +Lemma wordToZ_ZToWord_full sz (H: (0 < sz)%nat) (z:Z) : + wordToZ (ZToWord sz z) = ((z + 2 ^ (Z.of_nat sz - 1)) mod (2 ^ Z.of_nat sz) - 2 ^ (Z.of_nat sz - 1))%Z. +Proof. + destruct sz; [lia|]. + replace (Z.of_nat (S sz) - 1)%Z with (Z.of_nat sz) by lia. + rewrite <- !Zpow2_eqn, signed_eqn, Zmod.unsigned_of_Z, Zpow2_S. + pose proof (Zpow2_pos sz). + pose proof (Z.mod_pos_bound z (2 * Zpow2 sz) ltac:(lia)). + rewrite Zplus_mod, (Z.mod_small (Zpow2 sz)) by lia. + set (r := (z mod (2 * Zpow2 sz))%Z) in *; clearbody r. + destruct (Z.ltb_spec (2 * r) (2 * Zpow2 sz)). + - rewrite Z.mod_small by lia; lia. + - rewrite Zmod_small_2 by lia; lia. +Qed. + +Theorem wordToN_nat : forall sz (w : word sz), wordToN w = N_of_nat (wordToNat w). +Proof. word_lia_Z. Qed. + +Theorem wnot_zero : forall sz, wnot (wzero sz) = wones sz. +Proof. intros; apply bits.not_0. Qed. + +Lemma lt_wlt : forall sz (n m : word sz), (wordToNat n < wordToNat m)%nat -> n < m. +Proof. word_lia_Z. Qed. + +Lemma wordToNat_split1 : forall sz1 sz2 (w : word (sz1 + sz2)), + wordToNat (split1 _ _ w) = Nat.modulo (wordToNat w) (pow2 sz1). +Proof. + intros; cbv [wordToNat]; rewrite unsigned_split1. + pose proof (unsigned_range w); pose proof (Zpow2_pos sz1). + rewrite Z2Nat.inj_mod by lia. rewrite <- (pow2_Z sz1), Nat2Z.id; reflexivity. +Qed. + +Lemma wordToNat_natToWord_eqn : forall sz n, wordToNat (natToWord sz n) = (n mod pow2 sz)%nat. +Proof. + intros; cbv [wordToNat]; rewrite unsigned_natToWord; pose proof (Zpow2_pos sz). + rewrite Z2Nat.inj_mod by lia. rewrite <- (pow2_Z sz), !Nat2Z.id; reflexivity. +Qed. + +Lemma wordToNat_eq_rect : forall sz (w : word sz) nsz Hsz, + wordToNat (eq_rect _ word w nsz Hsz) = wordToNat w. +Proof. intros; subst; reflexivity. Qed. + +Theorem NToWord_nat : forall sz n, NToWord sz n = natToWord sz (nat_of_N n). +Proof. word_lia_Z. Qed. + +Lemma unsigned_wzero : forall sz, uwordToZ (wzero sz) = 0%Z. +Proof. intros; apply Zmod.unsigned_0. Qed. + +Lemma unsigned_ZToWord : forall sz z, uwordToZ (ZToWord sz z) = (z mod Zpow2 sz)%Z. +Proof. intros; apply Zmod.unsigned_of_Z. Qed. + +Theorem weqb_true_iff : forall sz x y, @weqb sz x y = true <-> x = y. +Proof. intros; apply Zmod.eqb_eq. Qed. + +Lemma wordToN_to_nat : forall sz (w : word sz), N.to_nat (wordToN w) = wordToNat w. +Proof. word_lia_Z. Qed. + +Lemma pow2_pos_Z : forall n, (0 < 2 ^ Z.of_nat n)%Z. +Proof. intros; rewrite <- Zpow2_eqn; apply Zpow2_pos. Qed. + +Lemma pow2_add_Z : forall a b, (2 ^ Z.of_nat (a + b) = 2 ^ Z.of_nat a * 2 ^ Z.of_nat b)%Z. +Proof. intros; rewrite <- !Zpow2_eqn; apply Zpow2_add. Qed. + +Lemma ZToWord_Z_of_N : forall sz n, ZToWord sz (Z.of_N n) = NToWord sz n. +Proof. reflexivity. Qed. + +Theorem combine_assoc : forall n1 (w1 : word n1) n2 n3 (w2 : word n2) (w3 : word n3) Heq, + combine (combine w1 w2) w3 + = match Heq in _ = N return word N with + | refl_equal => combine w1 (combine w2 w3) + end. +Proof. word_lia_Z. Qed. + +Lemma rewrite_weq : forall sz (a b : word sz) (pf : a = b), weq a b = left _ pf. +Proof. + intros; destruct (weq a b) as [e|n]; [f_equal; apply weq_dec_eq | elim n; exact pf]. +Qed. + +Lemma wordToZ_size : forall sz (w : word (S sz)), (Z.abs (wordToZ w) <= Z.of_nat (pow2 sz))%Z. +Proof. word_lia_Z. Qed. + +Lemma wordToZ_ZToWord'' : forall (sz : nat), (0 < sz)%nat -> + forall n : Z, (- 2 ^ (Z.of_nat sz - 1) <= n < 2 ^ (Z.of_nat sz - 1))%Z -> + wordToZ (ZToWord sz n) = n. +Proof. + intros; rewrite wordToZ_ZToWord_full by assumption. + pose proof (Z.pow_pos_nonneg 2 (Z.of_nat sz - 1) ltac:(lia) ltac:(lia)). + replace (2 ^ Z.of_nat sz)%Z with (2 * 2 ^ (Z.of_nat sz - 1))%Z + by (rewrite <- Z.pow_succ_r by lia; f_equal; lia). + rewrite Z.mod_small by lia; lia. +Qed. diff --git a/Kami/Lib/WordSupport.v b/Kami/Lib/WordSupport.v index b506243..8f6e506 100644 --- a/Kami/Lib/WordSupport.v +++ b/Kami/Lib/WordSupport.v @@ -6,106 +6,43 @@ Set Implicit Arguments. Local Open Scope word_scope. Lemma wordToNat_eq1: forall sz (a b: word sz), a = b -> wordToNat a = wordToNat b. -Proof. - intros; subst; reflexivity. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_eq2: forall sz (a b: word sz), wordToNat a = wordToNat b -> a = b. -Proof. - intros. - rewrite <- natToWord_wordToNat with (w := a). - rewrite <- natToWord_wordToNat with (w := b). - rewrite H. - reflexivity. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToN_to_nat sz: forall (w: word sz), BinNat.N.to_nat (wordToN w) = wordToNat w. -Proof. - intros. - rewrite wordToN_nat. - rewrite Nnat.Nat2N.id. - reflexivity. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_lt1: forall sz (a b: word sz), a < b -> (wordToNat a < wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_lt2: forall sz (a b: word sz), (wordToNat a < wordToNat b)%nat -> a < b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_gt1: forall sz (a b: word sz), a > b -> (wordToNat a > wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_gt2: forall sz (a b: word sz), (wordToNat a > wordToNat b)%nat -> a > b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_le1: forall sz (a b: word sz), a <= b -> (wordToNat a <= wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_le2: forall sz (a b: word sz), (wordToNat a <= wordToNat b)%nat -> a <= b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_ge1: forall sz (a b: word sz), a >= b -> (wordToNat a >= wordToNat b)%nat. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat in H. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_ge2: forall sz (a b: word sz), (wordToNat a >= wordToNat b)%nat -> a >= b. -Proof. - intros. - pre_nlia. - repeat rewrite wordToN_to_nat. - assumption. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_neq1: forall sz (a b: word sz), a <> b -> wordToNat a <> wordToNat b. -Proof. - unfold not. - intros. - apply wordToNat_eq2 in H0. - tauto. -Qed. +Proof. word_lia_Z. Qed. Lemma wordToNat_neq2: forall sz (a b: word sz), wordToNat a <> wordToNat b -> a <> b. -Proof. - unfold not. - intros. - subst. - tauto. -Qed. +Proof. word_lia_Z. Qed. Lemma wordNotNot: forall sz (a b: word sz), (a <> b -> False) -> a = b. Proof. @@ -113,114 +50,9 @@ Proof. destruct (weq a b); subst; tauto. Qed. -Ltac pre_word_lia := - unfold wzero, wone in *; - repeat match goal with - | H: @eq ?T ?a ?b |- _ => - match T with - | word ?sz => - apply (@wordToNat_eq1 sz a b) in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - end - | |- @eq ?T ?a ?b => - match T with - | word ?sz => - apply (@wordToNat_eq2 sz a b); - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - end - | H: ?a < ?b |- _ => - apply wordToNat_lt1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a < ?b => - apply wordToNat_lt2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a > ?b |- _ => - apply wordToNat_gt1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a > ?b => - apply wordToNat_gt2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a <= ?b |- _ => - apply wordToNat_le1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a <= ?b => - apply wordToNat_le2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a > ?b -> False |- _ => - apply wordToNat_le1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a > ?b -> False => - apply wordToNat_le2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: ?a < ?b -> False |- _ => - apply wordToNat_ge1 in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - | |- ?a < ?b -> False => - apply wordToNat_ge2; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - | H: not (@eq ?T ?a ?b) |- _ => - match T with - | word ?sz => - apply (@wordToNat_neq1 sz a b) in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - end - | |- not (@eq ?T ?a ?b) => - match T with - | word ?sz => - apply (@wordToNat_neq2 sz a b); - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - end - | H: @eq ?T ?a ?b -> False |- _ => - match T with - | word ?sz => - apply (@wordToNat_neq1 sz a b) in H; - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one in H; - simpl in H - end - | |- @eq ?T ?a ?b -> False => - match T with - | word ?sz => - apply (@wordToNat_neq2 sz a b); - rewrite ?roundTrip_0, ?roundTrip_1, ?wones_pow2_minus_one; - simpl - end - | H: (@eq ?T ?a ?b -> False) -> False |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - | H: (not (@eq ?T ?a ?b)) -> False |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - | H: not (@eq ?T ?a ?b -> False) |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - | H: not (not (@eq ?T ?a ?b)) |- _ => - match T with - | word ?sz => - apply (@wordNotNot sz a b) in H - end - end. - -Ltac word_lia := pre_word_lia; lia. +Ltac pre_word_lia := word_to_Z. + +Ltac word_lia := word_lia_Z. Lemma word_le_ge_eq sz (w1 w2: word sz): w1 <= w2 -> w1 >= w2 -> w1 = w2. Proof. @@ -232,4 +64,3 @@ Proof. intros; word_lia. Qed. - diff --git a/Kami/Semantics.v b/Kami/Semantics.v index c6cf305..c476d33 100644 --- a/Kami/Semantics.v +++ b/Kami/Semantics.v @@ -11,25 +11,12 @@ Set Asymmetric Patterns. Section VecFunc. Variable A: Type. - Fixpoint evalVec n (vec: Vec A n): word n -> A. - Proof. - refine match vec in Vec _ n return word n -> A with - | Vec0 e => fun _ => e - | VecNext n' v1 v2 => - fun w => - match w in word m0 return m0 = S n' -> A with - | WO => _ - | WS b m w' => - if b - then fun _ => evalVec _ v2 (_ w') - else fun _ => evalVec _ v1 (_ w') - end eq_refl - end; - clear evalVec. - - abstract (intros; discriminate). - - injection e; intros; subst; exact x. - - injection e; intros; subst; exact x. - Defined. + Fixpoint evalVec n (vec: Vec A n): word n -> A := + match vec in Vec _ n return word n -> A with + | Vec0 e => fun _ => e + | VecNext n' v1 v2 => + fun w => if whd w then evalVec v2 (wtl w) else evalVec v1 (wtl w) + end. Variable B: Type. Variable map: A -> B. @@ -47,7 +34,7 @@ Definition cmb := fun sz1 (w1: word sz1) sz2 (w2: word sz2) => combine w2 w1. Section WordFunc. Definition wordZero (w: word 0): w = WO := - shatter_word w. + word0 w. Variable A: Type. @@ -238,8 +225,8 @@ Defined. Definition evalUniBit n1 n2 (op: UniBitOp n1 n2): word n1 -> word n2. destruct op. - - exact (@wnot n). - - exact (@wneg n). + - exact wnot. + - exact wneg. - exact (fun w => split2 n1 n2 (split1 (n1 + n2) n3 w)). - exact (fun w => split1 n1 n2 w). - exact (fun w => evalZeroExtendTrunc _ w). @@ -250,20 +237,16 @@ Defined. Definition evalBinBit n1 n2 n3 (op: BinBitOp n1 n2 n3) : word n1 -> word n2 -> word n3 := match op with - | Add n => @wplus n - | Sub n => @wminus n - | Mul n SignSS => @wmultZ n - | Mul n SignSU => @wmultZsu n - | Mul n SignUU => @wmult n + | Add n => wplus + | Sub n => wminus + | Mul n _ => wmult | Div n true => @wdivZ n - (* | Div n SignSU => @wdivZsu n *) | Div n false => @wdivN n | Rem n true => @wremZ n - (* | Rem n SignSU => @wremZsu n *) | Rem n false => @wremN n - | Band n => @wand n - | Bor n => @wor n - | Bxor n => @wxor n + | Band n => wand + | Bor n => wor + | Bxor n => wxor | Sll n m => (fun x y => wlshift x (wordToNat y)) | Srl n m => (fun x y => wrshift x (wordToNat y)) | Sra n m => (fun x y => wrshifta x (wordToNat y)) @@ -273,8 +256,8 @@ Definition evalBinBit n1 n2 n3 (op: BinBitOp n1 n2 n3) Definition evalBinBitBool n1 n2 (op: BinBitBoolOp n1 n2) : word n1 -> word n2 -> bool := match op with - | Lt n => fun a b => if @wlt_dec n a b then true else false - | Slt n => fun a b => if @wslt_dec n a b then true else false + | Lt n => fun a b => (uwordToZ a fun a b => (wordToZ a A := diff --git a/Kami/Syntax.v b/Kami/Syntax.v index cf627fb..5311484 100644 --- a/Kami/Syntax.v +++ b/Kami/Syntax.v @@ -196,17 +196,18 @@ Qed. Inductive ConstT: Kind -> Type := | ConstBool: bool -> ConstT Bool -| ConstBit n: word n -> ConstT (Bit n) +| ConstBit n: Zmod (Zpow2 n) -> ConstT (Bit n) | ConstVector k n: Vec (ConstT k) n -> ConstT (Vector k n) | ConstStruct n (ls: Vector.t _ n): ilist (fun a => ConstT (attrType a)) ls -> ConstT (Struct ls) | ConstArray k n: Vector.t (ConstT k) n -> ConstT (Array k n). +Arguments ConstBit [n] _. Inductive ConstFullT: FullKind -> Type := | SyntaxConst k: ConstT k -> ConstFullT (SyntaxKind k) | NativeConst t (c c': t): ConstFullT (NativeKind c). Coercion ConstBool : bool >-> ConstT. -Coercion ConstBit : word >-> ConstT. +Coercion ConstBit : Zmod >-> ConstT. Fixpoint vector_repeat A n (a: A) := match n return Vector.t A n with