├── .github └── workflows │ └── coq.yml ├── .gitignore ├── CONTRIBUTORS ├── LICENSE ├── Makefile ├── README.md ├── _CoqProject ├── etc └── ci │ └── sudo-apt-get-update.sh ├── print_assumptions.sh └── src └── bbv ├── BinNotation.v ├── BinNotationZ.v ├── DepEq.v ├── DepEqNat.v ├── HexNotation.v ├── HexNotationWord.v ├── HexNotationZ.v ├── NLib.v ├── N_Z_nat_conversions.v ├── NatLib.v ├── Nomega.v ├── ReservedNotations.v ├── Word.v ├── WordScope.v ├── ZHints.v └── ZLib.v /.github/workflows/coq.yml: -------------------------------------------------------------------------------- 1 | name: CI (Coq) 2 | 3 | on: 4 | push: 5 | pull_request: 6 | 7 | jobs: 8 | build: 9 | 10 | runs-on: ubuntu-20.04 11 | 12 | strategy: 13 | matrix: 14 | env: 15 | - { COQ_VERSION: "master", COQ_PACKAGE: "coq" , PPA: "ppa:jgross-h/coq-master-daily" } 16 | - { COQ_VERSION: "8.17.1", COQ_PACKAGE: "coq-8.17.1", PPA: "ppa:jgross-h/many-coq-versions-ocaml-4-11" } 17 | - { COQ_VERSION: "8.16.1", COQ_PACKAGE: "coq-8.16.1", PPA: "ppa:jgross-h/many-coq-versions-ocaml-4-11" } 18 | fail-fast: false 19 | 20 | env: ${{ matrix.env }} 21 | 22 | steps: 23 | - name: install Coq 24 | run: | 25 | if [ ! -z "$PPA" ]; then sudo add-apt-repository "$PPA" -y; fi 26 | sudo apt-get update -q 27 | sudo apt-get install $COQ_PACKAGE -y --allow-unauthenticated 28 | - name: echo build params 29 | run: | 30 | lscpu 31 | uname -a 32 | lsb_release -a 33 | coqc --version 34 | echo | coqtop 35 | - uses: actions/checkout@v2 36 | - run: make 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.vo 3 | *.vos 4 | *.vok 5 | *.glob 6 | *.aux 7 | *.d 8 | .depend 9 | .*.cache 10 | Makefile.coq.all.conf 11 | Makefile.coq.all 12 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Contributors (in alphabetical order): 2 | 3 | Tej Chajed 4 | Haogang Chen 5 | Adam Chlipala 6 | Joonwon Choi 7 | Andres Erbsen 8 | Jason Gross 9 | Samuel Gruetter 10 | Frans Kaashoek 11 | Alex Konradi 12 | Gregory Malecha 13 | Duckki Oe 14 | Murali Vijayaraghavan 15 | Nickolai Zeldovich 16 | Daniel Ziegler 17 | 18 | This list was generated from the commit history of the various projects from which bbv was merged, so it's likely that some people are missing. If you think someone should be added, please make a pull request! 19 | 20 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2011-2018, Massachusetts Institute of Technology 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | VS:=$(shell find . -type f -name '*.v') 2 | 3 | .PHONY: coq clean force 4 | 5 | coq: Makefile.coq.all $(VS) 6 | $(MAKE) -f Makefile.coq.all 7 | 8 | Makefile.coq.all: force 9 | $(COQBIN)coq_makefile -f _CoqProject $(VS) -o Makefile.coq.all 10 | 11 | force: 12 | 13 | clean:: Makefile.coq.all 14 | $(MAKE) -f Makefile.coq.all clean 15 | rm -rf *.v.d *.glob *.vo *~ *.hi *.o 16 | rm -f Makefile.coq.all Makefile.coq.all.conf 17 | 18 | install: Makefile.coq.all 19 | $(MAKE) -f Makefile.coq.all install 20 | 21 | uninstall: Makefile.coq.all 22 | $(MAKE) -f Makefile.coq.all uninstall 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # bbv - Bedrock Bit Vectors 2 | 3 | Several Coq projects at MIT use a file called Word.v, defining bit vectors and lemmas about them. 4 | 5 | This repo unifies the different versions of this file into one repository, so that everyone can benefit from additions made by other projects. 6 | 7 | Suggested collaboration protocol: 8 | 9 | - For non-breaking, backwards-compatible (i.e. just additions) changes you just push to master, to keep the workflow as lightweight as possible. 10 | - For more "controversial" changes which might break something, make a PR. 11 | 12 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -Q src/bbv bbv 2 | -arg -w -arg -deprecated-hint-rewrite-without-locality,+deprecated-hint-without-locality,+deprecated-instance-without-locality 3 | -------------------------------------------------------------------------------- /etc/ci/sudo-apt-get-update.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | (sudo apt-get update "$@" 2>&1 || echo 'E: update failed') | tee /tmp/apt.err 4 | ! grep -q '^\(E:\|W: Failed to fetch\)' /tmp/apt.err || exit $? 5 | -------------------------------------------------------------------------------- /print_assumptions.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ "$#" -ne 1 ]; then 4 | echo "Illegal number of parameters" 5 | echo "Usage: 1 arg (name of coq module to consider without .v extension)" 6 | exit 1 7 | fi 8 | 9 | infile="src/bbv/$1.v" 10 | outfile="$1_print_assumptions.v" 11 | 12 | echo "Require Import bbv.$1." > "$outfile" 13 | 14 | grep -E "$infile" -e '^ *(Lemma|Theorem|Corollary)' | grep -v 'Note: not axiom free' | sed -E -e 's/ *(Lemma|Theorem|Corollary) //g' -e 's/^([^ :]+).*/About \1. Print Assumptions \1./g' >> "$outfile" 15 | -------------------------------------------------------------------------------- /src/bbv/BinNotation.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | 3 | (* Adapted from http://poleiro.info/posts/2013-04-03-parse-errors-as-type-errors.html, 4 | https://github.com/arthuraa/poleiro/blob/master/theories/ForceOption.v 5 | to produce N instead of nat *) 6 | 7 | Require Export Coq.Strings.String. 8 | Require Import Coq.Strings.Ascii. 9 | Require Import Coq.NArith.NArith. 10 | 11 | Local Open Scope char_scope. 12 | 13 | Local Open Scope N_scope. 14 | 15 | Definition binDigitToN (c : ascii) : option N := 16 | match c with 17 | | "0" => Some 0 18 | | "1" => Some 1 19 | | _ => None 20 | end. 21 | 22 | Open Scope string_scope. 23 | 24 | Fixpoint readBinNAux (s : string) (acc : N) : option N := 25 | match s with 26 | | "" => Some acc 27 | | String c s' => 28 | match binDigitToN c with 29 | | Some n => readBinNAux s' (2 * acc + n) 30 | | None => None 31 | end 32 | end. 33 | 34 | Definition readBinN (s : string) : option N := readBinNAux s 0. 35 | 36 | Goal readBinN "11111111" = Some 255. 37 | Proof. reflexivity. Qed. 38 | 39 | Definition forceOption A Err (o : option A) (err : Err) : match o with 40 | | Some _ => A 41 | | None => Err 42 | end := 43 | match o with 44 | | Some a => a 45 | | None => err 46 | end. 47 | 48 | Inductive parseError := ParseError. 49 | 50 | Definition bin (s : string) := forceOption N parseError (readBinN s) ParseError. 51 | 52 | Goal bin"11111111" = 255. 53 | Proof. reflexivity. Qed. 54 | 55 | Goal bin"1011" = 11. 56 | Proof. reflexivity. Qed. 57 | 58 | Goal bin"1O" = ParseError. 59 | Proof. reflexivity. Qed. 60 | -------------------------------------------------------------------------------- /src/bbv/BinNotationZ.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Require Export bbv.BinNotation. 3 | Require Export bbv.ReservedNotations. 4 | Require Import Coq.ZArith.BinInt. 5 | 6 | Notation "'Ob' a" := (Z.of_N (bin a)). 7 | 8 | Goal Ob"01000001" = 65%Z. 9 | Proof. reflexivity. Qed. 10 | -------------------------------------------------------------------------------- /src/bbv/DepEq.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Require Import Coq.Arith.Peano_dec. 3 | Require Import Coq.Logic.Eqdep Coq.Logic.Eqdep_dec Coq.Program.Equality. 4 | 5 | (** * Equalities on dependent types *) 6 | 7 | Theorem eq_rect_nat_double : forall T (a b c : nat) x ab bc, 8 | eq_rect b T (eq_rect a T x b ab) c bc = eq_rect a T x c (eq_trans ab bc). 9 | Proof. 10 | intros. 11 | destruct ab. 12 | destruct bc. 13 | rewrite (UIP_dec eq_nat_dec (eq_trans eq_refl eq_refl) eq_refl). 14 | simpl. 15 | auto. 16 | Qed. 17 | 18 | Hint Rewrite eq_rect_nat_double. 19 | Hint Rewrite <- (eq_rect_eq_dec eq_nat_dec). 20 | 21 | Ltac generalize_proof := 22 | match goal with 23 | | [ |- context[eq_rect _ _ _ _ ?H ] ] => generalize H 24 | end. 25 | 26 | Ltac eq_rect_simpl := 27 | unfold eq_rec_r, eq_rec; 28 | repeat rewrite eq_rect_nat_double; 29 | repeat rewrite <- (eq_rect_eq_dec eq_nat_dec). 30 | 31 | Ltac destruct_existT := 32 | repeat match goal with 33 | | [H: existT _ _ _ = existT _ _ _ |- _] => 34 | (apply Eqdep.EqdepTheory.inj_pair2 in H; subst) 35 | end. 36 | 37 | Lemma eq_rect_word_offset_helper : forall a b c, 38 | a = b -> c + a = c + b. 39 | Proof. 40 | intros; congruence. 41 | Qed. 42 | 43 | Lemma eq_rect_word_mult_helper : forall a b c, 44 | a = b -> a * c = b * c. 45 | Proof. 46 | intros; congruence. 47 | Qed. 48 | 49 | Lemma existT_eq_rect: 50 | forall (X: Type) (P: X -> Type) (x1 x2: X) (H1: P x1) (Hx: x1 = x2), 51 | existT P x2 (eq_rect x1 P H1 x2 Hx) = 52 | existT P x1 H1. 53 | Proof. 54 | intros; subst; reflexivity. 55 | Qed. 56 | 57 | Lemma existT_eq_rect_eq: 58 | forall (X: Type) (P: X -> Type) (x1 x2: X) 59 | (H1: P x1) (H2: P x2) (Hx: x1 = x2), 60 | H2 = eq_rect _ P H1 _ Hx -> 61 | existT P x1 H1 = existT P x2 H2. 62 | Proof. 63 | intros; subst; reflexivity. 64 | Qed. 65 | 66 | Lemma eq_rect_existT_eq: 67 | forall (X: Type) (P: X -> Type) (x1 x2: X) 68 | (H1: P x1) (H2: P x2) (Hx: x1 = x2) 69 | (Hex: existT P x1 H1 = existT P x2 H2), 70 | H2 = eq_rect _ P H1 _ Hx. 71 | Proof. 72 | intros; subst. 73 | subst; destruct_existT. 74 | reflexivity. 75 | Qed. 76 | 77 | -------------------------------------------------------------------------------- /src/bbv/DepEqNat.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | 3 | (* This file defines nat_cast, an alternative to eq_rect which works only for type nat instead 4 | of any type A. 5 | The motivation behind nat_cast is that it only matches on proofs in contradictory cases, 6 | so functions using nat_cast can always be run inside Coq using cbv, whereas function using 7 | eq_rect cannot. *) 8 | 9 | Arguments id {A} x. 10 | 11 | (* Transport equality, only matching on eq_refl in contradictory cases, to make sure 12 | terms using this function reduce *) 13 | Fixpoint nat_cast (P : nat -> Type) {n m} : n = m -> P n -> P m. 14 | refine match n, m return n = m -> P n -> P m with 15 | | O, O => fun _ => id 16 | | S n, S m => fun pf => @nat_cast (fun n => P (S n)) n m (f_equal pred pf) 17 | | _, _ => fun pf => match _ pf : False with end 18 | end; 19 | clear; abstract congruence. 20 | Defined. (* thx Jason *) 21 | 22 | Lemma nat_cast_eq_rect: forall (P : nat -> Type), 23 | forall (n m : nat) (e: n = m) (pn: P n), 24 | nat_cast P e pn = eq_rect n P pn m e. 25 | Proof. 26 | destruct e. 27 | revert dependent P; induction n; simpl; intros. 28 | - reflexivity. 29 | - rewrite IHn. reflexivity. 30 | Qed. (* thx Clement *) 31 | 32 | Lemma nat_cast_proof_irrel: forall (P : nat -> Type), 33 | forall (n m : nat) (e1 e2: n = m) (pn: P n), 34 | nat_cast P e1 pn = nat_cast P e2 pn. 35 | Proof. 36 | destruct e1. 37 | revert dependent P; induction n; simpl; intros. 38 | - reflexivity. 39 | - erewrite IHn. reflexivity. 40 | Qed. 41 | 42 | Lemma nat_cast_same: forall (P: nat -> Type) (s: nat) (n: P s), 43 | nat_cast P eq_refl n = n. 44 | Proof. 45 | intros. rewrite nat_cast_eq_rect. reflexivity. 46 | Qed. 47 | 48 | Lemma nat_cast_fuse: forall (P: nat -> Type) (n1 n2 n3: nat) (e12: n1 = n2) (e23: n2 = n3) (x: P n1), 49 | nat_cast P e23 (nat_cast P e12 x) = nat_cast P (eq_trans e12 e23) x. 50 | Proof. 51 | destruct e12. 52 | destruct e23. 53 | intros. 54 | rewrite nat_cast_same. 55 | reflexivity. 56 | Qed. 57 | 58 | Lemma nat_cast_cast ni no (pf: ni = no) (P: nat -> Type) (x : P ni): 59 | nat_cast P pf x = match pf in _ = Y return P Y with 60 | | eq_refl => x 61 | end. 62 | Proof. 63 | destruct pf. 64 | rewrite nat_cast_same. 65 | auto. 66 | Qed. 67 | -------------------------------------------------------------------------------- /src/bbv/HexNotation.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | 3 | (* Adapted from http://poleiro.info/posts/2013-04-03-parse-errors-as-type-errors.html, 4 | https://github.com/arthuraa/poleiro/blob/master/theories/ForceOption.v 5 | to produce N instead of nat *) 6 | 7 | Require Export Coq.Strings.String. 8 | Require Import Coq.Strings.Ascii. 9 | Require Import Coq.NArith.NArith. 10 | 11 | Local Open Scope char_scope. 12 | 13 | Local Open Scope N_scope. 14 | 15 | Definition hexDigitToN (c : ascii) : option N := 16 | match c with 17 | | "0" => Some 0 18 | | "1" => Some 1 19 | | "2" => Some 2 20 | | "3" => Some 3 21 | | "4" => Some 4 22 | | "5" => Some 5 23 | | "6" => Some 6 24 | | "7" => Some 7 25 | | "8" => Some 8 26 | | "9" => Some 9 27 | | "a" | "A" => Some 10 28 | | "b" | "B" => Some 11 29 | | "c" | "C" => Some 12 30 | | "d" | "D" => Some 13 31 | | "e" | "E" => Some 14 32 | | "f" | "F" => Some 15 33 | | _ => None 34 | end. 35 | 36 | Local Open Scope string_scope. 37 | 38 | Fixpoint readHexNAux (s : string) (acc : N) : option N := 39 | match s with 40 | | "" => Some acc 41 | | String c s' => 42 | match hexDigitToN c with 43 | | Some n => readHexNAux s' (16 * acc + n) 44 | | None => None 45 | end 46 | end. 47 | 48 | Definition readHexN (s : string) : option N := readHexNAux s 0. 49 | 50 | Goal readHexN "ff" = Some 255. 51 | Proof. reflexivity. Qed. 52 | 53 | Definition forceOption A Err (o : option A) (err : Err) : match o with 54 | | Some _ => A 55 | | None => Err 56 | end := 57 | match o with 58 | | Some a => a 59 | | None => err 60 | end. 61 | 62 | Inductive parseError := ParseError. 63 | 64 | Definition hex (s : string) := forceOption N parseError (readHexN s) ParseError. 65 | 66 | Goal hex"ff" = 255. 67 | Proof. reflexivity. Qed. 68 | 69 | Goal hex"a0f" = 2575. 70 | Proof. reflexivity. Qed. 71 | 72 | Goal hex"1O" = ParseError. 73 | Proof. reflexivity. Qed. 74 | 75 | Goal hex"ff34c8e3" = 4281649379. 76 | Proof. reflexivity. Qed. 77 | Local Close Scope string_scope. 78 | Local Close Scope N_scope. 79 | 80 | Definition binDigitToNat (c : ascii) : option nat := 81 | match c with 82 | | "0" => Some 0 83 | | "1" => Some 1 84 | | _ => None 85 | end. 86 | 87 | Open Scope string_scope. 88 | 89 | Fixpoint readBinAux (s : string) (acc : nat) : option nat := 90 | match s with 91 | | "" => Some acc 92 | | String c s' => 93 | match binDigitToNat c with 94 | | Some n => readBinAux s' (2 * acc + n) 95 | | None => None 96 | end 97 | end. 98 | 99 | Definition readBinNat (s : string) : option nat := readBinAux s 0. 100 | 101 | Goal readBinNat "01" = Some 1. 102 | Proof. reflexivity. Qed. 103 | 104 | Definition bin (s : string) := @forceOption nat parseError (readBinNat s) ParseError. 105 | -------------------------------------------------------------------------------- /src/bbv/HexNotationWord.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Require Export bbv.HexNotation. 3 | Require Import bbv.WordScope. 4 | Require bbv.BinNotation. 5 | 6 | Notation "'Ox' a" := (NToWord _ (hex a)) (at level 50). 7 | 8 | Notation "sz ''h' a" := (NToWord sz (hex a)) (at level 50). 9 | 10 | Goal 8'h"a" = WO~0~0~0~0~1~0~1~0. 11 | Proof. reflexivity. Qed. 12 | 13 | Goal Ox"41" = WO~1~0~0~0~0~0~1. 14 | Proof. reflexivity. Qed. 15 | 16 | Notation "sz ''b' a" := (NToWord sz (BinNotation.bin a)) (at level 50). 17 | 18 | Notation "''b' a" := (NToWord _ (BinNotation.bin a)) (at level 50). 19 | 20 | Goal 'b"00001010" = WO~0~0~0~0~1~0~1~0. 21 | Proof. reflexivity. Qed. 22 | 23 | Goal 'b"1000001" = WO~1~0~0~0~0~0~1. 24 | Proof. reflexivity. Qed. 25 | 26 | Goal 'b"111110000000000000101" = WO~1~1~1~1~1~0~0~0~0~0~0~0~0~0~0~0~0~0~1~0~1. 27 | Proof. cbv. reflexivity. Qed. 28 | 29 | 30 | -------------------------------------------------------------------------------- /src/bbv/HexNotationZ.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Require Export bbv.HexNotation. 3 | Require Export bbv.ReservedNotations. 4 | Require Import Coq.ZArith.BinInt. 5 | 6 | Notation "'Ox' a" := (Z.of_N (hex a)). 7 | 8 | Goal Ox"41" = 65%Z. 9 | Proof. reflexivity. Qed. 10 | -------------------------------------------------------------------------------- /src/bbv/NLib.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Require Import Coq.NArith.NArith. 3 | 4 | Local Open Scope N_scope. 5 | 6 | Definition Nlt_dec: forall (l r : N), {l < r} + {l >= r}. 7 | refine (fun l r => 8 | match N.compare l r as k return N.compare l r = k -> _ with 9 | | Lt => fun pf => left _ _ 10 | | _ => fun pf => right _ _ 11 | end (refl_equal _)); 12 | abstract congruence. 13 | Defined. 14 | -------------------------------------------------------------------------------- /src/bbv/N_Z_nat_conversions.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | (* This should be in the Coq library *) 3 | Require Import Coq.Classes.Morphisms Coq.Classes.Morphisms_Prop. 4 | Require Import Coq.Arith.Arith Coq.NArith.NArith Coq.ZArith.ZArith. 5 | Require Import Coq.micromega.Lia. 6 | 7 | Lemma N_to_Z_to_nat: forall (a: N), Z.to_nat (Z.of_N a) = N.to_nat a. 8 | Proof. 9 | intros. rewrite <- (N2Z.id a) at 2. 10 | rewrite Z_N_nat. reflexivity. 11 | Qed. 12 | 13 | Module N2Nat. 14 | 15 | Lemma inj_mod: forall (a b: N), 16 | (b <> 0)%N -> 17 | N.to_nat (a mod b)%N = (N.to_nat a) mod (N.to_nat b). 18 | Proof. 19 | intros. 20 | rewrite <-? N_to_Z_to_nat. 21 | rewrite N2Z.inj_mod by assumption. 22 | apply Nat2Z.inj. 23 | rewrite Nat2Z.inj_mod. 24 | rewrite? Z2Nat.id; try apply N2Z.is_nonneg. 25 | - reflexivity. 26 | - pose proof (Z.mod_pos_bound (Z.of_N a) (Z.of_N b)) as Q. 27 | destruct Q as [Q _]. 28 | + destruct b; try contradiction. simpl. constructor. 29 | + exact Q. 30 | Qed. 31 | 32 | End N2Nat. 33 | 34 | Module Nat2Z. 35 | 36 | Lemma inj_pow: forall n m : nat, 37 | Z.of_nat (n ^ m) = (Z.of_nat n ^ Z.of_nat m)%Z. 38 | Proof. 39 | intros. induction m. 40 | - reflexivity. 41 | - rewrite Nat2Z.inj_succ. 42 | rewrite Z.pow_succ_r by (apply Nat2Z.is_nonneg). 43 | rewrite <- IHm. 44 | rewrite <- Nat2Z.inj_mul. 45 | reflexivity. 46 | Qed. 47 | 48 | End Nat2Z. 49 | 50 | Module Z2Nat. 51 | 52 | Lemma inj_pow: forall n m : Z, 53 | (0 <= n)%Z -> 54 | (0 <= m)%Z -> 55 | Z.to_nat (n ^ m) = Z.to_nat n ^ Z.to_nat m. 56 | Proof. 57 | intros. 58 | pose proof (Nat2Z.inj_pow (Z.to_nat n) (Z.to_nat m)) as P. 59 | rewrite? Z2Nat.id in P by assumption. 60 | rewrite <- P. 61 | apply Nat2Z.id. 62 | Qed. 63 | 64 | End Z2Nat. 65 | -------------------------------------------------------------------------------- /src/bbv/NatLib.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Require Import Coq.Classes.Morphisms Coq.Classes.Morphisms_Prop. 3 | Require Import Coq.Bool.Bool. 4 | Require Import Coq.Arith.Arith. 5 | Import Coq.Arith.PeanoNat.Nat. 6 | Require Import Coq.micromega.Lia. 7 | Require Import Coq.NArith.NArith. 8 | Require Import Coq.ZArith.ZArith. 9 | Require Import bbv.N_Z_nat_conversions. 10 | Require Export bbv.Nomega. 11 | 12 | Set Implicit Arguments. 13 | 14 | Fixpoint mod2 (n : nat) : bool := 15 | match n with 16 | | 0 => false 17 | | 1 => true 18 | | S (S n') => mod2 n' 19 | end. 20 | 21 | Ltac rethink := 22 | match goal with 23 | | [ H : ?f ?n = _ |- ?f ?m = _ ] => replace m with n; simpl; auto 24 | end. 25 | 26 | Theorem mod2_S_double : forall n, mod2 (S (2 * n)) = true. 27 | induction n; simpl; intuition; rethink. 28 | Qed. 29 | 30 | Theorem mod2_double : forall n, mod2 (2 * n) = false. 31 | induction n; simpl; intuition; rewrite <- plus_n_Sm; rethink. 32 | Qed. 33 | 34 | Theorem div2_double : forall n, div2 (2 * n) = n. 35 | induction n; simpl; intuition; rewrite <- plus_n_Sm; f_equal; rethink. 36 | Qed. 37 | 38 | Theorem div2_S_double : forall n, div2 (S (2 * n)) = n. 39 | induction n; simpl; intuition; f_equal; rethink. 40 | Qed. 41 | 42 | Notation pow2 := (Nat.pow 2). 43 | 44 | Fixpoint Npow2 (n : nat) : N := 45 | match n with 46 | | O => 1 47 | | S n' => 2 * Npow2 n' 48 | end%N. 49 | 50 | Theorem untimes2 : forall n, n + (n + 0) = 2 * n. 51 | auto. 52 | Qed. 53 | 54 | Section strong. 55 | Variable P : nat -> Prop. 56 | 57 | Hypothesis PH : forall n, (forall m, m < n -> P m) -> P n. 58 | 59 | Lemma strong' : forall n m, m <= n -> P m. 60 | induction n; simpl; intuition; apply PH; intuition. 61 | exfalso; lia. 62 | Qed. 63 | 64 | Theorem strong : forall n, P n. 65 | intros; eapply strong'; eauto. 66 | Qed. 67 | End strong. 68 | 69 | Theorem div2_odd : forall n, 70 | mod2 n = true 71 | -> n = S (2 * div2 n). 72 | induction n as [n] using strong; simpl; intuition. 73 | 74 | destruct n as [|n]; simpl in *. 75 | discriminate. 76 | destruct n as [|n]; simpl in *; intuition. 77 | do 2 f_equal. 78 | replace (div2 n + S (div2 n + 0)) with (S (div2 n + (div2 n + 0))); auto. 79 | Qed. 80 | 81 | Theorem div2_even : forall n, 82 | mod2 n = false 83 | -> n = 2 * div2 n. 84 | induction n as [n] using strong; simpl; intuition. 85 | 86 | destruct n as [|n]; simpl in *; intuition. 87 | destruct n as [|n]; simpl in *. 88 | discriminate. 89 | f_equal. 90 | replace (div2 n + S (div2 n + 0)) with (S (div2 n + (div2 n + 0))); auto. 91 | Qed. 92 | 93 | Theorem drop_mod2 : forall n k, 94 | 2 * k <= n 95 | -> mod2 (n - 2 * k) = mod2 n. 96 | induction n as [n] using strong; intros. 97 | 98 | do 2 (destruct n; simpl in *; repeat rewrite untimes2 in *; intuition). 99 | 100 | destruct k; simpl in *; intuition. 101 | 102 | destruct k; simpl; intuition. 103 | rewrite <- plus_n_Sm. 104 | repeat rewrite untimes2 in *. 105 | simpl; auto. 106 | apply H; lia. 107 | Qed. 108 | 109 | Theorem div2_minus_2 : forall n k, 110 | 2 * k <= n 111 | -> div2 (n - 2 * k) = div2 n - k. 112 | induction n as [n] using strong; intros. 113 | 114 | do 2 (destruct n; simpl in *; intuition; repeat rewrite untimes2 in *). 115 | destruct k; simpl in *; intuition. 116 | 117 | destruct k; simpl in *; intuition. 118 | rewrite <- plus_n_Sm. 119 | apply H; lia. 120 | Qed. 121 | 122 | Theorem div2_bound : forall k n, 123 | 2 * k <= n 124 | -> k <= div2 n. 125 | intros ? n H; case_eq (mod2 n); intro Heq. 126 | 127 | rewrite (div2_odd _ Heq) in H. 128 | lia. 129 | 130 | rewrite (div2_even _ Heq) in H. 131 | lia. 132 | Qed. 133 | 134 | Lemma two_times_div2_bound: forall n, 2 * Nat.div2 n <= n. 135 | Proof. 136 | eapply strong. intros n IH. 137 | destruct n. 138 | - constructor. 139 | - destruct n. 140 | + simpl. constructor. constructor. 141 | + simpl (Nat.div2 (S (S n))). 142 | specialize (IH n). lia. 143 | Qed. 144 | 145 | Lemma div2_compat_lt_l: forall a b, b < 2 * a -> Nat.div2 b < a. 146 | Proof. 147 | induction a; intros. 148 | - lia. 149 | - destruct b. 150 | + simpl. lia. 151 | + destruct b. 152 | * simpl. lia. 153 | * simpl. 154 | apply Nat.lt_succ_r. apply IHa. lia. 155 | Qed. 156 | 157 | (* otherwise b is made implicit, while a isn't, which is weird *) 158 | Arguments div2_compat_lt_l {_} {_} _. 159 | 160 | Lemma pow2_add_mul: forall a b, 161 | pow2 (a + b) = (pow2 a) * (pow2 b). 162 | Proof. 163 | induction a; destruct b; firstorder auto with arith; simpl. 164 | repeat rewrite Nat.add_0_r. 165 | rewrite Nat.mul_1_r; auto. 166 | repeat rewrite Nat.add_0_r. 167 | rewrite IHa. 168 | simpl. 169 | repeat rewrite Nat.add_0_r. 170 | rewrite Nat.mul_add_distr_r; auto. 171 | Qed. 172 | 173 | Lemma mult_pow2_bound: forall a b x y, 174 | x < pow2 a -> y < pow2 b -> x * y < pow2 (a + b). 175 | Proof. 176 | intros. 177 | rewrite pow2_add_mul. 178 | apply Nat.mul_lt_mono_nonneg; lia. 179 | Qed. 180 | 181 | Lemma mult_pow2_bound_ex: forall a c x y, 182 | x < pow2 a -> y < pow2 (c - a) -> c >= a -> x * y < pow2 c. 183 | Proof. 184 | intros. 185 | replace c with (a + (c - a)) by lia. 186 | apply mult_pow2_bound; auto. 187 | Qed. 188 | 189 | Lemma lt_mul_mono' : forall c a b, 190 | a < b -> a < b * (S c). 191 | Proof. 192 | induction c; intros. 193 | rewrite Nat.mul_1_r; auto. 194 | rewrite Nat.mul_succ_r. 195 | apply Nat.lt_lt_add_r. 196 | apply IHc; auto. 197 | Qed. 198 | 199 | Lemma lt_mul_mono : forall a b c, 200 | c <> 0 -> a < b -> a < b * c. 201 | Proof. 202 | intros. 203 | replace c with (S (c - 1)) by lia. 204 | apply lt_mul_mono'; auto. 205 | Qed. 206 | 207 | Lemma zero_lt_pow2 : forall sz, 0 < pow2 sz. 208 | Proof. 209 | induction sz; simpl; lia. 210 | Qed. 211 | 212 | Lemma one_lt_pow2: 213 | forall n, 214 | 1 < pow2 (S n). 215 | Proof. 216 | intros. 217 | induction n. 218 | simpl; lia. 219 | remember (S n); simpl. 220 | lia. 221 | Qed. 222 | 223 | Lemma one_le_pow2 : forall sz, 1 <= pow2 sz. 224 | Proof. 225 | intros. pose proof (zero_lt_pow2 sz). lia. 226 | Qed. 227 | 228 | Lemma pow2_ne_zero: forall n, pow2 n <> 0. 229 | Proof. 230 | intros. 231 | pose proof (zero_lt_pow2 n). 232 | lia. 233 | Qed. 234 | 235 | Lemma mul2_add : forall n, n * 2 = n + n. 236 | Proof. 237 | induction n; firstorder auto with zarith. 238 | Qed. 239 | 240 | Lemma pow2_le_S : forall sz, (pow2 sz) + 1 <= pow2 (sz + 1). 241 | Proof. 242 | induction sz; simpl; auto. 243 | repeat rewrite Nat.add_0_r. 244 | rewrite pow2_add_mul. 245 | repeat rewrite mul2_add. 246 | pose proof (zero_lt_pow2 sz). 247 | lia. 248 | Qed. 249 | 250 | Lemma pow2_bound_mono: forall a b x, 251 | x < pow2 a -> a <= b -> x < pow2 b. 252 | Proof. 253 | intros. 254 | replace b with (a + (b - a)) by lia. 255 | rewrite pow2_add_mul. 256 | apply lt_mul_mono; auto. 257 | pose proof (zero_lt_pow2 (b - a)). 258 | lia. 259 | Qed. 260 | 261 | Lemma pow2_inc : forall n m, n < m -> pow2 n < pow2 m. 262 | Proof. 263 | intros n m; revert n; induction m as [|m IH]; intros n nLm; [lia|]. 264 | destruct n; [now apply one_lt_pow2|]. 265 | assert (H : pow2 n < pow2 m) by (apply IH; lia). 266 | simpl; lia. 267 | Qed. 268 | 269 | Lemma pow2_S: forall x, pow2 (S x) = 2 * pow2 x. 270 | Proof. intros. reflexivity. Qed. 271 | 272 | Lemma mod2_S_S : forall n, 273 | mod2 (S (S n)) = mod2 n. 274 | Proof. 275 | intros. 276 | destruct n; auto; destruct n; auto. 277 | Qed. 278 | 279 | Lemma mod2_S_not : forall n, 280 | mod2 (S n) = if (mod2 n) then false else true. 281 | Proof. 282 | intros. 283 | induction n; auto. 284 | rewrite mod2_S_S. 285 | destruct (mod2 n); replace (mod2 (S n)); auto. 286 | Qed. 287 | 288 | Lemma mod2_S_eq : forall n k, 289 | mod2 n = mod2 k -> 290 | mod2 (S n) = mod2 (S k). 291 | Proof. 292 | intros. 293 | do 2 rewrite mod2_S_not. 294 | rewrite H. 295 | auto. 296 | Qed. 297 | 298 | Theorem drop_mod2_add : forall n k, 299 | mod2 (n + 2 * k) = mod2 n. 300 | Proof. 301 | intros. 302 | induction n. 303 | simpl. 304 | rewrite Nat.add_0_r. 305 | replace (k + k) with (2 * k) by lia. 306 | apply mod2_double. 307 | replace (S n + 2 * k) with (S (n + 2 * k)) by lia. 308 | apply mod2_S_eq; auto. 309 | Qed. 310 | 311 | Lemma mod2sub: forall a b, 312 | b <= a -> 313 | mod2 (a - b) = xorb (mod2 a) (mod2 b). 314 | Proof. 315 | intros. remember (a - b) as c. revert dependent b. revert a. revert c. 316 | change (forall c, 317 | (fun c => forall a b, b <= a -> c = a - b -> mod2 c = xorb (mod2 a) (mod2 b)) c). 318 | apply strong. 319 | intros c IH a b AB N. 320 | destruct c. 321 | - assert (a=b) by lia. subst. rewrite Bool.xorb_nilpotent. reflexivity. 322 | - destruct c. 323 | + assert (a = S b) by lia. subst a. simpl (mod2 1). rewrite mod2_S_not. 324 | destruct (mod2 b); reflexivity. 325 | + destruct a; [lia|]. 326 | destruct a; [lia|]. 327 | simpl. 328 | apply IH; lia. 329 | Qed. 330 | 331 | Theorem mod2_pow2_twice: forall n, 332 | mod2 (pow2 n + (pow2 n + 0)) = false. 333 | Proof. 334 | intros. 335 | replace (pow2 n + (pow2 n + 0)) with (2 * pow2 n) by lia. 336 | apply mod2_double. 337 | Qed. 338 | 339 | Theorem div2_plus_2 : forall n k, 340 | div2 (n + 2 * k) = div2 n + k. 341 | Proof. 342 | induction n; intros. 343 | simpl. 344 | rewrite Nat.add_0_r. 345 | replace (k + k) with (2 * k) by lia. 346 | apply div2_double. 347 | replace (S n + 2 * k) with (S (n + 2 * k)) by lia. 348 | destruct (Even_Odd_dec n). 349 | - rewrite <- Even_div2. 350 | rewrite <- Even_div2 by auto. 351 | apply IHn. 352 | apply Even_Even_add; auto. 353 | apply Even_mul_l. now exists 1. 354 | - rewrite <- Odd_div2. 355 | rewrite <- Odd_div2 by auto. 356 | rewrite IHn. 357 | lia. 358 | apply Odd_add_l; auto. 359 | now exists k. 360 | Qed. 361 | 362 | Lemma pred_add: 363 | forall n, n <> 0 -> pred n + 1 = n. 364 | Proof. 365 | intros n Hn. rewrite add_1_r. exact (succ_pred n Hn). 366 | Qed. 367 | 368 | Lemma pow2_zero: forall sz, (pow2 sz > 0)%nat. 369 | Proof. 370 | induction sz; simpl; auto; lia. 371 | Qed. 372 | 373 | Theorem Npow2_nat : forall n, nat_of_N (Npow2 n) = pow2 n. 374 | induction n as [|n IHn]; simpl; intuition. 375 | rewrite <- IHn; clear IHn. 376 | case_eq (Npow2 n); intuition; zify; intuition. 377 | Qed. 378 | 379 | Theorem pow2_N : forall n, Npow2 n = N.of_nat (pow2 n). 380 | Proof. 381 | intro n. apply nat_of_N_eq. rewrite Nat2N.id. apply Npow2_nat. 382 | Qed. 383 | 384 | Lemma Z_of_N_Npow2: forall n, Z.of_N (Npow2 n) = (2 ^ Z.of_nat n)%Z. 385 | Proof. 386 | intros. 387 | rewrite pow2_N. 388 | rewrite nat_N_Z. 389 | rewrite Nat2Z.inj_pow. 390 | reflexivity. 391 | Qed. 392 | 393 | Lemma pow2_S_z: 394 | forall n, Z.of_nat (pow2 (S n)) = (2 * Z.of_nat (pow2 n))%Z. 395 | Proof. 396 | intros. 397 | replace (2 * Z.of_nat (pow2 n))%Z with 398 | (Z.of_nat (pow2 n) + Z.of_nat (pow2 n))%Z by lia. 399 | simpl. 400 | repeat rewrite Nat2Z.inj_add. 401 | ring. 402 | Qed. 403 | 404 | Lemma pow2_le: 405 | forall n m, (n <= m)%nat -> (pow2 n <= pow2 m)%nat. 406 | Proof. 407 | intros. 408 | assert (exists s, n + s = m) by (exists (m - n); lia). 409 | destruct H0; subst. 410 | rewrite pow2_add_mul. 411 | pose proof (pow2_zero x). 412 | replace (pow2 n) with (pow2 n * 1) at 1 by lia. 413 | apply mul_le_mono_l. 414 | lia. 415 | Qed. 416 | 417 | Lemma Zabs_of_nat: 418 | forall n, Z.abs (Z.of_nat n) = Z.of_nat n. 419 | Proof. 420 | unfold Z.of_nat; intros. 421 | destruct n; auto. 422 | Qed. 423 | 424 | Lemma Npow2_not_zero: 425 | forall n, Npow2 n <> 0%N. 426 | Proof. 427 | induction n; simpl; intros; [discriminate|]. 428 | destruct (Npow2 n); auto. 429 | discriminate. 430 | Qed. 431 | 432 | Lemma Npow2_S: 433 | forall n, Npow2 (S n) = (Npow2 n + Npow2 n)%N. 434 | Proof. 435 | simpl; intros. 436 | destruct (Npow2 n); auto. 437 | rewrite <-Pos.add_diag. 438 | reflexivity. 439 | Qed. 440 | 441 | Lemma Npow2_pos: forall a, 442 | (0 < Npow2 a)%N. 443 | Proof. 444 | intros. 445 | destruct (Npow2 a) eqn: E. 446 | - exfalso. apply (Npow2_not_zero a). assumption. 447 | - constructor. 448 | Qed. 449 | 450 | Lemma minus_minus: forall a b c, 451 | c <= b <= a -> 452 | a - (b - c) = a - b + c. 453 | Proof. intros. lia. Qed. 454 | 455 | Lemma even_odd_destruct: forall n, 456 | (exists a, n = 2 * a) \/ (exists a, n = 2 * a + 1). 457 | Proof. 458 | induction n. 459 | - left. exists 0. reflexivity. 460 | - destruct IHn as [[a E] | [a E]]. 461 | + right. exists a. lia. 462 | + left. exists (S a). lia. 463 | Qed. 464 | 465 | Lemma mul_div_undo: forall i c, 466 | c <> 0 -> 467 | c * i / c = i. 468 | Proof. 469 | intros. 470 | pose proof (Nat.div_mul_cancel_l i 1 c) as P. 471 | rewrite Nat.div_1_r in P. 472 | rewrite Nat.mul_1_r in P. 473 | apply P; auto. 474 | Qed. 475 | 476 | Lemma mod_add_r: forall a b, 477 | b <> 0 -> 478 | (a + b) mod b = a mod b. 479 | Proof. 480 | intros. rewrite <- Nat.add_mod_idemp_r by lia. 481 | rewrite Nat.mod_same by lia. 482 | rewrite Nat.add_0_r. 483 | reflexivity. 484 | Qed. 485 | 486 | Lemma mod2_cases: forall (n: nat), n mod 2 = 0 \/ n mod 2 = 1. 487 | Proof. 488 | intros. 489 | assert (n mod 2 < 2). { 490 | apply Nat.mod_upper_bound. congruence. 491 | } 492 | lia. 493 | Qed. 494 | 495 | Lemma div_mul_undo: forall a b, 496 | b <> 0 -> 497 | a mod b = 0 -> 498 | a / b * b = a. 499 | Proof. 500 | intros. 501 | pose proof Nat.div_mul_cancel_l as A. specialize (A a 1 b). 502 | replace (b * 1) with b in A by lia. 503 | rewrite Nat.div_1_r in A. 504 | rewrite mul_comm. 505 | rewrite <- Nat.divide_div_mul_exact; try assumption. 506 | - apply A; congruence. 507 | - apply Nat.mod_divide; assumption. 508 | Qed. 509 | 510 | Lemma Smod2_1: forall k, S k mod 2 = 1 -> k mod 2 = 0. 511 | Proof. 512 | intros k C. 513 | change (S k) with (1 + k) in C. 514 | rewrite Nat.add_mod in C by congruence. 515 | pose proof (Nat.mod_upper_bound k 2). 516 | assert (k mod 2 = 0 \/ k mod 2 = 1) as E by lia. 517 | destruct E as [E | E]; [assumption|]. 518 | rewrite E in C. simpl in C. discriminate. 519 | Qed. 520 | 521 | Lemma mod_0_r: forall (m: nat), 522 | m mod 0 = match (1 mod 0) with | 0 => 0 | _ => m end. 523 | Proof. 524 | intros. reflexivity. 525 | Qed. 526 | 527 | Lemma sub_mod_0: forall (a b m: nat), 528 | a mod m = 0 -> 529 | b mod m = 0 -> 530 | (a - b) mod m = 0. 531 | Proof. 532 | intros. assert (m = 0 \/ m <> 0) as C by lia. destruct C as [C | C]. 533 | - subst. rewrite mod_0_r in *. simpl in *. now subst. 534 | - assert (a - b = 0 \/ b < a) as D by lia. destruct D as [D | D]. 535 | + rewrite D. apply Nat.mod_0_l. assumption. 536 | + apply Nat2Z.inj. 537 | rewrite Nat2Z.inj_mod. 538 | rewrite Nat2Z.inj_sub by lia. 539 | rewrite Zdiv.Zminus_mod. 540 | rewrite <-! Nat2Z.inj_mod. 541 | rewrite H. rewrite H0. 542 | apply Z.mod_0_l. 543 | lia. 544 | Qed. 545 | 546 | Lemma mul_div_exact: forall (a b: nat), 547 | b <> 0 -> 548 | a mod b = 0 -> 549 | b * (a / b) = a. 550 | Proof. 551 | intros. edestruct Nat.div_exact as [_ P]; [eassumption|]. 552 | specialize (P H0). symmetry. exact P. 553 | Qed. 554 | -------------------------------------------------------------------------------- /src/bbv/Nomega.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | (* Make [lia] work for [N] *) 3 | 4 | Require Import Coq.Bool.Bool Coq.Classes.Morphisms. 5 | Require Import Coq.Arith.Arith Coq.micromega.Lia Coq.NArith.NArith. 6 | Require Import Coq.ZArith.ZArith. 7 | 8 | Local Open Scope N_scope. 9 | 10 | Hint Rewrite Nplus_0_r nat_of_Nsucc nat_of_Nplus nat_of_Nminus 11 | N_of_nat_of_N nat_of_N_of_nat 12 | nat_of_P_o_P_of_succ_nat_eq_succ nat_of_P_succ_morphism : N. 13 | 14 | Theorem nat_of_N_eq : forall n m, 15 | nat_of_N n = nat_of_N m 16 | -> n = m. 17 | intros ? ? H; apply (f_equal N_of_nat) in H; 18 | autorewrite with N in *; assumption. 19 | Qed. 20 | 21 | Theorem Nneq_in : forall n m, 22 | nat_of_N n <> nat_of_N m 23 | -> n <> m. 24 | congruence. 25 | Qed. 26 | 27 | Theorem Nneq_out : forall n m, 28 | n <> m 29 | -> nat_of_N n <> nat_of_N m. 30 | intuition; zify; intuition. 31 | Qed. 32 | 33 | Theorem Nlt_out : forall n m, n < m 34 | -> (nat_of_N n < nat_of_N m)%nat. 35 | unfold N.lt; intros ?? H. 36 | rewrite nat_of_Ncompare in H. 37 | apply nat_compare_Lt_lt; assumption. 38 | Qed. 39 | 40 | Theorem Nlt_in : forall n m, (nat_of_N n < nat_of_N m)%nat 41 | -> n < m. 42 | unfold N.lt; intros. 43 | rewrite nat_of_Ncompare. 44 | apply (proj1 (nat_compare_lt _ _)); assumption. 45 | Qed. 46 | 47 | Theorem Nge_out : forall n m, n >= m 48 | -> (nat_of_N n >= nat_of_N m)%nat. 49 | unfold N.ge; intros ?? H. 50 | rewrite nat_of_Ncompare in H. 51 | apply nat_compare_ge; assumption. 52 | Qed. 53 | 54 | Theorem Nge_in : forall n m, (nat_of_N n >= nat_of_N m)%nat 55 | -> n >= m. 56 | unfold N.ge; intros. 57 | rewrite nat_of_Ncompare. 58 | apply nat_compare_ge; assumption. 59 | Qed. 60 | 61 | Ltac nsimp H := simpl in H; repeat progress (autorewrite with N in H; simpl in H). 62 | 63 | Ltac pre_nomega := 64 | try (apply nat_of_N_eq || apply Nneq_in || apply Nlt_in || apply Nge_in); simpl; 65 | repeat (progress autorewrite with N; simpl); 66 | repeat match goal with 67 | | [ H : _ <> _ |- _ ] => apply Nneq_out in H; nsimp H 68 | | [ H : _ = _ -> False |- _ ] => apply Nneq_out in H; nsimp H 69 | | [ H : _ |- _ ] => (apply (f_equal nat_of_N) in H 70 | || apply Nlt_out in H || apply Nge_out in H); nsimp H 71 | end. 72 | 73 | Ltac nomega := pre_nomega; lia || (unfold nat_of_P in *; simpl in *; lia). 74 | -------------------------------------------------------------------------------- /src/bbv/ReservedNotations.v: -------------------------------------------------------------------------------- 1 | Set Loose Hint Behavior "Strict". 2 | Reserved Notation "'Ob' a" (at level 50). 3 | Reserved Notation "'Ox' a" (at level 50). 4 | Reserved Notation "sz ''h' a" (at level 50). 5 | Reserved Notation "'Ox' a" (at level 50). 6 | Reserved Notation "l ^+ r" (at level 50, left associativity). 7 | Reserved Notation "l ^* r" (at level 40, left associativity). 8 | Reserved Notation "l ^- r" (at level 50, left associativity). 9 | Reserved Notation "l ^/ r" (at level 50, left associativity). 10 | Reserved Notation "l ^% r" (at level 50, left associativity). 11 | Reserved Notation "l ^| r" (at level 50, left associativity). 12 | Reserved Notation "l ^& r" (at level 40, left associativity). 13 | Reserved Notation "w1 '>s' w2" (at level 70, w2 at next level). 14 | Reserved Notation "w1 '>s=' w2" (at level 70, w2 at next level). 15 | Reserved Notation "w1 ' 0 -> 18 | a mod b = 0 -> 19 | a / b * b = a. 20 | Proof. 21 | intros. 22 | pose proof Z.div_mul_cancel_l as A. specialize (A a 1 b). 23 | replace (b * 1) with b in A by lia. 24 | rewrite Z.div_1_r in A. 25 | rewrite Z.mul_comm. 26 | rewrite <- Z.divide_div_mul_exact; try assumption. 27 | - apply A; congruence. 28 | - apply Z.mod_divide; assumption. 29 | Qed. 30 | 31 | Lemma mod_0_r: forall (m: Z), 32 | m mod 0 = match (1 mod 0) with | 0 => 0 | _ => m end. 33 | Proof. 34 | intros. destruct m; reflexivity. 35 | Qed. 36 | 37 | Lemma sub_mod_0: forall (a b m: Z), 38 | a mod m = 0 -> 39 | b mod m = 0 -> 40 | (a - b) mod m = 0. 41 | Proof. 42 | intros *. intros E1 E2. 43 | rewrite Zminus_mod. 44 | rewrite E1. rewrite E2. 45 | reflexivity. 46 | Qed. 47 | 48 | Lemma add_mod_0: forall a b m : Z, 49 | a mod m = 0 -> 50 | b mod m = 0 -> 51 | (a + b) mod m = 0. 52 | Proof. 53 | intros *. intros E1 E2. 54 | rewrite Zplus_mod. 55 | rewrite E1. rewrite E2. 56 | reflexivity. 57 | Qed. 58 | 59 | Lemma Z_mod_mult': forall a b : Z, 60 | (a * b) mod a = 0. 61 | Proof. 62 | intros. rewrite Z.mul_comm. apply Z_mod_mult. 63 | Qed. 64 | 65 | Lemma mod_add_r: forall a b, 66 | b <> 0 -> 67 | (a + b) mod b = a mod b. 68 | Proof. 69 | intros. rewrite <- Z.add_mod_idemp_r by lia. 70 | rewrite Z.mod_same by lia. 71 | rewrite Z.add_0_r. 72 | reflexivity. 73 | Qed. 74 | 75 | Lemma mod_pow2_same_cases: forall a n, 76 | a mod 2 ^ n = a -> 77 | 2 ^ n = 0 \/ 0 <= a < 2 ^ n. 78 | Proof. 79 | intros. 80 | assert (n < 0 \/ 0 <= n) as C by lia. destruct C as [C | C]. 81 | - left. rewrite (Z.pow_neg_r 2 n C) in *. rewrite mod_0_r in H. auto. 82 | - right. 83 | rewrite <- H. apply Z.mod_pos_bound. 84 | apply Z.pow_pos_nonneg; lia. 85 | Qed. 86 | 87 | Lemma mod_pow2_same_bounds: forall a n, 88 | a mod 2 ^ n = a -> 89 | 0 <= n -> 90 | 0 <= a < 2 ^ n. 91 | Proof. 92 | intros. rewrite <- H. apply Z.mod_pos_bound. 93 | apply Z.pow_pos_nonneg; lia. 94 | Qed. 95 | 96 | Lemma pow2_nonneg: forall n, 97 | 0 <= 2 ^ n. 98 | Proof. 99 | intros. apply Z.pow_nonneg. lia. 100 | Qed. 101 | 102 | Lemma pow2_pos: forall n, 103 | 0 <= n -> 104 | 0 < 2 ^ n. 105 | Proof. 106 | intros. apply Z.pow_pos_nonneg; lia. 107 | Qed. 108 | 109 | Lemma pow2_times2: forall i, 110 | 0 < i -> 111 | 2 ^ i = 2 * 2 ^ (i - 1). 112 | Proof. 113 | intros. 114 | rewrite <- Z.pow_succ_r by lia. 115 | f_equal. 116 | lia. 117 | Qed. 118 | 119 | Lemma pow2_div2: forall i, 120 | 0 <= i -> 121 | 2 ^ (i - 1) = 2 ^ i / 2. 122 | Proof. 123 | intros. 124 | assert (i = 0 \/ 0 < i) as C by lia. destruct C as [C | C]. 125 | - subst. reflexivity. 126 | - rewrite Z.pow_sub_r by lia. 127 | reflexivity. 128 | Qed. 129 | 130 | Lemma div_mul_undo_le: forall a b, 131 | 0 <= a -> 132 | 0 < b -> 133 | a / b * b <= a. 134 | Proof. 135 | intros. 136 | pose proof (Zmod_eq_full a b) as P. 137 | pose proof (Z.mod_bound_pos a b) as Q. 138 | lia. 139 | Qed. 140 | 141 | Lemma testbit_true_nonneg: forall a i, 142 | 0 <= a -> 143 | 0 <= i -> 144 | Z.testbit a i = true -> 145 | 2 ^ i <= a. 146 | Proof. 147 | intros. 148 | apply Z.testbit_true in H1; [|assumption]. 149 | pose proof (pow2_pos i H0). 150 | eapply Z.le_trans; [| apply (div_mul_undo_le a (2 ^ i)); lia]. 151 | replace (2 ^ i) with (1 * 2 ^ i) at 1 by lia. 152 | apply Z.mul_le_mono_nonneg_r; [lia|]. 153 | pose proof (Z.div_pos a (2 ^ i)). 154 | assert (a / 2 ^ i <> 0); [|lia]. 155 | intro E. rewrite E in H1. cbv in H1. discriminate H1. 156 | Qed. 157 | 158 | Lemma range_div_pos: forall a b c d, 159 | 0 < d -> 160 | a <= b <= c -> 161 | a / d <= b / d <= c / d. 162 | Proof. 163 | intuition idtac. 164 | - apply (Z.div_le_mono _ _ _ H H1). 165 | - apply (Z.div_le_mono _ _ _ H H2). 166 | Qed. 167 | 168 | Lemma testbit_true_nonneg': forall a i, 169 | 0 <= i -> 170 | 2 ^ i <= a < 2 ^ (i + 1) -> 171 | Z.testbit a i = true. 172 | Proof. 173 | intros. 174 | apply Z.testbit_true; [assumption|]. 175 | destruct H0 as [A B]. 176 | pose proof (pow2_pos i H) as Q. 177 | apply (Z.div_le_mono _ _ _ Q) in A. 178 | rewrite Z_div_same in A by lia. 179 | pose proof (Z.div_lt_upper_bound a (2 ^ i) 2 Q) as P. 180 | rewrite Z.mul_comm in P. 181 | replace i with (i + 1 - 1) in P by lia. 182 | rewrite <- pow2_times2 in P by lia. 183 | specialize (P B). 184 | replace (i + 1 - 1) with i in P by lia. 185 | replace (a / 2 ^ i) with 1 by lia. 186 | reflexivity. 187 | Qed. 188 | 189 | Lemma testbit_false_nonneg: forall a i, 190 | 0 <= a < 2 ^ i -> 191 | 0 < i -> 192 | Z.testbit a (i - 1) = false -> 193 | a < 2 ^ (i - 1). 194 | Proof. 195 | intros. 196 | assert (2 ^ (i - 1) <= a < 2 ^ i \/ a < 2 ^ (i - 1)) as C by lia. 197 | destruct C as [C | C]; [exfalso|assumption]. 198 | assert (Z.testbit a (i - 1) = true); [|congruence]. 199 | replace i with (i - 1 + 1) in C at 2 by lia. 200 | apply testbit_true_nonneg'; lia. 201 | Qed. 202 | 203 | Lemma signed_bounds_to_sz_pos: forall sz n, 204 | - 2 ^ (sz - 1) <= n < 2 ^ (sz - 1) -> 205 | 0 < sz. 206 | Proof. 207 | intros. 208 | assert (0 < sz \/ sz - 1 < 0) as C by lia. 209 | destruct C as [C | C]; [assumption|exfalso]. 210 | rewrite Z.pow_neg_r in H by assumption. 211 | lia. 212 | Qed. 213 | 214 | Lemma two_digits_encoding_inj_lo: forall base a b c d: Z, 215 | 0 <= b < base -> 216 | 0 <= d < base -> 217 | base * a + b = base * c + d -> 218 | b = d. 219 | Proof. 220 | intros. 221 | pose proof Z.mod_unique as P. 222 | specialize P with (b := base) (q := c) (r := d). 223 | specialize P with (2 := H1). 224 | rewrite P by lia. 225 | rewrite <- Z.add_mod_idemp_l by lia. 226 | rewrite Z.mul_comm. 227 | rewrite Z.mod_mul by lia. 228 | rewrite Z.add_0_l. 229 | rewrite Z.mod_small by lia. 230 | reflexivity. 231 | Qed. 232 | 233 | Lemma two_digits_encoding_inj_hi: forall base a b c d: Z, 234 | 0 <= b < base -> 235 | 0 <= d < base -> 236 | base * a + b = base * c + d -> 237 | a = c. 238 | Proof. 239 | intros. nia. 240 | Qed. 241 | 242 | Lemma Z_to_nat_neg: forall (n: Z), 243 | n < 0 -> 244 | Z.to_nat n = 0%nat. 245 | Proof. 246 | intros. destruct n; (lia||reflexivity). 247 | Qed. 248 | --------------------------------------------------------------------------------